File Coverage

blib/lib/Mail/Mbox/MessageParser/MetaInfo.pm
Criterion Covered Total %
statement 69 88 78.4
branch 20 36 55.5
condition 3 30 10.0
subroutine 11 13 84.6
pod 3 3 100.0
total 106 170 62.3


line stmt bran cond sub pod time code
1             package Mail::Mbox::MessageParser::MetaInfo;
2              
3 38     38   3181289 use strict;
  38         125  
  38         1097  
4 38     38   214 use Carp;
  38         86  
  38         2092  
5              
6 38     38   802 use Mail::Mbox::MessageParser;
  38         70  
  38         1003  
7              
8 38     38   308 use vars qw( $VERSION $_DEBUG @ISA );
  38         66  
  38         2084  
9 38     38   241 use vars qw( $_CACHE %_CACHE_OPTIONS $UPDATING_CACHE );
  38         68  
  38         41388  
10              
11             @ISA = qw( Exporter );
12              
13             $VERSION = sprintf "%d.%02d%02d", q/0.2.0/ =~ /(\d+)/g;
14              
15             *_DEBUG = \$Mail::Mbox::MessageParser::_DEBUG;
16             *_dprint = \&Mail::Mbox::MessageParser::_dprint;
17             sub _dprint;
18              
19             # The class-wide cache, which will be read and written when necessary. i.e.
20             # read when an folder reader object is created which uses caching, and
21             # written when a different cache is specified, or when the program exits,
22             $_CACHE = {};
23              
24             %_CACHE_OPTIONS = ();
25              
26             $UPDATING_CACHE = 0;
27              
28             #-------------------------------------------------------------------------------
29              
30             sub _LOAD_STORABLE
31             {
32 266 50   266   599 if (eval {require Storable})
  266         3056  
33             {
34 266         15719 import Storable;
35 266         1118 return 1;
36             }
37             else
38             {
39 0         0 return 0;
40             }
41             }
42              
43             #-------------------------------------------------------------------------------
44              
45             sub SETUP_CACHE
46             {
47 266     266 1 157428 my $cache_options = shift;
48              
49 266 50       1071 carp "Need file_name option" unless defined $cache_options->{'file_name'};
50              
51 266 50       878 return "Can not load " . __PACKAGE__ . ": Storable is not installed.\n"
52             unless _LOAD_STORABLE();
53            
54             # Load Storable if we need to
55             # See if the client is setting up a different cache
56 266 100 66     1672 if (exists $_CACHE_OPTIONS{'file_name'} &&
57             $cache_options->{'file_name'} ne $_CACHE_OPTIONS{'file_name'})
58             {
59 243         1071 _dprint "New cache file specified--writing old cache if necessary.";
60 243         773 WRITE_CACHE();
61 243         1905 $_CACHE = {};
62             }
63              
64 266         1206 %_CACHE_OPTIONS = %$cache_options;
65              
66 266         1034 _READ_CACHE();
67              
68 266         1149 return 'ok';
69             }
70              
71             #-------------------------------------------------------------------------------
72              
73             sub CLEAR_CACHE
74             {
75             unlink $_CACHE_OPTIONS{'file_name'}
76 0 0 0 0 1 0 if defined $_CACHE_OPTIONS{'file_name'} && -f $_CACHE_OPTIONS{'file_name'};
77              
78 0         0 $_CACHE = {};
79 0         0 $UPDATING_CACHE = 1;
80             }
81              
82             #-------------------------------------------------------------------------------
83              
84             sub _INITIALIZE_ENTRY
85             {
86 257     257   572 my $file_name = shift;
87              
88 257         4987 my @stat = stat $file_name;
89              
90 257 50       1097 return 0 unless @stat;
91              
92 257         696 my $size = $stat[7];
93 257         536 my $time_stamp = $stat[9];
94              
95              
96 257 50 0     1214 if (exists $_CACHE->{$file_name} &&
      0        
      0        
      33        
97             (defined $_CACHE->{$file_name}{'size'} &&
98             defined $_CACHE->{$file_name}{'time_stamp'} &&
99             $_CACHE->{$file_name}{'size'} == $size &&
100             $_CACHE->{$file_name}{'time_stamp'} == $time_stamp))
101             {
102 0         0 _dprint "Cache is valid";
103              
104             # TODO: For now, if we re-initialize, we start over. Fix this so that we
105             # can use partial cache information.
106 0 0       0 if ($UPDATING_CACHE)
107             {
108 0         0 _dprint "Resetting cache entry for \"$file_name\"\n";
109              
110             # Reset the cache entry for this file
111 0         0 $_CACHE->{$file_name}{'size'} = $size;
112 0         0 $_CACHE->{$file_name}{'time_stamp'} = $time_stamp;
113 0         0 $_CACHE->{$file_name}{'emails'} = [];
114 0         0 $_CACHE->{$file_name}{'modified'} = 0;
115             }
116             }
117             else
118             {
119 257 50       647 if (exists $_CACHE->{$file_name})
120             {
121 0         0 _dprint "Size or time stamp has changed for file \"" .
122             $file_name . "\". Invalidating cache entry";
123             }
124             else
125             {
126 257         1524 _dprint "Cache is invalid: \"$file_name\" has not yet been parsed";
127             }
128              
129 257         1790 $_CACHE->{$file_name}{'size'} = $size;
130 257         1016 $_CACHE->{$file_name}{'time_stamp'} = $time_stamp;
131 257         1191 $_CACHE->{$file_name}{'emails'} = [];
132 257         1043 $_CACHE->{$file_name}{'modified'} = 0;
133              
134 257         1007 $UPDATING_CACHE = 1;
135             }
136             }
137              
138             #-------------------------------------------------------------------------------
139              
140             sub _ENTRY_STILL_VALID
141             {
142 0     0   0 my $file_name = shift;
143              
144             return 0 unless exists $_CACHE->{$file_name} &&
145             defined $_CACHE->{$file_name}{'size'} &&
146             defined $_CACHE->{$file_name}{'time_stamp'} &&
147             # Sanity check the cache to ensure we can at least determine the prologue
148             # length.
149 0 0 0     0 defined $_CACHE->{$file_name}{'emails'}[0]{'offset'};
      0        
      0        
150              
151 0         0 my @stat = stat $file_name;
152              
153 0 0       0 return 0 unless @stat;
154              
155 0         0 my $size = $stat[7];
156 0         0 my $time_stamp = $stat[9];
157              
158             return ($_CACHE->{$file_name}{'size'} == $size &&
159 0   0     0 $_CACHE->{$file_name}{'time_stamp'} == $time_stamp);
160             }
161              
162             #-------------------------------------------------------------------------------
163              
164             sub _READ_CACHE
165             {
166 266     266   538 my $self = shift;
167              
168 266 100       4004 return unless -f $_CACHE_OPTIONS{'file_name'};
169              
170 153         763 _dprint "Reading cache";
171              
172             # Unserialize using Storable
173 153         271 local $@;
174              
175 153         381 eval { $_CACHE = retrieve($_CACHE_OPTIONS{'file_name'}) };
  153         650  
176              
177 153 50       49783 if ($@)
178             {
179 153         414 $_CACHE = {};
180 153         592 _dprint "Invalid cache detected, and will be ignored.";
181 153         573 _dprint "Message from Storable module: \"$@\"";
182             }
183             }
184              
185             #-------------------------------------------------------------------------------
186              
187             sub WRITE_CACHE
188             {
189             # In case this is called during cleanup following an error loading
190             # Storable
191 648 100   648 1 1940 return unless defined $Storable::VERSION;
192              
193 634 100       1546 return if $UPDATING_CACHE;
194              
195             # TODO: Make this cache separate files instead of one big file, to improve
196             # performance.
197 627         994 my $cache_modified = 0;
198              
199 627         2465 foreach my $file_name (keys %$_CACHE)
200             {
201 473 100       1423 if ($_CACHE->{$file_name}{'modified'})
202             {
203 253         496 $cache_modified = 1;
204 253         606 $_CACHE->{$file_name}{'modified'} = 0;
205             }
206             }
207              
208 627 100       1663 unless ($cache_modified)
209             {
210 374         1468 _dprint "Cache not modified, so no writing is necessary";
211 374         1059 return;
212             }
213              
214 253         772 _dprint "Cache was modified, so writing is necessary";
215              
216             # The mail box cache may contain sensitive information, so protect it
217             # from prying eyes.
218 253         1816 my $oldmask = umask(077);
219              
220             # Serialize using Storable
221 253         1795 store($_CACHE, $_CACHE_OPTIONS{'file_name'});
222              
223 253         52848 umask($oldmask);
224              
225 253         2297 $_CACHE->{$_CACHE_OPTIONS{'file_name'}}{'modified'} = 0;
226             }
227              
228             #-------------------------------------------------------------------------------
229              
230             # Write the cache when the program exits
231             sub END
232             {
233 38 50   38   1385988 _dprint "Exiting and writing cache if necessary"
234             if defined(&_dprint);
235              
236 38         265 WRITE_CACHE();
237             }
238              
239             1;
240              
241             __END__