/[suikacvs]/test/cvs
Suika

Diff of /test/cvs

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

revision 1.31 by wakaba, Sat Jul 6 10:30:10 2002 UTC revision 1.32 by wakaba, Sat Jul 6 11:37:01 2002 UTC
# Line 22  push @ISA, qw(Message::Field::Structured Line 22  push @ISA, qw(Message::Field::Structured
22    
23  ## Namespace support  ## Namespace support
24          our %NS_phname2uri;     ## PH-namespace name -> namespace URI          our %NS_phname2uri;     ## PH-namespace name -> namespace URI
25          our %NS_uri2phpackage;  ## namespace URI -> PH-package name          our %NS_uri2package;    ## namespace URI -> Package name
26            our %NS_uri2phpackage;  ## namespace URI -> PH-Package name
27          require Message::Header::Default;       ## Default namespace          require Message::Header::Default;       ## Default namespace
28    
29  ## Initialize of this class -- called by constructors  ## Initialize of this class -- called by constructors
# Line 188  sub parse ($$;%) { Line 189  sub parse ($$;%) {
189    } else {    } else {
190      $header =~ s/\x0D?\x0A$REG{WSP}/\x20/gos if $self->{option}->{use_folding};      $header =~ s/\x0D?\x0A$REG{WSP}/\x20/gos if $self->{option}->{use_folding};
191    }    }
192      my %option = (%{ $self->{option} });
193      $option{parse_all} = 0;
194    for my $field (split /\x0D?\x0A/, $header) {    for my $field (split /\x0D?\x0A/, $header) {
195      if ($field =~ /$REG{M_fromline}/) {      if ($field =~ /$REG{M_fromline}/) {
196        my ($s,undef,$value) = $self->_value_to_arrayitem        my ($s,undef,$value) = $self->_value_to_arrayitem
197          ('mail-from' => $1, $self->{option});          ('mail-from' => $1, \%option);
198        push @{$self->{value}}, $value if $s;        push @{$self->{value}}, $value if $s;
199      } elsif ($field =~ /$REG{M_field}/) {      } elsif ($field =~ /$REG{M_field}/) {
200        my ($name, $body) = ($1, $2);        my ($name, $body) = ($1, $2);
201        $body =~ s/$REG{WSP}+$//;        $body =~ s/$REG{WSP}+$//;
202        my ($s,undef,$value) = $self->_value_to_arrayitem        my ($s,undef,$value) = $self->_value_to_arrayitem
203          ($name => $body, $self->{option});          ($name => $body, \%option);
204        push @{$self->{value}}, $value if $s;        push @{$self->{value}}, $value if $s;
205      } elsif (length $field) {      } elsif (length $field) {
206        my ($s,undef,$value) = $self->_value_to_arrayitem        my ($s,undef,$value) = $self->_value_to_arrayitem
207          ('x-unknown' => $field, $self->{option});          ('x-unknown' => $field, \%option);
208        push @{$self->{value}}, $value if $s;        push @{$self->{value}}, $value if $s;
209      }      }
210    }    }
211    $self->_ns_associate_numerical_prefix;        ## RFC 2774 namespace    $self->_ns_associate_numerical_prefix;        ## RFC 2774 namespace
212      for (@{ $self->{value} }) {
213        no strict 'refs';
214        $_->{name}
215          = &{ ${ &_NS_uri2package ($_->{ns}).'::OPTION' }{n11n_name} }
216          ($self, &_NS_uri2package ($_->{ns}), $_->{name});
217        $_->{body} = $self->_parse_value ($_->{name} => $_->{body}, ns => $_->{ns})
218          if $self->{option}->{parse_all};
219      }
220    $self;    $self;
221  }  }
222    
# Line 351  sub _parse_value ($$$;%) { Line 362  sub _parse_value ($$$;%) {
362    my $value = shift;  return $value if ref $value;    my $value = shift;  return $value if ref $value;
363    my %option = @_;    my %option = @_;
364    my $vtype; { no strict 'refs';    my $vtype; { no strict 'refs';
365      my $vt = ${&_NS_uri2phpackage ($option{ns}).'::OPTION'}{value_type};      my $vt = ${&_NS_uri2package ($option{ns}).'::OPTION'}{value_type};
366      if (ref $vt) {      if (ref $vt) {
367        $vtype = $vt->{$name} || $vt->{$self->{option}->{_VALTYPE_DEFAULT}};        $vtype = $vt->{$name} || $vt->{$self->{option}->{_VALTYPE_DEFAULT}};
368      }      }
# Line 415  sub namespace_ph_default ($;$) { Line 426  sub namespace_ph_default ($;$) {
426    if (defined $_[0]) {    if (defined $_[0]) {
427      no strict 'refs';      no strict 'refs';
428      $self->{option}->{ns_default_phuri} = $_[0];      $self->{option}->{ns_default_phuri} = $_[0];
429      $self->_ns_load_ph (${&_NS_uri2phpackage ($self->{option}->{ns_default_phuri}).'::OPTION'}{namespace_phname});      $self->_ns_load_ph (${&_NS_uri2package ($self->{option}->{ns_default_phuri}).'::OPTION'}{namespace_phname});
430    }    }
431    $self->{option}->{ns_default_phuri};    $self->{option}->{ns_default_phuri};
432  }  }
# Line 484  sub _value_to_arrayitem ($$$\%) { Line 495  sub _value_to_arrayitem ($$$\%) {
495        $one_prefix = 1;        $one_prefix = 1;
496      }      }
497      my $prefix      my $prefix
498        = &{ ${ &_NS_uri2phpackage ($nsuri).'::OPTION' }{n11n_prefix} }        = &{ ${ &_NS_uri2package ($nsuri).'::OPTION' }{n11n_prefix} }
499          ($self, &_NS_uri2phpackage ($nsuri), $prefix1.'-'.$prefix2);          ($self, &_NS_uri2package ($nsuri), $prefix1.'-'.$prefix2);
500      $self->_ns_load_ph ($prefix);      $self->_ns_load_ph ($prefix);
501      $nsuri = $self->{ns}->{phname2uri}->{ $prefix };      $nsuri = $self->{ns}->{phname2uri}->{ $prefix };
502      unless ($nsuri) {      unless ($nsuri) {
503        $nsuri = $self->{option}->{ns_default_phuri};        $nsuri = $self->{option}->{ns_default_phuri};
504        $prefix        $prefix
505          = &{ ${ &_NS_uri2phpackage ($nsuri).'::OPTION' }{n11n_prefix} }          = &{ ${ &_NS_uri2package ($nsuri).'::OPTION' }{n11n_prefix} }
506            ($self, &_NS_uri2phpackage ($nsuri), $one_prefix? $prefix2: $prefix1);            ($self, &_NS_uri2package ($nsuri), $one_prefix? $prefix2: $prefix1);
507        $self->_ns_load_ph ($prefix);        $self->_ns_load_ph ($prefix);
508        $nsuri = $self->{ns}->{phname2uri}->{ $prefix };        $nsuri = $self->{ns}->{phname2uri}->{ $prefix };
509        if ($nsuri) {        if ($nsuri) {
# Line 504  sub _value_to_arrayitem ($$$\%) { Line 515  sub _value_to_arrayitem ($$$\%) {
515      }      }
516    }    }
517    $name    $name
518      = &{${&_NS_uri2phpackage ($nsuri).'::OPTION'}{n11n_name}}      = &{${&_NS_uri2package ($nsuri).'::OPTION'}{n11n_name}}
519        ($self, &_NS_uri2phpackage ($nsuri), $name);        ($self, &_NS_uri2package ($nsuri), $name);
520    Carp::croak "$name: invalid field-name"    Carp::croak "$name: invalid field-name"
521      if $option->{field_name_validation}      if $option->{field_name_validation}
522        && $name =~ /$REG{$option->{field_name_unsafe_rule}}/;        && $name =~ /$REG{$option->{field_name_unsafe_rule}}/;
# Line 622  sub _n11n_field_name ($$) { Line 633  sub _n11n_field_name ($$) {
633    my $self = shift;    my $self = shift;
634    my $s = shift;    my $s = shift;
635    $s =~ s/^$REG{WSP}+//; $s =~ s/$REG{WSP}+$//;    $s =~ s/^$REG{WSP}+//; $s =~ s/$REG{WSP}+$//;
636    $s = lc $s unless ${&_NS_uri2phpackage ($self->{option}->{ns_default_phuri}).'::OPTION'}{case_sensible};    $s = lc $s unless ${&_NS_uri2package ($self->{option}->{ns_default_phuri}).'::OPTION'}{case_sensible};
637    $s;    $s;
638  }  }
639    
# Line 661  sub stringify ($;%) { Line 672  sub stringify ($;%) {
672      %nprefix = reverse %{ $self->{ns}->{number2uri} };      %nprefix = reverse %{ $self->{ns}->{number2uri} };
673      my $i = (sort { $a <=> $b } keys %{ $self->{ns}->{number2uri} })[-1] + 1;      my $i = (sort { $a <=> $b } keys %{ $self->{ns}->{number2uri} })[-1] + 1;
674      $i = 10 if $i < 10;      $i = 10 if $i < 10;
675      my $hprefix = ${ &_NS_uri2phpackage      my $hprefix = ${ &_NS_uri2package
676                         ($self->{ns}->{phname2uri}->{'x-http'})                         ($self->{ns}->{phname2uri}->{'x-http'})
677                         .'::OPTION' } {namespace_phname_goodcase};                         .'::OPTION' } {namespace_phname_goodcase};
678      for my $uri (keys %nprefix) {      for my $uri (keys %nprefix) {
# Line 685  sub stringify ($;%) { Line 696  sub stringify ($;%) {
696        return unless length $name;        return unless length $name;
697        return if $option{output_mail_from} && $name eq 'mail-from';        return if $option{output_mail_from} && $name eq 'mail-from';
698        $body = '' if !$option{output_bcc} && $name eq 'bcc';        $body = '' if !$option{output_bcc} && $name eq 'bcc';
699        my $nspackage = &_NS_uri2phpackage ($nsuri);        my $nspackage = &_NS_uri2package ($nsuri);
700        my $oname;        ## Outputed field-name        my $oname;        ## Outputed field-name
701        my $prefix = $nprefix{ $nsuri }        my $prefix = $nprefix{ $nsuri }
702                  || ${$nspackage.'::OPTION'} {namespace_phname_goodcase}                  || ${$nspackage.'::OPTION'} {namespace_phname_goodcase}
703                  || $self->{ns}->{uri2phname}->{ $nsuri };                  || $self->{ns}->{uri2phname}->{ $nsuri };
704        my $default_prefix = ${ &_NS_uri2phpackage ($option{ns_default_phuri})        my $default_prefix = ${ &_NS_uri2package ($option{ns_default_phuri})
705                                .'::OPTION'} {namespace_phname_goodcase};                                .'::OPTION'} {namespace_phname_goodcase};
706        $prefix = '' if $prefix eq $default_prefix;        $prefix = '' if $prefix eq $default_prefix;
707        $prefix =~ s/^\Q$default_prefix\E-//;        $prefix =~ s/^\Q$default_prefix\E-//;
       #$prefix = undef if $nsuri eq $option{ns_default_phuri};  
       #if ($prefix && $prefix eq $nprefix{ $nsuri }) {  ## RFC 2774 prefix  
       #  $prefix = ${ &_NS_uri2phpackage ($self->{ns}->{phname2uri}->{'x-http'})  
       #               .'::OPTION' } {namespace_phname_goodcase} . '-' . $prefix  
       #  unless $option{ns_default_phuri} eq $self->{ns}->{phname2uri}->{'x-http'};  
       #}  
708        my $gc = ${$nspackage.'::OPTION'} {to_be_goodcase};        my $gc = ${$nspackage.'::OPTION'} {to_be_goodcase};
709        if (ref $gc) { $oname = &$gc ($self, $nspackage, $name, \%option) }        if (ref $gc) { $oname = &$gc ($self, $nspackage, $name, \%option) }
710        else { $oname = $name }        else { $oname = $name }
# Line 865  sub _NS_uri2phpackage ($) { Line 870  sub _NS_uri2phpackage ($) {
870    $NS_uri2phpackage{$_[0]}    $NS_uri2phpackage{$_[0]}
871    || $NS_uri2phpackage{$Message::Header::Default::OPTION{namespace_uri}};    || $NS_uri2phpackage{$Message::Header::Default::OPTION{namespace_uri}};
872  }  }
873    sub _NS_uri2package ($) {
874      $NS_uri2package{$_[0]}
875      || $NS_uri2phpackage{$_[0]}
876      || $NS_uri2phpackage{$Message::Header::Default::OPTION{namespace_uri}};
877    }
878    
879  =head2 $self->clone ()  =head2 $self->clone ()
880    
Legend:
Removed from v.1.31  
changed lines
  Added in v.1.32
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24