view release on metacpan or  search on metacpan

lib/Cache/FileBackend.pm  view on Meta::CPAN

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 ) = @_;