This file is indexed.

/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;