/[suikacvs]/test/cvs
Suika

Diff of /test/cvs

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

revision 1.1 by wakaba, Wed Mar 13 12:51:11 2002 UTC revision 1.8 by wakaba, Sat Mar 23 11:43:06 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'},
52  );  );
53    my @field_type_Structured = qw(cancel-lock
54      importance mime-version path precedence user-agent x-cite
55      x-face x-mail-count x-msmail-priority x-priority x-uidl xref);
56    for (@field_type_Structured)
57      {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}
58    my @field_type_Address = qw(approved bcc cc delivered-to disposition-notification-to
59      envelope-to
60      errors-to fcc from mail-followup-to mail-followup-cc mail-from reply-to resent-bcc
61      resent-cc resent-to resent-from resent-sender return-path
62      return-receipt-to sender to x-approved x-beenthere
63      x-complaints-to x-envelope-from x-envelope-sender
64      x-envelope-to x-ml-address x-ml-command x-ml-to x-nfrom x-nto);
65    for (@field_type_Address)
66      {$DEFAULT{field_type}->{$_} = 'Message::Field::Address'}
67    my @field_type_Date = qw(date date-received delivery-date expires
68      expire-date nntp-posting-date posted reply-by resent-date x-tcup-date);
69    for (@field_type_Date)
70      {$DEFAULT{field_type}->{$_} = 'Message::Field::Date'}
71    my @field_type_MsgID = qw(content-id in-reply-to message-id
72      references resent-message-id see-also supersedes);
73    for (@field_type_MsgID)
74      {$DEFAULT{field_type}->{$_} = 'Message::Field::MsgID'}
75    for (qw(received x-received))
76      {$DEFAULT{field_type}->{$_} = 'Message::Field::Received'}
77    $DEFAULT{field_type}->{'content-type'} = 'Message::Field::ContentType';
78    $DEFAULT{field_type}->{'content-disposition'} = 'Message::Field::ContentDisposition';
79    for (qw(x-face-type))
80      {$DEFAULT{field_type}->{$_} = 'Message::Field::ValueParams'}
81    for (qw(accept accept-charset accept-encoding accept-language
82      content-language
83      content-transfer-encoding encrypted followup-to keywords newsgroups
84      x-brother x-daughter x-respect x-moe x-syster x-wife))
85      {$DEFAULT{field_type}->{$_} = 'Message::Field::CSV'}
86    my @field_type_URI = qw(list-archive list-help list-owner
87      list-post list-subscribe list-unsubscribe uri url x-home-page x-http_referer
88      x-info x-pgp-key x-ml-url x-uri x-url x-web);
89    for (@field_type_URI)
90      {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}
91    for (qw(list-id))
92      {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}
93    for (qw(content-description subject title x-nsubject))
94      {$DEFAULT{field_type}->{$_} = 'Message::Field::Subject'}
95    
96  =head2 Message::Header->new ([%option])  =head2 Message::Header->new ([%option])
97    
# Line 106  sub field ($$) { Line 149  sub field ($$) {
149    for my $field (@{$self->{field}}) {    for my $field (@{$self->{field}}) {
150      if ($field->{name} eq $name) {      if ($field->{name} eq $name) {
151        unless (wantarray) {        unless (wantarray) {
152            $field->{body} = $self->_field_body ($field->{body}, $name);
153          return $field->{body};          return $field->{body};
154        } else {        } else {
155            $field->{body} = $self->_field_body ($field->{body}, $name);
156          push @ret, $field->{body};          push @ret, $field->{body};
157        }        }
158      }      }
# Line 115  sub field ($$) { Line 160  sub field ($$) {
160    @ret;    @ret;
161  }  }
162    
163    =head2 $self->field_name ($index)
164    
165    Returns C<field-name> of $index'th C<field>.
166    
167    =head2 $self->field_body ($index)
168    
169    Returns C<field-body> of $index'th C<field>.
170    
171    =cut
172    
173    sub field_name ($$) {
174      my $self = shift;
175      $self->{field}->[shift]->{name};
176    }
177    sub field_body ($$) {
178      my $self = shift;
179      my $i = shift;
180      $self->{field}->[$i]->{body}
181       = $self->_field_body ($self->{field}->[$i]->{body}, $self->{field}->[$i]->{name});
182      $self->{field}->[$i]->{body};
183    }
184    
185    sub _field_body ($$$) {
186      my $self = shift;
187      my ($body, $name) = @_;
188      unless (ref $body) {
189        my $type = $self->{option}->{field_type}->{$name}
190                || $self->{option}->{field_type}->{':DEFAULT'};
191        eval "require $type";
192        unless ($body) {
193          $body = $type->new (field_name => $name);
194        } else {
195          $body = $type->parse ($body, field_name => $name);
196        }
197      }
198      $body;
199    }
200    
201  =head2 $self->field_name_list ()  =head2 $self->field_name_list ()
202    
203  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 137  If you don't want duplicated C<field>s, Line 220  If you don't want duplicated C<field>s,
220    
221  =cut  =cut
222    
223  sub add ($$$) {  sub add ($$$;%) {
224    my $self = shift;    my $self = shift;
225    my ($name, $body) = (lc shift, shift);    my ($name, $body) = (lc shift, shift);
226      my %option = @_;
227    return 0 if $name =~ /$REG{UNSAFE_field_name}/;    return 0 if $name =~ /$REG{UNSAFE_field_name}/;
228    push @{$self->{field}}, {name => $name, body => $body};    $body = $self->_field_body ($body, $name);
229    $self;    if ($option{prepend}) {
230       unshift @{$self->{field}}, {name => $name, body => $body};
231      } else {
232        push @{$self->{field}}, {name => $name, body => $body};
233      }
234      $body;
235  }  }
236    
237  =head2 $self->relace ($field_name, $field_body)  =head2 $self->relace ($field_name, $field_body)
# Line 162  sub replace ($$$) { Line 251  sub replace ($$$) {
251    for my $field (@{$self->{field}}) {    for my $field (@{$self->{field}}) {
252      if ($field->{name} eq $name) {      if ($field->{name} eq $name) {
253        $field->{body} = $body;        $field->{body} = $body;
254        return $self;        return $body;
255      }      }
256    }    }
257    push @{$self->{field}}, {name => $name, body => $body};    push @{$self->{field}}, {name => $name, body => $body};
# Line 194  sub delete ($$;$) { Line 283  sub delete ($$;$) {
283    $self;    $self;
284  }  }
285    
286  =head2 $self->count ($field_name)  =head2 $self->count ([$field_name])
287    
288  Returns the number of times the given C<field> appears.  Returns the number of times the given C<field> appears.
289    If no $field_name is given, returns the number
290    of fields.  (Same as $#$self+1)
291    
292  =cut  =cut
293    
294  sub count ($$) {  sub count ($;$) {
295    my $self = shift;    my $self = shift;
296    my ($name) = (lc shift);    my ($name) = (lc shift);
297      unless ($name) {
298        $self->_delete_empty_field ();
299        return $#{$self->{field}}+1;
300      }
301    my $count = 0;    my $count = 0;
302    for my $field (@{$self->{field}}) {    for my $field (@{$self->{field}}) {
303      if ($field->{name} eq $name) {      if ($field->{name} eq $name) {
# Line 229  sub stringify ($;%) { Line 324  sub stringify ($;%) {
324      my $name = $field->{name};      my $name = $field->{name};
325      next unless $field->{name};      next unless $field->{name};
326      next if !$OPT{mail_from} && $name eq 'mail-from';      next if !$OPT{mail_from} && $name eq 'mail-from';
327        my $fbody = scalar $field->{body};
328        next unless $fbody;
329      $name =~ s/((?:^|-)[a-z])/uc($1)/ge if $OPT{capitalize};      $name =~ s/((?:^|-)[a-z])/uc($1)/ge if $OPT{capitalize};
330      push @ret, $name.': '.$self->fold ($field->{body});      push @ret, $name.': '.$self->fold ($fbody);
331    }    }
332    join "\n", @ret;    my $ret = join ("\n", @ret);
333      $ret? $ret."\n": "";
334  }  }
335    
336  =head2 $self->get_option ($option_name)  =head2 $self->get_option ($option_name)
# Line 257  sub set_option ($$$) { Line 355  sub set_option ($$$) {
355    $self;    $self;
356  }  }
357    
358    sub field_type ($$;$) {
359      my $self = shift;
360      my $field_name = shift;
361      my $new_field_type = shift;
362      if ($new_field_type) {
363        $self->{option}->{field_type}->{$field_name} = $new_field_type;
364      }
365      $self->{option}->{field_type}->{$field_name}
366      || $self->{option}->{field_type}->{':DEFAULT'};
367    }
368    
369  sub _delete_empty_field ($) {  sub _delete_empty_field ($) {
370    my $self = shift;    my $self = shift;
371    my @ret;    my @ret;
# Line 308  sub fold ($$;$) { Line 417  sub fold ($$;$) {
417    use Message::Header;    use Message::Header;
418    my $header = Message::Header->parse ($header);    my $header = Message::Header->parse ($header);
419        
420    for my $field (@$header) {    ## Next sample is better.
421      print $field->{name}, "\t=> ", $field->{body}, "\n";    #for my $field (@$header) {
422      #  print $field->{name}, "\t=> ", $field->{body}, "\n";
423      #}
424      
425      for my $i (0..$#$header) {
426        print $header->field_name ($i), "\t=> ", $header->field_body ($i), "\n";
427    }    }
428        
429        
430    ## Make simple header    ## Make simple header
431        
432      use Message::Header;
433    use Message::Field::Address;    use Message::Field::Address;
434    my $header = new Message::Header;    my $header = new Message::Header;
435        
# Line 351  Boston, MA 02111-1307, USA. Line 466  Boston, MA 02111-1307, USA.
466  =head1 CHANGE  =head1 CHANGE
467    
468  See F<ChangeLog>.  See F<ChangeLog>.
469    $Date$
470    
471  =cut  =cut
472    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.8
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24