/[suikacvs]/test/cvs
Suika

Diff of /test/cvs

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

revision 1.33 by wakaba, Sun Jul 7 00:46:07 2002 UTC revision 1.34 by wakaba, Mon Jul 8 11:49:18 2002 UTC
# Line 131  sub _init ($;%) { Line 131  sub _init ($;%) {
131  sub _init_by_format ($$\%) {  sub _init_by_format ($$\%) {
132    my $self = shift;    my $self = shift;
133    my ($format, $option) = @_;    my ($format, $option) = @_;
134      return if $format eq $option->{format};
135    if ($format =~ /http/) {    if ($format =~ /http/) {
136      $option->{ns_default_phuri} = $self->{ns}->{phname2uri}->{'x-http'};      $option->{ns_default_phuri} = $self->{ns}->{phname2uri}->{'x-http'};
137      if ($format =~ /cgi/) {      if ($format =~ /cgi/) {
# Line 140  sub _init_by_format ($$\%) { Line 141  sub _init_by_format ($$\%) {
141      } else {      } else {
142        $option->{field_sort} = 'good-practice';        $option->{field_sort} = 'good-practice';
143      }      }
144    } else {      ## RFC 822    } elsif ($format =~ /mail|news/) {    ## RFC 822
145      $option->{ns_default_phuri} = $self->{ns}->{phname2uri}->{'x-rfc822'};      $option->{ns_default_phuri} = $self->{ns}->{phname2uri}->{'x-rfc822'};
146    }    }
147    if ($format =~ /uri-url-mailto/) {    if ($format =~ /uri-url-mailto/) {
# Line 298  sub _item_match ($$\$\%\%) { Line 299  sub _item_match ($$\$\%\%) {
299      my %o = %$option; #$o{parse} = 0;      my %o = %$option; #$o{parse} = 0;
300      my %l;      my %l;
301      for (keys %$list) {      for (keys %$list) {
302        my ($s, undef, $v) = $self->_value_to_arrayitem ($_, '', %o);        my ($s, undef, $v) = $self->_value_to_arrayitem ($_, '', \%o);
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 {
# Line 467  sub _value_to_arrayitem ($$$\%) { Line 468  sub _value_to_arrayitem ($$$\%) {
468    if (ref $value eq 'ARRAY') {    if (ref $value eq 'ARRAY') {
469      ($value, %$value_option) = @$value;      ($value, %$value_option) = @$value;
470    }    }
471    my $nsuri = $self->{option}->{ns_default_phuri};    my $default_ns = $option->{ns_default_phuri};
472      my $nsuri = $default_ns;
473    $name =~ s/^$REG{WSP}+//;  $name =~ s/$REG{WSP}+$//;    $name =~ s/^$REG{WSP}+//;  $name =~ s/$REG{WSP}+$//;
474        
475    no strict 'refs';    no strict 'refs';
# Line 475  sub _value_to_arrayitem ($$$\%) { Line 477  sub _value_to_arrayitem ($$$\%) {
477      $nsuri = $value_option->{ns};      $nsuri = $value_option->{ns};
478    } elsif ($option->{ns}) {    } elsif ($option->{ns}) {
479      $nsuri = $option->{ns};      $nsuri = $option->{ns};
480    } elsif (($option->{ns_default_phuri} eq $self->{ns}->{uri2phname}->{'x-http'}    } elsif (($default_ns eq $self->{ns}->{uri2phname}->{'x-http'}
481         && $name =~ s/^([0-9]+)-//)         && $name =~ s/^([0-9]+)-//)
482      || ($name =~ s/^x-http-([0-9]+)-//i)) {     ## Numric namespace prefix, RFC 2774      || ($name =~ s/^x-http-([0-9]+)-//i)) {     ## Numric namespace prefix, RFC 2774
483      my $prefix = 0+$1;      my $prefix = 0+$1;
# Line 484  sub _value_to_arrayitem ($$$\%) { Line 486  sub _value_to_arrayitem ($$$\%) {
486        $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;
487        $nsuri = $self->{ns}->{number2uri}->{ $prefix };        $nsuri = $self->{ns}->{number2uri}->{ $prefix };
488      }      }
489    } elsif (($name =~ s/^([Xx]-[A-Za-z0-9]+|[A-Za-z]*[A-WYZa-wyz0-9][A-Za-z0-9]*)-    } elsif (
490                     ([Xx]-[A-Za-z0-9]+|[A-Za-z0-9]*[A-WYZa-wyz0-9][A-Za-z0-9]*)-//x)      ${ &_NS_uri2package ($default_ns).'::OPTION' }{use_ph_namespace}
491      || $name =~ s/^([Xx]-[A-Za-z0-9]+|[A-Za-z0-9]*[A-WYZa-wyz0-9][A-Za-z0-9]*)-//) {      && (
492           ($name =~ s/^([Xx]-[A-Za-z0-9]+|[A-Za-z]*[A-WYZa-wyz0-9][A-Za-z0-9]*)-
493                        ([Xx]-[A-Za-z0-9]+|[A-Za-z0-9]*[A-WYZa-wyz0-9][A-Za-z0-9]*)-//x)
494         || $name =~ s/^([Xx]-[A-Za-z0-9]+|[A-Za-z0-9]*[A-WYZa-wyz0-9][A-Za-z0-9]*)-//
495        )) {
496      my ($prefix1, $prefix2) = ($1, $2);      my ($prefix1, $prefix2) = ($1, $2);
497      my $original_prefix = $&;  my $one_prefix = 0;      my $original_prefix = $&;  my $one_prefix = 0;
498      unless ($prefix2) {      unless ($prefix2) {
499        $prefix2 = $prefix1;        $prefix2 = $prefix1;
500        $prefix1 = $self->{ns}->{uri2phname}->{ $option->{ns_default_phuri} };        $prefix1 = $self->{ns}->{uri2phname}->{ $default_ns };
501        $one_prefix = 1;        $one_prefix = 1;
502      }      }
503      my $prefix      my $prefix
# Line 500  sub _value_to_arrayitem ($$$\%) { Line 506  sub _value_to_arrayitem ($$$\%) {
506      $self->_ns_load_ph ($prefix);      $self->_ns_load_ph ($prefix);
507      $nsuri = $self->{ns}->{phname2uri}->{ $prefix };      $nsuri = $self->{ns}->{phname2uri}->{ $prefix };
508      unless ($nsuri) {      unless ($nsuri) {
509        $nsuri = $self->{option}->{ns_default_phuri};        $nsuri = $default_ns;
510        $prefix        $prefix
511          = &{ ${ &_NS_uri2package ($nsuri).'::OPTION' }{n11n_prefix} }          = &{ ${ &_NS_uri2package ($nsuri).'::OPTION' }{n11n_prefix} }
512            ($self, &_NS_uri2package ($nsuri), $one_prefix? $prefix2: $prefix1);            ($self, &_NS_uri2package ($nsuri), $one_prefix? $prefix2: $prefix1);
# Line 510  sub _value_to_arrayitem ($$$\%) { Line 516  sub _value_to_arrayitem ($$$\%) {
516          $name = $prefix2 . '-' . $name unless $one_prefix;          $name = $prefix2 . '-' . $name unless $one_prefix;
517        } else {        } else {
518          $name = $original_prefix . $name;          $name = $original_prefix . $name;
519          $nsuri = $self->{option}->{ns_default_phuri};          $nsuri = $default_ns;
520        }        }
521      }      }
522    }    }
523    $name    $name
524      = &{${&_NS_uri2package ($nsuri).'::OPTION'}{n11n_name}}      = &{ ${ &_NS_uri2package ($nsuri).'::OPTION' }{n11n_name} }
525        ($self, &_NS_uri2package ($nsuri), $name);        ($self, &_NS_uri2package ($nsuri), $name);
526    Carp::croak "$name: invalid field-name"    Carp::croak "$name: invalid field-name"
527      if $option->{field_name_validation}      if $option->{field_name_validation}
528        && $name =~ /$REG{$option->{field_name_unsafe_rule}}/;        && $name =~ /$REG{ $option->{field_name_unsafe_rule} }/;
529    $value = $self->_parse_value ($name => $value, ns => $nsuri)    $value = $self->_parse_value ($name => $value, ns => $nsuri)
530      if $$option{parse} || $$option{parse_all};      if $option->{parse} || $option->{parse_all};
531    $$option{parse} = 0;    $option->{parse} = 0;
532    (1, $name.':'.$nsuri => {name => $name, body => $value, ns => $nsuri});    (1, $name.':'.$nsuri => {name => $name, body => $value, ns => $nsuri});
533  }  }
534  *_add_hash_check = \&_value_to_arrayitem;  *_add_hash_check = \&_value_to_arrayitem;
Legend:
Removed from v.1.33  
changed lines
  Added in v.1.34
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24