/[suikacvs]/test/cvs
Suika

Diff of /test/cvs

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

revision 1.32 by wakaba, Sat Jul 6 11:37:01 2002 UTC revision 1.39 by wakaba, Fri Jul 26 12:42:00 2002 UTC
# Line 41  push @ISA, qw(Message::Field::Structured Line 41  push @ISA, qw(Message::Field::Structured
41      -format     => 'mail-rfc2822',      -format     => 'mail-rfc2822',
42      -header_default_charset     => 'iso-2022-int-1',      -header_default_charset     => 'iso-2022-int-1',
43      -header_default_charset_input       => 'iso-2022-int-1',      -header_default_charset_input       => 'iso-2022-int-1',
44        -hook_init_fill_options     => sub {},
45        -hook_stringify_fill_fields => sub {},
46      -linebreak_strict   => 0,      -linebreak_strict   => 0,
47      -line_length_max    => 60,  ## For folding      -line_length_max    => 60,  ## For folding
48      #ns_default_phuri      #ns_default_phuri
# Line 116  sub _init ($;%) { Line 118  sub _init ($;%) {
118        push @new_fields, ($name => $options{$name});        push @new_fields, ($name => $options{$name});
119      }      }
120    }    }
121      &{ $self->{option}->{hook_init_fill_options} } ($self, $self->{option});
122    $self->_init_by_format ($self->{option}->{format}, $self->{option});    $self->_init_by_format ($self->{option}->{format}, $self->{option});
123    # Make alternative representations of @header_order.  This is used    # Make alternative representations of @header_order.  This is used
124    # for sorting.    # for sorting.
# Line 140  sub _init_by_format ($$\%) { Line 143  sub _init_by_format ($$\%) {
143      } else {      } else {
144        $option->{field_sort} = 'good-practice';        $option->{field_sort} = 'good-practice';
145      }      }
146    } else {      ## RFC 822    } elsif ($format =~ /mail|news|mime/) {       ## RFC 822
147      $option->{ns_default_phuri} = $self->{ns}->{phname2uri}->{'x-rfc822'};      $option->{ns_default_phuri} = $self->{ns}->{phname2uri}->{'x-rfc822'};
148    }    }
149    if ($format =~ /uri-url-mailto/) {    if ($format =~ /uri-url-mailto/) {
# Line 298  sub _item_match ($$\$\%\%) { Line 301  sub _item_match ($$\$\%\%) {
301      my %o = %$option; #$o{parse} = 0;      my %o = %$option; #$o{parse} = 0;
302      my %l;      my %l;
303      for (keys %$list) {      for (keys %$list) {
304        my ($s, undef, $v) = $self->_value_to_arrayitem ($_, '', %o);        my ($s, undef, $v) = $self->_value_to_arrayitem ($_, '', \%o);
305        if ($s) {        if ($s) {
306          $l{$v->{name} . ':' . ( $option->{ns} || $v->{ns} ) } = 1;          $l{$v->{name} . ':' . ( $option->{ns} || $v->{ns} ) } = 1;
307        } else {        } else {
# Line 374  sub _parse_value ($$$;%) { Line 377  sub _parse_value ($$$;%) {
377    my %vopt = %{$vtype->[1]} if ref $vtype->[1];    my %vopt = %{$vtype->[1]} if ref $vtype->[1];
378    if ($vpackage eq ':none:') {    if ($vpackage eq ':none:') {
379      return $value;      return $value;
380    } elsif (defined $value) {    } elsif (length $value) {
381      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: $@};
382      return $vpackage->parse ($value,      return $vpackage->parse ($value,
383        -format   => $self->{option}->{format},        -format   => $self->{option}->{format},
# Line 382  sub _parse_value ($$$;%) { Line 385  sub _parse_value ($$$;%) {
385        -field_name       => $name,        -field_name       => $name,
386      -header_default_charset     => $self->{option}->{header_default_charset},      -header_default_charset     => $self->{option}->{header_default_charset},
387      -header_default_charset_input       => $self->{option}->{header_default_charset_input},      -header_default_charset_input       => $self->{option}->{header_default_charset_input},
388        -internal_charset_name      => $self->{option}->{internal_charset_name},
389        -parse_all        => $self->{option}->{parse_all},        -parse_all        => $self->{option}->{parse_all},
390      %vopt);      %vopt);
391    } else {    } else {
# Line 392  sub _parse_value ($$$;%) { Line 396  sub _parse_value ($$$;%) {
396        -field_name       => $name,        -field_name       => $name,
397      -header_default_charset     => $self->{option}->{header_default_charset},      -header_default_charset     => $self->{option}->{header_default_charset},
398      -header_default_charset_input       => $self->{option}->{header_default_charset_input},      -header_default_charset_input       => $self->{option}->{header_default_charset_input},
399        -internal_charset_name      => $self->{option}->{internal_charset_name},
400        -parse_all        => $self->{option}->{parse_all},        -parse_all        => $self->{option}->{parse_all},
401      %vopt);      %vopt);
402    }    }
# Line 467  sub _value_to_arrayitem ($$$\%) { Line 472  sub _value_to_arrayitem ($$$\%) {
472    if (ref $value eq 'ARRAY') {    if (ref $value eq 'ARRAY') {
473      ($value, %$value_option) = @$value;      ($value, %$value_option) = @$value;
474    }    }
475    my $nsuri = $self->{option}->{ns_default_phuri};    my $default_ns = $option->{ns_default_phuri};
476      my $nsuri = $default_ns;
477    $name =~ s/^$REG{WSP}+//;  $name =~ s/$REG{WSP}+$//;    $name =~ s/^$REG{WSP}+//;  $name =~ s/$REG{WSP}+$//;
478        
479    no strict 'refs';    no strict 'refs';
# Line 475  sub _value_to_arrayitem ($$$\%) { Line 481  sub _value_to_arrayitem ($$$\%) {
481      $nsuri = $value_option->{ns};      $nsuri = $value_option->{ns};
482    } elsif ($option->{ns}) {    } elsif ($option->{ns}) {
483      $nsuri = $option->{ns};      $nsuri = $option->{ns};
484    } elsif (($option->{ns_default_phuri} eq $self->{ns}->{uri2phname}->{'x-http'}    } elsif (($default_ns eq $self->{ns}->{uri2phname}->{'x-http'}
485         && $name =~ s/^([0-9]+)-//)         && $name =~ s/^([0-9]+)-//)
486      || ($name =~ s/^x-http-([0-9]+)-//i)) {     ## Numric namespace prefix, RFC 2774      || ($name =~ s/^x-http-([0-9]+)-//i)) {     ## Numric namespace prefix, RFC 2774
487      my $prefix = 0+$1;      my $prefix = 0+$1;
# Line 484  sub _value_to_arrayitem ($$$\%) { Line 490  sub _value_to_arrayitem ($$$\%) {
490        $self->{ns}->{number2uri}->{ $prefix } = 'urn:x-suika-fam-cx:msgpm:header:x-temp:'.$prefix;        $self->{ns}->{number2uri}->{ $prefix } = 'urn:x-suika-fam-cx:msgpm:header:x-temp:'.$prefix;
491        $nsuri = $self->{ns}->{number2uri}->{ $prefix };        $nsuri = $self->{ns}->{number2uri}->{ $prefix };
492      }      }
493    } elsif (($name =~ s/^([Xx]-[A-Za-z]+|[A-YZa-yz][A-Za-z]*)-    } elsif (
494                         ([Xx]-[A-Za-z]+|[A-YZa-yz][A-Za-z]*)-//x)      ${ &_NS_uri2package ($default_ns).'::OPTION' }{use_ph_namespace}
495      || $name =~ s/^([Xx]-[A-Za-z]+|[A-Za-z]+)-//) {      && (
496           ($name =~ s/^([Xx]-[A-Za-z0-9]+|[A-Za-z]*[A-WYZa-wyz0-9][A-Za-z0-9]*)-
497                        ([Xx]-[A-Za-z0-9]+|[A-Za-z0-9]*[A-WYZa-wyz0-9][A-Za-z0-9]*)-//x)
498         || $name =~ s/^([Xx]-[A-Za-z0-9]+|[A-Za-z0-9]*[A-WYZa-wyz0-9][A-Za-z0-9]*)-//
499        )) {
500      my ($prefix1, $prefix2) = ($1, $2);      my ($prefix1, $prefix2) = ($1, $2);
501      my $original_prefix = $&;  my $one_prefix = 0;      my $original_prefix = $&;  my $one_prefix = 0;
502      unless ($prefix2) {      unless ($prefix2) {
503        $prefix2 = $prefix1;        $prefix2 = $prefix1;
504        $prefix1 = $self->{ns}->{uri2phname}->{ $option->{ns_default_phuri} };        $prefix1 = $self->{ns}->{uri2phname}->{ $default_ns };
505        $one_prefix = 1;        $one_prefix = 1;
506      }      }
507      my $prefix      my $prefix
# Line 500  sub _value_to_arrayitem ($$$\%) { Line 510  sub _value_to_arrayitem ($$$\%) {
510      $self->_ns_load_ph ($prefix);      $self->_ns_load_ph ($prefix);
511      $nsuri = $self->{ns}->{phname2uri}->{ $prefix };      $nsuri = $self->{ns}->{phname2uri}->{ $prefix };
512      unless ($nsuri) {      unless ($nsuri) {
513        $nsuri = $self->{option}->{ns_default_phuri};        $nsuri = $default_ns;
514        $prefix        $prefix
515          = &{ ${ &_NS_uri2package ($nsuri).'::OPTION' }{n11n_prefix} }          = &{ ${ &_NS_uri2package ($nsuri).'::OPTION' }{n11n_prefix} }
516            ($self, &_NS_uri2package ($nsuri), $one_prefix? $prefix2: $prefix1);            ($self, &_NS_uri2package ($nsuri), $one_prefix? $prefix2: $prefix1);
# Line 510  sub _value_to_arrayitem ($$$\%) { Line 520  sub _value_to_arrayitem ($$$\%) {
520          $name = $prefix2 . '-' . $name unless $one_prefix;          $name = $prefix2 . '-' . $name unless $one_prefix;
521        } else {        } else {
522          $name = $original_prefix . $name;          $name = $original_prefix . $name;
523          $nsuri = $self->{option}->{ns_default_phuri};          $nsuri = $default_ns;
524        }        }
525      }      }
526    }    }
527    $name    $name
528      = &{${&_NS_uri2package ($nsuri).'::OPTION'}{n11n_name}}      = &{ ${ &_NS_uri2package ($nsuri).'::OPTION' }{n11n_name} }
529        ($self, &_NS_uri2package ($nsuri), $name);        ($self, &_NS_uri2package ($nsuri), $name);
530    Carp::croak "$name: invalid field-name"    Carp::croak "$name: invalid field-name"
531      if $option->{field_name_validation}      if $option->{field_name_validation}
532        && $name =~ /$REG{$option->{field_name_unsafe_rule}}/;        && $name =~ /$REG{ $option->{field_name_unsafe_rule} }/;
533    $value = $self->_parse_value ($name => $value, ns => $nsuri)    $value = $self->_parse_value ($name => $value, ns => $nsuri)
534      if $$option{parse} || $$option{parse_all};      if $option->{parse} || $option->{parse_all};
535    $$option{parse} = 0;    $option->{parse} = 0;
536    (1, $name.':'.$nsuri => {name => $name, body => $value, ns => $nsuri});    (1, $name.':'.$nsuri => {name => $name, body => $value, ns => $nsuri});
537  }  }
538  *_add_hash_check = \&_value_to_arrayitem;  *_add_hash_check = \&_value_to_arrayitem;
# Line 663  sub stringify ($;%) { Line 673  sub stringify ($;%) {
673    my %params = @_;    my %params = @_;
674    my %option = %{$self->{option}};    my %option = %{$self->{option}};
675    $option{format} = $params{-format} if $params{-format};    $option{format} = $params{-format} if $params{-format};
676    $self->_init_by_format ($option{format}, \%option);    $self->_init_by_format ($option{format}, \%option)
677        if $self->{option}->{format} ne $option{format};
678    for (grep {/^-/} keys %params) {$option{substr ($_, 1)} = $params{$_}}    for (grep {/^-/} keys %params) {$option{substr ($_, 1)} = $params{$_}}
679      ## Fill required fields
680        my %exist;
681        for ($self->field_name_list) {$exist{$_} = 1}
682        &{ $option{hook_stringify_fill_fields} } ($self, \%exist, \%option);
683    my @ret;    my @ret;
684    ## RFC 2774 numerical field name prefix    ## RFC 2774 numerical field name prefix
685    my %nprefix;    my %nprefix;
Legend:
Removed from v.1.32  
changed lines
  Added in v.1.39
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24