/[suikacvs]/test/cvs
Suika

Diff of /test/cvs

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

revision 1.14 by wakaba, Wed Apr 3 13:31:36 2002 UTC revision 1.15 by wakaba, Fri Apr 5 14:56:26 2002 UTC
# Line 14  use strict; Line 14  use strict;
14  use vars qw($VERSION %REG);  use vars qw($VERSION %REG);
15  $VERSION = '1.00';  $VERSION = '1.00';
16  use Carp ();  use Carp ();
17  use overload '@{}' => sub {shift->_delete_empty_field()->{field}},  use overload '@{}' => sub { shift->_delete_empty_field->{field} },
18               '""' => sub {shift->stringify};               '""' => sub { shift->stringify },
19                 fallback => 1;
20    
21  $REG{WSP}     = qr/[\x09\x20]/;  $REG{WSP}     = qr/[\x09\x20]/;
22  $REG{FWS}     = qr/[\x09\x20]*/;  $REG{FWS}     = qr/[\x09\x20]*/;
# Line 44  when C<stringify>.  (Default = 0) Line 45  when C<stringify>.  (Default = 0)
45    
46  =cut  =cut
47    
48    =head1 CONSTRUCTORS
49    
50    The following methods construct new C<Message::Header> objects:
51    
52    =over 4
53    
54    ## Initialize
55  my %DEFAULT = (  my %DEFAULT = (
56    capitalize    => 1,    capitalize    => 1,
57    fold_length   => 70,    fold_length   => 70,
# Line 64  $DEFAULT{field_type} = { Line 72  $DEFAULT{field_type} = {
72                    
73          'content-type'  => 'Message::Field::ContentType',          'content-type'  => 'Message::Field::ContentType',
74          'content-disposition'   => 'Message::Field::ContentDisposition',          'content-disposition'   => 'Message::Field::ContentDisposition',
75            'auto-submitted'        => 'Message::Field::ValueParams',
76          link    => 'Message::Field::ValueParams',          link    => 'Message::Field::ValueParams',
77          archive => 'Message::Field::ValueParams',          archive => 'Message::Field::ValueParams',
78          'x-face-type'   => 'Message::Field::ValueParams',          'x-face-type'   => 'Message::Field::ValueParams',
# Line 75  $DEFAULT{field_type} = { Line 84  $DEFAULT{field_type} = {
84          'user-agent'    => 'Message::Field::UA',          'user-agent'    => 'Message::Field::UA',
85          server  => 'Message::Field::UA',          server  => 'Message::Field::UA',
86                    
87            ## Numeric value
88          'content-length'        => 'Message::Field::Numval',          'content-length'        => 'Message::Field::Numval',
89          lines   => 'Message::Field::Numval',          lines   => 'Message::Field::Numval',
90          'max-forwards'  => 'Message::Field::Numval',          'max-forwards'  => 'Message::Field::Numval',
91          'mime-version'  => 'Message::Field::Numval',          'mime-version'  => 'Message::Field::Numval',
92            'x-jsmail-priority'     => 'Message::Field::Numval',
93            'x-priority'    => 'Message::Field::Numval',
94                    
95          path    => 'Message::Field::Path',          path    => 'Message::Field::Path',
96  };  };
97  for (qw(cancel-lock importance   precedence list-id  for (qw(cancel-lock importance   precedence list-id
98    x-face x-mail-count x-msmail-priority x-priority xref))    x-face x-mail-count x-msmail-priority x-priority xref))
99    {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}    {$DEFAULT{field_type}->{$_} = 'Message::Field::Structured'}
100  for (qw(approved bcc cc delivered-to disposition-notification-to envelope-to  for (qw(approved bcc cc complaints-to
101    errors-to fcc from mail-followup-to mail-followup-cc reply-to resent-bcc    delivered-to disposition-notification-to envelope-to
102      errors-to fcc from mail-followup-to mail-followup-cc
103      mail-reply-to
104      notice-requested-upon-delivery-to reply-to resent-bcc
105    resent-cc resent-to resent-from resent-sender return-path    resent-cc resent-to resent-from resent-sender return-path
106    return-receipt-to sender to x-approved x-beenthere    return-receipt-to sender to x-approved x-beenthere
107    x-complaints-to x-envelope-from x-envelope-sender    x-complaints-to x-envelope-from x-envelope-sender
# Line 172  sub _init ($;%) { Line 187  sub _init ($;%) {
187    }    }
188  }  }
189    
190  =head2 Message::Header->new ([%initial-fields/options])  =item Message::Header->new ([%initial-fields/options])
191    
192  Constructs a new C<Message::Headers> object.  You might pass some initial  Constructs a new C<Message::Headers> object.  You might pass some initial
193  C<field-name>-C<field-body> pairs and/or options as parameters to the constructor.  C<field-name>-C<field-body> pairs and/or options as parameters to the constructor.
194    
195  =head3 example  Example:
196    
197   $hdr = new Message::Headers   $hdr = new Message::Headers
198          Date         => 'Thu, 03 Feb 1994 00:00:00 +0000',          Date         => 'Thu, 03 Feb 1994 00:00:00 +0000',
# Line 195  sub new ($;%) { Line 210  sub new ($;%) {
210    $self;    $self;
211  }  }
212    
213  =head2 Message::Header->parse ($header, [%initial-fields/options])  =item Message::Header->parse ($header, [%initial-fields/options])
214    
215  Parses given C<header> and constructs a new C<Message::Headers>  Parses given C<header> and constructs a new C<Message::Headers>
216  object.  You might pass some additional C<field-name>-C<field-body> pairs  object.  You might pass some additional C<field-name>-C<field-body> pairs
# Line 226  sub parse ($$;%) { Line 241  sub parse ($$;%) {
241    $self;    $self;
242  }  }
243    
244    =item Message::Header->parse_array (\@header, [%initial-fields/options])
245    
246    Parses given C<header> and constructs a new C<Message::Headers>
247    object.  Same as C<Message::Header-E<lt>parse> but this method
248    is given an array reference.  You might pass some additional
249    C<field-name>-C<field-body> pairs or/and initial options
250    as parameters to the constructor.
251    
252    =cut
253    
254  sub parse_array ($\@;%) {  sub parse_array ($\@;%) {
255    my $class = shift;    my $class = shift;
256    my $header = shift;    my $header = shift;
# Line 258  sub parse_array ($\@;%) { Line 283  sub parse_array ($\@;%) {
283    $self;    $self;
284  }  }
285    
286    =back
287    
288    =head1 METHODS
289    
290  =head2 $self->field ($field_name)  =head2 $self->field ($field_name)
291    
292  Returns C<field-body> of given C<field-name>.  Returns C<field-body> of given C<field-name>.
# Line 412  sub replace ($%) { Line 441  sub replace ($%) {
441    my %option = %{$self->{option}};    my %option = %{$self->{option}};
442    $option{parse} = defined wantarray unless defined $option{parse};    $option{parse} = defined wantarray unless defined $option{parse};
443    for (grep {/^-/} keys %params) {$option{substr ($_, 1)} = $params{$_}}    for (grep {/^-/} keys %params) {$option{substr ($_, 1)} = $params{$_}}
444    my (%new_field, $body);    my (%new_field);
445    for (grep {/^[^-]/} keys %params) {    for (grep {/^[^-]/} keys %params) {
446      my $name = lc $_;      my $name = lc $_;
447      $name =~ tr/_/-/ if $option{translate_underscore};      $name =~ tr/_/-/ if $option{translate_underscore};
# Line 421  sub replace ($%) { Line 450  sub replace ($%) {
450      $params{$_} = $self->_field_body ($params{$_}, $name) if $option{parse};      $params{$_} = $self->_field_body ($params{$_}, $name) if $option{parse};
451      $new_field{$name} = $params{$_};      $new_field{$name} = $params{$_};
452    }    }
453      my $body = (%new_field)[-1];
454    for my $field (@{$self->{field}}) {    for my $field (@{$self->{field}}) {
455      if (defined $new_field{$field->{name}}) {      if (defined $new_field{$field->{name}}) {
456        $body = $new_field {$field->{name}};        $field->{body} = $new_field {$field->{name}};
       $field->{body} = $body;  
457        $new_field{$field->{name}} = undef;        $new_field{$field->{name}} = undef;
458      }      }
459    }    }
Legend:
Removed from v.1.14  
changed lines
  Added in v.1.15
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24