%PDF- %PDF-
Direktori : /usr/share/perl5/vendor_perl/Cache/ |
Current File : //usr/share/perl5/vendor_perl/Cache/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::SHA1 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 persistance 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