/[suikacvs]/test/cvs
Suika

Diff of /test/cvs

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.11 by wakaba, Tue Mar 26 15:19:53 2002 UTC revision 1.13 by wakaba, Mon Apr 1 05:32:37 2002 UTC
# Line 13  package Message::Header; Line 13  package Message::Header;
13  use strict;  use strict;
14  use vars qw($VERSION %REG %DEFAULT);  use vars qw($VERSION %REG %DEFAULT);
15  $VERSION = '1.00';  $VERSION = '1.00';
16    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    
# Line 48  when C<stringify>.  (Default = 0) Line 48  when C<stringify>.  (Default = 0)
48    capitalize    => 1,    capitalize    => 1,
49    fold_length   => 70,    fold_length   => 70,
50    field_type    => {':DEFAULT' => 'Message::Field::Unstructured'},    field_type    => {':DEFAULT' => 'Message::Field::Unstructured'},
51      format        => 'rfc2822',   ## rfc2822, usefor, http
52    mail_from     => -1,    mail_from     => -1,
53    output_bcc    => -1,    output_bcc    => -1,
54    parse_all     => -1,    parse_all     => -1,
55  );  );
56  my @field_type_Structured = qw(cancel-lock  my @field_type_Structured = qw(cancel-lock
57    importance mime-version path precedence x-cite    importance path precedence
58    x-face x-mail-count x-msmail-priority x-priority x-uidl xref);    x-face x-mail-count x-msmail-priority x-priority xref);
59  for (@field_type_Structured)  for (@field_type_Structured)
60    {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}
61  my @field_type_Address = qw(approved bcc cc delivered-to disposition-notification-to  my @field_type_Address = qw(approved bcc cc delivered-to disposition-notification-to
# Line 70  my @field_type_Date = qw(date date-recei Line 71  my @field_type_Date = qw(date date-recei
71    expire-date nntp-posting-date posted reply-by resent-date x-tcup-date);    expire-date nntp-posting-date posted reply-by resent-date x-tcup-date);
72  for (@field_type_Date)  for (@field_type_Date)
73    {$DEFAULT{field_type}->{$_} = 'Message::Field::Date'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::Date'}
74  my @field_type_MsgID = qw(content-id in-reply-to message-id  my @field_type_MsgID = qw(article-updates content-id in-reply-to message-id
75    references resent-message-id see-also supersedes);    references resent-message-id see-also supersedes);
76  for (@field_type_MsgID)  for (@field_type_MsgID)
77    {$DEFAULT{field_type}->{$_} = 'Message::Field::MsgID'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::MsgID'}
# Line 78  for (qw(received x-received)) Line 79  for (qw(received x-received))
79    {$DEFAULT{field_type}->{$_} = 'Message::Field::Received'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::Received'}
80  $DEFAULT{field_type}->{'content-type'} = 'Message::Field::ContentType';  $DEFAULT{field_type}->{'content-type'} = 'Message::Field::ContentType';
81  $DEFAULT{field_type}->{'content-disposition'} = 'Message::Field::ContentDisposition';  $DEFAULT{field_type}->{'content-disposition'} = 'Message::Field::ContentDisposition';
82  for (qw(x-face-type))  for (qw(archive link x-face-type))
83    {$DEFAULT{field_type}->{$_} = 'Message::Field::ValueParams'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::ValueParams'}
84  for (qw(accept accept-charset accept-encoding accept-language  for (qw(accept accept-charset accept-encoding accept-language
85    content-language    content-language
86    content-transfer-encoding encrypted followup-to keywords newsgroups    content-transfer-encoding encrypted followup-to keywords
87      list-archive list-digest list-help list-owner
88      list-post list-subscribe list-unsubscribe list-url uri newsgroups
89    x-brother x-daughter x-respect x-moe x-syster x-wife))    x-brother x-daughter x-respect x-moe x-syster x-wife))
90    {$DEFAULT{field_type}->{$_} = 'Message::Field::CSV'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::CSV'}
91  my @field_type_URI = qw(list-archive list-help list-owner  for (qw(content-alias content-base content-location location referer
92    list-post list-subscribe list-unsubscribe uri url x-home-page x-http_referer    url x-home-page x-http_referer
93    x-info x-pgp-key x-ml-url x-uri x-url x-web);    x-info x-pgp-key x-ml-url x-uri x-url x-web))
94  for (@field_type_URI)    {$DEFAULT{field_type}->{$_} = 'Message::Field::URI'}
   {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}  
95  for (qw(list-id))  for (qw(list-id))
96    {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}
97  for (qw(subject title x-nsubject))  for (qw(subject title x-nsubject))
98    {$DEFAULT{field_type}->{$_} = 'Message::Field::Subject'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::Subject'}
99  for (qw(list-software user-agent server))  for (qw(list-software user-agent server))
100    {$DEFAULT{field_type}->{$_} = 'Message::Field::UA'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::UA'}
101    for (qw(content-length lines max-forwards mime-version))
102      {$DEFAULT{field_type}->{$_} = 'Message::Field::Numval'}
103    
104  =head2 Message::Header->new ([%option])  =head2 Message::Header->new ([%option])
105    
# Line 211  sub _field_body ($$$) { Line 215  sub _field_body ($$$) {
215              || $self->{option}->{field_type}->{':DEFAULT'};              || $self->{option}->{field_type}->{':DEFAULT'};
216      eval "require $type";      eval "require $type";
217      unless ($body) {      unless ($body) {
218        $body = $type->new (field_name => $name);        $body = $type->new (field_name => $name, format => $self->{option}->{format});
219      } else {      } else {
220        $body = $type->parse ($body, field_name => $name);        $body = $type->parse ($body, field_name => $name,
221            format => $self->{option}->{format});
222      }      }
223    }    }
224    $body;    $body;
# Line 284  sub replace ($$$) { Line 289  sub replace ($$$) {
289    
290  Deletes C<field> named as $field_name.  Deletes C<field> named as $field_name.
291  If $index is specified, only $index'th C<field> is deleted.  If $index is specified, only $index'th C<field> is deleted.
292    ($index of first field is C<1>, not C<0>.)
293  If not, ($index == 0), all C<field>s that have the C<field-name>  If not, ($index == 0), all C<field>s that have the C<field-name>
294  $field_name are deleted.  $field_name are deleted.
295    
# Line 329  sub count ($;$) { Line 335  sub count ($;$) {
335    $count;    $count;
336  }  }
337    
338    =head2 $self->rename ($field_name, [$index])
339    
340    Renames C<field> named as $field_name.
341    If $index is specified, only $index'th C<field> is renamed.
342    ($index of first field is C<1>, not C<0>.)
343    If not, ($index == 0), all C<field>s that have the C<field-name>
344    $field_name are renamed.
345    
346    =cut
347    
348    sub rename ($$$;$) {
349      my $self = shift;
350      my ($name, $newname, $index) = (lc shift, lc shift, shift);
351      my $i = 0;
352      croak "rename: new field-name contains of unsafe character: $newname"
353        if !$newname || $newname =~ /$REG{UNSAFE_field_name}/;
354      for my $field (@{$self->{field}}) {
355        if ($field->{name} eq $name) {
356          $i++;
357          if ($index == 0 || $i == $index) {
358            $field->{name} = $newname;
359            return $self if $i == $index;
360          }
361        }
362      }
363      $self;
364    }
365    
366  =head2 $self->stringify ([%option])  =head2 $self->stringify ([%option])
367    
368  Returns the C<header> as a string.  Returns the C<header> as a string.
# Line 342  sub stringify ($;%) { Line 376  sub stringify ($;%) {
376    $OPT{capitalize} ||= $self->{option}->{capitalize};    $OPT{capitalize} ||= $self->{option}->{capitalize};
377    $OPT{mail_from} ||= $self->{option}->{mail_from};    $OPT{mail_from} ||= $self->{option}->{mail_from};
378    $OPT{output_bcc} ||= $self->{option}->{output_bcc};    $OPT{output_bcc} ||= $self->{option}->{output_bcc};
379      $OPT{format} ||= $self->{option}->{format};
380    push @ret, 'From '.$self->field ('mail-from') if $OPT{mail_from}>0;    push @ret, 'From '.$self->field ('mail-from') if $OPT{mail_from}>0;
381    for my $field (@{$self->{field}}) {    for my $field (@{$self->{field}}) {
382      my $name = $field->{name};      my $name = $field->{name};
383      next unless $name;      next unless $name;
384      next if $OPT{mail_from}<0 && $name eq 'mail-from';      next if $OPT{mail_from}<0 && $name eq 'mail-from';
385      next if $OPT{output_bcc}<0 && ($name eq 'bcc' || $name eq 'resent-bcc');      next if $OPT{output_bcc}<0 && ($name eq 'bcc' || $name eq 'resent-bcc');
386      my $fbody = scalar $field->{body};      my $fbody;
387        if (ref $field->{body}) {
388          $fbody = $field->{body}->stringify (format => $OPT{format});
389        } else {
390          $fbody = $field->{body};
391        }
392      next unless $fbody;      next unless $fbody;
393      $fbody =~ s/\x0D([^\x09\x0A\x20])/\x0D\x20$1/g;      $fbody =~ s/\x0D([^\x09\x0A\x20])/\x0D\x20$1/g;
394      $fbody =~ s/\x0A([^\x09\x20])/\x0A\x20$1/g;      $fbody =~ s/\x0A([^\x09\x20])/\x0A\x20$1/g;
# Line 359  sub stringify ($;%) { Line 399  sub stringify ($;%) {
399    $ret? $ret."\n": "";    $ret? $ret."\n": "";
400  }  }
401    
402  =head2 $self->get_option ($option_name)  =head2 $self->option ($option_name, [$option_value])
   
 Returns value of the option.  
   
 =head2 $self->set_option ($option_name, $option_value)  
403    
404  Set new value of the option.  Set/gets new value of the option.
405    
406  =cut  =cut
407    
408  sub get_option ($$) {  sub option ($$;$) {
   my $self = shift;  
   my ($name) = @_;  
   $self->{option}->{$name};  
 }  
 sub set_option ($$$) {  
409    my $self = shift;    my $self = shift;
410    my ($name, $value) = @_;    my ($name, $value) = @_;
411    $self->{option}->{$name} = $value;    if (defined $value) {
412    $self;      $self->{option}->{$name} = $value;
413        if ($name eq 'format') {
414          for my $f (@{$self->{field}}) {
415            if (ref $f) {
416              $f->option (format => $value);
417            }
418          }
419        }
420      }
421      $self->{option}->{$name};
422  }  }
423    
424  sub field_type ($$;$) {  sub field_type ($$;$) {
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.13
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24