/[suikacvs]/messaging/manakai/lib/Message/Body/Multipart.pm
Suika

Diff of /messaging/manakai/lib/Message/Body/Multipart.pm

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

revision 1.3 by wakaba, Sun Jun 16 10:44:08 2002 UTC revision 1.4 by wakaba, Tue Jul 2 06:30:49 2002 UTC
# Line 22  $REG{NON_bchars} = qr#[^0-9A-Za-z'()+_,- Line 22  $REG{NON_bchars} = qr#[^0-9A-Za-z'()+_,-
22  %DEFAULT = (  %DEFAULT = (
23          ## "#i" : only inherited from parent Entity and inherits to child Entity          ## "#i" : only inherited from parent Entity and inherits to child Entity
24    -_ARRAY_NAME  => 'value',    -_ARRAY_NAME  => 'value',
25    -_METHODS     => [qw|entity_header add delete count item preamble epilogue|],    -_METHODS     => [qw|data_part control_part entity_header add delete count item preamble epilogue|],
26    -_MEMBERS     => [qw|boundary preamble epilogue|],    -_MEMBERS     => [qw|boundary preamble epilogue|],
27    #i accept_cte    #i accept_cte
28    #i body_default_charset    #i body_default_charset
# Line 30  $REG{NON_bchars} = qr#[^0-9A-Za-z'()+_,- Line 30  $REG{NON_bchars} = qr#[^0-9A-Za-z'()+_,-
30    #i cte_default    #i cte_default
31    -default_media_type   => 'text',    -default_media_type   => 'text',
32    -default_media_subtype        => 'plain',    -default_media_subtype        => 'plain',
33      -linebreak_strict     => 0,
34    -media_type   => 'multipart',    -media_type   => 'multipart',
35    -media_subtype        => 'mixed',    -media_subtype        => 'mixed',
36    #output_epilogue    #output_epilogue
# Line 102  sub parse ($$;%) { Line 103  sub parse ($$;%) {
103    my $body = shift;    my $body = shift;
104    $self->_init (@_);    $self->_init (@_);
105    my $b = $self->{boundary};    my $b = $self->{boundary};
106      my $nl = "\x0D\x0A";
107      unless ($self->{option}->{strict_linebreak}) {
108        $nl = Message::Util::decide_newline ($body);
109      }
110    if (length $b) {    if (length $b) {
111      $self->{value} = [ split /\x0D\x0A--\Q$b\E[\x09\x20]*\x0D\x0A/, $body ];      $body = $nl . $body if $body =~ /^--\Q$b\E[\x09\x20]*$nl/s;
112      if (length $self->{value}->[0]) {      $self->{value} = [ split /$nl--\Q$b\E[\x09\x20]*$nl/s, $body ];
113        my @p = split /(?:\x0D\x0A)?--\Q$b\E[\x09\x20]*\x0D\x0A/, $self->{value}->[0], 2;      $self->{preamble} = shift (@{ $self->{value} });
       $self->{preamble} = $p[0];  
       if (length $p[1]) {  
         $self->{value}->[0] = $p[1];  
       } else { shift (@{$self->{value}}) }  
     }  
114      if (length $self->{value}->[-1]) {      if (length $self->{value}->[-1]) {
115        my @p = split /\x0D\x0A--\Q$b\E--[\x09\x20]*(?:\x0D\x0A)?/, $self->{value}->[-1], 2;        my @p = split /$nl--\Q$b\E--[\x09\x20]*(?:$nl)?/s, $self->{value}->[-1], 2;
116        $self->{value}->[-1] = $p[0];        $self->{value}->[-1] = $p[0];
117        $self->{epilogue} = $p[1];        $self->{epilogue} = $p[1];
118      }      }
119    } else {    } else {
120      $self->{preamble} = [ $body ];      $self->{preamble} = $body;
121    }    }
122    if ($self->{option}->{parse_all}) {    if ($self->{option}->{parse_all}) {
123      $self->{value} = [map {      $self->{value} = [ map {
124        $self->_parse_value (body_part => $_);        $self->_parse_value (body_part => $_);
125      } @{$self->{value}}];      } @{ $self->{value} } ];
126      $self->{preamble} = $self->_parse_value (preamble => $self->{preamble});      $self->{preamble} = $self->_parse_value (preamble => $self->{preamble});
127      $self->{epilogue} = $self->_parse_value (epilogue => $self->{epilogue});      $self->{epilogue} = $self->_parse_value (epilogue => $self->{epilogue});
128    }    }
# Line 154  sub _item_match ($$\$\%\%) { Line 154  sub _item_match ($$\$\%\%) {
154  ## Returns returned item value    \$item-value, \%option  ## Returns returned item value    \$item-value, \%option
155  sub _item_return_value ($\$\%) {  sub _item_return_value ($\$\%) {
156    unless (ref ${$_[1]}) {    unless (ref ${$_[1]}) {
157      ${$_[1]} = $_[0]->_parse_value (body_part => ${$_[1]});      ${$_[1]} = $_[0]->_parse_value (body_part => ${$_[1]})
158          if $_[2]->{parse};
159    }    }
160    ${$_[1]};    ${$_[1]};
161  }  }
# Line 172  sub _item_new_value ($$\%) { Line 173  sub _item_new_value ($$\%) {
173    $v;    $v;
174  }  }
175    
176    sub data_part ($;%) {
177      my $self = shift;
178      my %option = @_;
179      $option{-by} = 'index';
180      my $st = $self->{option}->{media_subtype};
181      if ($st eq 'signed' || $st eq 'appledouble') {
182        $self->item (0, @_);
183      } elsif ($st eq 'encrypted') {
184        $self->item (1, @_);
185      } else {
186        my $msg = qq{data_part: This method is not supported for $self->{option}->{media_type}/$st};
187        if ($option{-dont_croak}) {
188          Carp::carp $msg;
189        } else {
190          Carp::croak $msg;
191        }
192      }
193    }
194    
195    sub control_part ($;%) {
196      my $self = shift;
197      my %option = @_;
198      $option{-by} = 'index';
199      my $st = $self->{option}->{media_subtype};
200      if ($st eq 'signed' || $st eq 'appledouble') {
201        $self->item (1, @_);
202      } elsif ($st eq 'encrypted') {
203        $self->item (0, @_);
204      } else {
205        my $msg = qq{control_part: This method is not supported for $self->{option}->{media_type}/$st};
206        if ($option{-dont_croak}) {
207          Carp::carp $msg;
208        } else {
209          Carp::croak $msg;
210        }
211      }
212    }
213    
214  sub _add_array_check ($$\%) {  sub _add_array_check ($$\%) {
215    my $self = shift;    my $self = shift;
216    my ($value, $option) = @_;    my ($value, $option) = @_;
# Line 235  sub stringify ($;%) { Line 274  sub stringify ($;%) {
274      }      }
275    }    }
276    if (ref $self->{header}) {    if (ref $self->{header}) {
277      $self->{header}->field ('content-type')->parameter (boundary => $b);      my $ct = $self->{header}->field ('content-type');
278        my $mt = $ct->media_type;
279        $ct->replace (boundary => $b);
280        if ($mt eq 'multipart/signed') {
281          $ct->replace (protocol => scalar $self->{value}->[1]->content_type);
282        } elsif ($mt eq 'multipart/encrypted') {
283          $ct->replace (protocol => scalar $self->{value}->[0]->content_type);
284        }
285    }    }
286    $self->{preamble}."\x0D\x0A--".$b."\x0D\x0A".    $self->{preamble}."\x0D\x0A--".$b."\x0D\x0A".
287    join ("\x0D\x0A--".$b."\x0D\x0A", @parts)    join ("\x0D\x0A--".$b."\x0D\x0A", @parts)
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24