/usr/share/perl5/CHI/t/Driver/File.pm is in libchi-perl 0.60-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 | package CHI::t::Driver::File;
$CHI::t::Driver::File::VERSION = '0.60';
use strict;
use warnings;
use CHI::Test;
use CHI::Test::Util qw(random_string);
use CHI::Util qw(fast_catdir unique_id);
use File::Basename;
use File::Path;
use File::Temp qw(tempdir);
use base qw(CHI::t::Driver);
my $root_dir;
sub new_cache_options {
my $self = shift;
$root_dir ||= tempdir( "chi-driver-file-XXXX", TMPDIR => 1, CLEANUP => 1 );
return ( $self->SUPER::new_cache_options(), root_dir => $root_dir );
}
{
package CHI::t::Driver::File::NoTempDriver;
$CHI::t::Driver::File::NoTempDriver::VERSION = '0.60';
use Moo;
extends 'CHI::Driver::File';
sub generate_temporary_filename {
my ( $self, $dir, $file ) = @_;
return undef;
}
}
{
package CHI::t::Driver::File::BadTempDriver;
$CHI::t::Driver::File::BadTempDriver::VERSION = '0.60';
use Moo;
extends 'CHI::Driver::File';
sub generate_temporary_filename {
my ( $self, $dir, $file ) = @_;
return "/dir/does/not/exist/$file";
}
}
# Test that we can override how temporary files are generated
#
sub test_generate_temporary_filename : Tests {
my $self = shift;
$self->{cache} =
$self->new_cache( driver => '+CHI::t::Driver::File::NoTempDriver' );
$self->test_simple();
$self->{cache} =
$self->new_cache( driver => '+CHI::t::Driver::File::BadTempDriver' );
throws_ok { $self->test_simple() } qr/error during cache set/;
}
sub test_default_depth : Tests {
my $self = shift;
my $cache = $self->new_cache();
is( $cache->depth, 2 );
}
sub test_creation_and_deletion : Tests {
my $self = shift;
my $cache = $self->new_cache();
my ( $key, $value ) = $self->kvpair();
my $cache_file = $cache->path_to_key($key);
my $namespace_dir = $cache->path_to_namespace();
ok( !-f $cache_file, "cache file '$cache_file' does not exist before set" );
$cache->set( $key, $value, 0 );
ok( !defined $cache->get($key) );
ok( -f $cache_file, "cache file '$cache_file' exists after set" );
ok( -d $namespace_dir, "namespace dir '$namespace_dir' exists after set" );
$cache->remove($key);
ok( !-f $cache_file,
"cache file '$cache_file' does not exist after remove" );
ok( -d $namespace_dir,
"namespace dir '$namespace_dir' exists after remove" );
$cache->clear();
ok( !-d $namespace_dir,
"namespace dir '$namespace_dir' does not exist after clear" );
}
sub test_root_dir_does_not_exist : Tests {
my $self = shift;
my $parent_dir =
tempdir( "chi-driver-file-XXXX", TMPDIR => 1, CLEANUP => 1 );
my $non_existent_root = fast_catdir( $parent_dir, unique_id() );
ok( !-d $non_existent_root, "$non_existent_root does not exist" );
my $cache = $self->new_cache( root_dir => $non_existent_root );
ok( !defined( $cache->get('foo') ), 'miss' );
$cache->set( 'foo', 5 );
is( $cache->get('foo'), 5, 'hit' );
ok( -d $non_existent_root, "$non_existent_root exists after set" );
}
sub test_ignore_bad_namespaces : Tests {
my $self = shift;
my $cache =
$self->new_cleared_cache( root_dir =>
tempdir( "chi-driver-file-XXXX", TMPDIR => 1, CLEANUP => 1 ) );
foreach my $dir ( ".etc", "+2eetd", 'a@b', 'a+40c', "plain" ) {
mkpath( join( "/", $cache->root_dir, $dir ) );
}
cmp_set(
[ $cache->get_namespaces ],
[ '.etd', 'a@c', 'plain' ],
'only valid dirs shown as namespaces'
);
}
sub test_default_discard : Tests {
my $self = shift;
my $cache = $self->new_cleared_cache( is_size_aware => 1 );
is( $cache->discard_policy, 'arbitrary' );
}
1;
|