/[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.5 by wakaba, Wed Mar 20 09:56:52 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 content-language
54      content-transfer-encoding
55      encrypted followup-to importance mime-version newsgroups
56      path precedence user-agent x-cite
57      x-face x-mail-count
58      x-msmail-priority x-priority x-uidl xref);
59    for (@field_type_Structured)
60      {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}
61    my @field_type_Address = qw(approved bcc cc delivered-to envelope-to
62      errors-to from mail-followup-to reply-to resent-bcc
63      resent-cc resent-to resent-from resent-sender return-path
64      return-receipt-to sender to x-approved x-beenthere
65      x-complaints-to x-envelope-from x-envelope-sender
66      x-envelope-to x-ml-address x-ml-command x-ml-to);
67    for (@field_type_Address)
68      {$DEFAULT{field_type}->{$_} = 'Message::Field::Address'}
69    my @field_type_Date = qw(date date-received delivery-date expires
70      expire-date nntp-posting-date posted reply-by resent-date x-tcup-date);
71    for (@field_type_Date)
72      {$DEFAULT{field_type}->{$_} = 'Message::Field::Date'}
73    my @field_type_MsgID = qw(content-id in-reply-to message-id
74      references resent-message-id supersedes);
75    for (@field_type_MsgID)
76      {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}
77    my @field_type_Received = qw(received x-received);
78    for (@field_type_Received)
79      {$DEFAULT{field_type}->{$_} = 'Message::Field::Received'}
80    my @field_type_Param = qw(content-disposition content-type
81      x-brother x-daughter x-face-type x-respect x-moe
82      x-syster x-wife);
83    for (@field_type_Param)
84      {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}
85    my @field_type_URI = qw(list-archive list-help list-owner
86      list-post list-subscribe list-unsubscribe uri url x-home-page x-http_referer
87      x-info x-pgp-key x-ml-url x-uri x-url x-web);
88    for (@field_type_URI)
89      {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}
90    my @field_type_ListID = qw(list-id);
91    for (@field_type_ListID)
92      {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}
93    my @field_type_Subject = qw(content-description subject title);
94    for (@field_type_Subject)
95      {$DEFAULT{field_type}->{$_} = 'Message::Field::Subject'}
96    
97  =head2 Message::Header->new ([%option])  =head2 Message::Header->new ([%option])
98    
# Line 106  sub field ($$) { Line 150  sub field ($$) {
150    for my $field (@{$self->{field}}) {    for my $field (@{$self->{field}}) {
151      if ($field->{name} eq $name) {      if ($field->{name} eq $name) {
152        unless (wantarray) {        unless (wantarray) {
153            $field->{body} = $self->_field_body ($field->{body}, $name);
154          return $field->{body};          return $field->{body};
155        } else {        } else {
156            $field->{body} = $self->_field_body ($field->{body}, $name);
157          push @ret, $field->{body};          push @ret, $field->{body};
158        }        }
159      }      }
# Line 115  sub field ($$) { Line 161  sub field ($$) {
161    @ret;    @ret;
162  }  }
163    
164    =head2 $self->field_name ($index)
165    
166    Returns C<field-name> of $index'th C<field>.
167    
168    =head2 $self->field_body ($index)
169    
170    Returns C<field-body> of $index'th C<field>.
171    
172    =cut
173    
174    sub field_name ($$) {
175      my $self = shift;
176      $self->{field}->[shift]->{name};
177    }
178    sub field_body ($$) {
179      my $self = shift;
180      my $i = shift;
181      $self->{field}->[$i]->{body}
182       = $self->_field_body ($self->{field}->[$i]->{body}, $self->{field}->[$i]->{name});
183      $self->{field}->[$i]->{body};
184    }
185    
186    sub _field_body ($$$) {
187      my $self = shift;
188      my ($body, $name) = @_;
189      unless (ref $body) {
190        my $type = $self->{option}->{field_type}->{$name}
191                || $self->{option}->{field_type}->{_DEFAULT};
192        eval "require $type";
193        unless ($body) {
194          $body = $type->new (field_name => $name);
195        } else {
196          $body = $type->parse ($body, field_name => $name);
197        }
198      }
199      $body;
200    }
201    
202  =head2 $self->field_name_list ()  =head2 $self->field_name_list ()
203    
204  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 141  sub add ($$$) { Line 225  sub add ($$$) {
225    my $self = shift;    my $self = shift;
226    my ($name, $body) = (lc shift, shift);    my ($name, $body) = (lc shift, shift);
227    return 0 if $name =~ /$REG{UNSAFE_field_name}/;    return 0 if $name =~ /$REG{UNSAFE_field_name}/;
228      $body = $self->_field_body ($body, $name);
229    push @{$self->{field}}, {name => $name, body => $body};    push @{$self->{field}}, {name => $name, body => $body};
230    $self;    $body;
231  }  }
232    
233  =head2 $self->relace ($field_name, $field_body)  =head2 $self->relace ($field_name, $field_body)
# Line 194  sub delete ($$;$) { Line 279  sub delete ($$;$) {
279    $self;    $self;
280  }  }
281    
282  =head2 $self->count ($field_name)  =head2 $self->count ([$field_name])
283    
284  Returns the number of times the given C<field> appears.  Returns the number of times the given C<field> appears.
285    If no $field_name is given, returns the number
286    of fields.  (Same as $#$self+1)
287    
288  =cut  =cut
289    
290  sub count ($$) {  sub count ($;$) {
291    my $self = shift;    my $self = shift;
292    my ($name) = (lc shift);    my ($name) = (lc shift);
293      unless ($name) {
294        $self->_delete_empty_field ();
295        return $#{$self->{field}}+1;
296      }
297    my $count = 0;    my $count = 0;
298    for my $field (@{$self->{field}}) {    for my $field (@{$self->{field}}) {
299      if ($field->{name} eq $name) {      if ($field->{name} eq $name) {
# Line 229  sub stringify ($;%) { Line 320  sub stringify ($;%) {
320      my $name = $field->{name};      my $name = $field->{name};
321      next unless $field->{name};      next unless $field->{name};
322      next if !$OPT{mail_from} && $name eq 'mail-from';      next if !$OPT{mail_from} && $name eq 'mail-from';
323        my $fbody = scalar $field->{body};
324        next unless $fbody;
325      $name =~ s/((?:^|-)[a-z])/uc($1)/ge if $OPT{capitalize};      $name =~ s/((?:^|-)[a-z])/uc($1)/ge if $OPT{capitalize};
326      push @ret, $name.': '.$self->fold ($field->{body});      push @ret, $name.': '.$self->fold ($fbody);
327    }    }
328    join "\n", @ret;    my $ret = join ("\n", @ret);
329      $ret? $ret."\n": "";
330  }  }
331    
332  =head2 $self->get_option ($option_name)  =head2 $self->get_option ($option_name)
# Line 257  sub set_option ($$$) { Line 351  sub set_option ($$$) {
351    $self;    $self;
352  }  }
353    
354    sub field_type ($$;$) {
355      my $self = shift;
356      my $field_name = shift;
357      my $new_field_type = shift;
358      if ($new_field_type) {
359        $self->{option}->{field_type}->{$field_name} = $new_field_type;
360      }
361      $self->{option}->{field_type}->{$field_name}
362      || $self->{option}->{field_type}->{_DEFAULT};
363    }
364    
365  sub _delete_empty_field ($) {  sub _delete_empty_field ($) {
366    my $self = shift;    my $self = shift;
367    my @ret;    my @ret;
# Line 308  sub fold ($$;$) { Line 413  sub fold ($$;$) {
413    use Message::Header;    use Message::Header;
414    my $header = Message::Header->parse ($header);    my $header = Message::Header->parse ($header);
415        
416    for my $field (@$header) {    ## Next sample is better.
417      print $field->{name}, "\t=> ", $field->{body}, "\n";    #for my $field (@$header) {
418      #  print $field->{name}, "\t=> ", $field->{body}, "\n";
419      #}
420      
421      for my $i (0..$#$header) {
422        print $header->field_name ($i), "\t=> ", $header->field_body ($i), "\n";
423    }    }
424        
425        
426    ## Make simple header    ## Make simple header
427        
428      use Message::Header;
429    use Message::Field::Address;    use Message::Field::Address;
430    my $header = new Message::Header;    my $header = new Message::Header;
431        
# Line 351  Boston, MA 02111-1307, USA. Line 462  Boston, MA 02111-1307, USA.
462  =head1 CHANGE  =head1 CHANGE
463    
464  See F<ChangeLog>.  See F<ChangeLog>.
465    $Date$
466    
467  =cut  =cut
468    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.5
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24