/[suikacvs]/test/cvs
Suika

Diff of /test/cvs

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

revision 1.25 by wakaba, Wed Jun 12 11:38:56 2002 UTC revision 1.28 by wakaba, Tue Jul 2 06:37:56 2002 UTC
# Line 30  push @ISA, qw(Message::Field::Structured Line 30  push @ISA, qw(Message::Field::Structured
30      -_HASH_NAME => 'value',      -_HASH_NAME => 'value',
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|],
     -M_namsepace_prefix_regex => qr/(?!)/,  
33      -_VALTYPE_DEFAULT   => ':default',      -_VALTYPE_DEFAULT   => ':default',
34      -by => 'name',      ## (Reserved for method level option)      -by => 'name',      ## (Reserved for method level option)
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',
42        -header_default_charset_input       => 'iso-2022-int-1',
43      -linebreak_strict   => 0,   ## Not implemented completely      -linebreak_strict   => 0,   ## Not implemented completely
44      -line_length_max    => 60,  ## For folding      -line_length_max    => 60,  ## For folding
45      -ns_default_uri     => $Message::Header::Default::OPTION{namespace_uri},      #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,
# Line 59  $DEFAULT{-value_type} = { Line 60  $DEFAULT{-value_type} = {
60          p3p     => ['Message::Field::Params'],          p3p     => ['Message::Field::Params'],
61          link    => ['Message::Field::ValueParams'],          link    => ['Message::Field::ValueParams'],
62                    
         'list-software' => ['Message::Field::UA'],  
63          'user-agent'    => ['Message::Field::UA'],          'user-agent'    => ['Message::Field::UA'],
64          server  => ['Message::Field::UA'],          server  => ['Message::Field::UA'],
65  };  };
 for (qw(pics-label list-id status))  
   {$DEFAULT{-value_type}->{$_} = ['Message::Field::Structured']}  
         ## Not supported yet, but to be supported...  
         # x-list: unstructured, ml name  
66  for (qw(date expires))  for (qw(date expires))
67    {$DEFAULT{-value_type}->{$_} = ['Message::Field::Date']}    {$DEFAULT{-value_type}->{$_} = ['Message::Field::Date']}
68  for (qw(accept accept-charset accept-encoding accept-language uri))  for (qw(accept accept-charset accept-encoding accept-language uri))
# Line 128  sub _init ($;%) { Line 124  sub _init ($;%) {
124    $self->SUPER::_init (%$DEFAULT, %options);    $self->SUPER::_init (%$DEFAULT, %options);
125    $self->{value} = [];    $self->{value} = [];
126    $self->_ns_load_ph ('default');    $self->_ns_load_ph ('default');
   $self->{ns}->{default_phuri} = $self->{ns}->{phname2uri}->{'default'};  
127    $self->_ns_load_ph ('rfc822');    $self->_ns_load_ph ('rfc822');
128    $self->{ns}->{default_phuri} = $self->{ns}->{phname2uri}->{'rfc822'};    $self->{option}->{ns_default_phuri} = $self->{ns}->{phname2uri}->{'rfc822'}
129        unless $self->{option}->{ns_default_phuri};
130        
131    my @new_fields = ();    my @new_fields = ();
132    for my $name (keys %options) {    for my $name (keys %options) {
# Line 200  sub parse ($$;%) { Line 196  sub parse ($$;%) {
196    my $class = shift;    my $class = shift;
197    my $header = shift;    my $header = shift;
198    my $self = bless {}, $class;    my $self = bless {}, $class;
199    $self->_init (@_);    ## BUG: don't check linebreak_strict    $self->_init (@_);
200    $header =~ s/\x0D?\x0A$REG{WSP}/\x20/gos if $self->{option}->{use_folding};    if ($self->{option}->{linebreak_strict}) {
201        $header =~ s/\x0D\x0A$REG{WSP}/\x20/gos if $self->{option}->{use_folding};
202      } else {
203        $header =~ s/\x0D?\x0A$REG{WSP}/\x20/gos if $self->{option}->{use_folding};
204      }
205    for my $field (split /\x0D?\x0A/, $header) {    for my $field (split /\x0D?\x0A/, $header) {
206      if ($field =~ /$REG{M_fromline}/) {      if ($field =~ /$REG{M_fromline}/) {
207        my ($s,undef,$value) = $self->_value_to_arrayitem        my ($s,undef,$value) = $self->_value_to_arrayitem
# Line 303  sub _item_match ($$\$\%\%) { Line 303  sub _item_match ($$\$\%\%) {
303        if ($s) {        if ($s) {
304          $l{$v->{name} . ':' . ( $option->{ns} || $v->{ns} ) } = 1;          $l{$v->{name} . ':' . ( $option->{ns} || $v->{ns} ) } = 1;
305        } else {        } else {
306          $l{$v->{name} .':'. ( $option->{ns} || $self->{ns}->{default_phuri} ) } = 1;          $l{$v->{name} .':'. ( $option->{ns} || $self->{option}->{ns_default_phuri} ) } = 1;
307        }        }
308      }      }
309      return 1 if $l{$$i->{name} . ':' . $$i->{ns}};      return 1 if $l{$$i->{name} . ':' . $$i->{ns}};
# Line 324  sub _item_return_value ($\$\%) { Line 324  sub _item_return_value ($\$\%) {
324      ${$_[1]}->{body};      ${$_[1]}->{body};
325    }    }
326  }  }
327    *_add_return_value = \&_item_return_value;
328    *_replace_return_value = \&_item_return_value;
329    
330  ## Returns returned (new created) item value    $name, \%option  ## Returns returned (new created) item value    $name, \%option
331  sub _item_new_value ($$\%) {  sub _item_new_value ($$\%) {
# Line 341  sub _parse_value ($$$;%) { Line 343  sub _parse_value ($$$;%) {
343    my $value = shift;  return $value if ref $value;    my $value = shift;  return $value if ref $value;
344    my %option = @_;    my %option = @_;
345    my $vtype; { no strict 'refs';    my $vtype; { no strict 'refs';
346      $vtype = ${&_NS_uri2phpackage ($option{ns}).'::OPTION'}{value_type};      my $vt = ${&_NS_uri2phpackage ($option{ns}).'::OPTION'}{value_type};
347      if (ref $vtype) { $vtype = $vtype->{$name} }      if (ref $vt) {
348      unless (ref $vtype) { $vtype = $vtype->{$self->{option}->{_VALTYPE_DEFAULT}} }        $vtype = $vt->{$name} || $vt->{$self->{option}->{_VALTYPE_DEFAULT}};
349        }
350      ## For compatiblity.      ## For compatiblity.
351      unless (ref $vtype) { $vtype = $self->{option}->{value_type}->{$name}      unless (ref $vtype) { $vtype = $self->{option}->{value_type}->{$name}
352        || $self->{option}->{value_type}->{$self->{option}->{_VALTYPE_DEFAULT}} }        || $self->{option}->{value_type}->{$self->{option}->{_VALTYPE_DEFAULT}} }
# Line 358  sub _parse_value ($$$;%) { Line 361  sub _parse_value ($$$;%) {
361        -format   => $self->{option}->{format},        -format   => $self->{option}->{format},
362        -field_ns => $option{ns},        -field_ns => $option{ns},
363        -field_name       => $name,        -field_name       => $name,
364        -header_default_charset     => $self->{option}->{header_default_charset},
365        -header_default_charset_input       => $self->{option}->{header_default_charset_input},
366        -parse_all        => $self->{option}->{parse_all},        -parse_all        => $self->{option}->{parse_all},
367      %vopt);      %vopt);
368    } else {    } else {
# Line 366  sub _parse_value ($$$;%) { Line 371  sub _parse_value ($$$;%) {
371        -format   => $self->{option}->{format},        -format   => $self->{option}->{format},
372        -field_ns => $option{ns},        -field_ns => $option{ns},
373        -field_name       => $name,        -field_name       => $name,
374        -header_default_charset     => $self->{option}->{header_default_charset},
375        -header_default_charset_input       => $self->{option}->{header_default_charset_input},
376        -parse_all        => $self->{option}->{parse_all},        -parse_all        => $self->{option}->{parse_all},
377      %vopt);      %vopt);
378    }    }
# Line 389  sub namespace_ph_default ($;$) { Line 396  sub namespace_ph_default ($;$) {
396    my $self = shift;    my $self = shift;
397    if (defined $_[0]) {    if (defined $_[0]) {
398      no strict 'refs';      no strict 'refs';
399      $self->{ns}->{default_phuri} = $_[0];      $self->{option}->{ns_default_phuri} = $_[0];
400      $self->_ns_load_ph (${&_NS_uri2phpackage ($self->{ns}->{default_phuri}).'::OPTION'}{namespace_phname});      $self->_ns_load_ph (${&_NS_uri2phpackage ($self->{option}->{ns_default_phuri}).'::OPTION'}{namespace_phname});
401    }    }
402    $self->{ns}->{default_phuri};    $self->{option}->{ns_default_phuri};
403  }  }
404    
405  =item $hdr->add ($field-name, $field-body, [$name, $body, ...])  =item $hdr->add ($field-name, $field-body, [$name, $body, ...])
# Line 431  sub _value_to_arrayitem ($$$\%) { Line 438  sub _value_to_arrayitem ($$$\%) {
438    if (ref $value eq 'ARRAY') {    if (ref $value eq 'ARRAY') {
439      ($value, %$value_option) = @$value;      ($value, %$value_option) = @$value;
440    }    }
441    my $nsuri = $self->{ns}->{default_phuri};    my $nsuri = $self->{option}->{ns_default_phuri};
442      
443    no strict 'refs';    no strict 'refs';
444    if ($value_option->{ns}) {    if ($value_option->{ns}) {
445      $nsuri = $value_option->{ns};      $nsuri = $value_option->{ns};
# Line 446  sub _value_to_arrayitem ($$$\%) { Line 454  sub _value_to_arrayitem ($$$\%) {
454      $nsuri = $self->{ns}->{phname2uri}->{$prefix};      $nsuri = $self->{ns}->{phname2uri}->{$prefix};
455      unless ($nsuri) {      unless ($nsuri) {
456        $name = $oprefix . '-' . $name;        $name = $oprefix . '-' . $name;
457        $nsuri = $self->{ns}->{default_phuri};        $nsuri = $self->{option}->{ns_default_phuri};
458      }      }
459    }    }
460    $name    $name
# Line 455  sub _value_to_arrayitem ($$$\%) { Line 463  sub _value_to_arrayitem ($$$\%) {
463    Carp::croak "$name: invalid field-name"    Carp::croak "$name: invalid field-name"
464      if $option->{field_name_validation}      if $option->{field_name_validation}
465        && $name =~ /$REG{$option->{field_name_unsafe_rule}}/;        && $name =~ /$REG{$option->{field_name_unsafe_rule}}/;
466    $value = $self->_parse_value ($name => $value, ns => $nsuri) if $$option{parse};    $value = $self->_parse_value ($name => $value, ns => $nsuri)
467        if $$option{parse} || $$option{parse_all};
468    $$option{parse} = 0;    $$option{parse} = 0;
469    (1, $name.':'.$nsuri => {name => $name, body => $value, ns => $nsuri});    (1, $name.':'.$nsuri => {name => $name, body => $value, ns => $nsuri});
470  }  }
# Line 563  sub _scan_sort ($\@\%) { Line 572  sub _scan_sort ($\@\%) {
572  }  }
573    
574  sub _n11n_field_name ($$) {  sub _n11n_field_name ($$) {
575      no strict 'refs';
576    my $self = shift;    my $self = shift;
577    my $s = shift;    my $s = shift;
578    $s =~ s/^$REG{WSP}+//; $s =~ s/$REG{WSP}+$//;    $s =~ s/^$REG{WSP}+//; $s =~ s/$REG{WSP}+$//;
579    $s = lc $s ;#unless $self->{option}->{field_name_case_sensible};    $s = lc $s unless ${&_NS_uri2phpackage ($self->{option}->{ns_default_phuri}).'::OPTION'}{case_sensible};
580    $s;    $s;
581  }  }
582    
# Line 609  sub stringify ($;%) { Line 619  sub stringify ($;%) {
619        my $oname;        ## Outputed field-name        my $oname;        ## Outputed field-name
620        my $prefix = ${$nspackage.'::OPTION'} {namespace_phname_goodcase}        my $prefix = ${$nspackage.'::OPTION'} {namespace_phname_goodcase}
621                  || $self->{ns}->{uri2phname}->{$nsuri};                  || $self->{ns}->{uri2phname}->{$nsuri};
622        $prefix = undef if $nsuri eq $self->{ns}->{default_phuri};        $prefix = undef if $nsuri eq $self->{option}->{ns_default_phuri};
623        my $gc = ${$nspackage.'::OPTION'} {to_be_goodcase};        my $gc = ${$nspackage.'::OPTION'} {to_be_goodcase};
624        if (ref $gc) { $oname = &$gc ($self, $nspackage, $name, \%option) }        if (ref $gc) { $oname = &$gc ($self, $nspackage, $name, \%option) }
625        else { $oname = $name }        else { $oname = $name }
# Line 720  sub _fold ($$;%) { Line 730  sub _fold ($$;%) {
730    $max = 20 if $max < 20;    $max = 20 if $max < 20;
731        
732    my $l = $option{-initial_length} || 0;    my $l = $option{-initial_length} || 0;
733      $l += length $1 if $string =~ /^([^\x09\x20]+)/;
734    $string =~ s{([\x09\x20][^\x09\x20]+)}{    $string =~ s{([\x09\x20][^\x09\x20]+)}{
735      my $s = $1;      my $s = $1;
736      if ($l + length $s > $max) {      if (($l + length $s) > $max) {
737        $s = "\x0D\x0A\x20" . $s;        $s = "\x0D\x0A\x20" . $s;
738        $l = length ($s) - 2;        $l = 1 + length $s;
739      } else { $l += length $s }      } else { $l += length $s }
740      $s;      $s;
741    }gex;    }gex;
Legend:
Removed from v.1.25  
changed lines
  Added in v.1.28
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24