line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
20
|
|
|
20
|
|
80486
|
use strict; |
|
20
|
|
|
|
|
62
|
|
|
20
|
|
|
|
|
717
|
|
2
|
20
|
|
|
20
|
|
112
|
use warnings; |
|
20
|
|
|
|
|
41
|
|
|
20
|
|
|
|
|
893
|
|
3
|
|
|
|
|
|
|
package Email::MIME::Encode 1.951; |
4
|
|
|
|
|
|
|
# ABSTRACT: a private helper for MIME header encoding |
5
|
|
|
|
|
|
|
|
6
|
20
|
|
|
20
|
|
127
|
use Carp (); |
|
20
|
|
|
|
|
39
|
|
|
20
|
|
|
|
|
263
|
|
7
|
20
|
|
|
20
|
|
721
|
use Encode (); |
|
20
|
|
|
|
|
10712
|
|
|
20
|
|
|
|
|
337
|
|
8
|
20
|
|
|
20
|
|
8174
|
use Email::MIME::Header; |
|
20
|
|
|
|
|
57
|
|
|
20
|
|
|
|
|
730
|
|
9
|
20
|
|
|
20
|
|
8737
|
use MIME::Base64(); |
|
20
|
|
|
|
|
13120
|
|
|
20
|
|
|
|
|
513
|
|
10
|
20
|
|
|
20
|
|
133
|
use Module::Runtime (); |
|
20
|
|
|
|
|
41
|
|
|
20
|
|
|
|
|
355
|
|
11
|
20
|
|
|
20
|
|
106
|
use Scalar::Util; |
|
20
|
|
|
|
|
39
|
|
|
20
|
|
|
|
|
5256
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
our @CARP_NOT; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
my %no_mime_headers = map { $_ => undef } qw(date message-id in-reply-to references downgraded-message-id downgraded-in-reply-to downgraded-references); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub maybe_mime_encode_header { |
18
|
44
|
|
|
44
|
0
|
207
|
my ($header, $val, $charset) = @_; |
19
|
|
|
|
|
|
|
|
20
|
44
|
|
|
|
|
89
|
$header = lc $header; |
21
|
|
|
|
|
|
|
|
22
|
44
|
|
|
|
|
99
|
my $header_name_length = length($header) + length(": "); |
23
|
|
|
|
|
|
|
|
24
|
44
|
100
|
100
|
|
|
190
|
if (Scalar::Util::blessed($val) && $val->can("as_mime_string")) { |
25
|
2
|
|
|
|
|
12
|
return $val->as_mime_string({ |
26
|
|
|
|
|
|
|
charset => $charset, |
27
|
|
|
|
|
|
|
header_name_length => $header_name_length, |
28
|
|
|
|
|
|
|
}); |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
return _object_encode($val, $charset, $header_name_length, $Email::MIME::Header::header_to_class_map{$header}) |
32
|
42
|
100
|
|
|
|
138
|
if exists $Email::MIME::Header::header_to_class_map{$header}; |
33
|
|
|
|
|
|
|
|
34
|
20
|
|
|
|
|
34
|
my $min_wrap_length = 78 - $header_name_length + 1; |
35
|
|
|
|
|
|
|
|
36
|
20
|
100
|
66
|
|
|
35
|
return $val |
37
|
|
|
|
|
|
|
unless _needs_mime_encode($val) || $val =~ /[^\s]{$min_wrap_length,}/; |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
return $val |
40
|
11
|
50
|
|
|
|
33
|
if exists $no_mime_headers{$header}; |
41
|
|
|
|
|
|
|
|
42
|
11
|
|
|
|
|
24
|
return mime_encode($val, $charset, $header_name_length); |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
sub _needs_mime_encode { |
46
|
100
|
|
|
100
|
|
166
|
my ($val) = @_; |
47
|
100
|
|
100
|
1
|
|
1177
|
return defined $val && $val =~ /(?:\P{ASCII}|=\?|[^\s]{79,}|^\s+|\s+$)/s; |
|
1
|
|
|
|
|
19
|
|
|
1
|
|
|
|
|
10
|
|
|
1
|
|
|
|
|
19
|
|
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
sub _needs_mime_encode_addr { |
51
|
80
|
|
|
80
|
|
436
|
my ($val) = @_; |
52
|
80
|
|
66
|
|
|
138
|
return _needs_mime_encode($val) || ( defined $val && $val =~ /[:;,]/ ); |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub _object_encode { |
56
|
22
|
|
|
22
|
|
54
|
my ($val, $charset, $header_name_length, $class) = @_; |
57
|
|
|
|
|
|
|
|
58
|
22
|
|
|
|
|
68
|
local @CARP_NOT = qw(Email::MIME Email::MIME::Header); |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
{ |
61
|
22
|
|
|
|
|
35
|
local $@; |
|
22
|
|
|
|
|
34
|
|
62
|
22
|
50
|
|
|
|
39
|
Carp::croak("Cannot load package '$class': $@") unless eval { Module::Runtime::require_module($class) }; |
|
22
|
|
|
|
|
64
|
|
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
22
|
50
|
|
|
|
799
|
Carp::croak("Class '$class' does not have method 'from_string'") unless $class->can('from_string'); |
66
|
|
|
|
|
|
|
|
67
|
22
|
100
|
|
|
|
114
|
my $object = $class->from_string(ref $val eq 'ARRAY' ? @{$val} : $val); |
|
2
|
|
|
|
|
9
|
|
68
|
|
|
|
|
|
|
|
69
|
22
|
50
|
|
|
|
98
|
Carp::croak("Object from class '$class' does not have method 'as_mime_string'") unless $object->can('as_mime_string'); |
70
|
|
|
|
|
|
|
|
71
|
22
|
|
|
|
|
101
|
return $object->as_mime_string({ |
72
|
|
|
|
|
|
|
charset => $charset, |
73
|
|
|
|
|
|
|
header_name_length => $header_name_length, |
74
|
|
|
|
|
|
|
}); |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
# XXX this is copied directly out of Courriel::Header |
78
|
|
|
|
|
|
|
# eventually, this should be extracted out into something that could be shared |
79
|
|
|
|
|
|
|
sub mime_encode { |
80
|
36
|
|
|
36
|
0
|
192
|
my ($text, $charset, $header_name_length) = @_; |
81
|
|
|
|
|
|
|
|
82
|
36
|
100
|
|
|
|
85
|
$header_name_length = 0 unless defined $header_name_length; |
83
|
36
|
100
|
|
|
|
69
|
$charset = 'UTF-8' unless defined $charset; |
84
|
|
|
|
|
|
|
|
85
|
36
|
|
|
|
|
106
|
my $enc_obj = Encode::find_encoding($charset); |
86
|
|
|
|
|
|
|
|
87
|
36
|
|
|
|
|
1519
|
my $head = '=?' . $enc_obj->mime_name() . '?B?'; |
88
|
36
|
|
|
|
|
2582
|
my $tail = '?='; |
89
|
|
|
|
|
|
|
|
90
|
36
|
|
|
|
|
63
|
my $mime_length = length($head) + length($tail); |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
# This code is copied from Mail::Message::Field::Full in the Mail-Box |
93
|
|
|
|
|
|
|
# distro. |
94
|
36
|
|
|
|
|
123
|
my $real_length = int( ( 75 - $mime_length ) / 4 ) * 3; |
95
|
36
|
|
|
|
|
65
|
my $first_length = int( ( 75 - $header_name_length - $mime_length ) / 4 ) * 3; |
96
|
|
|
|
|
|
|
|
97
|
36
|
|
|
|
|
49
|
my @result; |
98
|
36
|
|
|
|
|
52
|
my $chunk = q{}; |
99
|
36
|
|
|
|
|
44
|
my $first_processed = 0; |
100
|
36
|
|
|
|
|
188
|
while ( length( my $chr = substr( $text, 0, 1, '' ) ) ) { |
101
|
832
|
|
|
|
|
1942
|
my $chr = $enc_obj->encode( $chr, 0 ); |
102
|
|
|
|
|
|
|
|
103
|
832
|
100
|
|
|
|
1848
|
if ( length($chunk) + length($chr) > ( $first_processed ? $real_length : $first_length ) ) { |
|
|
100
|
|
|
|
|
|
104
|
8
|
50
|
|
|
|
20
|
if ( length($chunk) > 0 ) { |
105
|
8
|
|
|
|
|
34
|
push @result, $head . MIME::Base64::encode_base64( $chunk, q{} ) . $tail; |
106
|
8
|
|
|
|
|
14
|
$chunk = q{}; |
107
|
|
|
|
|
|
|
} |
108
|
8
|
50
|
|
|
|
51
|
$first_processed = 1 |
109
|
|
|
|
|
|
|
unless $first_processed; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
832
|
|
|
|
|
2537
|
$chunk .= $chr; |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
36
|
50
|
|
|
|
192
|
push @result, $head . MIME::Base64::encode_base64( $chunk, q{} ) . $tail |
116
|
|
|
|
|
|
|
if length $chunk; |
117
|
|
|
|
|
|
|
|
118
|
36
|
|
|
|
|
231
|
return join q{ }, @result; |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
sub maybe_mime_decode_header { |
122
|
37
|
|
|
37
|
0
|
71
|
my ($header, $val) = @_; |
123
|
|
|
|
|
|
|
|
124
|
37
|
|
|
|
|
74
|
$header = lc $header; |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
return _object_decode($val, $Email::MIME::Header::header_to_class_map{$header}) |
127
|
37
|
100
|
|
|
|
113
|
if exists $Email::MIME::Header::header_to_class_map{$header}; |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
return $val |
130
|
16
|
100
|
|
|
|
35
|
if exists $no_mime_headers{$header}; |
131
|
|
|
|
|
|
|
|
132
|
15
|
100
|
|
|
|
39
|
return $val |
133
|
|
|
|
|
|
|
unless $val =~ /=\?/; |
134
|
|
|
|
|
|
|
|
135
|
14
|
|
|
|
|
26
|
return mime_decode($val); |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
sub _object_decode { |
139
|
21
|
|
|
21
|
|
84
|
my ($string, $class) = @_; |
140
|
|
|
|
|
|
|
|
141
|
21
|
|
|
|
|
61
|
local @CARP_NOT = qw(Email::MIME Email::MIME::Header); |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
{ |
144
|
21
|
|
|
|
|
64
|
local $@; |
|
21
|
|
|
|
|
31
|
|
145
|
21
|
50
|
|
|
|
38
|
Carp::croak("Cannot load package '$class': $@") unless eval { Module::Runtime::require_module($class) }; |
|
21
|
|
|
|
|
68
|
|
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
|
148
|
21
|
50
|
|
|
|
821
|
Carp::croak("Class '$class' does not have method 'from_mime_string'") unless $class->can('from_mime_string'); |
149
|
|
|
|
|
|
|
|
150
|
21
|
|
|
|
|
68
|
my $object = $class->from_mime_string($string); |
151
|
|
|
|
|
|
|
|
152
|
21
|
50
|
|
|
|
112
|
Carp::croak("Object from class '$class' does not have method 'as_string'") unless $object->can('as_string'); |
153
|
|
|
|
|
|
|
|
154
|
21
|
|
|
|
|
61
|
return $object->as_string(); |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
sub mime_decode { |
158
|
64
|
|
|
64
|
0
|
311
|
my ($text) = @_; |
159
|
64
|
50
|
|
|
|
129
|
return undef unless defined $text; |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
# The eval is to cope with unknown encodings, like Latin-62, or other |
162
|
|
|
|
|
|
|
# nonsense that gets put in there by spammers and weirdos |
163
|
|
|
|
|
|
|
# -- rjbs, 2014-12-04 |
164
|
64
|
|
|
|
|
90
|
local $@; |
165
|
64
|
|
|
|
|
109
|
my $result = eval { Encode::decode("MIME-Header", $text) }; |
|
64
|
|
|
|
|
167
|
|
166
|
64
|
50
|
|
|
|
27116
|
return defined $result ? $result : $text; |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
1; |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
__END__ |