/[suikacvs]/test/cvs
Suika

Diff of /test/cvs

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

revision 1.27 by wakaba, Sun Jun 23 12:20:11 2002 UTC revision 1.30 by wakaba, Thu Jul 4 06:38:21 2002 UTC
# Line 31  push @ISA, qw(Message::Field::Structured Line 31  push @ISA, qw(Message::Field::Structured
31      -_METHODS   => [qw|field field_exist field_type add replace count delete subject id is|],      -_METHODS   => [qw|field field_exist field_type add replace count delete subject id is|],
32      -_MEMBERS   => [qw|value|],      -_MEMBERS   => [qw|value|],
33      -_VALTYPE_DEFAULT   => ':default',      -_VALTYPE_DEFAULT   => ':default',
34      -by => 'name',      ## (Reserved for method level option)      -by => 'name',
35      -field_format_pattern       => '%s: %s',      -field_format_pattern       => '%s: %s',
36      -field_name_case_sensible   => 0,      -field_name_case_sensible   => 0,
37      -field_name_unsafe_rule     => 'NON_ftext',      -field_name_unsafe_rule     => 'NON_ftext',
38      -field_name_validation      => 1,   ## Method level option.      -field_name_validation      => 0,
39      -field_sort => 0,      -field_sort => 0,
40      #-format    => 'mail-rfc2822',      -format     => 'mail-rfc2822',
41      -header_default_charset     => 'iso-2022-int-1',      -header_default_charset     => 'iso-2022-int-1',
42      -header_default_charset_input       => 'iso-2022-int-1',      -header_default_charset_input       => 'iso-2022-int-1',
43      -linebreak_strict   => 0,   ## Not implemented completely      -linebreak_strict   => 0,
44      -line_length_max    => 60,  ## For folding      -line_length_max    => 60,  ## For folding
45      #ns_default_phuri      #ns_default_phuri
46      -output_bcc => 0,      -output_bcc => 0,
47      -output_folding     => 1,      -output_folding     => 1,
48      -output_mail_from   => 0,      -output_mail_from   => 0,
49      #-parse_all => 0,      #parse_all
50      -translate_underscore       => 1,      -translate_underscore       => 1,
51      #-uri_mailto_safe      #uri_mailto_safe
52      -uri_mailto_safe_level      => 4,      -uri_mailto_safe_level      => 4,
53      -use_folding        => 1,      -use_folding        => 1,
54      #-value_type      #value_type
 );  
   
 $DEFAULT{-value_type} = {  
         ':default'      => ['Message::Field::Unstructured'],  
           
         p3p     => ['Message::Field::Params'],  
         link    => ['Message::Field::ValueParams'],  
           
         'user-agent'    => ['Message::Field::UA'],  
         server  => ['Message::Field::UA'],  
 };  
 for (qw(date expires))  
   {$DEFAULT{-value_type}->{$_} = ['Message::Field::Date']}  
 for (qw(accept accept-charset accept-encoding accept-language uri))  
   {$DEFAULT{-value_type}->{$_} = ['Message::Field::CSV']}  
 for (qw(location referer))  
   {$DEFAULT{-value_type}->{$_} = ['Message::Field::URI']}  
   
 my %header_goodcase = (  
         'article-i.d.'  => 'Article-I.D.',  
         etag    => 'ETag',  
         'pics-label'    => 'PICS-Label',  
         te      => 'TE',  
         url     => 'URL',  
         'www-authenticate'      => 'WWW-Authenticate',  
55  );  );
56    
57  ## taken from L<HTTP::Header>  ## taken from L<HTTP::Header>
# Line 128  sub _init ($;%) { Line 103  sub _init ($;%) {
103    $self->{option}->{ns_default_phuri} = $self->{ns}->{phname2uri}->{'rfc822'}    $self->{option}->{ns_default_phuri} = $self->{ns}->{phname2uri}->{'rfc822'}
104      unless $self->{option}->{ns_default_phuri};      unless $self->{option}->{ns_default_phuri};
105        
106      ## For text/rfc822-headers
107      if (ref $options{entity_header}) {
108        $self->{entity_header} = $options{entity_header};
109        delete $options{entity_header};
110      }
111    my @new_fields = ();    my @new_fields = ();
112    for my $name (keys %options) {    for my $name (keys %options) {
113      unless (substr ($name, 0, 1) eq '-') {      unless (substr ($name, 0, 1) eq '-') {
# Line 196  sub parse ($$;%) { Line 176  sub parse ($$;%) {
176    my $class = shift;    my $class = shift;
177    my $header = shift;    my $header = shift;
178    my $self = bless {}, $class;    my $self = bless {}, $class;
179    $self->_init (@_);    ## BUG: don't check linebreak_strict    $self->_init (@_);
180    $header =~ s/\x0D?\x0A$REG{WSP}/\x20/gos if $self->{option}->{use_folding};    if ($self->{option}->{linebreak_strict}) {
181        $header =~ s/\x0D\x0A$REG{WSP}/\x20/gos if $self->{option}->{use_folding};
182      } else {
183        $header =~ s/\x0D?\x0A$REG{WSP}/\x20/gos if $self->{option}->{use_folding};
184      }
185    for my $field (split /\x0D?\x0A/, $header) {    for my $field (split /\x0D?\x0A/, $header) {
186      if ($field =~ /$REG{M_fromline}/) {      if ($field =~ /$REG{M_fromline}/) {
187        my ($s,undef,$value) = $self->_value_to_arrayitem        my ($s,undef,$value) = $self->_value_to_arrayitem
# Line 374  sub _parse_value ($$$;%) { Line 358  sub _parse_value ($$$;%) {
358    }    }
359  }  }
360    
361    ## Defined for text/rfc822-headers
362    sub entity_header ($;$) {
363      my $self = shift;
364      my $new_header = shift;
365      if (ref $new_header) {
366        $self->{header} = $new_header;
367      }
368      $self->{header};
369    }
370    
371  =head2 $self->field_name_list ()  =head2 $self->field_name_list ()
372    
373  Returns list of all C<field-name>s.  (Even if there are two  Returns list of all C<field-name>s.  (Even if there are two
# Line 610  sub stringify ($;%) { Line 604  sub stringify ($;%) {
604        my ($name, $body, $nsuri) = ($_[1]->{name}, $_[1]->{body}, $_[1]->{ns});        my ($name, $body, $nsuri) = ($_[1]->{name}, $_[1]->{body}, $_[1]->{ns});
605        return unless length $name;        return unless length $name;
606        return if $option{output_mail_from} && $name eq 'mail-from';        return if $option{output_mail_from} && $name eq 'mail-from';
607        return if !$option{output_bcc} && ($name eq 'bcc' || $name eq 'resent-bcc');        $body = '' if !$option{output_bcc} && $name eq 'bcc';
608        my $nspackage = &_NS_uri2phpackage ($nsuri);        my $nspackage = &_NS_uri2phpackage ($nsuri);
609        my $oname;        ## Outputed field-name        my $oname;        ## Outputed field-name
610        my $prefix = ${$nspackage.'::OPTION'} {namespace_phname_goodcase}        my $prefix = ${$nspackage.'::OPTION'} {namespace_phname_goodcase}
# Line 640  sub stringify ($;%) { Line 634  sub stringify ($;%) {
634        } else {        } else {
635          $fbody = $body;          $fbody = $body;
636        }        }
637        return unless length $fbody;        unless (${$nspackage.'::OPTION'} {field}->{$name}->{empty_body}) {
638            return unless length $fbody;
639          }
640        unless ($option{linebreak_strict}) {        unless ($option{linebreak_strict}) {
641          ## bare \x0D and bare \x0A are unsafe          ## bare \x0D and bare \x0A are unsafe
642          $fbody =~ s/\x0D(?=[^\x09\x0A\x20])/\x0D\x20/g;          $fbody =~ s/\x0D(?=[^\x09\x0A\x20])/\x0D\x20/g;
Legend:
Removed from v.1.27  
changed lines
  Added in v.1.30
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24