/[suikacvs]/test/cvs
Suika

Diff of /test/cvs

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

revision 1.20 by wakaba, Sat May 25 09:53:24 2002 UTC revision 1.29 by wakaba, Wed Jul 3 23:39:15 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',
     -field_name_capitalize      => 1,  
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 53  push @ISA, qw(Message::Field::Structured Line 53  push @ISA, qw(Message::Field::Structured
53      -use_folding        => 1,      -use_folding        => 1,
54      #-value_type      #-value_type
55  );  );
   $DEFAULT{-uri_mailto_safe}    = {  
         ## 1 all (no check)     2 no trace & bcc & from  
         ## 3 no sender's info   4 (default) (currently not used)  
         ## 5 only a few  
         ':default'      => 4,  
         'cc'    => 5,  
         'bcc'   => 1,  
         'body'  => 1,  
         'comment'       => 5,  
         'content-id'    => 1,  
         'date'  => 1,  
         'from'  => 1,  
         'keywords'      => 5,  
         'list-id'       => 1,  
         'mail-from'     => 1,  
         'message-id'    => 1,  
         'received'      => 1,  
         'resent-bcc'    => 1,  
         'resent-date'   => 1,  
         'resent-from'   => 1,  
         'resent-sender' => 1,  
         'return-path'   => 1,  
         'sender'        => 1,  
         'subject'       => 5,  
         'summary'       => 5,  
         'to'    => 5,  
         'user-agent'    => 3,  
         'x-face'        => 2,  
         'x-mailer'      => 3,  
         'x-nsubject'    => 5,  
         'x-received'    => 1,  
         'x400-received' => 1,  
         };  
56    
57  $DEFAULT{-value_type} = {  $DEFAULT{-value_type} = {
58          ':default'      => ['Message::Field::Unstructured'],          ':default'      => ['Message::Field::Unstructured'],
59                    
         received        => ['Message::Field::Received'],  
         'x-received'    => ['Message::Field::Received'],  
           
60          p3p     => ['Message::Field::Params'],          p3p     => ['Message::Field::Params'],
         'auto-submitted'        => ['Message::Field::ValueParams'],  
61          link    => ['Message::Field::ValueParams'],          link    => ['Message::Field::ValueParams'],
         archive => ['Message::Field::ValueParams'],  
         'x-face-type'   => ['Message::Field::ValueParams'],  
         'x-mozilla-draft-info'  => ['Message::Field::ValueParams'],  
           
         subject => ['Message::Field::Subject'],  
         'x-nsubject'    => ['Message::Field::Subject'],  
62                    
         'list-software' => ['Message::Field::UA'],  
63          'user-agent'    => ['Message::Field::UA'],          'user-agent'    => ['Message::Field::UA'],
         'resent-user-agent'     => ['Message::Field::UA'],  
64          server  => ['Message::Field::UA'],          server  => ['Message::Field::UA'],
           
         ## A message id  
         'message-id'    => ['Message::Field::MsgID'],  
         'resent-message-id'     => ['Message::Field::MsgID'],  
           
         ## Numeric value  
         lines   => ['Message::Field::Numval'],  
         'max-forwards'  => ['Message::Field::Numval'],  
         'mime-version'  => ['Message::Field::Numval'],  
         'x-jsmail-priority'     => ['Message::Field::Numval'],  
         'x-mail-count'  => ['Message::Field::Numval'],  
         'x-ml-count'    => ['Message::Field::Numval'],  
         'x-priority'    => ['Message::Field::Numval'],  
           
         path    => ['Message::Field::Path'],  
65  };  };
66  for (qw(archive cancel-lock  for (qw(date expires))
   disposition-notification-options encoding  
   importance injector-info  
   pics-label posted-and-mailed precedence list-id message-type  
   original-recipient priority x-list-id  
   sensitivity status x-face x-msmail-priority xref))  
   {$DEFAULT{-value_type}->{$_} = ['Message::Field::Structured']}  
         ## Not supported yet, but to be supported...  
         # x-list: unstructured, ml name  
 for (qw(abuse-reports-to apparently-to approved approved-by bcc cc complaints-to  
   delivered-to disposition-notification-to envelope-to  
   errors-to  from mail-copies-to mail-followup-to mail-reply-to  
   notice-requested-upon-delivery-to read-receipt-to register-mail-reply-requested-by  
   reply-to resent-bcc  
   resent-cc resent-to resent-from resent-sender return-path  
   return-receipt-to return-receipt-requested-to sender to x-abuse-reports-to  
   x-admin x-approved x-beenthere x-confirm-reading-to  
   x-complaints-to x-envelope-from x-envelope-sender  
   x-envelope-to x-ml-address x-ml-command x-ml-to x-nfrom x-nto  
   x-rcpt-to x-sender x-x-sender))  
   {$DEFAULT{-value_type}->{$_} = ['Message::Field::Addresses']}  
 for (qw(client-date date date-received delivery-date expires  
   expire-date nntp-posting-date posted posted-date received-date  
   reply-by resent-date  
   x-originalarrivaltime x-tcup-date))  
67    {$DEFAULT{-value_type}->{$_} = ['Message::Field::Date']}    {$DEFAULT{-value_type}->{$_} = ['Message::Field::Date']}
68  for (qw(article-updates in-reply-to  for (qw(accept accept-charset accept-encoding accept-language uri))
   obsoletes references replaces see-also supersedes))  
   {$DEFAULT{-value_type}->{$_} = ['Message::Field::MsgIDs']}  
 for (qw(accept accept-charset accept-encoding accept-language  
   content-language  
   encrypted followup-to keywords  
   list-archive list-digest list-help list-owner  
   list-post list-subscribe list-unsubscribe list-url uri newsgroups  
   posted-to))  
69    {$DEFAULT{-value_type}->{$_} = ['Message::Field::CSV']}    {$DEFAULT{-value_type}->{$_} = ['Message::Field::CSV']}
70  for (qw(x-brother x-boss x-classmate x-daughter x-dearfriend x-favoritesong  for (qw(location referer))
   x-friend x-me  
   x-moe x-respect  
   x-sublimate x-son x-sister x-wife))  
   {$DEFAULT{-value_type}->{$_} =[ 'Message::Field::CSV']}       ## NOT M::F::XMOE!  
 for (qw(location referer url x-home-page x-http_referer  
   x-info x-pgp-key x-ml-url x-uri x-url x-web))  
71    {$DEFAULT{-value_type}->{$_} = ['Message::Field::URI']}    {$DEFAULT{-value_type}->{$_} = ['Message::Field::URI']}
72    
73  my %header_goodcase = (  my %header_goodcase = (
# Line 176  my %header_goodcase = ( Line 78  my %header_goodcase = (
78          url     => 'URL',          url     => 'URL',
79          'www-authenticate'      => 'WWW-Authenticate',          'www-authenticate'      => 'WWW-Authenticate',
80  );  );
 $DEFAULT{-field_name_capitalize} = sub {  
   my $self = shift;  
   my $name = shift;  
   if ($header_goodcase{$name}) {  
     return $header_goodcase{$name};  
   }  
   $name =~ s/(?:^|-)cgi-/uc $&/ge;  
   $name =~ s/(?:^|-)[a-z]/uc $&/ge;  
   $name;  
 };  
81    
82  ## taken from L<HTTP::Header>  ## taken from L<HTTP::Header>
83  # "Good Practice" order of HTTP message headers:  # "Good Practice" order of HTTP message headers:
# Line 232  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      ## For text/rfc822-headers
132      if (ref $options{entity_header}) {
133        $self->{entity_header} = $options{entity_header};
134        delete $options{entity_header};
135      }
136    my @new_fields = ();    my @new_fields = ();
137    for my $name (keys %options) {    for my $name (keys %options) {
138      unless (substr ($name, 0, 1) eq '-') {      unless (substr ($name, 0, 1) eq '-') {
# Line 257  sub _init ($;%) { Line 154  sub _init ($;%) {
154  sub _init_by_format ($$\%) {  sub _init_by_format ($$\%) {
155    my $self = shift;    my $self = shift;
156    my ($format, $option) = @_;    my ($format, $option) = @_;
157    if ($format =~ /rfc822/) {    if ($format =~ /cgi/) {
     $header_goodcase{bcc} = 'bcc';  
     $header_goodcase{cc} = 'cc';  
     $header_goodcase{'resent-bcc'} = 'Resent-bcc';  
     $header_goodcase{'resent-cc'} = 'Resent-cc';  
   } elsif ($format =~ /cgi/) {  
158      unshift @header_order, qw(content-type location);      unshift @header_order, qw(content-type location);
159      $option->{field_sort} = 'good-practice';      $option->{field_sort} = 'good-practice';
160      $option->{use_folding} = 0;      $option->{use_folding} = 0;
# Line 271  sub _init_by_format ($$\%) { Line 163  sub _init_by_format ($$\%) {
163    }    }
164    if ($format =~ /uri-url-mailto/) {    if ($format =~ /uri-url-mailto/) {
165      $option->{output_bcc} = 0;      $option->{output_bcc} = 0;
     $option->{field_name_capitalize} = 0;  
166      $option->{field_format_pattern} = '%s=%s';      $option->{field_format_pattern} = '%s=%s';
167      $option->{output_folding} = sub {      $option->{output_folding} = sub {
168        $_[1] =~ s/([^:@+\$A-Za-z0-9\-_.!~*])/sprintf('%%%02X', ord $1)/ge;        $_[1] =~ s/([^:@+\$A-Za-z0-9\-_.!~*])/sprintf('%%%02X', ord $1)/ge;
# Line 310  sub parse ($$;%) { Line 201  sub parse ($$;%) {
201    my $class = shift;    my $class = shift;
202    my $header = shift;    my $header = shift;
203    my $self = bless {}, $class;    my $self = bless {}, $class;
204    $self->_init (@_);    ## BUG: don't check linebreak_strict    $self->_init (@_);
205    $header =~ s/\x0D?\x0A$REG{WSP}/\x20/gos if $self->{option}->{use_folding};    if ($self->{option}->{linebreak_strict}) {
206        $header =~ s/\x0D\x0A$REG{WSP}/\x20/gos if $self->{option}->{use_folding};
207      } else {
208        $header =~ s/\x0D?\x0A$REG{WSP}/\x20/gos if $self->{option}->{use_folding};
209      }
210    for my $field (split /\x0D?\x0A/, $header) {    for my $field (split /\x0D?\x0A/, $header) {
211      if ($field =~ /$REG{M_fromline}/) {      if ($field =~ /$REG{M_fromline}/) {
212        my ($s,undef,$value) = $self->_value_to_arrayitem        my ($s,undef,$value) = $self->_value_to_arrayitem
# Line 323  sub parse ($$;%) { Line 218  sub parse ($$;%) {
218        my ($s,undef,$value) = $self->_value_to_arrayitem        my ($s,undef,$value) = $self->_value_to_arrayitem
219          ($name => $body, $self->{option});          ($name => $body, $self->{option});
220        push @{$self->{value}}, $value if $s;        push @{$self->{value}}, $value if $s;
221        } elsif (length $field) {
222          my ($s,undef,$value) = $self->_value_to_arrayitem
223            ('x-unknown' => $field, $self->{option});
224          push @{$self->{value}}, $value if $s;
225      }      }
226    }    }
227    $self;    $self;
# Line 370  sub parse_array ($\@;%) { Line 269  sub parse_array ($\@;%) {
269        my ($s,undef,$value) = $self->_value_to_arrayitem        my ($s,undef,$value) = $self->_value_to_arrayitem
270          ($name => $body, $self->{option});          ($name => $body, $self->{option});
271        push @{$self->{value}}, $value if $s;        push @{$self->{value}}, $value if $s;
272        } elsif (length $field) {
273          my ($s,undef,$value) = $self->_value_to_arrayitem
274            ('x-unknown' => $field, $self->{option});
275          push @{$self->{value}}, $value if $s;
276      }      }
277      last if $#$header < 0;      last if $#$header < 0;
278    }    }
# Line 405  sub _item_match ($$\$\%\%) { Line 308  sub _item_match ($$\$\%\%) {
308        if ($s) {        if ($s) {
309          $l{$v->{name} . ':' . ( $option->{ns} || $v->{ns} ) } = 1;          $l{$v->{name} . ':' . ( $option->{ns} || $v->{ns} ) } = 1;
310        } else {        } else {
311          $l{$v->{name} .':'. ( $option->{ns} || $self->{ns}->{default_phuri} ) } = 1;          $l{$v->{name} .':'. ( $option->{ns} || $self->{option}->{ns_default_phuri} ) } = 1;
312        }        }
313      }      }
314      return 1 if $l{$$i->{name} . ':' . $$i->{ns}};      return 1 if $l{$$i->{name} . ':' . $$i->{ns}};
315      } elsif ($by eq 'ns') {
316        return 1 if $list->{ $$i->{ns} };
317    }    }
318    0;    0;
319  }  }
# Line 424  sub _item_return_value ($\$\%) { Line 329  sub _item_return_value ($\$\%) {
329      ${$_[1]}->{body};      ${$_[1]}->{body};
330    }    }
331  }  }
332    *_add_return_value = \&_item_return_value;
333    *_replace_return_value = \&_item_return_value;
334    
335  ## Returns returned (new created) item value    $name, \%option  ## Returns returned (new created) item value    $name, \%option
336  sub _item_new_value ($$\%) {  sub _item_new_value ($$\%) {
# Line 441  sub _parse_value ($$$;%) { Line 348  sub _parse_value ($$$;%) {
348    my $value = shift;  return $value if ref $value;    my $value = shift;  return $value if ref $value;
349    my %option = @_;    my %option = @_;
350    my $vtype; { no strict 'refs';    my $vtype; { no strict 'refs';
351      $vtype = ${&_NS_uri2phpackage ($option{ns}).'::OPTION'}{value_type};      my $vt = ${&_NS_uri2phpackage ($option{ns}).'::OPTION'}{value_type};
352      if (ref $vtype) { $vtype = $vtype->{$name} }      if (ref $vt) {
353      unless (ref $vtype) { $vtype = $vtype->{$self->{option}->{_VALTYPE_DEFAULT}} }        $vtype = $vt->{$name} || $vt->{$self->{option}->{_VALTYPE_DEFAULT}};
354        }
355      ## For compatiblity.      ## For compatiblity.
356      unless (ref $vtype) { $vtype = $self->{option}->{value_type}->{$name}      unless (ref $vtype) { $vtype = $self->{option}->{value_type}->{$name}
357        || $self->{option}->{value_type}->{$self->{option}->{_VALTYPE_DEFAULT}} }        || $self->{option}->{value_type}->{$self->{option}->{_VALTYPE_DEFAULT}} }
# Line 456  sub _parse_value ($$$;%) { Line 364  sub _parse_value ($$$;%) {
364      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: $@};
365      return $vpackage->parse ($value,      return $vpackage->parse ($value,
366        -format   => $self->{option}->{format},        -format   => $self->{option}->{format},
367          -field_ns => $option{ns},
368        -field_name       => $name,        -field_name       => $name,
369        -header_default_charset     => $self->{option}->{header_default_charset},
370        -header_default_charset_input       => $self->{option}->{header_default_charset_input},
371        -parse_all        => $self->{option}->{parse_all},        -parse_all        => $self->{option}->{parse_all},
372      %vopt);      %vopt);
373    } else {    } else {
374      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: $@};
375      return $vpackage->new (      return $vpackage->new (
376        -format   => $self->{option}->{format},        -format   => $self->{option}->{format},
377          -field_ns => $option{ns},
378        -field_name       => $name,        -field_name       => $name,
379        -header_default_charset     => $self->{option}->{header_default_charset},
380        -header_default_charset_input       => $self->{option}->{header_default_charset_input},
381        -parse_all        => $self->{option}->{parse_all},        -parse_all        => $self->{option}->{parse_all},
382      %vopt);      %vopt);
383    }    }
384  }  }
385    
386    ## Defined for text/rfc822-headers
387    sub entity_header ($;$) {
388      my $self = shift;
389      my $new_header = shift;
390      if (ref $new_header) {
391        $self->{header} = $new_header;
392      }
393      $self->{header};
394    }
395    
396  =head2 $self->field_name_list ()  =head2 $self->field_name_list ()
397    
398  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 487  sub namespace_ph_default ($;$) { Line 411  sub namespace_ph_default ($;$) {
411    my $self = shift;    my $self = shift;
412    if (defined $_[0]) {    if (defined $_[0]) {
413      no strict 'refs';      no strict 'refs';
414      $self->{ns}->{default_phuri} = $_[0];      $self->{option}->{ns_default_phuri} = $_[0];
415      $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});
416    }    }
417    $self->{ns}->{default_phuri};    $self->{option}->{ns_default_phuri};
418  }  }
419    
420  =item $hdr->add ($field-name, $field-body, [$name, $body, ...])  =item $hdr->add ($field-name, $field-body, [$name, $body, ...])
# Line 529  sub _value_to_arrayitem ($$$\%) { Line 453  sub _value_to_arrayitem ($$$\%) {
453    if (ref $value eq 'ARRAY') {    if (ref $value eq 'ARRAY') {
454      ($value, %$value_option) = @$value;      ($value, %$value_option) = @$value;
455    }    }
456    my $nsuri = $self->{ns}->{default_phuri};    my $nsuri = $self->{option}->{ns_default_phuri};
457      
458    no strict 'refs';    no strict 'refs';
459    if ($option->{ns}) {    if ($value_option->{ns}) {
460        $nsuri = $value_option->{ns};
461      } elsif ($option->{ns}) {
462      $nsuri = $option->{ns};      $nsuri = $option->{ns};
463    } elsif ($name =~ s/^([Xx]-[A-Za-z]+|[A-Za-z]+)-//) {    } elsif ($name =~ s/^([Xx]-[A-Za-z]+|[A-Za-z]+)-//) {
464      my $oprefix = $1;      my $oprefix = $1;
# Line 542  sub _value_to_arrayitem ($$$\%) { Line 469  sub _value_to_arrayitem ($$$\%) {
469      $nsuri = $self->{ns}->{phname2uri}->{$prefix};      $nsuri = $self->{ns}->{phname2uri}->{$prefix};
470      unless ($nsuri) {      unless ($nsuri) {
471        $name = $oprefix . '-' . $name;        $name = $oprefix . '-' . $name;
472        $nsuri = $self->{ns}->{default_phuri};        $nsuri = $self->{option}->{ns_default_phuri};
473      }      }
474    }    }
475    $name    $name
# Line 551  sub _value_to_arrayitem ($$$\%) { Line 478  sub _value_to_arrayitem ($$$\%) {
478    Carp::croak "$name: invalid field-name"    Carp::croak "$name: invalid field-name"
479      if $option->{field_name_validation}      if $option->{field_name_validation}
480        && $name =~ /$REG{$option->{field_name_unsafe_rule}}/;        && $name =~ /$REG{$option->{field_name_unsafe_rule}}/;
481    $value = $self->_parse_value ($name => $value, ns => $nsuri) if $$option{parse};    $value = $self->_parse_value ($name => $value, ns => $nsuri)
482        if $$option{parse} || $$option{parse_all};
483    $$option{parse} = 0;    $$option{parse} = 0;
484    (1, $name.':'.$nsuri => {name => $name, body => $value, ns => $nsuri});    (1, $name.':'.$nsuri => {name => $name, body => $value, ns => $nsuri});
485  }  }
# Line 569  first one is used and the others are not Line 497  first one is used and the others are not
497  =cut  =cut
498    
499  sub _replace_hash_shift ($\%$\%) {  sub _replace_hash_shift ($\%$\%) {
500    shift; my $r = shift;  my $n = $_[0]->{name};    shift; my $r = shift;  my $n = $_[0]->{name} . ':' . $_[0]->{ns};
501    if ($$r{$n}) {    if ($$r{$n}) {
502      my $d = $$r{$n};      my $d = $$r{$n};
503      delete $$r{$n};      delete $$r{$n};
# Line 659  sub _scan_sort ($\@\%) { Line 587  sub _scan_sort ($\@\%) {
587  }  }
588    
589  sub _n11n_field_name ($$) {  sub _n11n_field_name ($$) {
590      no strict 'refs';
591    my $self = shift;    my $self = shift;
592    my $s = shift;    my $s = shift;
593    $s =~ s/^$REG{WSP}+//; $s =~ s/$REG{WSP}+$//;    $s =~ s/^$REG{WSP}+//; $s =~ s/$REG{WSP}+$//;
594    $s = lc $s ;#unless $self->{option}->{field_name_case_sensible};    $s = lc $s unless ${&_NS_uri2phpackage ($self->{option}->{ns_default_phuri}).'::OPTION'}{case_sensible};
595    $s;    $s;
596  }  }
597    
# Line 705  sub stringify ($;%) { Line 634  sub stringify ($;%) {
634        my $oname;        ## Outputed field-name        my $oname;        ## Outputed field-name
635        my $prefix = ${$nspackage.'::OPTION'} {namespace_phname_goodcase}        my $prefix = ${$nspackage.'::OPTION'} {namespace_phname_goodcase}
636                  || $self->{ns}->{uri2phname}->{$nsuri};                  || $self->{ns}->{uri2phname}->{$nsuri};
637        $prefix = undef if $nsuri eq $self->{ns}->{default_phuri};        $prefix = undef if $nsuri eq $self->{option}->{ns_default_phuri};
638        my $gc = ${$nspackage.'::OPTION'} {to_be_goodcase};        my $gc = ${$nspackage.'::OPTION'} {to_be_goodcase};
639        if (ref $gc) { $oname = &$gc ($self, $nspackage, $name) }        if (ref $gc) { $oname = &$gc ($self, $nspackage, $name, \%option) }
640        else { $oname = $name }        else { $oname = $name }
641        if ($prefix) { $oname = $prefix . '-' . $oname }        if ($prefix) { $oname = $prefix . '-' . $oname }
642        if ($option{format} =~ /uri-url-mailto/) {        if ($option{format} =~ /uri-url-mailto/) {
643          return if ((   $option{uri_mailto_safe}->{$name}          return if (( ${$nspackage.'::OPTION'} {uri_mailto_safe}->{$name}
644               || $option{uri_mailto_safe}->{':default'})                    || ${$nspackage.'::OPTION'} {uri_mailto_safe}->{':default'})
645                < $option{uri_mailto_safe_level});                    < $option{uri_mailto_safe_level});
646          if ($name eq 'to') {          if ($name eq 'to') {
647            $body = $self->field ('to', -new_item_unless_exist => 0);            $body = $self->field ('to', -new_item_unless_exist => 0);
648            if (ref $body && $body->have_group) {            if (ref $body && $body->have_group) {
# Line 816  sub _fold ($$;%) { Line 745  sub _fold ($$;%) {
745    $max = 20 if $max < 20;    $max = 20 if $max < 20;
746        
747    my $l = $option{-initial_length} || 0;    my $l = $option{-initial_length} || 0;
748      $l += length $1 if $string =~ /^([^\x09\x20]+)/;
749    $string =~ s{([\x09\x20][^\x09\x20]+)}{    $string =~ s{([\x09\x20][^\x09\x20]+)}{
750      my $s = $1;      my $s = $1;
751      if ($l + length $s > $max) {      if (($l + length $s) > $max) {
752        $s = "\x0D\x0A\x20" . $s;        $s = "\x0D\x0A\x20" . $s;
753        $l = length ($s) - 2;        $l = 1 + length $s;
754      } else { $l += length $s }      } else { $l += length $s }
755      $s;      $s;
756    }gex;    }gex;
Legend:
Removed from v.1.20  
changed lines
  Added in v.1.29
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24