This queue is for tickets about the Cache-Cache CPAN distribution.

Report information
The Basics
Id:
112967
Status:
open
Priority:
Low/Low
Queue:

People
Owner:
Nobody in particular
Requestors:
ether [...] cpan.org
Cc:
AdminCc:

BugTracker
Severity:
(no value)
Broken in:
(no value)
Fixed in:
(no value)



Subject: Digest::SHA1 -> Digest::SHA
Digest::SHA is in core and should be used preferentially over Digest::SHA1.
Am Sa 12. Mär 2016, 21:33:43, ETHER schrieb:
Show quoted text
> Digest::SHA is in core and should be used preferentially over Digest::SHA1.
+1 This would be really great and only two lines have to be changed: in Makefile.PL line 14: Change 'Digest::SHA1' in 'Digest::SHA' and do the same in the File lib/Cache/FileBackend.pm in line 15. I know Cache::Cache is no longer actively developed. But this is really such a minimal change at has such a huge effect. You then wouldn't need a compiler any more (which is important e.g. in some CGI/Web context). An advantage also compared to CHI!!! In the meantime I saw that Cache also seems not to need a compiler. For easier implementation you find the two files attached. Thanks a lot for all your great work!!!
Subject: FileBackend.pm
###################################################################### # $Id: FileBackend.pm,v 1.27 2005/03/17 19:31:27 dclinton Exp $ # Copyright (C) 2001-2003 DeWitt Clinton All Rights Reserved # # Software distributed under the License is distributed on an "AS # IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or # implied. See the License for the specific language governing # rights and limitations under the License. ###################################################################### package Cache::FileBackend; use strict; use Cache::CacheUtils qw( Assert_Defined Build_Path Freeze_Data Thaw_Data ); use Digest::SHA qw( sha1_hex ); use Error; use File::Path qw( mkpath ); use File::Temp qw( tempfile ); # the file mode for new directories, which will be modified by the # current umask my $DIRECTORY_MODE = 0777; # regex for untainting directory and file paths. since all paths are # generated by us or come from user via API, a tautological regex # suffices. my $UNTAINTED_PATH_REGEX = '^(.*)$'; sub new { my ( $proto, $p_root, $p_depth, $p_directory_umask ) = @_; my $class = ref( $proto ) || $proto; my $self = {}; $self = bless( $self, $class ); $self->set_root( $p_root ); $self->set_depth( $p_depth ); $self->set_directory_umask( $p_directory_umask ); return $self; } sub delete_key { my ( $self, $p_namespace, $p_key ) = @_; Assert_Defined( $p_namespace ); Assert_Defined( $p_key ); _Remove_File( $self->_path_to_key( $p_namespace, $p_key ) ); } sub delete_namespace { my ( $self, $p_namespace ) = @_; Assert_Defined( $p_namespace ); _Recursively_Remove_Directory( Build_Path( $self->get_root( ), $p_namespace ) ); } sub get_keys { my ( $self, $p_namespace ) = @_; Assert_Defined( $p_namespace ); my @keys; foreach my $unique_key ( $self->_get_unique_keys( $p_namespace ) ) { my $key = $self->_get_key_for_unique_key( $p_namespace, $unique_key ) or next; push( @keys, $key ); } return @keys; } sub get_namespaces { my ( $self ) = @_; my @namespaces; _List_Subdirectories( $self->get_root( ), \@namespaces ); return @namespaces; } sub get_size { my ( $self, $p_namespace, $p_key ) = @_; Assert_Defined( $p_namespace ); Assert_Defined( $p_key ); if ( -e $self->_path_to_key( $p_namespace, $p_key ) ) { return -s $self->_path_to_key( $p_namespace, $p_key ); } else { return 0; } } sub restore { my ( $self, $p_namespace, $p_key ) = @_; Assert_Defined( $p_namespace ); Assert_Defined( $p_key ); return $self->_read_data( $self->_path_to_key($p_namespace, $p_key) )->[1]; } sub store { my ( $self, $p_namespace, $p_key, $p_data ) = @_; Assert_Defined( $p_namespace ); Assert_Defined( $p_key ); $self->_write_data( $self->_path_to_key( $p_namespace, $p_key ), [ $p_key, $p_data ] ); } sub get_depth { my ( $self ) = @_; return $self->{_Depth}; } sub set_depth { my ( $self, $depth ) = @_; $self->{_Depth} = $depth; } sub get_root { my ( $self ) = @_; return $self->{_Root}; } sub set_root { my ( $self, $root ) = @_; $self->{_Root} = $root; } sub get_directory_umask { my ( $self ) = @_; return $self->{_Directory_Umask}; } sub set_directory_umask { my ( $self, $directory_umask ) = @_; $self->{_Directory_Umask} = $directory_umask; } # Take an human readable key, and create a unique key from it sub _Build_Unique_Key { my ( $p_key ) = @_; Assert_Defined( $p_key ); return sha1_hex( $p_key ); } # create a directory with optional mask, building subdirectories as # needed. sub _Create_Directory { my ( $p_directory, $p_optional_new_umask ) = @_; Assert_Defined( $p_directory ); my $old_umask = umask( ) if defined $p_optional_new_umask; umask( $p_optional_new_umask ) if defined $p_optional_new_umask; my $directory = _Untaint_Path( $p_directory ); $directory =~ s|/$||; mkpath( $directory, 0, $DIRECTORY_MODE ); -d $directory or throw Error::Simple( "Couldn't create directory: $directory: $!" ); umask( $old_umask ) if defined $old_umask; } # list the names of the subdirectories in a given directory, without the # full path sub _List_Subdirectories { my ( $p_directory, $p_subdirectories_ref ) = @_; foreach my $dirent ( _Read_Dirents( $p_directory ) ) { next if $dirent eq '.' or $dirent eq '..'; my $path = Build_Path( $p_directory, $dirent ); next unless -d $path; push( @$p_subdirectories_ref, $dirent ); } } # read the dirents from a directory sub _Read_Dirents { my ( $p_directory ) = @_; Assert_Defined( $p_directory ); -d $p_directory or return ( ); local *Dir; opendir( Dir, _Untaint_Path( $p_directory ) ) or throw Error::Simple( "Couldn't open directory $p_directory: $!" ); my @dirents = readdir( Dir ); closedir( Dir ) or throw Error::Simple( "Couldn't close directory $p_directory: $!" ); return @dirents; } # read in a file. returns a reference to the data read sub _Read_File { my ( $p_path ) = @_; Assert_Defined( $p_path ); local *File; open( File, _Untaint_Path( $p_path ) ) or return undef; binmode( File ); local $/ = undef; my $data_ref; $$data_ref = <File>; close( File ); return $data_ref; } # read in a file. returns a reference to the data read, without # modifying the last accessed time sub _Read_File_Without_Time_Modification { my ( $p_path ) = @_; Assert_Defined( $p_path ); -e $p_path or return undef; my ( $file_access_time, $file_modified_time ) = ( stat( _Untaint_Path( $p_path ) ) )[8,9]; my $data_ref = _Read_File( $p_path ); utime( $file_access_time, $file_modified_time, _Untaint_Path( $p_path ) ); return $data_ref; } # remove a file sub _Remove_File { my ( $p_path ) = @_; Assert_Defined( $p_path ); if ( -f _Untaint_Path( $p_path ) ) { # We don't catch the error, because this may fail if two # processes are in a race and try to remove the object unlink( _Untaint_Path( $p_path ) ); } } # remove a directory sub _Remove_Directory { my ( $p_directory ) = @_; Assert_Defined( $p_directory ); if ( -d _Untaint_Path( $p_directory ) ) { # We don't catch the error, because this may fail if two # processes are in a race and try to remove the object rmdir( _Untaint_Path( $p_directory ) ); } } # recursively list the files of the subdirectories, without the full paths sub _Recursively_List_Files { my ( $p_directory, $p_files_ref ) = @_; return unless -d $p_directory; foreach my $dirent ( _Read_Dirents( $p_directory ) ) { next if $dirent eq '.' or $dirent eq '..'; my $path = Build_Path( $p_directory, $dirent ); if ( -d $path ) { _Recursively_List_Files( $path, $p_files_ref ); } else { push( @$p_files_ref, $dirent ); } } } # recursively list the files of the subdirectories, with the full paths sub _Recursively_List_Files_With_Paths { my ( $p_directory, $p_files_ref ) = @_; foreach my $dirent ( _Read_Dirents( $p_directory ) ) { next if $dirent eq '.' or $dirent eq '..'; my $path = Build_Path( $p_directory, $dirent ); if ( -d $path ) { _Recursively_List_Files_With_Paths( $path, $p_files_ref ); } else { push( @$p_files_ref, $path ); } } } # remove a directory and all subdirectories and files sub _Recursively_Remove_Directory { my ( $p_root ) = @_; return unless -d $p_root; foreach my $dirent ( _Read_Dirents( $p_root ) ) { next if $dirent eq '.' or $dirent eq '..'; my $path = Build_Path( $p_root, $dirent ); if ( -d $path ) { _Recursively_Remove_Directory( $path ); } else { _Remove_File( _Untaint_Path( $path ) ); } } _Remove_Directory( _Untaint_Path( $p_root ) ); } # walk down a directory structure and total the size of the files # contained therein. sub _Recursive_Directory_Size { my ( $p_directory ) = @_; Assert_Defined( $p_directory ); return 0 unless -d $p_directory; my $size = 0; foreach my $dirent ( _Read_Dirents( $p_directory ) ) { next if $dirent eq '.' or $dirent eq '..'; my $path = Build_Path( $p_directory, $dirent ); if ( -d $path ) { $size += _Recursive_Directory_Size( $path ); } else { $size += -s $path; } } return $size; } # Untaint a file path sub _Untaint_Path { my ( $p_path ) = @_; return _Untaint_String( $p_path, $UNTAINTED_PATH_REGEX ); } # Untaint a string sub _Untaint_String { my ( $p_string, $p_untainted_regex ) = @_; Assert_Defined( $p_string ); Assert_Defined( $p_untainted_regex ); my ( $untainted_string ) = $p_string =~ /$p_untainted_regex/; if ( not defined $untainted_string || $untainted_string ne $p_string ) { throw Error::Simple( "String $p_string contains possible taint" ); } return $untainted_string; } # create a directory with the optional umask if it doesn't already # exist sub _Make_Path { my ( $p_path, $p_optional_new_umask ) = @_; my ( $volume, $directory, $filename ) = File::Spec->splitpath( $p_path ); if ( defined $directory and defined $volume ) { $directory = File::Spec->catpath( $volume, $directory, "" ); } if ( defined $directory and not -d $directory ) { _Create_Directory( $directory, $p_optional_new_umask ); } } # return a list of the first $depth letters in the $word sub _Split_Word { my ( $p_word, $p_depth ) = @_; Assert_Defined( $p_word ); Assert_Defined( $p_depth ); my @split_word_list; for ( my $i = 0; $i < $p_depth; $i++ ) { push ( @split_word_list, substr( $p_word, $i, 1 ) ); } return @split_word_list; } # write a file atomically sub _Write_File { my ( $p_path, $p_data_ref, $p_optional_mode, $p_optional_umask ) = @_; Assert_Defined( $p_path ); Assert_Defined( $p_data_ref ); my $old_umask = umask if $p_optional_umask; umask( $p_optional_umask ) if $p_optional_umask; my ( $volume, $directory, $filename ) = File::Spec->splitpath( $p_path ); if ( defined $directory and defined $volume ) { $directory = File::Spec->catpath( $volume, $directory, "" ); } my ( $temp_fh, $temp_filename ) = tempfile( DIR => $directory ); binmode( $temp_fh ); print $temp_fh $$p_data_ref; close( $temp_fh ); -e $temp_filename or throw Error::Simple( "Temp file '$temp_filename' does not exist: $!" ); rename( $temp_filename, _Untaint_Path( $p_path ) ) or throw Error::Simple( "Couldn't rename $temp_filename to $p_path: $!" ); if ( -e $temp_filename ) { _Remove_File( $temp_filename ); warn( "Temp file '$temp_filename' shouldn't still exist" ); } $p_optional_mode ||= 0666 - umask( ); chmod( $p_optional_mode, _Untaint_Path($p_path) ); umask( $old_umask ) if $old_umask; } sub _get_key_for_unique_key { my ( $self, $p_namespace, $p_unique_key ) = @_; return $self->_read_data( $self->_path_to_unique_key( $p_namespace, $p_unique_key ) )->[0]; } sub _get_unique_keys { my ( $self, $p_namespace ) = @_; Assert_Defined( $p_namespace ); my @unique_keys; _Recursively_List_Files( Build_Path( $self->get_root( ), $p_namespace ), \@unique_keys ); return @unique_keys; } sub _path_to_key { my ( $self, $p_namespace, $p_key ) = @_; Assert_Defined( $p_namespace ); Assert_Defined( $p_key ); return $self->_path_to_unique_key( $p_namespace, _Build_Unique_Key( $p_key ) ); } sub _path_to_unique_key { my ( $self, $p_namespace, $p_unique_key ) = @_; Assert_Defined( $p_unique_key ); Assert_Defined( $p_namespace ); return Build_Path( $self->get_root( ), $p_namespace, _Split_Word( $p_unique_key, $self->get_depth( ) ), $p_unique_key ); } # the data is returned as reference to an array ( key, data ) sub _read_data { my ( $self, $p_path ) = @_; Assert_Defined( $p_path ); my $frozen_data_ref = _Read_File_Without_Time_Modification( $p_path ) or return [ undef, undef ]; my $data_ref = eval{ Thaw_Data( $$frozen_data_ref ) }; if ( $@ || ( ref( $data_ref ) ne 'ARRAY' ) ) { unlink _Untaint_Path( $p_path ); return [ undef, undef ]; } else { return $data_ref; } } # the data is passed as reference to an array ( key, data ) sub _write_data { my ( $self, $p_path, $p_data ) = @_; Assert_Defined( $p_path ); Assert_Defined( $p_data ); _Make_Path( $p_path, $self->get_directory_umask( ) ); my $frozen_file = Freeze_Data( $p_data ); _Write_File( $p_path, \$frozen_file ); } 1; __END__ =pod =head1 NAME Cache::FileBackend -- a filesystem based persistence mechanism =head1 DESCRIPTION The FileBackend class is used to persist data to the filesystem =head1 SYNOPSIS my $backend = new Cache::FileBackend( '/tmp/FileCache', 3, 000 ); See Cache::Backend for the usage synopsis. $backend->store( 'namespace', 'foo', 'bar' ); my $bar = $backend->restore( 'namespace', 'foo' ); my $size_of_bar = $backend->get_size( 'namespace', 'foo' ); foreach my $key ( $backend->get_keys( 'namespace' ) ) { $backend->delete_key( 'namespace', $key ); } foreach my $namespace ( $backend->get_namespaces( ) ) { $backend->delete_namespace( $namespace ); } =head1 METHODS See Cache::Backend for the API documentation. =over =item B<new( $root, $depth, $directory_umask )> Construct a new FileBackend that writes data to the I<$root> directory, automatically creates subdirectories I<$depth> levels deep, and uses the umask of I<$directory_umask> when creating directories. =back =head1 PROPERTIES =over =item B<(get|set)_root> The location of the parent directory in which to store the files =item B<(get|set)_depth> The branching factor of the subdirectories created to store the files =item B<(get|set)_directory_umask> The umask to be used when creating directories =back =head1 SEE ALSO Cache::Backend, Cache::MemoryBackend, Cache::SharedMemoryBackend =head1 AUTHOR Original author: DeWitt Clinton <dewitt@unto.net> Last author: $Author: dclinton $ Copyright (C) 2001-2003 DeWitt Clinton =cut
Subject: Makefile.PL
use strict; use ExtUtils::MakeMaker; ## # Constants ## my $NAME = 'Cache::Cache'; my $VERSION_FROM = 'lib/Cache/Cache.pm'; my $COMPRESS = 'gzip'; my $SUFFIX = '.gz'; my $DEFAULT_PREREQ_PM = { 'Digest::SHA' => '0', 'File::Spec' => '0.82', 'Storable' => '1.014', 'IPC::ShareLite' => '0.09', 'Error' => '0.15' }; my @NON_IPC_TESTS = ( 't/1_test_cache_interface.t', 't/2_test_memory_cache.t', 't/3_test_file_cache.t', 't/5_test_size_aware_file_cache.t', 't/6_test_size_aware_memory_cache.t' ); ## # Main ## Main( ); ## # Subroutines ## sub Main { my %options; $options{NAME} = $NAME; $options{VERSION_FROM} = $VERSION_FROM; $options{dist} = { COMPRESS => $COMPRESS, SUFFIX => $SUFFIX }; $options{PREREQ_PM} = $DEFAULT_PREREQ_PM; if ( not Has_Module( 'IPC::ShareLite' ) ) { Print_ShareLite_Missing_Message( ); $options{test} = { TESTS => join( ' ', @NON_IPC_TESTS ) }; delete $options{PREREQ_PM}->{'IPC::ShareLite'}; } WriteMakefile( %options ); Print_Make_Test_Message( ); } sub Has_Module { my ( $module ) = @_; print "Checking for $module... "; my $has_module = ( eval "require $module" && ! $@ ); print ( $has_module ? "found\n" : "not found\n" ); return $has_module; } sub Print_ShareLite_Missing_Message { print <<END NOTE: Your system does not seem to have IPC::ShareLite installed. This module is a prerequisite for the SharedMemoryCache implementations. However, since it is not available on all platforms, the Cache::Cache module does not list it as an explicit dependency. If you are able to build IPC::ShareLite (available on CPAN), please install it now and re run this Makefile.PL. Automatically disabling the tests for the SharedMemoryCache. END } sub Print_Make_Test_Message { print <<END ------------------------------------------------------------------ Please be patient while running "make test" as the full test suite takes roughly two minutes to complete. ------------------------------------------------------------------ END }


This service runs on Request Tracker, is sponsored by The Perl Foundation, and maintained by Best Practical Solutions.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.