14 |
use vars qw($VERSION %REG); |
use vars qw($VERSION %REG); |
15 |
$VERSION = '1.00'; |
$VERSION = '1.00'; |
16 |
use Carp (); |
use Carp (); |
17 |
use overload '@{}' => sub {shift->_delete_empty_field()->{field}}, |
use overload '@{}' => sub { shift->_delete_empty_field->{field} }, |
18 |
'""' => sub {shift->stringify}; |
'""' => sub { shift->stringify }, |
19 |
|
fallback => 1; |
20 |
|
|
21 |
$REG{WSP} = qr/[\x09\x20]/; |
$REG{WSP} = qr/[\x09\x20]/; |
22 |
$REG{FWS} = qr/[\x09\x20]*/; |
$REG{FWS} = qr/[\x09\x20]*/; |
45 |
|
|
46 |
=cut |
=cut |
47 |
|
|
48 |
|
=head1 CONSTRUCTORS |
49 |
|
|
50 |
|
The following methods construct new C<Message::Header> objects: |
51 |
|
|
52 |
|
=over 4 |
53 |
|
|
54 |
|
## Initialize |
55 |
my %DEFAULT = ( |
my %DEFAULT = ( |
56 |
capitalize => 1, |
capitalize => 1, |
57 |
fold_length => 70, |
fold_length => 70, |
72 |
|
|
73 |
'content-type' => 'Message::Field::ContentType', |
'content-type' => 'Message::Field::ContentType', |
74 |
'content-disposition' => 'Message::Field::ContentDisposition', |
'content-disposition' => 'Message::Field::ContentDisposition', |
75 |
|
'auto-submitted' => 'Message::Field::ValueParams', |
76 |
link => 'Message::Field::ValueParams', |
link => 'Message::Field::ValueParams', |
77 |
archive => 'Message::Field::ValueParams', |
archive => 'Message::Field::ValueParams', |
78 |
'x-face-type' => 'Message::Field::ValueParams', |
'x-face-type' => 'Message::Field::ValueParams', |
84 |
'user-agent' => 'Message::Field::UA', |
'user-agent' => 'Message::Field::UA', |
85 |
server => 'Message::Field::UA', |
server => 'Message::Field::UA', |
86 |
|
|
87 |
|
## Numeric value |
88 |
'content-length' => 'Message::Field::Numval', |
'content-length' => 'Message::Field::Numval', |
89 |
lines => 'Message::Field::Numval', |
lines => 'Message::Field::Numval', |
90 |
'max-forwards' => 'Message::Field::Numval', |
'max-forwards' => 'Message::Field::Numval', |
91 |
'mime-version' => 'Message::Field::Numval', |
'mime-version' => 'Message::Field::Numval', |
92 |
|
'x-jsmail-priority' => 'Message::Field::Numval', |
93 |
|
'x-priority' => 'Message::Field::Numval', |
94 |
|
|
95 |
path => 'Message::Field::Path', |
path => 'Message::Field::Path', |
96 |
}; |
}; |
97 |
for (qw(cancel-lock importance precedence list-id |
for (qw(cancel-lock importance precedence list-id |
98 |
x-face x-mail-count x-msmail-priority x-priority xref)) |
x-face x-mail-count x-msmail-priority x-priority xref)) |
99 |
{$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'} |
{$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'} |
100 |
for (qw(approved bcc cc delivered-to disposition-notification-to envelope-to |
for (qw(approved bcc cc complaints-to |
101 |
errors-to fcc from mail-followup-to mail-followup-cc reply-to resent-bcc |
delivered-to disposition-notification-to envelope-to |
102 |
|
errors-to fcc from mail-followup-to mail-followup-cc |
103 |
|
mail-reply-to |
104 |
|
notice-requested-upon-delivery-to reply-to resent-bcc |
105 |
resent-cc resent-to resent-from resent-sender return-path |
resent-cc resent-to resent-from resent-sender return-path |
106 |
return-receipt-to sender to x-approved x-beenthere |
return-receipt-to sender to x-approved x-beenthere |
107 |
x-complaints-to x-envelope-from x-envelope-sender |
x-complaints-to x-envelope-from x-envelope-sender |
187 |
} |
} |
188 |
} |
} |
189 |
|
|
190 |
=head2 Message::Header->new ([%initial-fields/options]) |
=item Message::Header->new ([%initial-fields/options]) |
191 |
|
|
192 |
Constructs a new C<Message::Headers> object. You might pass some initial |
Constructs a new C<Message::Headers> object. You might pass some initial |
193 |
C<field-name>-C<field-body> pairs and/or options as parameters to the constructor. |
C<field-name>-C<field-body> pairs and/or options as parameters to the constructor. |
194 |
|
|
195 |
=head3 example |
Example: |
196 |
|
|
197 |
$hdr = new Message::Headers |
$hdr = new Message::Headers |
198 |
Date => 'Thu, 03 Feb 1994 00:00:00 +0000', |
Date => 'Thu, 03 Feb 1994 00:00:00 +0000', |
210 |
$self; |
$self; |
211 |
} |
} |
212 |
|
|
213 |
=head2 Message::Header->parse ($header, [%initial-fields/options]) |
=item Message::Header->parse ($header, [%initial-fields/options]) |
214 |
|
|
215 |
Parses given C<header> and constructs a new C<Message::Headers> |
Parses given C<header> and constructs a new C<Message::Headers> |
216 |
object. You might pass some additional C<field-name>-C<field-body> pairs |
object. You might pass some additional C<field-name>-C<field-body> pairs |
241 |
$self; |
$self; |
242 |
} |
} |
243 |
|
|
244 |
|
=item Message::Header->parse_array (\@header, [%initial-fields/options]) |
245 |
|
|
246 |
|
Parses given C<header> and constructs a new C<Message::Headers> |
247 |
|
object. Same as C<Message::Header-E<lt>parse> but this method |
248 |
|
is given an array reference. You might pass some additional |
249 |
|
C<field-name>-C<field-body> pairs or/and initial options |
250 |
|
as parameters to the constructor. |
251 |
|
|
252 |
|
=cut |
253 |
|
|
254 |
sub parse_array ($\@;%) { |
sub parse_array ($\@;%) { |
255 |
my $class = shift; |
my $class = shift; |
256 |
my $header = shift; |
my $header = shift; |
283 |
$self; |
$self; |
284 |
} |
} |
285 |
|
|
286 |
|
=back |
287 |
|
|
288 |
|
=head1 METHODS |
289 |
|
|
290 |
=head2 $self->field ($field_name) |
=head2 $self->field ($field_name) |
291 |
|
|
292 |
Returns C<field-body> of given C<field-name>. |
Returns C<field-body> of given C<field-name>. |
441 |
my %option = %{$self->{option}}; |
my %option = %{$self->{option}}; |
442 |
$option{parse} = defined wantarray unless defined $option{parse}; |
$option{parse} = defined wantarray unless defined $option{parse}; |
443 |
for (grep {/^-/} keys %params) {$option{substr ($_, 1)} = $params{$_}} |
for (grep {/^-/} keys %params) {$option{substr ($_, 1)} = $params{$_}} |
444 |
my (%new_field, $body); |
my (%new_field); |
445 |
for (grep {/^[^-]/} keys %params) { |
for (grep {/^[^-]/} keys %params) { |
446 |
my $name = lc $_; |
my $name = lc $_; |
447 |
$name =~ tr/_/-/ if $option{translate_underscore}; |
$name =~ tr/_/-/ if $option{translate_underscore}; |
450 |
$params{$_} = $self->_field_body ($params{$_}, $name) if $option{parse}; |
$params{$_} = $self->_field_body ($params{$_}, $name) if $option{parse}; |
451 |
$new_field{$name} = $params{$_}; |
$new_field{$name} = $params{$_}; |
452 |
} |
} |
453 |
|
my $body = (%new_field)[-1]; |
454 |
for my $field (@{$self->{field}}) { |
for my $field (@{$self->{field}}) { |
455 |
if (defined $new_field{$field->{name}}) { |
if (defined $new_field{$field->{name}}) { |
456 |
$body = $new_field {$field->{name}}; |
$field->{body} = $new_field {$field->{name}}; |
|
$field->{body} = $body; |
|
457 |
$new_field{$field->{name}} = undef; |
$new_field{$field->{name}} = undef; |
458 |
} |
} |
459 |
} |
} |