File Coverage

blib/lib/NetApp/Filer/TimeoutCache.pm
Criterion Covered Total %
statement 15 42 35.7
branch 0 6 0.0
condition n/a
subroutine 5 11 45.4
pod n/a
total 20 59 33.9


line stmt bran cond sub pod time code
1              
2             package NetApp::Filer::TimeoutCache;
3              
4             our $VERSION = '500.002';
5             $VERSION = eval $VERSION; ## no critic: StringyEval
6              
7 7     7   36 use strict;
  7         45  
  7         223  
8 7     7   35 use warnings;
  7         14  
  7         244  
9 7     7   38 use English;
  7         13  
  7         57  
10 7     7   3855 use Carp;
  7         10  
  7         437  
11 7     7   35 use Params::Validate qw( :all );
  7         15  
  7         4355  
12              
13             sub TIEHASH {
14              
15 0     0     my $class = shift;
16 0           my (%args) = validate( @_, {
17             lifetime => { type => SCALAR,
18             regex => qr{^\d+$} },
19             });
20              
21 0 0         if ( $args{lifetime} <= 0 ) {
22 0           croak("Invalid argument: lifetime must be a positive integer\n");
23             }
24              
25 0           my %self = (
26             lifetime => $args{lifetime},
27             cache => {},
28             );
29              
30 0           return bless \%self => $class;
31              
32             }
33              
34             sub STORE {
35              
36 0     0     my $self = shift;
37 0           my ($key, $value) = @_;
38              
39 0           $self->{cache}->{$key} = {
40             expiration => $self->{lifetime} + time,
41             value => $value,
42             };
43              
44 0           return $value;
45              
46             }
47              
48             sub FETCH {
49 0     0     my $self = shift;
50 0           my $key = shift;
51 0           return $self->{cache}->{$key}->{value};
52             }
53              
54             sub DELETE {
55 0     0     my $self = shift;
56 0           my $key = shift;
57 0           my $value = $self->{cache}->{$key}->{value};
58 0           delete $self->{cache}->{$key};
59 0           return $value;
60             }
61              
62             sub CLEAR {
63 0     0     return shift->{cache} = {};
64             }
65              
66             sub EXISTS {
67              
68 0     0     my $self = shift;
69 0           my $key = shift;
70              
71 0 0         if ( not exists $self->{cache}->{$key} ) {
72 0           return 0;
73             }
74              
75 0           my $data = $self->{cache}->{$key};
76              
77 0 0         if ( $data->{expiration} > time ) {
78 0           return 1;
79             } else {
80 0           return 0;
81             }
82              
83             }
84              
85             1;