line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Lingua::JA::Mail::Header;
|
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
our $VERSION = '0.02'; # 2003-04-03 (since 2003-03-05)
|
4
|
|
|
|
|
|
|
|
5
|
2
|
|
|
2
|
|
31765
|
use 5.008;
|
|
2
|
|
|
|
|
7
|
|
|
2
|
|
|
|
|
79
|
|
6
|
2
|
|
|
2
|
|
12
|
use strict;
|
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
82
|
|
7
|
2
|
|
|
2
|
|
11
|
use warnings;
|
|
2
|
|
|
|
|
9
|
|
|
2
|
|
|
|
|
58
|
|
8
|
2
|
|
|
2
|
|
17
|
use Carp;
|
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
199
|
|
9
|
|
|
|
|
|
|
|
10
|
2
|
|
|
2
|
|
2414
|
use Encode;
|
|
2
|
|
|
|
|
30302
|
|
|
2
|
|
|
|
|
234
|
|
11
|
2
|
|
|
2
|
|
1951
|
use MIME::Base64;
|
|
2
|
|
|
|
|
1970
|
|
|
2
|
|
|
|
|
4684
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
sub new {
|
14
|
9
|
|
|
9
|
1
|
5749
|
my $class = shift;
|
15
|
9
|
|
|
|
|
23
|
my $self = {};
|
16
|
9
|
|
|
|
|
35
|
bless $self, $class;
|
17
|
9
|
|
|
|
|
24
|
return $self;
|
18
|
|
|
|
|
|
|
}
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub set {
|
21
|
0
|
|
|
0
|
1
|
0
|
my ($self, $entity, $value) = @_;
|
22
|
0
|
|
|
|
|
0
|
$$self{$entity} = $value;
|
23
|
0
|
|
|
|
|
0
|
return $self;
|
24
|
|
|
|
|
|
|
}
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub build {
|
27
|
4
|
|
|
4
|
1
|
25
|
my $self = shift;
|
28
|
4
|
|
|
|
|
17
|
my @key = $self->_header_order;
|
29
|
4
|
|
|
|
|
8
|
my @header;
|
30
|
4
|
|
|
|
|
7
|
foreach my $key (@key) {
|
31
|
20
|
|
|
|
|
82
|
push(@header, "$key: $$self{$key}");
|
32
|
|
|
|
|
|
|
}
|
33
|
4
|
|
|
|
|
43
|
return join("\n", @header);
|
34
|
|
|
|
|
|
|
}
|
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub _header_order {
|
37
|
9
|
|
|
9
|
|
17
|
my $self = shift;
|
38
|
9
|
|
|
|
|
94
|
my @key = keys(%$self);
|
39
|
9
|
|
|
|
|
161
|
my @order = qw(
|
40
|
|
|
|
|
|
|
Date From Sender Reply-To To Cc Bcc
|
41
|
|
|
|
|
|
|
Message-ID In-Reply-To References
|
42
|
|
|
|
|
|
|
Subject Comments Keywords
|
43
|
|
|
|
|
|
|
);
|
44
|
|
|
|
|
|
|
|
45
|
9
|
|
|
|
|
16
|
my @newkey;
|
46
|
9
|
|
|
|
|
22
|
foreach my $order (@order) {
|
47
|
117
|
|
|
|
|
152
|
foreach my $key (@key) {
|
48
|
689
|
100
|
|
|
|
1386
|
if ($key eq $order) {
|
49
|
48
|
|
|
|
|
94
|
push(@newkey, $key);
|
50
|
|
|
|
|
|
|
}
|
51
|
|
|
|
|
|
|
}
|
52
|
|
|
|
|
|
|
}
|
53
|
|
|
|
|
|
|
|
54
|
9
|
|
|
|
|
18
|
my @oldkey;
|
55
|
9
|
|
|
|
|
19
|
foreach my $key (@key) {
|
56
|
53
|
|
|
|
|
61
|
my $exist = 0;
|
57
|
53
|
|
|
|
|
71
|
foreach my $newkey (@newkey) {
|
58
|
196
|
100
|
|
|
|
445
|
if ($key eq $newkey) {
|
59
|
48
|
|
|
|
|
54
|
$exist = 1;
|
60
|
48
|
|
|
|
|
65
|
last;
|
61
|
|
|
|
|
|
|
}
|
62
|
|
|
|
|
|
|
}
|
63
|
53
|
100
|
|
|
|
127
|
if ($exist != 1) {
|
64
|
5
|
|
|
|
|
12
|
push(@oldkey, $key);
|
65
|
|
|
|
|
|
|
}
|
66
|
|
|
|
|
|
|
}
|
67
|
|
|
|
|
|
|
|
68
|
9
|
|
|
|
|
64
|
return @newkey, @oldkey;
|
69
|
|
|
|
|
|
|
}
|
70
|
|
|
|
|
|
|
########################################################################
|
71
|
|
|
|
|
|
|
# specify the origination date.
|
72
|
|
|
|
|
|
|
sub date {
|
73
|
9
|
|
|
9
|
1
|
15540
|
my($self, $date_time) = @_;
|
74
|
9
|
|
|
|
|
42
|
$$self{'Date'} = $date_time;
|
75
|
9
|
|
|
|
|
23
|
return $self;
|
76
|
|
|
|
|
|
|
}
|
77
|
|
|
|
|
|
|
########################################################################
|
78
|
|
|
|
|
|
|
# add a originator address or a destination address.
|
79
|
|
|
|
|
|
|
sub add_from {
|
80
|
15
|
|
|
15
|
1
|
86
|
my($self, $addr_spec, $name) = @_;
|
81
|
15
|
|
|
|
|
51
|
$self->_add_mailbox('From', $addr_spec, $name);
|
82
|
15
|
|
|
|
|
44
|
return $self
|
83
|
|
|
|
|
|
|
}
|
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
sub sender {
|
86
|
3
|
|
|
3
|
1
|
35
|
my($self, $addr_spec, $name) = @_;
|
87
|
3
|
|
|
|
|
10
|
$self->_add_mailbox('Sender', $addr_spec, $name);
|
88
|
3
|
|
|
|
|
10
|
return $self
|
89
|
|
|
|
|
|
|
}
|
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
sub add_reply {
|
92
|
9
|
|
|
9
|
1
|
51
|
my($self, $addr_spec, $name) = @_;
|
93
|
9
|
|
|
|
|
25
|
$self->_add_mailbox('Reply-To', $addr_spec, $name);
|
94
|
9
|
|
|
|
|
85
|
return $self
|
95
|
|
|
|
|
|
|
}
|
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
sub add_to {
|
98
|
27
|
|
|
27
|
1
|
373
|
my($self, $addr_spec, $name) = @_;
|
99
|
27
|
|
|
|
|
60
|
$self->_add_mailbox('To', $addr_spec, $name);
|
100
|
27
|
|
|
|
|
66
|
return $self
|
101
|
|
|
|
|
|
|
}
|
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
sub add_cc {
|
104
|
9
|
|
|
9
|
1
|
61
|
my($self, $addr_spec, $name) = @_;
|
105
|
9
|
|
|
|
|
27
|
$self->_add_mailbox('Cc', $addr_spec, $name);
|
106
|
9
|
|
|
|
|
100
|
return $self
|
107
|
|
|
|
|
|
|
}
|
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
sub add_bcc {
|
110
|
9
|
|
|
9
|
1
|
55
|
my($self, $addr_spec, $name) = @_;
|
111
|
9
|
|
|
|
|
26
|
$self->_add_mailbox('Bcc', $addr_spec, $name);
|
112
|
9
|
|
|
|
|
23
|
return $self
|
113
|
|
|
|
|
|
|
}
|
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
sub _add_mailbox {
|
116
|
72
|
|
|
72
|
|
146
|
my($self, $field, $addr_spec, $name) = @_;
|
117
|
|
|
|
|
|
|
|
118
|
72
|
|
|
|
|
89
|
my $address;
|
119
|
72
|
100
|
|
|
|
136
|
if ($name) {
|
120
|
62
|
100
|
|
|
|
121
|
if ( _check_if_contain_japanese($name) ) {
|
121
|
24
|
|
|
|
|
49
|
my $name = encoded_header($name);
|
122
|
24
|
|
|
|
|
102
|
$address = "$name\n <$addr_spec>";
|
123
|
|
|
|
|
|
|
}
|
124
|
|
|
|
|
|
|
else {
|
125
|
38
|
100
|
|
|
|
87
|
if ( length($name) <= 73) {
|
126
|
16
|
|
|
|
|
53
|
$address = "\"$name\"\n <$addr_spec>";
|
127
|
|
|
|
|
|
|
}
|
128
|
|
|
|
|
|
|
else {
|
129
|
22
|
|
|
|
|
88
|
my @name = split(/ /, $name);
|
130
|
22
|
|
|
|
|
41
|
my $too_long_word = 0;
|
131
|
22
|
|
|
|
|
38
|
foreach my $piece (@name) {
|
132
|
33
|
100
|
|
|
|
102
|
if ( length($piece) > 75 ) {
|
133
|
11
|
|
|
|
|
13
|
$too_long_word = 1;
|
134
|
11
|
|
|
|
|
24
|
last;
|
135
|
|
|
|
|
|
|
}
|
136
|
|
|
|
|
|
|
}
|
137
|
22
|
100
|
|
|
|
46
|
if ($too_long_word) {
|
138
|
11
|
|
|
|
|
27
|
$name = encoded_header_ascii($name);
|
139
|
11
|
|
|
|
|
36
|
$address = "$name\n <$addr_spec>";
|
140
|
|
|
|
|
|
|
}
|
141
|
|
|
|
|
|
|
else {
|
142
|
11
|
|
|
|
|
30
|
$name = join("\n ", @name);
|
143
|
11
|
|
|
|
|
36
|
$address = "$name\n <$addr_spec>";
|
144
|
|
|
|
|
|
|
}
|
145
|
|
|
|
|
|
|
}
|
146
|
|
|
|
|
|
|
}
|
147
|
|
|
|
|
|
|
}
|
148
|
|
|
|
|
|
|
else {
|
149
|
10
|
|
|
|
|
17
|
$address = $addr_spec;
|
150
|
|
|
|
|
|
|
}
|
151
|
|
|
|
|
|
|
|
152
|
72
|
100
|
|
|
|
1463
|
if ($$self{$field}) {
|
153
|
42
|
50
|
|
|
|
90
|
if ($field eq 'Sender') {
|
154
|
0
|
|
|
|
|
0
|
croak "a violation of the RFC2822 - you can specify the 'Sender:' field with only one 'mailbox'";
|
155
|
|
|
|
|
|
|
}
|
156
|
|
|
|
|
|
|
else {
|
157
|
42
|
|
|
|
|
164
|
$$self{$field} = "$$self{$field},\n $address";
|
158
|
|
|
|
|
|
|
}
|
159
|
|
|
|
|
|
|
}
|
160
|
|
|
|
|
|
|
else {
|
161
|
30
|
|
|
|
|
103
|
$$self{$field} = "\n $address";
|
162
|
|
|
|
|
|
|
}
|
163
|
|
|
|
|
|
|
|
164
|
72
|
|
|
|
|
3625
|
return $self;
|
165
|
|
|
|
|
|
|
}
|
166
|
|
|
|
|
|
|
########################################################################
|
167
|
|
|
|
|
|
|
sub _check_if_contain_japanese {
|
168
|
62
|
|
|
62
|
|
85
|
my $string = shift;
|
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
# $string = decode('utf8', $string);
|
171
|
62
|
|
|
|
|
169
|
$string =~ tr/\n//d; # ignore line-break
|
172
|
62
|
|
|
|
|
179
|
return $string =~
|
173
|
|
|
|
|
|
|
tr/\x01-\x08\x0B\x0C\x0E-\x1F\x7F\x21\x23-\x5B\x5D-\x7E\x20//c;
|
174
|
|
|
|
|
|
|
# this tr/// checks if there is other than qtext characters or SPACE.
|
175
|
|
|
|
|
|
|
# from RFC2822:
|
176
|
|
|
|
|
|
|
# qtext = NO-WS-CTL / %d33 / %d35-91 / %d93-126
|
177
|
|
|
|
|
|
|
# qcontent = qtext / quoted-pair
|
178
|
|
|
|
|
|
|
# quoted-string = [CFWS] DQUOTE *([FWS] qcontent) [FWS] DQUOTE [CFWS]
|
179
|
|
|
|
|
|
|
}
|
180
|
|
|
|
|
|
|
########################################################################
|
181
|
|
|
|
|
|
|
sub subject {
|
182
|
9
|
|
|
9
|
1
|
65
|
my($self, $string) = @_;
|
183
|
9
|
|
|
|
|
27
|
$$self{'Subject'} = encoded_header($string);
|
184
|
9
|
|
|
|
|
34
|
$$self{'Subject'} = "\n $$self{'Subject'}";
|
185
|
9
|
|
|
|
|
28
|
return $self;
|
186
|
|
|
|
|
|
|
}
|
187
|
|
|
|
|
|
|
########################################################################
|
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
# RFC2822 describes about the length of a line
|
190
|
|
|
|
|
|
|
# Max: 998 = 1000 - (CR + LF)
|
191
|
|
|
|
|
|
|
# Rec: 76 = 78 - (CR + LF)
|
192
|
|
|
|
|
|
|
# RFC2047 describes about the length of an encoded-word
|
193
|
|
|
|
|
|
|
# Max: 75 = 76 - SPACE
|
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
sub encoded_header {
|
196
|
33
|
|
|
33
|
0
|
42
|
my ($string) = @_;
|
197
|
|
|
|
|
|
|
|
198
|
33
|
|
|
|
|
73
|
my @lines = _encoded_word($string);
|
199
|
|
|
|
|
|
|
|
200
|
33
|
|
|
|
|
93
|
my $line = join("\n ", @lines);
|
201
|
33
|
|
|
|
|
118
|
return $line;
|
202
|
|
|
|
|
|
|
}
|
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
# an encoded-word is composed of
|
205
|
|
|
|
|
|
|
# 'charset', 'encoding', 'encoded-text' and delimiters.
|
206
|
|
|
|
|
|
|
# Hence the max length of an encoded-text is:
|
207
|
|
|
|
|
|
|
# 75 - ('charset', 'encoding' and delimiters)
|
208
|
|
|
|
|
|
|
#
|
209
|
|
|
|
|
|
|
# charset 'ISO-2022-JP' is 11.
|
210
|
|
|
|
|
|
|
# encoding 'B' is 1.
|
211
|
|
|
|
|
|
|
# delimiters '=?', '?', '?' and '?=' is total 6.
|
212
|
|
|
|
|
|
|
# 75 - (11 + 1 + 6) = 57
|
213
|
|
|
|
|
|
|
# It is said that the max length of an encoded-text is 57
|
214
|
|
|
|
|
|
|
# when we use ISO-2022-JP B encoding.
|
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
sub _encoded_word {
|
217
|
33
|
|
|
33
|
|
42
|
my ($string) = @_;
|
218
|
|
|
|
|
|
|
|
219
|
33
|
|
|
|
|
69
|
my @words = _encoded_text($string);
|
220
|
|
|
|
|
|
|
|
221
|
33
|
|
|
|
|
131
|
foreach my $word (@words) {
|
222
|
69
|
|
|
|
|
211
|
$word = "=?ISO-2022-JP?B?$word?=";
|
223
|
|
|
|
|
|
|
}
|
224
|
|
|
|
|
|
|
|
225
|
33
|
|
|
|
|
250
|
return @words;
|
226
|
|
|
|
|
|
|
}
|
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
# Through Base64 encoding, a group of 4 ASCII-6bit characters
|
229
|
|
|
|
|
|
|
# is generated by 3 ASCII-8bit pre-encode characters.
|
230
|
|
|
|
|
|
|
# We can get 14 group of encoded 4 ASCII-6bit characters under
|
231
|
|
|
|
|
|
|
# the encoded-text's 57 characters limit.
|
232
|
|
|
|
|
|
|
# Hence, we may handle max 42 ASCII-8bit characters as
|
233
|
|
|
|
|
|
|
# a pre-encode text.
|
234
|
|
|
|
|
|
|
# So we should split a ISO-2022-JP text that
|
235
|
|
|
|
|
|
|
# each splitted piece's length is within 42
|
236
|
|
|
|
|
|
|
# if it is counted as ASCII-8bit characters.
|
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
sub _encoded_text {
|
239
|
33
|
|
|
33
|
|
42
|
my ($string) = @_;
|
240
|
|
|
|
|
|
|
|
241
|
33
|
|
|
|
|
2077
|
my @text = _split($string);
|
242
|
|
|
|
|
|
|
|
243
|
33
|
|
|
|
|
76
|
foreach my $text (@text) {
|
244
|
69
|
|
|
|
|
231
|
$text = encode_base64($text);
|
245
|
69
|
|
|
|
|
341
|
$text =~ tr/\n//d;
|
246
|
|
|
|
|
|
|
}
|
247
|
|
|
|
|
|
|
|
248
|
33
|
|
|
|
|
112
|
return @text;
|
249
|
|
|
|
|
|
|
}
|
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
sub _split {
|
252
|
33
|
|
|
33
|
|
46
|
my ($string) = @_;
|
253
|
|
|
|
|
|
|
|
254
|
33
|
|
|
|
|
34
|
my @strings;
|
255
|
33
|
|
|
|
|
74
|
while ($string) {
|
256
|
69
|
|
|
|
|
138
|
(my $piece, $string) = _cut_once($string);
|
257
|
69
|
|
|
|
|
226
|
push(@strings, $piece);
|
258
|
|
|
|
|
|
|
}
|
259
|
|
|
|
|
|
|
|
260
|
33
|
|
|
|
|
121
|
return @strings;
|
261
|
|
|
|
|
|
|
}
|
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
sub _cut_once {
|
264
|
69
|
|
|
69
|
|
102
|
my ($string) = @_;
|
265
|
|
|
|
|
|
|
|
266
|
69
|
|
|
|
|
4823
|
my $whole = encode('iso-2022-jp', $string);
|
267
|
69
|
100
|
|
|
|
49527
|
if ( length($whole) <= 42 ) {
|
268
|
33
|
|
|
|
|
102
|
return $whole;
|
269
|
0
|
|
|
|
|
0
|
last;
|
270
|
|
|
|
|
|
|
}
|
271
|
|
|
|
|
|
|
|
272
|
36
|
|
|
|
|
73
|
my $letters = length($string);
|
273
|
36
|
|
|
|
|
116
|
for (my $i = 1; $i <= $letters; $i++) {
|
274
|
684
|
|
|
|
|
1344
|
my $temp = substr($string, 0, $i);
|
275
|
684
|
|
|
|
|
1604
|
$temp = encode('iso-2022-jp', $temp);
|
276
|
684
|
100
|
|
|
|
73894
|
if (length($temp) > 42) {
|
277
|
36
|
|
|
|
|
99
|
my $piece = substr($string, 0, $i - 1);
|
278
|
36
|
|
|
|
|
107
|
$piece = encode('iso-2022-jp', $piece);
|
279
|
36
|
|
|
|
|
2718
|
my $rest = substr($string, $i - 1);
|
280
|
36
|
|
|
|
|
254
|
return ($piece, $rest);
|
281
|
0
|
|
|
|
|
0
|
last;
|
282
|
|
|
|
|
|
|
}
|
283
|
|
|
|
|
|
|
}
|
284
|
|
|
|
|
|
|
}
|
285
|
|
|
|
|
|
|
########################################################################
|
286
|
|
|
|
|
|
|
sub encoded_header_ascii {
|
287
|
11
|
|
|
11
|
0
|
18
|
my ($string) = @_;
|
288
|
|
|
|
|
|
|
|
289
|
11
|
|
|
|
|
34
|
my @lines = _encoded_word_q($string);
|
290
|
|
|
|
|
|
|
|
291
|
11
|
|
|
|
|
29
|
my $line = join("\n ", @lines);
|
292
|
11
|
|
|
|
|
39
|
return $line;
|
293
|
|
|
|
|
|
|
}
|
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
sub _encoded_word_q {
|
296
|
11
|
|
|
11
|
|
19
|
my ($string) = @_;
|
297
|
|
|
|
|
|
|
|
298
|
11
|
|
|
|
|
30
|
my @words = _encoded_text_q($string);
|
299
|
|
|
|
|
|
|
|
300
|
11
|
|
|
|
|
24
|
foreach my $word (@words) {
|
301
|
22
|
|
|
|
|
70
|
$word = "=?US-ASCII?Q?$word?=";
|
302
|
|
|
|
|
|
|
}
|
303
|
|
|
|
|
|
|
|
304
|
11
|
|
|
|
|
37
|
return @words;
|
305
|
|
|
|
|
|
|
}
|
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
sub _encoded_text_q {
|
308
|
11
|
|
|
11
|
|
18
|
my ($string) = @_;
|
309
|
|
|
|
|
|
|
|
310
|
11
|
|
|
|
|
33
|
my @text = _split_q($string);
|
311
|
|
|
|
|
|
|
|
312
|
11
|
|
|
|
|
25
|
foreach my $text (@text) {
|
313
|
22
|
|
|
|
|
35
|
$text = encode_q($text);
|
314
|
|
|
|
|
|
|
}
|
315
|
|
|
|
|
|
|
|
316
|
11
|
|
|
|
|
35
|
return @text;
|
317
|
|
|
|
|
|
|
}
|
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
sub _split_q {
|
320
|
11
|
|
|
11
|
|
18
|
my ($string) = @_;
|
321
|
|
|
|
|
|
|
|
322
|
11
|
|
|
|
|
14
|
my @strings;
|
323
|
11
|
|
|
|
|
30
|
while ($string) {
|
324
|
22
|
|
|
|
|
44
|
(my $piece, $string) = _cut_once_q($string);
|
325
|
22
|
|
|
|
|
108
|
push(@strings, $piece);
|
326
|
|
|
|
|
|
|
}
|
327
|
|
|
|
|
|
|
|
328
|
11
|
|
|
|
|
33
|
return @strings;
|
329
|
|
|
|
|
|
|
}
|
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
sub _cut_once_q {
|
332
|
22
|
|
|
22
|
|
29
|
my ($string) = @_;
|
333
|
|
|
|
|
|
|
|
334
|
22
|
|
|
|
|
44
|
my $whole = encode_q($string);
|
335
|
22
|
100
|
|
|
|
61
|
if ( length($whole) <= 60 ) {
|
336
|
11
|
|
|
|
|
25
|
return $string;
|
337
|
0
|
|
|
|
|
0
|
last;
|
338
|
|
|
|
|
|
|
}
|
339
|
|
|
|
|
|
|
|
340
|
11
|
|
|
|
|
16
|
my $letters = length($string);
|
341
|
11
|
|
|
|
|
66
|
for (my $i = 1; $i <= $letters; $i++) {
|
342
|
671
|
|
|
|
|
999
|
my $temp = substr($string, 0, $i);
|
343
|
671
|
|
|
|
|
949
|
$temp = encode_q($temp);
|
344
|
671
|
100
|
|
|
|
3401
|
if (length($temp) > 60) {
|
345
|
11
|
|
|
|
|
28
|
my $piece = substr($string, 0, $i - 1);
|
346
|
11
|
|
|
|
|
25
|
my $rest = substr($string, $i - 1);
|
347
|
11
|
|
|
|
|
61
|
return ($piece, $rest);
|
348
|
0
|
|
|
|
|
0
|
last;
|
349
|
|
|
|
|
|
|
}
|
350
|
|
|
|
|
|
|
}
|
351
|
|
|
|
|
|
|
}
|
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
sub encode_q {
|
354
|
715
|
|
|
715
|
0
|
823
|
my ($string) = @_;
|
355
|
|
|
|
|
|
|
|
356
|
715
|
|
|
|
|
1390
|
$string =~
|
357
|
0
|
|
|
|
|
0
|
s/([^\x21\x23-\x3C\x3E\x40-\x5B\x5D\x5E\x60-\x7E])/uc sprintf("=%02x", ord($1))/eg;
|
358
|
|
|
|
|
|
|
|
359
|
715
|
|
|
|
|
2531
|
return $string;
|
360
|
|
|
|
|
|
|
}
|
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
1;
|
364
|
|
|
|
|
|
|
__END__
|