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-2023 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.03.
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 39     39   1331 use vars '$VERSION';
  39         76  
  39         2127  
11             $VERSION = '3.013';
12              
13 39     39   270 use base 'Mail::Reporter';
  39         83  
  39         4422  
14              
15 39     39   296 use strict;
  39         91  
  39         863  
16 39     39   236 use warnings;
  39         107  
  39         1281  
17              
18 39     39   236 use Carp;
  39         93  
  39         40437  
19              
20              
21             sub new(@)
22 12     12 1 32 { my $class = shift;
23              
24 12 50       76 $class eq __PACKAGE__
25             ? $class->defaultParserType->new(@_) # bootstrap right parser
26             : $class->SUPER::new(@_);
27             }
28              
29             sub init(@)
30 12     12 0 25 { my ($self, $args) = @_;
31              
32             #warn "PARSER type=".ref $self,$self->VERSION;
33 12         49 $self->SUPER::init($args);
34              
35 12   50     56 $self->{MBP_mode} = $args->{mode} || 'r';
36              
37 12 50 33     54 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 12         56 $self->start(file => $args->{file});
43             }
44              
45             #------------------------------------------
46              
47              
48             sub start(@)
49 12     12 1 23 { my $self = shift;
50 12         43 my %args = (@_, filename => $self->filename, mode => $self->{MBP_mode});
51              
52 12 50       43 $self->openFile(\%args)
53             or return;
54              
55 12         57 $self->takeFileInfo;
56              
57 12         116 $self->log(PROGRESS => "Opened folder $args{filename} to be parsed");
58 12         50 $self;
59             }
60              
61             #------------------------------------------
62              
63              
64             sub stop()
65 24     24 1 44 { my $self = shift;
66              
67 24         74 my $filename = $self->filename;
68              
69             # $self->log(WARNING => "File $filename changed during access.")
70             # if $self->fileChanged;
71              
72 24         110 $self->log(NOTICE => "Close parser for file $filename");
73 24         79 $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 48     48 1 373 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 12     12 1 25 { my $self = shift;
144 12         37 @$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 88 { my $class = shift;
152              
153             # Select the parser manually?
154 1 50       4 if(@_)
155 1         2 { $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 12     12   39 { my $self = shift;
182 12         44 $self->stop;
183 12         53 $self->SUPER::DESTROY;
184             }
185              
186             1;