34 |
-_VALTYPE_DEFAULT => ':default', |
-_VALTYPE_DEFAULT => ':default', |
35 |
-by => 'name', ## (Reserved for method level option) |
-by => 'name', ## (Reserved for method level option) |
36 |
-field_format_pattern => '%s: %s', |
-field_format_pattern => '%s: %s', |
|
-field_name_capitalize => 1, |
|
37 |
-field_name_case_sensible => 0, |
-field_name_case_sensible => 0, |
38 |
-field_name_unsafe_rule => 'NON_ftext', |
-field_name_unsafe_rule => 'NON_ftext', |
39 |
-field_name_validation => 1, ## Method level option. |
-field_name_validation => 1, ## Method level option. |
52 |
-use_folding => 1, |
-use_folding => 1, |
53 |
#-value_type |
#-value_type |
54 |
); |
); |
|
$DEFAULT{-uri_mailto_safe} = { |
|
|
## 1 all (no check) 2 no trace & bcc & from |
|
|
## 3 no sender's info 4 (default) (currently not used) |
|
|
## 5 only a few |
|
|
':default' => 4, |
|
|
'cc' => 5, |
|
|
'bcc' => 1, |
|
|
'body' => 1, |
|
|
'comment' => 5, |
|
|
'content-id' => 1, |
|
|
'date' => 1, |
|
|
'from' => 1, |
|
|
'keywords' => 5, |
|
|
'list-id' => 1, |
|
|
'mail-from' => 1, |
|
|
'message-id' => 1, |
|
|
'received' => 1, |
|
|
'resent-bcc' => 1, |
|
|
'resent-date' => 1, |
|
|
'resent-from' => 1, |
|
|
'resent-sender' => 1, |
|
|
'return-path' => 1, |
|
|
'sender' => 1, |
|
|
'subject' => 5, |
|
|
'summary' => 5, |
|
|
'to' => 5, |
|
|
'user-agent' => 3, |
|
|
'x-face' => 2, |
|
|
'x-mailer' => 3, |
|
|
'x-nsubject' => 5, |
|
|
'x-received' => 1, |
|
|
'x400-received' => 1, |
|
|
}; |
|
55 |
|
|
56 |
$DEFAULT{-value_type} = { |
$DEFAULT{-value_type} = { |
57 |
':default' => ['Message::Field::Unstructured'], |
':default' => ['Message::Field::Unstructured'], |
58 |
|
|
|
received => ['Message::Field::Received'], |
|
|
'x-received' => ['Message::Field::Received'], |
|
|
|
|
59 |
p3p => ['Message::Field::Params'], |
p3p => ['Message::Field::Params'], |
|
'auto-submitted' => ['Message::Field::ValueParams'], |
|
60 |
link => ['Message::Field::ValueParams'], |
link => ['Message::Field::ValueParams'], |
|
archive => ['Message::Field::ValueParams'], |
|
|
'x-face-type' => ['Message::Field::ValueParams'], |
|
|
'x-mozilla-draft-info' => ['Message::Field::ValueParams'], |
|
|
|
|
|
subject => ['Message::Field::Subject'], |
|
|
'x-nsubject' => ['Message::Field::Subject'], |
|
61 |
|
|
62 |
'list-software' => ['Message::Field::UA'], |
'list-software' => ['Message::Field::UA'], |
63 |
'user-agent' => ['Message::Field::UA'], |
'user-agent' => ['Message::Field::UA'], |
|
'resent-user-agent' => ['Message::Field::UA'], |
|
64 |
server => ['Message::Field::UA'], |
server => ['Message::Field::UA'], |
|
|
|
|
## A message id |
|
|
'message-id' => ['Message::Field::MsgID'], |
|
|
'resent-message-id' => ['Message::Field::MsgID'], |
|
|
|
|
|
## Numeric value |
|
|
lines => ['Message::Field::Numval'], |
|
|
'max-forwards' => ['Message::Field::Numval'], |
|
|
'mime-version' => ['Message::Field::Numval'], |
|
|
'x-jsmail-priority' => ['Message::Field::Numval'], |
|
|
'x-mail-count' => ['Message::Field::Numval'], |
|
|
'x-ml-count' => ['Message::Field::Numval'], |
|
|
'x-priority' => ['Message::Field::Numval'], |
|
|
|
|
|
path => ['Message::Field::Path'], |
|
65 |
}; |
}; |
66 |
for (qw(archive cancel-lock |
for (qw(pics-label list-id status)) |
|
disposition-notification-options encoding |
|
|
importance injector-info |
|
|
pics-label posted-and-mailed precedence list-id message-type |
|
|
original-recipient priority x-list-id |
|
|
sensitivity status x-face x-msmail-priority xref)) |
|
67 |
{$DEFAULT{-value_type}->{$_} = ['Message::Field::Structured']} |
{$DEFAULT{-value_type}->{$_} = ['Message::Field::Structured']} |
68 |
## Not supported yet, but to be supported... |
## Not supported yet, but to be supported... |
69 |
# x-list: unstructured, ml name |
# x-list: unstructured, ml name |
70 |
for (qw(abuse-reports-to apparently-to approved approved-by bcc cc complaints-to |
for (qw(date expires)) |
|
delivered-to disposition-notification-to envelope-to |
|
|
errors-to from mail-copies-to mail-followup-to mail-reply-to |
|
|
notice-requested-upon-delivery-to read-receipt-to register-mail-reply-requested-by |
|
|
reply-to resent-bcc |
|
|
resent-cc resent-to resent-from resent-sender return-path |
|
|
return-receipt-to return-receipt-requested-to sender to x-abuse-reports-to |
|
|
x-admin x-approved x-beenthere x-confirm-reading-to |
|
|
x-complaints-to x-envelope-from x-envelope-sender |
|
|
x-envelope-to x-ml-address x-ml-command x-ml-to x-nfrom x-nto |
|
|
x-rcpt-to x-sender x-x-sender)) |
|
|
{$DEFAULT{-value_type}->{$_} = ['Message::Field::Addresses']} |
|
|
for (qw(client-date date date-received delivery-date expires |
|
|
expire-date nntp-posting-date posted posted-date received-date |
|
|
reply-by resent-date |
|
|
x-originalarrivaltime x-tcup-date)) |
|
71 |
{$DEFAULT{-value_type}->{$_} = ['Message::Field::Date']} |
{$DEFAULT{-value_type}->{$_} = ['Message::Field::Date']} |
72 |
for (qw(article-updates in-reply-to |
for (qw(accept accept-charset accept-encoding accept-language uri)) |
|
obsoletes references replaces see-also supersedes)) |
|
|
{$DEFAULT{-value_type}->{$_} = ['Message::Field::MsgIDs']} |
|
|
for (qw(accept accept-charset accept-encoding accept-language |
|
|
content-language |
|
|
encrypted followup-to keywords |
|
|
list-archive list-digest list-help list-owner |
|
|
list-post list-subscribe list-unsubscribe list-url uri newsgroups |
|
|
posted-to)) |
|
73 |
{$DEFAULT{-value_type}->{$_} = ['Message::Field::CSV']} |
{$DEFAULT{-value_type}->{$_} = ['Message::Field::CSV']} |
74 |
for (qw(x-brother x-boss x-classmate x-daughter x-dearfriend x-favoritesong |
for (qw(location referer)) |
|
x-friend x-me |
|
|
x-moe x-respect |
|
|
x-sublimate x-son x-sister x-wife)) |
|
|
{$DEFAULT{-value_type}->{$_} =[ 'Message::Field::CSV']} ## NOT M::F::XMOE! |
|
|
for (qw(location referer url x-home-page x-http_referer |
|
|
x-info x-pgp-key x-ml-url x-uri x-url x-web)) |
|
75 |
{$DEFAULT{-value_type}->{$_} = ['Message::Field::URI']} |
{$DEFAULT{-value_type}->{$_} = ['Message::Field::URI']} |
76 |
|
|
77 |
my %header_goodcase = ( |
my %header_goodcase = ( |
82 |
url => 'URL', |
url => 'URL', |
83 |
'www-authenticate' => 'WWW-Authenticate', |
'www-authenticate' => 'WWW-Authenticate', |
84 |
); |
); |
|
$DEFAULT{-field_name_capitalize} = sub { |
|
|
my $self = shift; |
|
|
my $name = shift; |
|
|
if ($header_goodcase{$name}) { |
|
|
return $header_goodcase{$name}; |
|
|
} |
|
|
$name =~ s/(?:^|-)cgi-/uc $&/ge; |
|
|
$name =~ s/(?:^|-)[a-z]/uc $&/ge; |
|
|
$name; |
|
|
}; |
|
85 |
|
|
86 |
## taken from L<HTTP::Header> |
## taken from L<HTTP::Header> |
87 |
# "Good Practice" order of HTTP message headers: |
# "Good Practice" order of HTTP message headers: |
153 |
sub _init_by_format ($$\%) { |
sub _init_by_format ($$\%) { |
154 |
my $self = shift; |
my $self = shift; |
155 |
my ($format, $option) = @_; |
my ($format, $option) = @_; |
156 |
if ($format =~ /rfc822/) { |
if ($format =~ /cgi/) { |
|
$header_goodcase{bcc} = 'bcc'; |
|
|
$header_goodcase{cc} = 'cc'; |
|
|
$header_goodcase{'resent-bcc'} = 'Resent-bcc'; |
|
|
$header_goodcase{'resent-cc'} = 'Resent-cc'; |
|
|
} elsif ($format =~ /cgi/) { |
|
157 |
unshift @header_order, qw(content-type location); |
unshift @header_order, qw(content-type location); |
158 |
$option->{field_sort} = 'good-practice'; |
$option->{field_sort} = 'good-practice'; |
159 |
$option->{use_folding} = 0; |
$option->{use_folding} = 0; |
162 |
} |
} |
163 |
if ($format =~ /uri-url-mailto/) { |
if ($format =~ /uri-url-mailto/) { |
164 |
$option->{output_bcc} = 0; |
$option->{output_bcc} = 0; |
|
$option->{field_name_capitalize} = 0; |
|
165 |
$option->{field_format_pattern} = '%s=%s'; |
$option->{field_format_pattern} = '%s=%s'; |
166 |
$option->{output_folding} = sub { |
$option->{output_folding} = sub { |
167 |
$_[1] =~ s/([^:@+\$A-Za-z0-9\-_.!~*])/sprintf('%%%02X', ord $1)/ge; |
$_[1] =~ s/([^:@+\$A-Za-z0-9\-_.!~*])/sprintf('%%%02X', ord $1)/ge; |
346 |
eval "require $vpackage" or Carp::croak qq{<parse>: $vpackage: Can't load package: $@}; |
eval "require $vpackage" or Carp::croak qq{<parse>: $vpackage: Can't load package: $@}; |
347 |
return $vpackage->parse ($value, |
return $vpackage->parse ($value, |
348 |
-format => $self->{option}->{format}, |
-format => $self->{option}->{format}, |
349 |
|
-field_ns => $option{ns}, |
350 |
-field_name => $name, |
-field_name => $name, |
351 |
-parse_all => $self->{option}->{parse_all}, |
-parse_all => $self->{option}->{parse_all}, |
352 |
%vopt); |
%vopt); |
354 |
eval "require $vpackage" or Carp::croak qq{<parse>: $vpackage: Can't load package: $@}; |
eval "require $vpackage" or Carp::croak qq{<parse>: $vpackage: Can't load package: $@}; |
355 |
return $vpackage->new ( |
return $vpackage->new ( |
356 |
-format => $self->{option}->{format}, |
-format => $self->{option}->{format}, |
357 |
|
-field_ns => $option{ns}, |
358 |
-field_name => $name, |
-field_name => $name, |
359 |
-parse_all => $self->{option}->{parse_all}, |
-parse_all => $self->{option}->{parse_all}, |
360 |
%vopt); |
%vopt); |
599 |
|| $self->{ns}->{uri2phname}->{$nsuri}; |
|| $self->{ns}->{uri2phname}->{$nsuri}; |
600 |
$prefix = undef if $nsuri eq $self->{ns}->{default_phuri}; |
$prefix = undef if $nsuri eq $self->{ns}->{default_phuri}; |
601 |
my $gc = ${$nspackage.'::OPTION'} {to_be_goodcase}; |
my $gc = ${$nspackage.'::OPTION'} {to_be_goodcase}; |
602 |
if (ref $gc) { $oname = &$gc ($self, $nspackage, $name) } |
if (ref $gc) { $oname = &$gc ($self, $nspackage, $name, \%option) } |
603 |
else { $oname = $name } |
else { $oname = $name } |
604 |
if ($prefix) { $oname = $prefix . '-' . $oname } |
if ($prefix) { $oname = $prefix . '-' . $oname } |
605 |
if ($option{format} =~ /uri-url-mailto/) { |
if ($option{format} =~ /uri-url-mailto/) { |
606 |
return if (( $option{uri_mailto_safe}->{$name} |
return if (( ${$nspackage.'::OPTION'} {uri_mailto_safe}->{$name} |
607 |
|| $option{uri_mailto_safe}->{':default'}) |
|| ${$nspackage.'::OPTION'} {uri_mailto_safe}->{':default'}) |
608 |
< $option{uri_mailto_safe_level}); |
< $option{uri_mailto_safe_level}); |
609 |
if ($name eq 'to') { |
if ($name eq 'to') { |
610 |
$body = $self->field ('to', -new_item_unless_exist => 0); |
$body = $self->field ('to', -new_item_unless_exist => 0); |
611 |
if (ref $body && $body->have_group) { |
if (ref $body && $body->have_group) { |