/[suikacvs]/test/cvs
Suika

Diff of /test/cvs

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

revision 1.20 by wakaba, Sat May 25 09:53:24 2002 UTC revision 1.21 by wakaba, Sun May 26 01:20:09 2002 UTC
# Line 34  push @ISA, qw(Message::Field::Structured Line 34  push @ISA, qw(Message::Field::Structured
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.
# Line 53  push @ISA, qw(Message::Field::Structured Line 52  push @ISA, qw(Message::Field::Structured
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 = (
# Line 176  my %header_goodcase = ( Line 82  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:
# Line 257  sub _init ($;%) { Line 153  sub _init ($;%) {
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;
# Line 271  sub _init_by_format ($$\%) { Line 162  sub _init_by_format ($$\%) {
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;
# Line 456  sub _parse_value ($$$;%) { Line 346  sub _parse_value ($$$;%) {
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);
# Line 463  sub _parse_value ($$$;%) { Line 354  sub _parse_value ($$$;%) {
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);
# Line 707  sub stringify ($;%) { Line 599  sub stringify ($;%) {
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) {
Legend:
Removed from v.1.20  
changed lines
  Added in v.1.21
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24