File Coverage

blib/lib/Mail/Mbox/MessageParser/Cache.pm
Criterion Covered Total %
statement 29 73 39.7
branch 3 16 18.7
condition 0 3 0.0
subroutine 8 12 66.6
pod 3 3 100.0
total 43 107 40.1


line stmt bran cond sub pod time code
1             package Mail::Mbox::MessageParser::Cache;
2              
3 38     38   1585241 use strict;
  38         102  
  38         1117  
4 38     38   237 use Carp;
  38         74  
  38         2078  
5              
6 38     38   727 use Mail::Mbox::MessageParser;
  38         85  
  38         746  
7 38     38   284 use Mail::Mbox::MessageParser::MetaInfo;
  38         76  
  38         1369  
8              
9 38     38   236 use vars qw( $VERSION $_DEBUG @ISA );
  38         85  
  38         2151  
10 38     38   236 use vars qw( $_CACHE );
  38         81  
  38         36722  
11              
12             @ISA = qw( Exporter Mail::Mbox::MessageParser );
13              
14             $VERSION = sprintf "%d.%02d%02d", q/1.30.2/ =~ /(\d+)/g;
15              
16             *_ENTRY_STILL_VALID = \&Mail::Mbox::MessageParser::MetaInfo::_ENTRY_STILL_VALID;
17             sub _ENTRY_STILL_VALID;
18              
19             *_CACHE = \$Mail::Mbox::MessageParser::MetaInfo::_CACHE;
20             *_WRITE_CACHE = \&Mail::Mbox::MessageParser::MetaInfo::WRITE_CACHE;
21             *_INITIALIZE_ENTRY = \&Mail::Mbox::MessageParser::MetaInfo::_INITIALIZE_ENTRY;
22             sub _WRITE_CACHE;
23             sub _INITIALIZE_ENTRY;
24              
25             *_DEBUG = \$Mail::Mbox::MessageParser::_DEBUG;
26             *_dprint = \&Mail::Mbox::MessageParser::_dprint;
27             sub _dprint;
28              
29             #-------------------------------------------------------------------------------
30              
31             sub new
32             {
33 257     257 1 872 my ($proto, $self) = @_;
34              
35 257 50       938 carp "Need file_name option" unless defined $self->{'file_name'};
36 257 50       800 carp "Need file_handle option" unless defined $self->{'file_handle'};
37              
38             carp "Call SETUP_CACHE() before calling new()"
39 257 50       800 unless exists $Mail::Mbox::MessageParser::MetaInfo::_CACHE_OPTIONS{'file_name'};
40              
41 257         1041 bless ($self, __PACKAGE__);
42              
43 257         2533 $self->_init();
44              
45 257         640 return $self;
46             }
47              
48             #-------------------------------------------------------------------------------
49              
50             sub _init
51             {
52 257     257   1315 my $self = shift;
53              
54 257         1595 _WRITE_CACHE();
55              
56 257         1659 $self->SUPER::_init();
57              
58 257         1294 _INITIALIZE_ENTRY($self->{'file_name'});
59             }
60              
61             #-------------------------------------------------------------------------------
62              
63             sub reset
64             {
65 0     0 1   my $self = shift;
66              
67 0           $self->SUPER::reset();
68              
69             # If we're in the middle of parsing this file, we need to reset the cache
70 0           _INITIALIZE_ENTRY($self->{'file_name'});
71             }
72              
73             #-------------------------------------------------------------------------------
74              
75             sub _read_prologue
76             {
77 0     0     my $self = shift;
78              
79 0           _dprint "Reading mailbox prologue using cache";
80              
81 0           my $prologue_length = $_CACHE->{$self->{'file_name'}}{'emails'}[0]{'offset'};
82              
83 0           my $total_amount_read = 0;
84 0           do {
85 0           $total_amount_read += read($self->{'file_handle'}, $self->{'prologue'},
86             $prologue_length-$total_amount_read, $total_amount_read);
87             } while ($total_amount_read != $prologue_length);
88             }
89              
90             #-------------------------------------------------------------------------------
91              
92             sub read_next_email
93             {
94 0     0 1   my $self = shift;
95              
96 0           my $entry_became_invalidated = 0;
97              
98 0 0 0       unless (defined $self->{'file_name'} && _ENTRY_STILL_VALID($self->{'file_name'}))
99             {
100 0           $entry_became_invalidated = 1;
101              
102             # Patch up the data structures for the Perl implementation
103             $self->{'CURRENT_LINE_NUMBER'} =
104 0           $_CACHE->{$self->{'file_name'}}{'emails'}[$self->{'email_number'}]{'line_number'};
105             $self->{'CURRENT_OFFSET'} =
106 0           $_CACHE->{$self->{'file_name'}}{'emails'}[$self->{'email_number'}]{'offset'};
107             $self->{'READ_CHUNK_SIZE'} =
108 0           $Mail::Mbox::MessageParser::Config{'read_chunk_size'};
109 0           $self->{'READ_BUFFER'} = '';
110 0           $self->{'END_OF_EMAIL'} = 0;
111              
112             # Invalidate the remaining data
113 0           $#{ $_CACHE->{$self->{'file_name'}}{'emails'} } = $self->{'email_number'};
  0            
114              
115 0           bless ($self, 'Mail::Mbox::MessageParser::Perl');
116              
117 0           return $self->read_next_email();
118             }
119              
120 0 0         return undef if $self->end_of_file(); ## no critic (ProhibitExplicitReturnUndef)
121              
122             $self->{'email_line_number'} =
123 0           $_CACHE->{$self->{'file_name'}}{'emails'}[$self->{'email_number'}]{'line_number'};
124             $self->{'email_offset'} =
125 0           $_CACHE->{$self->{'file_name'}}{'emails'}[$self->{'email_number'}]{'offset'};
126              
127 0           my $email = '';
128              
129             $self->{'email_length'} =
130 0           $_CACHE->{$self->{'file_name'}}{'emails'}[$self->{'email_number'}]{'length'};
131              
132             {
133 0           my $total_amount_read = length($email);
  0            
134             do {
135             $total_amount_read += read($self->{'file_handle'}, $email,
136 0           $self->{'email_length'}-$total_amount_read, $total_amount_read);
137 0           } while ($total_amount_read != $self->{'email_length'});
138             }
139              
140 0 0         unless ($_CACHE->{$self->{'file_name'}}{'emails'}[$self->{'email_number'}]{'validated'}) {
141 0           my $current_time = localtime;
142 0           my $email_last_modified_time = localtime((stat($self->{'file_name'}))[9]);
143             my $cache_last_modified_time =
144 0           localtime((stat($Mail::Mbox::MessageParser::MetaInfo::_CACHE_OPTIONS{'file_name'}))[9]);
145              
146 0           die <
147             Cache data not validated. This should not occur. Please send an email to
148             david\@coppit.org with the following information.
149              
150             Debugging info:
151             - Current time: $current_time
152             - Email file: $self->{'file_name'}
153             - Email file last modified time: $email_last_modified_time
154             - Cache file: $Mail::Mbox::MessageParser::MetaInfo::_CACHE_OPTIONS{'file_name'}
155             - Cache file last modified time: $cache_last_modified_time
156             - Email number: $self->{'email_number'}
157             - Email line number: $self->{'email_line_number'}
158             - Email offset: $self->{'email_offset'}
159             - Email length: $self->{'email_length'}
160             - Entry became invalidated?: $entry_became_invalidated
161              
162             It would also be really helpful if you could send the cache and email file,
163             but I realize that many would not be comfortable doing that.
164             EOF
165             }
166              
167 0           $self->{'email_number'}++;
168              
169 0           $self->SUPER::read_next_email();
170              
171 0           return \$email;
172             }
173              
174             #-------------------------------------------------------------------------------
175              
176             sub _print_debug_information
177             {
178 0 0   0     return unless $_DEBUG;
179              
180 0           my $self = shift;
181              
182 0           $self->SUPER::_print_debug_information();
183              
184             _dprint "Valid cache entry exists: " .
185 0 0         ($#{ $_CACHE->{$self->{'file_name'}}{'emails'} } != -1 ? "Yes" : "No");
  0            
186             }
187              
188             1;
189              
190             __END__