51 |
|
|
52 |
=over 4 |
=over 4 |
53 |
|
|
54 |
|
=cut |
55 |
|
|
56 |
## Initialize |
## Initialize |
57 |
my %DEFAULT = ( |
my %DEFAULT = ( |
58 |
capitalize => 1, |
capitalize => 1, |
59 |
|
fold => 1, |
60 |
fold_length => 70, |
fold_length => 70, |
61 |
|
field_format_pattern => '%s: %s', |
62 |
#field_type => {}, |
#field_type => {}, |
63 |
format => 'mail-rfc2822', |
format => 'mail-rfc2822', |
64 |
mail_from => 0, |
mail_from => 0, |
75 |
'x-received' => 'Message::Field::Received', |
'x-received' => 'Message::Field::Received', |
76 |
|
|
77 |
'content-type' => 'Message::Field::ContentType', |
'content-type' => 'Message::Field::ContentType', |
|
'content-disposition' => 'Message::Field::ContentDisposition', |
|
78 |
'auto-submitted' => 'Message::Field::ValueParams', |
'auto-submitted' => 'Message::Field::ValueParams', |
79 |
|
'content-disposition' => 'Message::Field::ValueParams', |
80 |
link => 'Message::Field::ValueParams', |
link => 'Message::Field::ValueParams', |
81 |
archive => 'Message::Field::ValueParams', |
archive => 'Message::Field::ValueParams', |
82 |
'x-face-type' => 'Message::Field::ValueParams', |
'x-face-type' => 'Message::Field::ValueParams', |
94 |
'max-forwards' => 'Message::Field::Numval', |
'max-forwards' => 'Message::Field::Numval', |
95 |
'mime-version' => 'Message::Field::Numval', |
'mime-version' => 'Message::Field::Numval', |
96 |
'x-jsmail-priority' => 'Message::Field::Numval', |
'x-jsmail-priority' => 'Message::Field::Numval', |
97 |
|
'x-mail-count' => 'Message::Field::Numval', |
98 |
|
'x-ml-count' => 'Message::Field::Numval', |
99 |
'x-priority' => 'Message::Field::Numval', |
'x-priority' => 'Message::Field::Numval', |
100 |
|
|
101 |
path => 'Message::Field::Path', |
path => 'Message::Field::Path', |
102 |
}; |
}; |
103 |
for (qw(cancel-lock importance precedence list-id |
for (qw(archive cancel-lock content-features content-md5 |
104 |
x-face x-mail-count x-msmail-priority x-priority xref)) |
disposition-notification-options encoding |
105 |
|
importance injector-info |
106 |
|
pics-label posted-and-mailed precedence list-id message-type |
107 |
|
original-recipient priority |
108 |
|
sensitivity status x-face x-msmail-priority xref)) |
109 |
{$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'} |
{$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'} |
110 |
for (qw(approved bcc cc complaints-to |
## Not supported yet, but to be supported... |
111 |
|
for (qw(abuse-reports-to apparently-to approved approved-by bcc cc complaints-to |
112 |
delivered-to disposition-notification-to envelope-to |
delivered-to disposition-notification-to envelope-to |
113 |
errors-to fcc from mail-followup-to mail-followup-cc |
errors-to from mail-copies-to mail-followup-to mail-reply-to |
114 |
mail-reply-to |
notice-requested-upon-delivery-to read-receipt-to register-mail-reply-requested-by |
115 |
notice-requested-upon-delivery-to reply-to resent-bcc |
reply-to resent-bcc |
116 |
resent-cc resent-to resent-from resent-sender return-path |
resent-cc resent-to resent-from resent-sender return-path |
117 |
return-receipt-to sender to x-approved x-beenthere |
return-receipt-to return-receipt-requested-to sender to x-abuse-reports-to |
118 |
|
x-admin x-approved |
119 |
|
x-beenthere |
120 |
|
x-confirm-reading-to |
121 |
x-complaints-to x-envelope-from x-envelope-sender |
x-complaints-to x-envelope-from x-envelope-sender |
122 |
x-envelope-to x-ml-address x-ml-command x-ml-to x-nfrom x-nto)) |
x-envelope-to x-ml-address x-ml-command x-ml-to x-nfrom x-nto |
123 |
|
x-rcpt-to x-sender x-x-sender)) |
124 |
{$DEFAULT{field_type}->{$_} = 'Message::Field::Address'} |
{$DEFAULT{field_type}->{$_} = 'Message::Field::Address'} |
125 |
for (qw(date date-received delivery-date expires |
for (qw(date date-received delivery-date expires |
126 |
expire-date nntp-posting-date posted reply-by resent-date x-tcup-date)) |
expire-date nntp-posting-date posted posted-date reply-by resent-date |
127 |
|
x-originalarrivaltime x-tcup-date)) |
128 |
{$DEFAULT{field_type}->{$_} = 'Message::Field::Date'} |
{$DEFAULT{field_type}->{$_} = 'Message::Field::Date'} |
129 |
for (qw(article-updates client-date content-id in-reply-to message-id |
for (qw(article-updates client-date content-id in-reply-to message-id |
130 |
references resent-message-id see-also supersedes)) |
obsoletes references replaces resent-message-id see-also supersedes)) |
131 |
{$DEFAULT{field_type}->{$_} = 'Message::Field::MsgID'} |
{$DEFAULT{field_type}->{$_} = 'Message::Field::MsgID'} |
132 |
for (qw(accept accept-charset accept-encoding accept-language |
for (qw(accept accept-charset accept-encoding accept-language |
133 |
content-language |
content-language |
134 |
content-transfer-encoding encrypted followup-to keywords |
content-transfer-encoding encrypted followup-to keywords |
135 |
list-archive list-digest list-help list-owner |
list-archive list-digest list-help list-owner |
136 |
list-post list-subscribe list-unsubscribe list-url uri newsgroups |
list-post list-subscribe list-unsubscribe list-url uri newsgroups |
137 |
|
posted-to |
138 |
x-brother x-daughter x-respect x-moe x-syster x-wife)) |
x-brother x-daughter x-respect x-moe x-syster x-wife)) |
139 |
{$DEFAULT{field_type}->{$_} = 'Message::Field::CSV'} |
{$DEFAULT{field_type}->{$_} = 'Message::Field::CSV'} |
140 |
for (qw(content-alias content-base content-location location referer |
for (qw(content-alias content-base content-location location referer |
189 |
if $#new_fields > -1; |
if $#new_fields > -1; |
190 |
|
|
191 |
my $format = $self->{option}->{format}; |
my $format = $self->{option}->{format}; |
192 |
if ($format =~ /^cgi/) { |
if ($format =~ /cgi/) { |
193 |
unshift @header_order, qw(content-type location); |
unshift @header_order, qw(content-type location); |
194 |
$self->{option}->{sort} = 'good-practice'; |
$self->{option}->{sort} = 'good-practice'; |
195 |
|
$self->{option}->{fold} = 0; |
196 |
} elsif ($format =~ /^http/) { |
} elsif ($format =~ /^http/) { |
197 |
$self->{option}->{sort} = 'good-practice'; |
$self->{option}->{sort} = 'good-practice'; |
198 |
} |
} |
375 |
|| $self->{option}->{field_type}->{':DEFAULT'}; |
|| $self->{option}->{field_type}->{':DEFAULT'}; |
376 |
eval "require $type" or Carp::croak ("_field_body: $type: $@"); |
eval "require $type" or Carp::croak ("_field_body: $type: $@"); |
377 |
unless ($body) { |
unless ($body) { |
378 |
$body = $type->new (-field_name => $name, |
$body = $type->new (-field_name => $name, |
379 |
-format => $self->{option}->{format}); |
-format => $self->{option}->{format} |
380 |
|
, field_name => $name, format => $self->{option}->{format}); |
381 |
} else { |
} else { |
382 |
$body = $type->parse ($body, -field_name => $name, |
$body = $type->parse ($body, -field_name => $name, |
383 |
-format => $self->{option}->{format}); |
-format => $self->{option}->{format}, |
384 |
|
field_name => $name,format => $self->{option}->{format}); |
385 |
} |
} |
386 |
} |
} |
387 |
$body; |
$body; |
401 |
map {$_->{name}} @{$self->{field}}; |
map {$_->{name}} @{$self->{field}}; |
402 |
} |
} |
403 |
|
|
404 |
=head2 $self->add ($field-name, $field-body, [$name, $body, ...]) |
=item $hdr->add ($field-name, $field-body, [$name, $body, ...]) |
405 |
|
|
406 |
Adds an new C<field>. It is not checked whether |
Adds some field name/body pairs. Even if there are |
407 |
the field which named $field_body is already exist or not. |
one or more fields named given C<$field-name>, |
408 |
If you don't want duplicated C<field>s, use C<replace> method. |
given name/body pairs are ADDed. Use C<replace> |
409 |
|
to remove same-name-fields. |
410 |
|
|
411 |
Instead of field name-body pair, you might pass some options. |
Instead of field name-body pair, you might pass some options. |
412 |
Four options are available for this method. |
Four options are available for this method. |
492 |
|
|
493 |
sub delete ($@) { |
sub delete ($@) { |
494 |
my $self = shift; |
my $self = shift; |
495 |
my %delete; |
my %delete; for (@_) {$delete{lc $_} = 1} |
|
for (@_) {$delete{lc $_} = 1} |
|
496 |
for my $field (@{$self->{field}}) { |
for my $field (@{$self->{field}}) { |
497 |
undef $field if $delete{$field->{name}}; |
undef $field if $delete{$field->{name}}; |
498 |
} |
} |
620 |
$fbody =~ s/\x0D(?=[^\x09\x0A\x20])/\x0D\x20/g; |
$fbody =~ s/\x0D(?=[^\x09\x0A\x20])/\x0D\x20/g; |
621 |
$fbody =~ s/\x0A(?=[^\x09\x20])/\x0A\x20/g; |
$fbody =~ s/\x0A(?=[^\x09\x20])/\x0A\x20/g; |
622 |
$name =~ s/((?:^|-)[a-z])/uc($1)/ge if $option{capitalize}; |
$name =~ s/((?:^|-)[a-z])/uc($1)/ge if $option{capitalize}; |
623 |
push @ret, $name.': '.$self->fold ($fbody); |
$fbody = $self->_fold ($fbody) if $self->{option}->{fold}; |
624 |
|
push @ret, sprintf $self->{option}->{field_format_pattern}, $name, $fbody; |
625 |
}); |
}); |
626 |
my $ret = join ("\n", @ret); |
my $ret = join ("\n", @ret); |
627 |
$ret? $ret."\n": ''; |
$ret? $ret."\n": ''; |
673 |
$self; |
$self; |
674 |
} |
} |
675 |
|
|
676 |
sub fold ($$;$) { |
sub _fold ($$;$) { |
677 |
my $self = shift; |
my $self = shift; |
678 |
my $string = shift; |
my $string = shift; |
679 |
my $len = shift || $self->{option}->{fold_length}; |
my $len = shift || $self->{option}->{fold_length}; |