/[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.9 by wakaba, Mon Mar 25 10:18:35 2002 UTC
# Line 47  when C<stringify>.  (Default = 0) Line 47  when C<stringify>.  (Default = 0)
47  %DEFAULT = (  %DEFAULT = (
48    capitalize    => 1,    capitalize    => 1,
49    fold_length   => 70,    fold_length   => 70,
50    mail_from     => 0,    field_type    => {':DEFAULT' => 'Message::Field::Unstructured'},
51    field_type    => {_DEFAULT => 'Message::Field::Unstructured'},    mail_from     => -1,
52      parse_all     => -1,
53  );  );
54  my @field_type_Structured = qw(cancel-lock content-language  my @field_type_Structured = qw(cancel-lock
55    content-transfer-encoding    importance mime-version path precedence user-agent x-cite
56    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);  
57  for (@field_type_Structured)  for (@field_type_Structured)
58    {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}
59  my @field_type_Address = qw(approved bcc cc delivered-to envelope-to  my @field_type_Address = qw(approved bcc cc delivered-to disposition-notification-to
60    errors-to from mail-followup-to reply-to resent-bcc    envelope-to
61      errors-to fcc from mail-followup-to mail-followup-cc mail-from reply-to resent-bcc
62    resent-cc resent-to resent-from resent-sender return-path    resent-cc resent-to resent-from resent-sender return-path
63    return-receipt-to sender to x-approved x-beenthere    return-receipt-to sender to x-approved x-beenthere
64    x-complaints-to x-envelope-from x-envelope-sender    x-complaints-to x-envelope-from x-envelope-sender
65    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);
66  for (@field_type_Address)  for (@field_type_Address)
67    {$DEFAULT{field_type}->{$_} = 'Message::Field::Address'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::Address'}
68  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 70  my @field_type_Date = qw(date date-recei
70  for (@field_type_Date)  for (@field_type_Date)
71    {$DEFAULT{field_type}->{$_} = 'Message::Field::Date'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::Date'}
72  my @field_type_MsgID = qw(content-id in-reply-to message-id  my @field_type_MsgID = qw(content-id in-reply-to message-id
73    references resent-message-id supersedes);    references resent-message-id see-also supersedes);
74  for (@field_type_MsgID)  for (@field_type_MsgID)
75    {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::MsgID'}
76  my @field_type_Received = qw(received x-received);  for (qw(received x-received))
77  for (@field_type_Received)    {$DEFAULT{field_type}->{$_} = 'Message::Field::Received'}
78    {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}  $DEFAULT{field_type}->{'content-type'} = 'Message::Field::ContentType';
79  my @field_type_Param = qw(content-disposition content-type  $DEFAULT{field_type}->{'content-disposition'} = 'Message::Field::ContentDisposition';
80    x-brother x-daughter x-face-type x-respect x-moe  for (qw(x-face-type))
81    x-syster x-wife);    {$DEFAULT{field_type}->{$_} = 'Message::Field::ValueParams'}
82  for (@field_type_Param)  for (qw(accept accept-charset accept-encoding accept-language
83    {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}    content-language
84      content-transfer-encoding encrypted followup-to keywords newsgroups
85      x-brother x-daughter x-respect x-moe x-syster x-wife))
86      {$DEFAULT{field_type}->{$_} = 'Message::Field::CSV'}
87  my @field_type_URI = qw(list-archive list-help list-owner  my @field_type_URI = qw(list-archive list-help list-owner
88    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
89    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);
90  for (@field_type_URI)  for (@field_type_URI)
91    {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}
92  my @field_type_ListID = qw(list-id);  for (qw(list-id))
 for (@field_type_ListID)  
93    {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}
94    for (qw(content-description subject title x-nsubject))
95      {$DEFAULT{field_type}->{$_} = 'Message::Field::Subject'}
96    
97  =head2 Message::Header->new ([%option])  =head2 Message::Header->new ([%option])
98    
# Line 119  sub parse ($$;%) { Line 123  sub parse ($$;%) {
123    $header =~ s/\x0D?\x0A$REG{WSP}+/\x20/gos;    ## unfold    $header =~ s/\x0D?\x0A$REG{WSP}+/\x20/gos;    ## unfold
124    for my $field (split /\x0D?\x0A/, $header) {    for my $field (split /\x0D?\x0A/, $header) {
125      if ($field =~ /$REG{M_fromline}/) {      if ($field =~ /$REG{M_fromline}/) {
126        push @{$self->{field}}, {name => 'mail-from', body => $1};        my $body = $1;
127          $body = $self->_field_body ($body, 'mail-from')
128            if $self->{option}->{parse_all}>0;
129          push @{$self->{field}}, {name => 'mail-from', body => $body};
130      } elsif ($field =~ /$REG{M_field}/) {      } elsif ($field =~ /$REG{M_field}/) {
131        my ($name, $body) = ($1, $2);        my ($name, $body) = (lc $1, $2);
132        $name =~ s/$REG{WSP}+$//;        $name =~ s/$REG{WSP}+$//;
133        $body =~ s/$REG{WSP}+$//;        $body =~ s/$REG{WSP}+$//;
134        push @{$self->{field}}, {name => lc $name, body => $body};        $body = $self->_field_body ($body, $name) if $self->{option}->{parse_all}>0;
135          push @{$self->{field}}, {name => $name, body => $body};
136      }      }
137    }    }
138    $self;    $self;
# Line 146  sub field ($$) { Line 154  sub field ($$) {
154    for my $field (@{$self->{field}}) {    for my $field (@{$self->{field}}) {
155      if ($field->{name} eq $name) {      if ($field->{name} eq $name) {
156        unless (wantarray) {        unless (wantarray) {
157          return $self->_field_body ($field->{body}, $name);          $field->{body} = $self->_field_body ($field->{body}, $name);
158            return $field->{body};
159        } else {        } else {
160          push @ret, $self->_field_body ($field->{body}, $name);          $field->{body} = $self->_field_body ($field->{body}, $name);
161            push @ret, $field->{body};
162        }        }
163      }      }
164    }    }
165      if ($#ret < 0) {
166        return $self->add ($name);
167      }
168    @ret;    @ret;
169  }  }
170    
171    sub field_exist ($$) {
172      my $self = shift;
173      my $name = lc shift;
174      my @ret;
175      for my $field (@{$self->{field}}) {
176        return 1 if ($field->{name} eq $name);
177      }
178      0;
179    }
180    
181  =head2 $self->field_name ($index)  =head2 $self->field_name ($index)
182    
183  Returns C<field-name> of $index'th C<field>.  Returns C<field-name> of $index'th C<field>.
# Line 172  sub field_name ($$) { Line 195  sub field_name ($$) {
195  sub field_body ($$) {  sub field_body ($$) {
196    my $self = shift;    my $self = shift;
197    my $i = shift;    my $i = shift;
198    $self->_field_body ($self->{field}->[$i]->{body}, $self->{field}->[$i]->{name});    $self->{field}->[$i]->{body}
199       = $self->_field_body ($self->{field}->[$i]->{body}, $self->{field}->[$i]->{name});
200      $self->{field}->[$i]->{body};
201  }  }
202    
203  sub _field_body ($$$) {  sub _field_body ($$$) {
204    my $self = shift;    my $self = shift;
205    my ($body, $name) = @_;    my ($body, $name) = @_;
206    if (ref $body) {    unless (ref $body) {
     return $body;  
   } else {  
207      my $type = $self->{option}->{field_type}->{$name}      my $type = $self->{option}->{field_type}->{$name}
208              || $self->{option}->{field_type}->{_DEFAULT};              || $self->{option}->{field_type}->{':DEFAULT'};
209      eval "use $type";      eval "require $type";
210      return $type->parse ($body);      unless ($body) {
211          $body = $type->new (field_name => $name);
212        } else {
213          $body = $type->parse ($body, field_name => $name);
214        }
215    }    }
216      $body;
217  }  }
218    
219  =head2 $self->field_name_list ()  =head2 $self->field_name_list ()
# Line 210  If you don't want duplicated C<field>s, Line 238  If you don't want duplicated C<field>s,
238    
239  =cut  =cut
240    
241  sub add ($$$) {  sub add ($$;$%) {
242    my $self = shift;    my $self = shift;
243    my ($name, $body) = (lc shift, shift);    my ($name, $body) = (lc shift, shift);
244      my %option = @_;
245    return 0 if $name =~ /$REG{UNSAFE_field_name}/;    return 0 if $name =~ /$REG{UNSAFE_field_name}/;
246    push @{$self->{field}}, {name => $name, body => $body};    $body = $self->_field_body ($body, $name);
247    $self;    if ($option{prepend}) {
248        unshift @{$self->{field}}, {name => $name, body => $body};
249      } else {
250        push @{$self->{field}}, {name => $name, body => $body};
251      }
252      $body;
253  }  }
254    
255  =head2 $self->relace ($field_name, $field_body)  =head2 $self->relace ($field_name, $field_body)
# Line 232  sub replace ($$$) { Line 266  sub replace ($$$) {
266    my $self = shift;    my $self = shift;
267    my ($name, $body) = (lc shift, shift);    my ($name, $body) = (lc shift, shift);
268    return 0 if $name =~ /$REG{UNSAFE_field_name}/;    return 0 if $name =~ /$REG{UNSAFE_field_name}/;
269      $body = $self->_field_body ($body, $name);
270    for my $field (@{$self->{field}}) {    for my $field (@{$self->{field}}) {
271      if ($field->{name} eq $name) {      if ($field->{name} eq $name) {
272        $field->{body} = $body;        $field->{body} = $body;
273        return $self;        return $body;
274      }      }
275    }    }
276    push @{$self->{field}}, {name => $name, body => $body};    push @{$self->{field}}, {name => $name, body => $body};
277    $self;    $body;
278  }  }
279    
280  =head2 $self->delete ($field_name, [$index])  =head2 $self->delete ($field_name, [$index])
# Line 303  sub stringify ($;%) { Line 338  sub stringify ($;%) {
338    my @ret;    my @ret;
339    $OPT{capitalize} ||= $self->{option}->{capitalize};    $OPT{capitalize} ||= $self->{option}->{capitalize};
340    $OPT{mail_from} ||= $self->{option}->{mail_from};    $OPT{mail_from} ||= $self->{option}->{mail_from};
341    push @ret, 'From '.$self->field ('mail-from') if $OPT{mail_from};    push @ret, 'From '.$self->field ('mail-from') if $OPT{mail_from}>0;
342    for my $field (@{$self->{field}}) {    for my $field (@{$self->{field}}) {
343      my $name = $field->{name};      my $name = $field->{name};
344      next unless $field->{name};      next unless $field->{name};
345      next if !$OPT{mail_from} && $name eq 'mail-from';      next if $OPT{mail_from}<0 && $name eq 'mail-from';
346        my $fbody = scalar $field->{body};
347        next unless $fbody;
348        $fbody =~ s/\x0D([^\x09\x0A\x20])/\x0D\x20$1/g;
349        $fbody =~ s/\x0A([^\x09\x20])/\x0A\x20$1/g;
350      $name =~ s/((?:^|-)[a-z])/uc($1)/ge if $OPT{capitalize};      $name =~ s/((?:^|-)[a-z])/uc($1)/ge if $OPT{capitalize};
351      push @ret, $name.': '.$self->fold ($field->{body});      push @ret, $name.': '.$self->fold ($fbody);
352    }    }
353    my $ret = join ("\n", @ret);    my $ret = join ("\n", @ret);
354    $ret? $ret."\n": "";    $ret? $ret."\n": "";
# Line 345  sub field_type ($$;$) { Line 384  sub field_type ($$;$) {
384      $self->{option}->{field_type}->{$field_name} = $new_field_type;      $self->{option}->{field_type}->{$field_name} = $new_field_type;
385    }    }
386    $self->{option}->{field_type}->{$field_name}    $self->{option}->{field_type}->{$field_name}
387    || $self->{option}->{field_type}->{_DEFAULT};    || $self->{option}->{field_type}->{':DEFAULT'};
388  }  }
389    
390  sub _delete_empty_field ($) {  sub _delete_empty_field ($) {
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.9
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24