/[suikacvs]/test/cvs
Suika

Diff of /test/cvs

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

revision 1.15 by wakaba, Fri Apr 5 14:56:26 2002 UTC revision 1.17 by wakaba, Sun Apr 21 04:28:46 2002 UTC
# Line 51  The following methods construct new C<Me Line 51  The following methods construct new C<Me
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,
# Line 71  $DEFAULT{field_type} = { Line 75  $DEFAULT{field_type} = {
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',
# Line 90  $DEFAULT{field_type} = { Line 94  $DEFAULT{field_type} = {
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
# Line 172  sub _init ($;%) { Line 189  sub _init ($;%) {
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    }    }
# Line 357  sub _field_body ($$$) { Line 375  sub _field_body ($$$) {
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;
# Line 381  sub field_name_list ($) { Line 401  sub field_name_list ($) {
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.
# Line 471  Deletes C<field> named as $field_name. Line 492  Deletes C<field> named as $field_name.
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    }    }
# Line 600  sub stringify ($;%) { Line 620  sub stringify ($;%) {
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": '';
# Line 652  sub _delete_empty_field ($) { Line 673  sub _delete_empty_field ($) {
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};
Legend:
Removed from v.1.15  
changed lines
  Added in v.1.17
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24