47 |
%DEFAULT = ( |
%DEFAULT = ( |
48 |
capitalize => 1, |
capitalize => 1, |
49 |
fold_length => 70, |
fold_length => 70, |
|
mail_from => 0, |
|
50 |
field_type => {':DEFAULT' => 'Message::Field::Unstructured'}, |
field_type => {':DEFAULT' => 'Message::Field::Unstructured'}, |
51 |
|
mail_from => -1, |
52 |
|
parse_all => -1, |
53 |
); |
); |
54 |
my @field_type_Structured = qw(cancel-lock |
my @field_type_Structured = qw(cancel-lock |
55 |
importance mime-version path precedence user-agent x-cite |
importance mime-version path precedence user-agent x-cite |
123 |
$header =~ s/\x0D?\x0A$REG{WSP}+/\x20/gos; ## unfold |
$header =~ s/\x0D?\x0A$REG{WSP}+/\x20/gos; ## unfold |
124 |
for my $field (split /\x0D?\x0A/, $header) { |
for my $field (split /\x0D?\x0A/, $header) { |
125 |
if ($field =~ /$REG{M_fromline}/) { |
if ($field =~ /$REG{M_fromline}/) { |
126 |
push @{$self->{field}}, {name => 'mail-from', body => $1}; |
my $body = $1; |
127 |
|
$body = $self->_field_body ($body, 'mail-from') |
128 |
|
if $self->{option}->{parse_all}>0; |
129 |
|
push @{$self->{field}}, {name => 'mail-from', body => $body}; |
130 |
} elsif ($field =~ /$REG{M_field}/) { |
} elsif ($field =~ /$REG{M_field}/) { |
131 |
my ($name, $body) = ($1, $2); |
my ($name, $body) = (lc $1, $2); |
132 |
$name =~ s/$REG{WSP}+$//; |
$name =~ s/$REG{WSP}+$//; |
133 |
$body =~ s/$REG{WSP}+$//; |
$body =~ s/$REG{WSP}+$//; |
134 |
push @{$self->{field}}, {name => lc $name, body => $body}; |
$body = $self->_field_body ($body, $name) if $self->{option}->{parse_all}>0; |
135 |
|
push @{$self->{field}}, {name => $name, body => $body}; |
136 |
} |
} |
137 |
} |
} |
138 |
$self; |
$self; |
162 |
} |
} |
163 |
} |
} |
164 |
} |
} |
165 |
|
if ($#ret < 0) { |
166 |
|
return $self->add ($name); |
167 |
|
} |
168 |
@ret; |
@ret; |
169 |
} |
} |
170 |
|
|
171 |
|
sub field_exist ($$) { |
172 |
|
my $self = shift; |
173 |
|
my $name = lc shift; |
174 |
|
my @ret; |
175 |
|
for my $field (@{$self->{field}}) { |
176 |
|
return 1 if ($field->{name} eq $name); |
177 |
|
} |
178 |
|
0; |
179 |
|
} |
180 |
|
|
181 |
=head2 $self->field_name ($index) |
=head2 $self->field_name ($index) |
182 |
|
|
183 |
Returns C<field-name> of $index'th C<field>. |
Returns C<field-name> of $index'th C<field>. |
238 |
|
|
239 |
=cut |
=cut |
240 |
|
|
241 |
sub add ($$$;%) { |
sub add ($$;$%) { |
242 |
my $self = shift; |
my $self = shift; |
243 |
my ($name, $body) = (lc shift, shift); |
my ($name, $body) = (lc shift, shift); |
244 |
my %option = @_; |
my %option = @_; |
245 |
return 0 if $name =~ /$REG{UNSAFE_field_name}/; |
return 0 if $name =~ /$REG{UNSAFE_field_name}/; |
246 |
$body = $self->_field_body ($body, $name); |
$body = $self->_field_body ($body, $name); |
247 |
if ($option{prepend}) { |
if ($option{prepend}) { |
248 |
unshift @{$self->{field}}, {name => $name, body => $body}; |
unshift @{$self->{field}}, {name => $name, body => $body}; |
249 |
} else { |
} else { |
250 |
push @{$self->{field}}, {name => $name, body => $body}; |
push @{$self->{field}}, {name => $name, body => $body}; |
251 |
} |
} |
266 |
my $self = shift; |
my $self = shift; |
267 |
my ($name, $body) = (lc shift, shift); |
my ($name, $body) = (lc shift, shift); |
268 |
return 0 if $name =~ /$REG{UNSAFE_field_name}/; |
return 0 if $name =~ /$REG{UNSAFE_field_name}/; |
269 |
|
$body = $self->_field_body ($body, $name); |
270 |
for my $field (@{$self->{field}}) { |
for my $field (@{$self->{field}}) { |
271 |
if ($field->{name} eq $name) { |
if ($field->{name} eq $name) { |
272 |
$field->{body} = $body; |
$field->{body} = $body; |
274 |
} |
} |
275 |
} |
} |
276 |
push @{$self->{field}}, {name => $name, body => $body}; |
push @{$self->{field}}, {name => $name, body => $body}; |
277 |
$self; |
$body; |
278 |
} |
} |
279 |
|
|
280 |
=head2 $self->delete ($field_name, [$index]) |
=head2 $self->delete ($field_name, [$index]) |
338 |
my @ret; |
my @ret; |
339 |
$OPT{capitalize} ||= $self->{option}->{capitalize}; |
$OPT{capitalize} ||= $self->{option}->{capitalize}; |
340 |
$OPT{mail_from} ||= $self->{option}->{mail_from}; |
$OPT{mail_from} ||= $self->{option}->{mail_from}; |
341 |
push @ret, 'From '.$self->field ('mail-from') if $OPT{mail_from}; |
push @ret, 'From '.$self->field ('mail-from') if $OPT{mail_from}>0; |
342 |
for my $field (@{$self->{field}}) { |
for my $field (@{$self->{field}}) { |
343 |
my $name = $field->{name}; |
my $name = $field->{name}; |
344 |
next unless $field->{name}; |
next unless $field->{name}; |
345 |
next if !$OPT{mail_from} && $name eq 'mail-from'; |
next if $OPT{mail_from}<0 && $name eq 'mail-from'; |
346 |
my $fbody = scalar $field->{body}; |
my $fbody = scalar $field->{body}; |
347 |
next unless $fbody; |
next unless $fbody; |
348 |
|
$fbody =~ s/\x0D([^\x09\x0A\x20])/\x0D\x20$1/g; |
349 |
|
$fbody =~ s/\x0A([^\x09\x20])/\x0A\x20$1/g; |
350 |
$name =~ s/((?:^|-)[a-z])/uc($1)/ge if $OPT{capitalize}; |
$name =~ s/((?:^|-)[a-z])/uc($1)/ge if $OPT{capitalize}; |
351 |
push @ret, $name.': '.$self->fold ($fbody); |
push @ret, $name.': '.$self->fold ($fbody); |
352 |
} |
} |