/[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.4 by wakaba, Tue Jul 2 06:30:49 2002 UTC revision 1.5 by wakaba, Thu Jul 4 06:38:21 2002 UTC
# Line 35  $REG{NON_bchars} = qr#[^0-9A-Za-z'()+_,- Line 35  $REG{NON_bchars} = qr#[^0-9A-Za-z'()+_,-
35    -media_subtype        => 'mixed',    -media_subtype        => 'mixed',
36    #output_epilogue    #output_epilogue
37    -parse_all    => 0,    -parse_all    => 0,
38      -parts_min    => 1,
39      -parts_max    => 0,
40    #i text_coderange    #i text_coderange
41    #use_normalization    => 0,    #use_normalization    => 0,
42    #use_param_charset    => 0,    #use_param_charset    => 0,
# Line 79  sub _init ($;%) { Line 81  sub _init ($;%) {
81      my $ct = $self->{header}->field ('content-type', -new_item_unless_exist => 0);      my $ct = $self->{header}->field ('content-type', -new_item_unless_exist => 0);
82      $self->{boundary} = $ct->parameter ('boundary') if ref $ct;      $self->{boundary} = $ct->parameter ('boundary') if ref $ct;
83    }    }
84      
85      my $mst = $self->{option}->{media_subtype};
86      if ($mst eq 'report') {
87        $self->{option}->{parts_min} = 2;
88        $self->{option}->{parts_max} = 3;
89      } elsif ($mst eq 'signed' || $mst eq 'encrypted' || $mst eq 'appledouble') {
90        $self->{option}->{parts_min} = 2;
91        $self->{option}->{parts_max} = 2;
92      } elsif ($mst eq 'headerset') {
93        $self->{option}->{parts_min} = 2;
94      }
95  }  }
96    
97  =item $body = Message::Body::Multipart->new ([%options])  =item $body = Message::Body::Multipart->new ([%options])
# Line 254  sub stringify ($;%) { Line 267  sub stringify ($;%) {
267    my $self = shift;    my $self = shift;
268    my %o = @_;  my %option = %{$self->{option}};    my %o = @_;  my %option = %{$self->{option}};
269    for (grep {/^-/} keys %o) {$option{substr ($_, 1)} = $o{$_}}    for (grep {/^-/} keys %o) {$option{substr ($_, 1)} = $o{$_}}
270    my $max = $option{max} || $#{$self->{value}}+1;  $max--;    $self->_delete_empty;
271    $max = $#{$self->{value}} if $max > $#{$self->{value}};    ## Check the number of parts
272    my @parts = map { ''. $_ } @{$self->{value}}[0..$max];      my $min = $option{parts_min} || 1;  $min--;
273    my $b = $self->{boundary};      $#{ $self->{value} } = $min unless $min <= $#{ $self->{value} };
274    if ($b =~ $REG{NON_bchars} || length ($b) > 70) {      my $max = $option{parts_max} || $#{$self->{value}}+1;  $max--;
275      undef $b;      $max = $#{$self->{value}} if $max > $#{$self->{value}};
276    } elsif (substr ($b, -1, 1) eq "\x20") {    ## Media type parameters
277      $b .= 'B';      my $ct;     ## Content-Type field of parent entity
278    }      if (ref $self->{header}) {
279    my $blength = 35;        $ct = $self->{header}->field ('content-type');
280    $b ||= $self->_generate_boundary ($blength);        my $mt = $ct->media_type;
281    my $i = 1; while ($i++) {        if ($mt eq 'multipart/signed') {
282      my @t = grep {/\Q--$b\E/} @parts;          $ct->replace (protocol => scalar $self->item (1, -by => 'index')->content_type);
283      last if @t == 0;        } elsif ($mt eq 'multipart/encrypted') {
284      $b = $self->_generate_boundary ($blength);          $ct->replace (protocol => scalar $self->item (0, -by => 'index')->content_type);
285      if ($i > @BCHARS ** $blength) {        } elsif ($mt eq 'multipart/report') {
286        $blength++; $i = 1;          $ct->replace ('report-type' => ($self->item (1, -by => 'index')->content_type) [1]);
287      }        }
   }  
   if (ref $self->{header}) {  
     my $ct = $self->{header}->field ('content-type');  
     my $mt = $ct->media_type;  
     $ct->replace (boundary => $b);  
     if ($mt eq 'multipart/signed') {  
       $ct->replace (protocol => scalar $self->{value}->[1]->content_type);  
     } elsif ($mt eq 'multipart/encrypted') {  
       $ct->replace (protocol => scalar $self->{value}->[0]->content_type);  
288      }      }
289    }    ## Preparates parts
290        my @parts = map { ''. $_ } @{$self->{value}}[0..$max];
291      ## Boundary
292        my $b = $self->{boundary};
293        if ($b =~ $REG{NON_bchars} || length ($b) > 70) {
294          undef $b;
295        } elsif (substr ($b, -1, 1) eq "\x20") {
296          $b .= 'B';
297        }
298        my $blength = 35;
299        $b ||= $self->_generate_boundary ($blength);
300        my $i = 1; while ($i++) {
301          my @t = grep {/\Q--$b\E/} (@parts, $self->{preamble}, $self->{epilogue});
302          last if @t == 0;
303          $b = $self->_generate_boundary ($blength);
304          if ($i > @BCHARS ** $blength) {
305            $blength++; $i = 1;
306          }
307        }
308        if (ref $ct) {
309          $ct->replace (boundary => $b);
310        }
311      
312    $self->{preamble}."\x0D\x0A--".$b."\x0D\x0A".    $self->{preamble}."\x0D\x0A--".$b."\x0D\x0A".
313    join ("\x0D\x0A--".$b."\x0D\x0A", @parts)    join ("\x0D\x0A--".$b."\x0D\x0A", @parts)
314    ."\x0D\x0A--$b--\x0D\x0A".    ."\x0D\x0A--$b--\x0D\x0A".
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24