File Coverage

blib/lib/Mail/Box/Parser.pm
Criterion Covered Total %
statement 42 73 57.5
branch 5 20 25.0
condition 2 8 25.0
subroutine 13 27 48.1
pod 20 21 95.2
total 82 149 55.0


line stmt bran cond sub pod time code
1             # Copyrights 2001-2021 by [Mark Overmeer ].
2             # For other contributors see ChangeLog.
3             # See the manual pages for details on the licensing terms.
4             # Pod stripped from pm file by OODoc 2.02.
5             # This code is part of distribution Mail-Message. Meta-POD processed with
6             # OODoc into POD and HTML manual-pages. See README.md
7             # Copyright Mark Overmeer. Licensed under the same terms as Perl itself.
8              
9             package Mail::Box::Parser;
10 36     36   1319 use vars '$VERSION';
  36         80  
  36         2098  
11             $VERSION = '3.011';
12              
13 36     36   216 use base 'Mail::Reporter';
  36         76  
  36         4353  
14              
15 36     36   264 use strict;
  36         78  
  36         918  
16 36     36   194 use warnings;
  36         86  
  36         1162  
17              
18 36     36   209 use Carp;
  36         71  
  36         37594  
19              
20              
21             sub new(@)
22 7     7 1 16 { my $class = shift;
23              
24 7 50       57 $class eq __PACKAGE__
25             ? $class->defaultParserType->new(@_) # bootstrap right parser
26             : $class->SUPER::new(@_);
27             }
28              
29             sub init(@)
30 7     7 0 15 { my ($self, $args) = @_;
31              
32             #warn "PARSER type=".ref $self,$self->VERSION;
33 7         32 $self->SUPER::init($args);
34              
35 7   50     34 $self->{MBP_mode} = $args->{mode} || 'r';
36              
37 7 50 33     31 unless($self->{MBP_filename} = $args->{filename} || ref $args->{file})
38 0         0 { $self->log(ERROR => "Filename or handle required to create a parser.");
39 0         0 return;
40             }
41              
42 7         30 $self->start(file => $args->{file});
43             }
44              
45             #------------------------------------------
46              
47              
48             sub start(@)
49 7     7 1 15 { my $self = shift;
50 7         27 my %args = (@_, filename => $self->filename, mode => $self->{MBP_mode});
51              
52 7 50       28 $self->openFile(\%args)
53             or return;
54              
55 7         37 $self->takeFileInfo;
56              
57 7         69 $self->log(PROGRESS => "Opened folder $args{filename} to be parsed");
58 7         28 $self;
59             }
60              
61             #------------------------------------------
62              
63              
64             sub stop()
65 14     14 1 27 { my $self = shift;
66              
67 14         35 my $filename = $self->filename;
68              
69             # $self->log(WARNING => "File $filename changed during access.")
70             # if $self->fileChanged;
71              
72 14         55 $self->log(NOTICE => "Close parser for file $filename");
73 14         39 $self->closeFile;
74             }
75              
76              
77             sub restart()
78 0     0 1 0 { my $self = shift;
79 0         0 my $filename = $self->filename;
80              
81 0         0 $self->closeFile;
82             $self->openFile( {filename => $filename, mode => $self->{MBP_mode}} )
83 0 0       0 or return;
84              
85 0         0 $self->takeFileInfo;
86 0         0 $self->log(NOTICE => "Restarted parser for file $filename");
87 0         0 $self;
88             }
89              
90              
91             sub fileChanged()
92 0     0 1 0 { my $self = shift;
93 0         0 my ($size, $mtime) = (stat $self->filename)[7,9];
94 0 0 0     0 return 0 if !defined $size || !defined $mtime;
95 0 0       0 $size != $self->{MBP_size} || $mtime != $self->{MBP_mtime};
96             }
97            
98              
99 28     28 1 255 sub filename() {shift->{MBP_filename}}
100              
101             #------------------------------------------
102              
103              
104 0     0 1 0 sub filePosition(;$) {shift->NotImplemented}
105              
106              
107 0     0 1 0 sub pushSeparator($) {shift->notImplemented}
108              
109              
110 0     0 1 0 sub popSeparator($) {shift->notImplemented}
111              
112              
113 0     0 1 0 sub readSeparator($) {shift->notImplemented}
114              
115              
116 0     0 1 0 sub readHeader() {shift->notImplemented}
117              
118              
119 0     0 1 0 sub bodyAsString() {shift->notImplemented}
120              
121              
122 0     0 1 0 sub bodyAsList() {shift->notImplemented}
123              
124              
125 0     0 1 0 sub bodyAsFile() {shift->notImplemented}
126              
127              
128 0     0 1 0 sub bodyDelayed() {shift->notImplemented}
129              
130              
131 0     0 1 0 sub lineSeparator() {shift->{MBP_linesep}}
132              
133             #------------------------------------------
134              
135              
136 0     0 1 0 sub openFile(@) {shift->notImplemented}
137              
138              
139 0     0 1 0 sub closeFile(@) {shift->notImplemented}
140              
141              
142             sub takeFileInfo()
143 7     7 1 11 { my $self = shift;
144 7         17 @$self{ qw/MBP_size MBP_mtime/ } = (stat $self->filename)[7,9];
145             }
146              
147              
148             my $parser_type;
149              
150             sub defaultParserType(;$)
151 1     1 1 96 { my $class = shift;
152              
153             # Select the parser manually?
154 1 50       5 if(@_)
155 1         3 { $parser_type = shift;
156 1 50       15 return $parser_type if $parser_type->isa( __PACKAGE__ );
157              
158 0         0 confess "Parser $parser_type does not extend "
159             . __PACKAGE__ . "\n";
160             }
161              
162             # Already determined which parser we want?
163 0 0       0 return $parser_type if $parser_type;
164              
165             # Try to use C-based parser.
166 0         0 eval 'require Mail::Box::Parser::C';
167             #warn "C-PARSER errors $@\n" if $@;
168              
169 0 0       0 return $parser_type = 'Mail::Box::Parser::C'
170             unless $@;
171              
172             # Fall-back on Perl-based parser.
173 0         0 require Mail::Box::Parser::Perl;
174 0         0 $parser_type = 'Mail::Box::Parser::Perl';
175             }
176              
177             #------------------------------------------
178              
179              
180             sub DESTROY
181 7     7   10 { my $self = shift;
182 7         20 $self->stop;
183 7         29 $self->SUPER::DESTROY;
184             }
185              
186             1;