/[suikacvs]/test/cvs
Suika

Diff of /test/cvs

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

revision 1.4 by wakaba, Sat Mar 16 08:54:39 2002 UTC revision 1.7 by wakaba, Thu Mar 21 04:21:28 2002 UTC
# 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    mail_from     => 0,    mail_from     => 0,
51    field_type    => {_DEFAULT => 'Message::Field::Unstructured'},    field_type    => {':DEFAULT' => 'Message::Field::Unstructured'},
52  );  );
53  my @field_type_Structured = qw(cancel-lock content-language  my @field_type_Structured = qw(cancel-lock
54    content-transfer-encoding    importance mime-version path precedence user-agent x-cite
55    encrypted importance mime-version precedence user-agent x-cite    x-face x-mail-count x-msmail-priority x-priority x-uidl xref);
   x-face x-mail-count  
   x-msmail-priority x-priority x-uidl xref);  
56  for (@field_type_Structured)  for (@field_type_Structured)
57    {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}
58  my @field_type_Address = qw(approved bcc cc delivered-to envelope-to  my @field_type_Address = qw(approved bcc cc delivered-to envelope-to
59    errors-to from mail-followup-to reply-to resent-bcc    errors-to fcc from mail-followup-to mail-followup-cc mail-from reply-to resent-bcc
60    resent-cc resent-to resent-from resent-sender return-path    resent-cc resent-to resent-from resent-sender return-path
61    return-receipt-to sender to x-approved x-beenthere    return-receipt-to sender to x-approved x-beenthere
62    x-complaints-to x-envelope-from x-envelope-sender    x-complaints-to x-envelope-from x-envelope-sender
63    x-envelope-to x-ml-address x-ml-command x-ml-to);    x-envelope-to x-ml-address x-ml-command x-ml-to x-nfrom x-nto);
64  for (@field_type_Address)  for (@field_type_Address)
65    {$DEFAULT{field_type}->{$_} = 'Message::Field::Address'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::Address'}
66  my @field_type_Date = qw(date date-received delivery-date expires  my @field_type_Date = qw(date date-received delivery-date expires
# Line 70  my @field_type_Date = qw(date date-recei Line 68  my @field_type_Date = qw(date date-recei
68  for (@field_type_Date)  for (@field_type_Date)
69    {$DEFAULT{field_type}->{$_} = 'Message::Field::Date'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::Date'}
70  my @field_type_MsgID = qw(content-id in-reply-to message-id  my @field_type_MsgID = qw(content-id in-reply-to message-id
71    references resent-message-id supersedes);    references resent-message-id see-also supersedes);
72  for (@field_type_MsgID)  for (@field_type_MsgID)
73    {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::MsgID'}
74  my @field_type_Received = qw(received x-received);  for (qw(received x-received))
75  for (@field_type_Received)    {$DEFAULT{field_type}->{$_} = 'Message::Field::Received'}
76    {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}  for (qw(accept accept-charset accept-encoding accept-language
77  my @field_type_Param = qw(content-disposition content-type    content-disposition content-language
78      content-transfer-encoding content-type encrypted followup-to keywords newsgroups
79    x-brother x-daughter x-face-type x-respect x-moe    x-brother x-daughter x-face-type x-respect x-moe
80    x-syster x-wife);    x-syster x-wife))
81  for (@field_type_Param)    {$DEFAULT{field_type}->{$_} = 'Message::Field::CSV'}
   {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}  
82  my @field_type_URI = qw(list-archive list-help list-owner  my @field_type_URI = qw(list-archive list-help list-owner
83    list-post list-subscribe list-unsubscribe uri url x-home-page x-http_referer    list-post list-subscribe list-unsubscribe uri url x-home-page x-http_referer
84    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);
85  for (@field_type_URI)  for (@field_type_URI)
86    {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}
87  my @field_type_ListID = qw(list-id);  for (qw(list-id))
 for (@field_type_ListID)  
88    {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}
89    for (qw(content-description subject title x-nsubject))
90      {$DEFAULT{field_type}->{$_} = 'Message::Field::Subject'}
91    
92  =head2 Message::Header->new ([%option])  =head2 Message::Header->new ([%option])
93    
# Line 146  sub field ($$) { Line 145  sub field ($$) {
145    for my $field (@{$self->{field}}) {    for my $field (@{$self->{field}}) {
146      if ($field->{name} eq $name) {      if ($field->{name} eq $name) {
147        unless (wantarray) {        unless (wantarray) {
148          return $self->_field_body ($field->{body}, $name);          $field->{body} = $self->_field_body ($field->{body}, $name);
149            return $field->{body};
150        } else {        } else {
151          push @ret, $self->_field_body ($field->{body}, $name);          $field->{body} = $self->_field_body ($field->{body}, $name);
152            push @ret, $field->{body};
153        }        }
154      }      }
155    }    }
# Line 172  sub field_name ($$) { Line 173  sub field_name ($$) {
173  sub field_body ($$) {  sub field_body ($$) {
174    my $self = shift;    my $self = shift;
175    my $i = shift;    my $i = shift;
176    $self->_field_body ($self->{field}->[$i]->{body}, $self->{field}->[$i]->{name});    $self->{field}->[$i]->{body}
177       = $self->_field_body ($self->{field}->[$i]->{body}, $self->{field}->[$i]->{name});
178      $self->{field}->[$i]->{body};
179  }  }
180    
181  sub _field_body ($$$) {  sub _field_body ($$$) {
182    my $self = shift;    my $self = shift;
183    my ($body, $name) = @_;    my ($body, $name) = @_;
184    if (ref $body) {    unless (ref $body) {
     return $body;  
   } else {  
185      my $type = $self->{option}->{field_type}->{$name}      my $type = $self->{option}->{field_type}->{$name}
186              || $self->{option}->{field_type}->{_DEFAULT};              || $self->{option}->{field_type}->{':DEFAULT'};
187      eval "use $type";      eval "require $type";
188      return $type->parse ($body);      unless ($body) {
189          $body = $type->new (field_name => $name);
190        } else {
191          $body = $type->parse ($body, field_name => $name);
192        }
193    }    }
194      $body;
195  }  }
196    
197  =head2 $self->field_name_list ()  =head2 $self->field_name_list ()
# Line 214  sub add ($$$) { Line 220  sub add ($$$) {
220    my $self = shift;    my $self = shift;
221    my ($name, $body) = (lc shift, shift);    my ($name, $body) = (lc shift, shift);
222    return 0 if $name =~ /$REG{UNSAFE_field_name}/;    return 0 if $name =~ /$REG{UNSAFE_field_name}/;
223      $body = $self->_field_body ($body, $name);
224    push @{$self->{field}}, {name => $name, body => $body};    push @{$self->{field}}, {name => $name, body => $body};
225    $self;    $body;
226  }  }
227    
228  =head2 $self->relace ($field_name, $field_body)  =head2 $self->relace ($field_name, $field_body)
# Line 308  sub stringify ($;%) { Line 315  sub stringify ($;%) {
315      my $name = $field->{name};      my $name = $field->{name};
316      next unless $field->{name};      next unless $field->{name};
317      next if !$OPT{mail_from} && $name eq 'mail-from';      next if !$OPT{mail_from} && $name eq 'mail-from';
318        my $fbody = scalar $field->{body};
319        next unless $fbody;
320      $name =~ s/((?:^|-)[a-z])/uc($1)/ge if $OPT{capitalize};      $name =~ s/((?:^|-)[a-z])/uc($1)/ge if $OPT{capitalize};
321      push @ret, $name.': '.$self->fold ($field->{body});      push @ret, $name.': '.$self->fold ($fbody);
322    }    }
323    my $ret = join ("\n", @ret);    my $ret = join ("\n", @ret);
324    $ret? $ret."\n": "";    $ret? $ret."\n": "";
# Line 345  sub field_type ($$;$) { Line 354  sub field_type ($$;$) {
354      $self->{option}->{field_type}->{$field_name} = $new_field_type;      $self->{option}->{field_type}->{$field_name} = $new_field_type;
355    }    }
356    $self->{option}->{field_type}->{$field_name}    $self->{option}->{field_type}->{$field_name}
357    || $self->{option}->{field_type}->{_DEFAULT};    || $self->{option}->{field_type}->{':DEFAULT'};
358  }  }
359    
360  sub _delete_empty_field ($) {  sub _delete_empty_field ($) {
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.7
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24