/[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.4 by wakaba, Sat Mar 16 08:54:39 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 importance mime-version precedence user-agent x-cite
56      x-face x-mail-count
57      x-msmail-priority x-priority x-uidl xref);
58    for (@field_type_Structured)
59      {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}
60    my @field_type_Address = qw(approved bcc cc delivered-to envelope-to
61      errors-to from mail-followup-to reply-to resent-bcc
62      resent-cc resent-to resent-from resent-sender return-path
63      return-receipt-to sender to x-approved x-beenthere
64      x-complaints-to x-envelope-from x-envelope-sender
65      x-envelope-to x-ml-address x-ml-command x-ml-to);
66    for (@field_type_Address)
67      {$DEFAULT{field_type}->{$_} = 'Message::Field::Address'}
68    my @field_type_Date = qw(date date-received delivery-date expires
69      expire-date nntp-posting-date posted reply-by resent-date x-tcup-date);
70    for (@field_type_Date)
71      {$DEFAULT{field_type}->{$_} = 'Message::Field::Date'}
72    my @field_type_MsgID = qw(content-id in-reply-to message-id
73      references resent-message-id supersedes);
74    for (@field_type_MsgID)
75      {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}
76    my @field_type_Received = qw(received x-received);
77    for (@field_type_Received)
78      {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}
79    my @field_type_Param = qw(content-disposition content-type
80      x-brother x-daughter x-face-type x-respect x-moe
81      x-syster x-wife);
82    for (@field_type_Param)
83      {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}
84    my @field_type_URI = qw(list-archive list-help list-owner
85      list-post list-subscribe list-unsubscribe uri url x-home-page x-http_referer
86      x-info x-pgp-key x-ml-url x-uri x-url x-web);
87    for (@field_type_URI)
88      {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}
89    my @field_type_ListID = qw(list-id);
90    for (@field_type_ListID)
91      {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}
92    
93  =head2 Message::Header->new ([%option])  =head2 Message::Header->new ([%option])
94    
# Line 106  sub field ($$) { Line 146  sub field ($$) {
146    for my $field (@{$self->{field}}) {    for my $field (@{$self->{field}}) {
147      if ($field->{name} eq $name) {      if ($field->{name} eq $name) {
148        unless (wantarray) {        unless (wantarray) {
149          return $field->{body};          return $self->_field_body ($field->{body}, $name);
150        } else {        } else {
151          push @ret, $field->{body};          push @ret, $self->_field_body ($field->{body}, $name);
152        }        }
153      }      }
154    }    }
155    @ret;    @ret;
156  }  }
157    
158    =head2 $self->field_name ($index)
159    
160    Returns C<field-name> of $index'th C<field>.
161    
162    =head2 $self->field_body ($index)
163    
164    Returns C<field-body> of $index'th C<field>.
165    
166    =cut
167    
168    sub field_name ($$) {
169      my $self = shift;
170      $self->{field}->[shift]->{name};
171    }
172    sub field_body ($$) {
173      my $self = shift;
174      my $i = shift;
175      $self->_field_body ($self->{field}->[$i]->{body}, $self->{field}->[$i]->{name});
176    }
177    
178    sub _field_body ($$$) {
179      my $self = shift;
180      my ($body, $name) = @_;
181      if (ref $body) {
182        return $body;
183      } else {
184        my $type = $self->{option}->{field_type}->{$name}
185                || $self->{option}->{field_type}->{_DEFAULT};
186        eval "use $type";
187        return $type->parse ($body);
188      }
189    }
190    
191  =head2 $self->field_name_list ()  =head2 $self->field_name_list ()
192    
193  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 194  sub delete ($$;$) { Line 267  sub delete ($$;$) {
267    $self;    $self;
268  }  }
269    
270  =head2 $self->count ($field_name)  =head2 $self->count ([$field_name])
271    
272  Returns the number of times the given C<field> appears.  Returns the number of times the given C<field> appears.
273    If no $field_name is given, returns the number
274    of fields.  (Same as $#$self+1)
275    
276  =cut  =cut
277    
278  sub count ($$) {  sub count ($;$) {
279    my $self = shift;    my $self = shift;
280    my ($name) = (lc shift);    my ($name) = (lc shift);
281      unless ($name) {
282        $self->_delete_empty_field ();
283        return $#{$self->{field}}+1;
284      }
285    my $count = 0;    my $count = 0;
286    for my $field (@{$self->{field}}) {    for my $field (@{$self->{field}}) {
287      if ($field->{name} eq $name) {      if ($field->{name} eq $name) {
# Line 232  sub stringify ($;%) { Line 311  sub stringify ($;%) {
311      $name =~ s/((?:^|-)[a-z])/uc($1)/ge if $OPT{capitalize};      $name =~ s/((?:^|-)[a-z])/uc($1)/ge if $OPT{capitalize};
312      push @ret, $name.': '.$self->fold ($field->{body});      push @ret, $name.': '.$self->fold ($field->{body});
313    }    }
314    join "\n", @ret;    my $ret = join ("\n", @ret);
315      $ret? $ret."\n": "";
316  }  }
317    
318  =head2 $self->get_option ($option_name)  =head2 $self->get_option ($option_name)
# Line 257  sub set_option ($$$) { Line 337  sub set_option ($$$) {
337    $self;    $self;
338  }  }
339    
340    sub field_type ($$;$) {
341      my $self = shift;
342      my $field_name = shift;
343      my $new_field_type = shift;
344      if ($new_field_type) {
345        $self->{option}->{field_type}->{$field_name} = $new_field_type;
346      }
347      $self->{option}->{field_type}->{$field_name}
348      || $self->{option}->{field_type}->{_DEFAULT};
349    }
350    
351  sub _delete_empty_field ($) {  sub _delete_empty_field ($) {
352    my $self = shift;    my $self = shift;
353    my @ret;    my @ret;
# Line 308  sub fold ($$;$) { Line 399  sub fold ($$;$) {
399    use Message::Header;    use Message::Header;
400    my $header = Message::Header->parse ($header);    my $header = Message::Header->parse ($header);
401        
402    for my $field (@$header) {    ## Next sample is better.
403      print $field->{name}, "\t=> ", $field->{body}, "\n";    #for my $field (@$header) {
404      #  print $field->{name}, "\t=> ", $field->{body}, "\n";
405      #}
406      
407      for my $i (0..$#$header) {
408        print $header->field_name ($i), "\t=> ", $header->field_body ($i), "\n";
409    }    }
410        
411        
412    ## Make simple header    ## Make simple header
413        
414      use Message::Header;
415    use Message::Field::Address;    use Message::Field::Address;
416    my $header = new Message::Header;    my $header = new Message::Header;
417        
# Line 351  Boston, MA 02111-1307, USA. Line 448  Boston, MA 02111-1307, USA.
448  =head1 CHANGE  =head1 CHANGE
449    
450  See F<ChangeLog>.  See F<ChangeLog>.
451    $Date$
452    
453  =cut  =cut
454    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24