/[suikacvs]/test/cvs
Suika

Diff of /test/cvs

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

revision 1.11 by wakaba, Tue Mar 26 15:19:53 2002 UTC revision 1.12 by wakaba, Sun Mar 31 13:12:41 2002 UTC
# Line 13  package Message::Header; Line 13  package Message::Header;
13  use strict;  use strict;
14  use vars qw($VERSION %REG %DEFAULT);  use vars qw($VERSION %REG %DEFAULT);
15  $VERSION = '1.00';  $VERSION = '1.00';
16    use Carp;
17  use overload '@{}' => sub {shift->_delete_empty_field()->{field}},  use overload '@{}' => sub {shift->_delete_empty_field()->{field}},
18               '""' => sub {shift->stringify};               '""' => sub {shift->stringify};
19    
# Line 48  when C<stringify>.  (Default = 0) Line 48  when C<stringify>.  (Default = 0)
48    capitalize    => 1,    capitalize    => 1,
49    fold_length   => 70,    fold_length   => 70,
50    field_type    => {':DEFAULT' => 'Message::Field::Unstructured'},    field_type    => {':DEFAULT' => 'Message::Field::Unstructured'},
51      format        => 'rfc2822',   ## rfc2822, usefor, http
52    mail_from     => -1,    mail_from     => -1,
53    output_bcc    => -1,    output_bcc    => -1,
54    parse_all     => -1,    parse_all     => -1,
# Line 70  my @field_type_Date = qw(date date-recei Line 71  my @field_type_Date = qw(date date-recei
71    expire-date nntp-posting-date posted reply-by resent-date x-tcup-date);    expire-date nntp-posting-date posted reply-by resent-date x-tcup-date);
72  for (@field_type_Date)  for (@field_type_Date)
73    {$DEFAULT{field_type}->{$_} = 'Message::Field::Date'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::Date'}
74  my @field_type_MsgID = qw(content-id in-reply-to message-id  my @field_type_MsgID = qw(article-updates content-id in-reply-to message-id
75    references resent-message-id see-also supersedes);    references resent-message-id see-also supersedes);
76  for (@field_type_MsgID)  for (@field_type_MsgID)
77    {$DEFAULT{field_type}->{$_} = 'Message::Field::MsgID'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::MsgID'}
# Line 78  for (qw(received x-received)) Line 79  for (qw(received x-received))
79    {$DEFAULT{field_type}->{$_} = 'Message::Field::Received'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::Received'}
80  $DEFAULT{field_type}->{'content-type'} = 'Message::Field::ContentType';  $DEFAULT{field_type}->{'content-type'} = 'Message::Field::ContentType';
81  $DEFAULT{field_type}->{'content-disposition'} = 'Message::Field::ContentDisposition';  $DEFAULT{field_type}->{'content-disposition'} = 'Message::Field::ContentDisposition';
82  for (qw(x-face-type))  for (qw(archive link x-face-type))
83    {$DEFAULT{field_type}->{$_} = 'Message::Field::ValueParams'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::ValueParams'}
84  for (qw(accept accept-charset accept-encoding accept-language  for (qw(accept accept-charset accept-encoding accept-language
85    content-language    content-language
86    content-transfer-encoding encrypted followup-to keywords newsgroups    content-transfer-encoding encrypted followup-to keywords
87      list-archive list-digest list-help list-owner
88      list-post list-subscribe list-unsubscribe list-url uri newsgroups
89    x-brother x-daughter x-respect x-moe x-syster x-wife))    x-brother x-daughter x-respect x-moe x-syster x-wife))
90    {$DEFAULT{field_type}->{$_} = 'Message::Field::CSV'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::CSV'}
91  my @field_type_URI = qw(list-archive list-help list-owner  for (qw(content-alias content-base content-location location referer
92    list-post list-subscribe list-unsubscribe uri url x-home-page x-http_referer    url x-home-page x-http_referer
93    x-info x-pgp-key x-ml-url x-uri x-url x-web);    x-info x-pgp-key x-ml-url x-uri x-url x-web))
94  for (@field_type_URI)    {$DEFAULT{field_type}->{$_} = 'Message::Field::URI'}
   {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}  
95  for (qw(list-id))  for (qw(list-id))
96    {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}
97  for (qw(subject title x-nsubject))  for (qw(subject title x-nsubject))
# Line 211  sub _field_body ($$$) { Line 213  sub _field_body ($$$) {
213              || $self->{option}->{field_type}->{':DEFAULT'};              || $self->{option}->{field_type}->{':DEFAULT'};
214      eval "require $type";      eval "require $type";
215      unless ($body) {      unless ($body) {
216        $body = $type->new (field_name => $name);        $body = $type->new (field_name => $name, format => $self->{option}->{format});
217      } else {      } else {
218        $body = $type->parse ($body, field_name => $name);        $body = $type->parse ($body, field_name => $name,
219            format => $self->{option}->{format});
220      }      }
221    }    }
222    $body;    $body;
# Line 284  sub replace ($$$) { Line 287  sub replace ($$$) {
287    
288  Deletes C<field> named as $field_name.  Deletes C<field> named as $field_name.
289  If $index is specified, only $index'th C<field> is deleted.  If $index is specified, only $index'th C<field> is deleted.
290    ($index of first field is C<1>, not C<0>.)
291  If not, ($index == 0), all C<field>s that have the C<field-name>  If not, ($index == 0), all C<field>s that have the C<field-name>
292  $field_name are deleted.  $field_name are deleted.
293    
# Line 329  sub count ($;$) { Line 333  sub count ($;$) {
333    $count;    $count;
334  }  }
335    
336    =head2 $self->rename ($field_name, [$index])
337    
338    Renames C<field> named as $field_name.
339    If $index is specified, only $index'th C<field> is renamed.
340    ($index of first field is C<1>, not C<0>.)
341    If not, ($index == 0), all C<field>s that have the C<field-name>
342    $field_name are renamed.
343    
344    =cut
345    
346    sub rename ($$$;$) {
347      my $self = shift;
348      my ($name, $newname, $index) = (lc shift, lc shift, shift);
349      my $i = 0;
350      croak "rename: new field-name contains of unsafe character: $newname"
351        if !$newname || $newname =~ /$REG{UNSAFE_field_name}/;
352      for my $field (@{$self->{field}}) {
353        if ($field->{name} eq $name) {
354          $i++;
355          if ($index == 0 || $i == $index) {
356            $field->{name} = $newname;
357            return $self if $i == $index;
358          }
359        }
360      }
361      $self;
362    }
363    
364  =head2 $self->stringify ([%option])  =head2 $self->stringify ([%option])
365    
366  Returns the C<header> as a string.  Returns the C<header> as a string.
# Line 342  sub stringify ($;%) { Line 374  sub stringify ($;%) {
374    $OPT{capitalize} ||= $self->{option}->{capitalize};    $OPT{capitalize} ||= $self->{option}->{capitalize};
375    $OPT{mail_from} ||= $self->{option}->{mail_from};    $OPT{mail_from} ||= $self->{option}->{mail_from};
376    $OPT{output_bcc} ||= $self->{option}->{output_bcc};    $OPT{output_bcc} ||= $self->{option}->{output_bcc};
377      $OPT{format} ||= $self->{option}->{format};
378    push @ret, 'From '.$self->field ('mail-from') if $OPT{mail_from}>0;    push @ret, 'From '.$self->field ('mail-from') if $OPT{mail_from}>0;
379    for my $field (@{$self->{field}}) {    for my $field (@{$self->{field}}) {
380      my $name = $field->{name};      my $name = $field->{name};
381      next unless $name;      next unless $name;
382      next if $OPT{mail_from}<0 && $name eq 'mail-from';      next if $OPT{mail_from}<0 && $name eq 'mail-from';
383      next if $OPT{output_bcc}<0 && ($name eq 'bcc' || $name eq 'resent-bcc');      next if $OPT{output_bcc}<0 && ($name eq 'bcc' || $name eq 'resent-bcc');
384      my $fbody = scalar $field->{body};      my $fbody;
385        if (ref $field->{body}) {
386          $fbody = $field->{body}->stringify (format => $OPT{format});
387        } else {
388          $fbody = $field->{body};
389        }
390      next unless $fbody;      next unless $fbody;
391      $fbody =~ s/\x0D([^\x09\x0A\x20])/\x0D\x20$1/g;      $fbody =~ s/\x0D([^\x09\x0A\x20])/\x0D\x20$1/g;
392      $fbody =~ s/\x0A([^\x09\x20])/\x0A\x20$1/g;      $fbody =~ s/\x0A([^\x09\x20])/\x0A\x20$1/g;
# Line 359  sub stringify ($;%) { Line 397  sub stringify ($;%) {
397    $ret? $ret."\n": "";    $ret? $ret."\n": "";
398  }  }
399    
400  =head2 $self->get_option ($option_name)  =head2 $self->option ($option_name, [$option_value])
   
 Returns value of the option.  
   
 =head2 $self->set_option ($option_name, $option_value)  
401    
402  Set new value of the option.  Set/gets new value of the option.
403    
404  =cut  =cut
405    
406  sub get_option ($$) {  sub option ($$;$) {
   my $self = shift;  
   my ($name) = @_;  
   $self->{option}->{$name};  
 }  
 sub set_option ($$$) {  
407    my $self = shift;    my $self = shift;
408    my ($name, $value) = @_;    my ($name, $value) = @_;
409    $self->{option}->{$name} = $value;    if (defined $value) {
410    $self;      $self->{option}->{$name} = $value;
411        if ($name eq 'format') {
412          for my $f (@{$self->{field}}) {
413            if (ref $f) {
414              $f->option (format => $value);
415            }
416          }
417        }
418      }
419      $self->{option}->{$name};
420  }  }
421    
422  sub field_type ($$;$) {  sub field_type ($$;$) {
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.12
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24