line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Copyrights 2001-2022 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
|
36
|
|
|
36
|
|
1013
|
use vars '$VERSION'; |
|
36
|
|
|
|
|
74
|
|
|
36
|
|
|
|
|
1781
|
|
11
|
|
|
|
|
|
|
$VERSION = '3.012'; |
12
|
|
|
|
|
|
|
|
13
|
36
|
|
|
36
|
|
200
|
use base 'Mail::Reporter'; |
|
36
|
|
|
|
|
62
|
|
|
36
|
|
|
|
|
3559
|
|
14
|
|
|
|
|
|
|
|
15
|
36
|
|
|
36
|
|
211
|
use strict; |
|
36
|
|
|
|
|
69
|
|
|
36
|
|
|
|
|
777
|
|
16
|
36
|
|
|
36
|
|
187
|
use warnings; |
|
36
|
|
|
|
|
71
|
|
|
36
|
|
|
|
|
1039
|
|
17
|
|
|
|
|
|
|
|
18
|
36
|
|
|
36
|
|
185
|
use Carp; |
|
36
|
|
|
|
|
63
|
|
|
36
|
|
|
|
|
31869
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub new(@) |
22
|
7
|
|
|
7
|
1
|
16
|
{ my $class = shift; |
23
|
|
|
|
|
|
|
|
24
|
7
|
50
|
|
|
|
48
|
$class eq __PACKAGE__ |
25
|
|
|
|
|
|
|
? $class->defaultParserType->new(@_) # bootstrap right parser |
26
|
|
|
|
|
|
|
: $class->SUPER::new(@_); |
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
sub init(@) |
30
|
7
|
|
|
7
|
0
|
17
|
{ my ($self, $args) = @_; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
#warn "PARSER type=".ref $self,$self->VERSION; |
33
|
7
|
|
|
|
|
27
|
$self->SUPER::init($args); |
34
|
|
|
|
|
|
|
|
35
|
7
|
|
50
|
|
|
28
|
$self->{MBP_mode} = $args->{mode} || 'r'; |
36
|
|
|
|
|
|
|
|
37
|
7
|
50
|
33
|
|
|
30
|
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
|
|
|
|
|
36
|
$self->start(file => $args->{file}); |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
#------------------------------------------ |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub start(@) |
49
|
7
|
|
|
7
|
1
|
14
|
{ my $self = shift; |
50
|
7
|
|
|
|
|
24
|
my %args = (@_, filename => $self->filename, mode => $self->{MBP_mode}); |
51
|
|
|
|
|
|
|
|
52
|
7
|
50
|
|
|
|
24
|
$self->openFile(\%args) |
53
|
|
|
|
|
|
|
or return; |
54
|
|
|
|
|
|
|
|
55
|
7
|
|
|
|
|
31
|
$self->takeFileInfo; |
56
|
|
|
|
|
|
|
|
57
|
7
|
|
|
|
|
66
|
$self->log(PROGRESS => "Opened folder $args{filename} to be parsed"); |
58
|
7
|
|
|
|
|
25
|
$self; |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
#------------------------------------------ |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub stop() |
65
|
14
|
|
|
14
|
1
|
20
|
{ my $self = shift; |
66
|
|
|
|
|
|
|
|
67
|
14
|
|
|
|
|
28
|
my $filename = $self->filename; |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
# $self->log(WARNING => "File $filename changed during access.") |
70
|
|
|
|
|
|
|
# if $self->fileChanged; |
71
|
|
|
|
|
|
|
|
72
|
14
|
|
|
|
|
51
|
$self->log(NOTICE => "Close parser for file $filename"); |
73
|
14
|
|
|
|
|
34
|
$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
|
250
|
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
|
15
|
{ my $self = shift; |
144
|
7
|
|
|
|
|
14
|
@$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
|
78
|
{ 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
|
|
31
|
{ my $self = shift; |
182
|
7
|
|
|
|
|
20
|
$self->stop; |
183
|
7
|
|
|
|
|
27
|
$self->SUPER::DESTROY; |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
1; |