File Coverage

blib/lib/File/Meta/Cache.pm
Criterion Covered Total %
statement 68 76 89.4
branch 16 28 57.1
condition 9 14 64.2
subroutine 11 11 100.0
pod n/a
total 104 129 80.6


line stmt bran cond sub pod time code
1 1     1   100218 use strict;
  1         2  
  1         29  
2 1     1   3 use warnings;
  1         1  
  1         62  
3             package File::Meta::Cache;
4              
5             our $VERSION="v0.4.2";
6              
7             # Default Opening Mode
8             #
9              
10 1     1   5 use Fcntl qw(O_RDONLY);
  1         1  
  1         52  
11 1     1   406 use File::Path::Redirect qw;
  1         14378  
  1         28  
12              
13             # Use these keys instead
14 1     1   184 use constant::more qw;
  1         1  
  1         4  
15              
16 1     1   961 use Object::Pad;
  1         9807  
  1         3  
17              
18             class File::Meta::Cache;
19 1     1   285 use feature qw;
  1         1  
  1         2643  
20              
21             #use uSAC::Log; # Logger
22             #use Log::OK; # Logger enabler
23              
24              
25              
26             my ($_open, $_close, $_dup2);
27              
28             ##############################
29             # if(eval "require IO::FD"){ #
30             # $_open=\&IO::FD::open; #
31             # $_close=\&IO::FD::close; #
32             # $_dup2=\&IO::FD::dup2; #
33             # } #
34             # else { #
35             # require POSIX; #
36             # $_open=\&POSIX::open; #
37             # $_close=\&POSIX::close; #
38             # $_dup2=\&POSIX::dup2; #
39             # } #
40             ##############################
41             require POSIX;
42             $_open=\&POSIX::open;
43             $_close=\&POSIX::close;
44             $_dup2=\&POSIX::dup2;
45              
46              
47              
48              
49              
50              
51             field $_sweep_size;
52              
53             field $_no_fh :param =undef;
54             field $_enabled;
55             field $_sweeper;
56             field %_cache;
57             field $_opener;
58             field $_closer;
59             field $_updater;
60             field $_http_headers;
61              
62             BUILD{
63             $_sweep_size//=100;
64             $_enabled=1;
65             }
66              
67             method sweeper {
68             $_sweeper//= sub {
69 1     1   3 my $cb=shift;
70 1         3 my $i=0;
71 1         2 my $entry;
72 1         6 my $closer=$self->closer;
73 1         6 for(keys %_cache){
74 1         2 $entry=$_cache{$_};
75              
76             # If the cached_ field reaches 1, this is the last code to use it. so close it
77             #
78 1 50       13 if($entry->[VALID]==1){
79 1         4 $closer->($entry);
80 1 50       6 $cb and $cb->($entry);
81             }
82 1 50       13 last if ++$i >= $_sweep_size;
83             }
84             }
85             }
86              
87             # returns a sub to execute. Object::Pad method lookup is slow. so bypass it
88             # when we don't need it
89             #
90             method opener{
91             $_opener//=
92             sub {
93 7     7   16 my ( $KEYpath, $mode, $force, $enable_redirect)=@_;
94 7         11 my $in_fd;
95              
96             # Entry is identified by the path, however, the actual data can come from another file
97             #
98              
99 7         13 my $existing_entry=$_cache{$KEYpath};
100 7   100     24 $mode//=O_RDONLY;
101 7 100 100     30 if(!$existing_entry or $force){
102             #Log::OK::TRACE and log_trace __PACKAGE__.": Searching for: $KEYpath";
103              
104 6         8 my @entry;
105             my $path;
106 6 50       15 if($enable_redirect){
107             # Attempt to redirect file if appropriate
108 0         0 local $@;
109 0         0 eval {$path=follow_redirect $KEYpath};
  0         0  
110              
111 0 0       0 return undef if $@;
112 0         0 $entry[PATH]=$path;
113              
114             }
115             else {
116 6         10 $path=$KEYpath;
117              
118             }
119              
120 6         21 $entry[PATH]=$path;
121 6         95 my @stat=stat $path; #$KEYpath;
122            
123             # If the stat fail or is not a file return undef.
124             # If this is a reopen(force), the force close the file to invalidate the cache
125             #
126 6 50 33     39 unless(@stat and -f _){
127 0 0       0 $_closer->($existing_entry, 1) if $existing_entry;
128 0         0 return undef;
129             };
130              
131 6         91 $in_fd=$_open->($path, $mode);
132 6         13 $in_fd+=0; # Convert to number? '0 but true'
133            
134              
135              
136 6 50       18 if(defined $in_fd){
137            
138 6 100       15 if($existing_entry){
139             # Duplicate and Close unused fd
140             #POSIX::dup2 $in_fd, $existing_entry->[FD];
141 2         25 $_dup2->($in_fd, $existing_entry->[FD]);
142             #POSIX::close $in_fd;
143 2         9 $_close->($in_fd);
144              
145             # Copy stat into existing array
146 2         9 $existing_entry->[STAT]->@*=@stat;
147             }
148             else {
149             # Only create a file handle if its enabled
150 4 50       149 open($entry[FH], "+<&=$in_fd") unless($_no_fh);
151              
152 4         12 $entry[STAT]=\@stat;
153 4         9 $entry[KEY]=$KEYpath;
154 4         7 $entry[FD]=$in_fd;
155 4         8 $entry[VALID]=1;#$count;
156              
157 4         6 $existing_entry =\@entry;
158 4 100       23 if($_enabled){
159 2         14 $_cache{$KEYpath}=$existing_entry;
160 2         6 $existing_entry->[VALID]++;
161             }
162             }
163             }
164             else {
165             #Log::OK::ERROR and log_error __PACKAGE__." Error opening file $KEYpath: $!";
166             }
167             }
168             else {
169             # Increment the counter of existing
170             #
171 1         2 $existing_entry->[VALID]++;
172             }
173              
174 7         21 $existing_entry;
175             }
176             }
177              
178              
179             # Mark the cache as disabled. Dumps all values and closes
180             # all fds
181             #
182             method disable{
183             $_enabled=undef;
184             for(values %_cache){
185             #POSIX::close($_cache{$_}[0]);
186             $_close->($_->[FD]);
187             }
188             %_cache=();
189             $self;
190             }
191              
192             # Generates a sub to close a cached fd
193             # removes meta data from the cache also
194             #
195             method closer {
196             $_closer//=sub {
197             #Log::OK::TRACE and log_trace ("FMC closer called");
198 3     3   6 my $entry=$_[0];
199 3 100 66     23 if(--$entry->[VALID] <=0 or $_[1]){
200             #Log::OK::TRACE and log_trace ("FMC closer valid 0 or lesss, or maybe force flag");
201             # Delete from cache
202 1         4 delete $_cache{$entry->[KEY]};
203             # Attempt to close only if the entry exists
204 1         6 $entry->[VALID]=0; #Mark as invalid
205 1         19 $entry->[FH]=undef;
206 1         15 $_close->($entry->[FD]);
207             }
208             }
209             }
210              
211             method updater{
212             $_updater//=sub {
213             # Do a stat on the entry
214 1     1   18 $_[0][STAT]->@*=stat $_[0][KEY];
215 1 50 33     11 unless($_[0][STAT]->@* and -f _){
216             # This is an error force close the file
217 0           $_closer->($_[0], 1 );
218             }
219             }
220             }
221              
222             # OO Interface
223             #
224              
225             method open {
226             $self->opener->&*;
227             }
228              
229             # First argument is entry, second is force flag
230             method close {
231             $self->closer->&*;
232             }
233              
234             # First argument is entry
235             method update{
236             $self->updater->&*;
237             }
238              
239             # First argument is callback to call if close is called
240             method sweep {
241             $self->sweeper->&*;
242             }
243              
244             method enable{ $_enabled=1; $self }
245              
246             method info {
247             $_cache{$_[0]}
248             }
249              
250             1;
251