File Coverage

blib/lib/Cache/File/Handle.pm
Criterion Covered Total %
statement 9 27 33.3
branch 0 6 0.0
condition 0 3 0.0
subroutine 3 7 42.8
pod 2 3 66.6
total 14 46 30.4


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Cache::File::Handle - wrapper for IO::File to use in Cache::File implementation
4              
5             =head1 DESCRIPTION
6              
7             This module implements a derived class of IO::File that allows callback on
8             close. It is for use by Cache::File and should not be used directly.
9              
10             =cut
11             package Cache::File::Handle;
12              
13             require 5.006;
14 1     1   2317 use strict;
  1         3  
  1         42  
15 1     1   5 use warnings;
  1         3  
  1         23  
16 1     1   944 use IO::File;
  1         9746  
  1         441  
17              
18             our @ISA = qw(IO::File);
19              
20              
21             sub new {
22 0     0 1   my $proto = shift;
23 0   0       my $class = ref($proto) || $proto;
24 0           my ($filename, $mode, $perms, $close_callback) = @_;
25              
26 0 0         my $self = $class->SUPER::new($filename, $mode, $perms)
27             or return undef;
28 0           bless $self, $class;
29 0           *$self->{_cache_close_callback} = $close_callback;
30              
31 0           return $self;
32             }
33              
34             sub open {
35 0     0 1   my $self = shift;
36 0           my ($filename, $mode, $perms, $close_callback) = @_;
37              
38 0           *$self->{_cache_close_callback} = $close_callback;
39              
40 0           return $self->SUPER::open($filename, $mode, $perms);
41             }
42              
43             sub close {
44 0     0 0   my $self = shift;
45 0           $self->flush;
46 0 0         *$self->{_cache_close_callback}->($self) if *$self->{_cache_close_callback};
47 0           delete *$self->{_cache_close_callback};
48 0           $self->SUPER::close(@_);
49             }
50              
51             sub DESTROY {
52 0     0     my $self = shift;
53 0 0         *$self->{_cache_close_callback}->($self) if *$self->{_cache_close_callback};
54             #$self->SUPER::DESTROY();
55             }
56              
57              
58             1;
59             __END__