1# Copyrights 2001-2021 by [Mark Overmeer <markov@cpan.org>].
2#  For other contributors see ChangeLog.
3# See the manual pages for details on the licensing terms.
4# Pod stripped from pm file by OODoc 2.02.
5# This code is part of distribution Mail-Message.  Meta-POD processed with
6# OODoc into POD and HTML manual-pages.  See README.md
7# Copyright Mark Overmeer.  Licensed under the same terms as Perl itself.
8
9package Mail::Message::Body::Multipart;
10use vars '$VERSION';
11$VERSION = '3.011';
12
13use base 'Mail::Message::Body';
14
15use strict;
16use warnings;
17
18use Mail::Message::Body::Lines;
19use Mail::Message::Part;
20
21use Mail::Box::FastScalar;
22use Carp;
23
24
25sub init($)
26{   my ($self, $args) = @_;
27    my $based = $args->{based_on};
28    $args->{mime_type} ||= defined $based ? $based->type : 'multipart/mixed';
29
30    $self->SUPER::init($args);
31
32    my @parts;
33    if($args->{parts})
34    {   foreach my $raw (@{$args->{parts}})
35        {   next unless defined $raw;
36            my $cooked = Mail::Message::Part->coerce($raw, $self);
37
38            $self->log(ERROR => 'Data not convertible to a message (type is '
39                      , ref $raw,")\n"), next unless defined $cooked;
40
41            push @parts, $cooked;
42        }
43    }
44
45    my $preamble = $args->{preamble};
46    $preamble    = Mail::Message::Body->new(data => $preamble)
47       if defined $preamble && ! ref $preamble;
48
49    my $epilogue = $args->{epilogue};
50    $epilogue    = Mail::Message::Body->new(data => $epilogue)
51       if defined $epilogue && ! ref $epilogue;
52
53    if($based)
54    {   $self->boundary($args->{boundary} || $based->boundary);
55        $self->{MMBM_preamble}
56            = defined $preamble ? $preamble : $based->preamble;
57
58        $self->{MMBM_parts}
59            = @parts ? \@parts
60            : !$args->{parts} && $based->isMultipart
61                     ? [ $based->parts('ACTIVE') ]
62            :          [];
63
64        $self->{MMBM_epilogue}
65            = defined $epilogue ? $epilogue : $based->epilogue;
66    }
67    else
68    {   $self->boundary($args->{boundary} ||$self->type->attribute('boundary'));
69        $self->{MMBM_preamble} = $preamble;
70        $self->{MMBM_parts}    = \@parts;
71        $self->{MMBM_epilogue} = $epilogue;
72    }
73
74    $self;
75}
76
77sub isMultipart() {1}
78
79# A multipart body is never binary itself.  The parts may be.
80sub isBinary() {0}
81
82sub clone()
83{   my $self     = shift;
84    my $preamble = $self->preamble;
85    my $epilogue = $self->epilogue;
86
87    my $body     = ref($self)->new
88     ( $self->logSettings
89     , based_on => $self
90     , preamble => ($preamble ? $preamble->clone : undef)
91     , epilogue => ($epilogue ? $epilogue->clone : undef)
92     , parts    => [ map {$_->clone} $self->parts('ACTIVE') ]
93     );
94
95}
96
97sub nrLines()
98{   my $self = shift;
99    my $nr   = 1;  # trailing part-sep
100
101    if(my $preamble = $self->preamble)
102    {   $nr += $preamble->nrLines;
103        $nr++ if $preamble->endsOnNewline;
104    }
105
106    foreach my $part ($self->parts('ACTIVE'))
107    {   $nr += 1 + $part->nrLines;
108        $nr++ if $part->body->endsOnNewline;
109    }
110
111    if(my $epilogue = $self->epilogue)
112    {   $nr += $epilogue->nrLines;
113    }
114
115    $nr;
116}
117
118sub size()
119{   my $self   = shift;
120    my $bbytes = length($self->boundary) +4;  # \n--$b\n
121
122    my $bytes  = $bbytes +2;   # last boundary, \n--$b--\n
123    if(my $preamble = $self->preamble)
124         { $bytes += $preamble->size }
125    else { $bytes -= 1 }      # no leading \n
126
127    $bytes += $bbytes + $_->size foreach $self->parts('ACTIVE');
128    if(my $epilogue = $self->epilogue)
129    {   $bytes += $epilogue->size;
130    }
131    $bytes;
132}
133
134sub string() { join '', shift->lines }
135
136sub lines()
137{   my $self     = shift;
138
139    my $boundary = $self->boundary;
140    my @lines;
141
142    my $preamble = $self->preamble;
143    push @lines, $preamble->lines if $preamble;
144
145    foreach my $part ($self->parts('ACTIVE'))
146    {   # boundaries start with \n
147        if(!@lines) { ; }
148        elsif($lines[-1] =~ m/\n$/) { push @lines, "\n" }
149        else { $lines[-1] .= "\n" }
150        push @lines, "--$boundary\n", $part->lines;
151    }
152
153    if(!@lines) { ; }
154    elsif($lines[-1] =~ m/\n$/) { push @lines, "\n" }
155    else { $lines[-1] .= "\n" }
156    push @lines, "--$boundary--";
157
158    if(my $epilogue = $self->epilogue)
159    {   $lines[-1] .= "\n";
160        push @lines, $epilogue->lines;
161    }
162
163    wantarray ? @lines : \@lines;
164}
165
166sub file()                    # It may be possible to speed-improve the next
167{   my $self   = shift;       # code, which first produces a full print of
168    my $text;                 # the message in memory...
169    my $dump   = Mail::Box::FastScalar->new(\$text);
170    $self->print($dump);
171    $dump->seek(0,0);
172    $dump;
173}
174
175sub print(;$)
176{   my $self = shift;
177    my $out  = shift || select;
178
179    my $boundary = $self->boundary;
180    my $count    = 0;
181    if(my $preamble = $self->preamble)
182    {   $preamble->print($out);
183        $count++;
184    }
185
186    if(ref $out eq 'GLOB')
187    {   foreach my $part ($self->parts('ACTIVE'))
188        {   print $out "\n" if $count++;
189            print $out "--$boundary\n";
190            $part->print($out);
191        }
192        print $out "\n" if $count++;
193        print $out "--$boundary--";
194    }
195    else
196    {   foreach my $part ($self->parts('ACTIVE'))
197        {   $out->print("\n") if $count++;
198            $out->print("--$boundary\n");
199            $part->print($out);
200        }
201        $out->print("\n") if $count++;
202        $out->print("--$boundary--");
203    }
204
205    if(my $epilogue = $self->epilogue)
206    {   $out->print("\n");
207        $epilogue->print($out);
208    }
209
210    $self;
211}
212
213
214sub foreachLine($)
215{   my ($self, $code) = @_;
216    $self->log(ERROR => "You cannot use foreachLine on a multipart");
217    confess;
218}
219
220sub check()
221{   my $self = shift;
222    $self->foreachComponent( sub {$_[1]->check} );
223}
224
225sub encode(@)
226{   my ($self, %args) = @_;
227    $self->foreachComponent( sub {$_[1]->encode(%args)} );
228}
229
230sub encoded()
231{   my $self = shift;
232    $self->foreachComponent( sub {$_[1]->encoded} );
233}
234
235sub read($$$$)
236{   my ($self, $parser, $head, $bodytype) = @_;
237
238    my $boundary   = $self->boundary;
239
240    $parser->pushSeparator("--$boundary");
241    my @msgopts    = $self->logSettings;
242
243    my $te;
244    $te = lc $1
245        if +($head->get('Content-Transfer-Encoding') || '') =~ m/(\w+)/;
246
247    my @sloppyopts =
248      ( mime_type         => 'text/plain'
249      , transfer_encoding => $te
250      );
251
252    # Get preamble.
253    my $headtype = ref $head;
254
255    my $begin    = $parser->filePosition;
256    my $preamble = Mail::Message::Body::Lines->new(@msgopts, @sloppyopts)
257       ->read($parser, $head);
258
259    $preamble->nrLines
260        or undef $preamble;
261
262    $self->{MMBM_preamble} = $preamble
263        if defined $preamble;
264
265    # Get the parts.
266
267    my @parts;
268    while(my $sep = $parser->readSeparator)
269    {   last if $sep eq "--$boundary--\n";
270
271        my $part = Mail::Message::Part->new
272         ( @msgopts
273         , container => $self
274         );
275
276        last unless $part->readFromParser($parser, $bodytype);
277        push @parts, $part
278            if $part->head->names || $part->body->size;
279    }
280    $self->{MMBM_parts} = \@parts;
281
282    # Get epilogue
283
284    $parser->popSeparator;
285    my $epilogue = Mail::Message::Body::Lines->new(@msgopts, @sloppyopts)
286        ->read($parser, $head);
287
288    my $end = defined $epilogue ? ($epilogue->fileLocation)[1]
289            : @parts            ? ($parts[-1]->body->fileLocation)[1]
290            : defined $preamble ? ($preamble->fileLocation)[1]
291            :                      $begin;
292    $self->fileLocation($begin, $end);
293
294   $epilogue->nrLines
295        or undef $epilogue;
296
297    $self->{MMBM_epilogue} = $epilogue
298        if defined $epilogue;
299
300    $self;
301}
302
303#------------------------------------------
304
305
306sub foreachComponent($)
307{   my ($self, $code) = @_;
308    my $changes  = 0;
309
310    my $new_preamble;
311    if(my $preamble = $self->preamble)
312    {   $new_preamble = $code->($self, $preamble);
313        $changes++ unless $preamble == $new_preamble;
314    }
315
316    my $new_epilogue;
317    if(my $epilogue = $self->epilogue)
318    {   $new_epilogue = $code->($self, $epilogue);
319        $changes++ unless $epilogue == $new_epilogue;
320    }
321
322    my @new_bodies;
323    foreach my $part ($self->parts('ACTIVE'))
324    {   my $part_body = $part->body;
325        my $new_body  = $code->($self, $part_body);
326
327        $changes++ if $new_body != $part_body;
328        push @new_bodies, [$part, $new_body];
329    }
330
331    return $self unless $changes;
332
333    my @new_parts;
334    foreach (@new_bodies)
335    {   my ($part, $body) = @$_;
336        my $new_part = Mail::Message::Part->new
337           ( head      => $part->head->clone,
338             container => undef
339           );
340        $new_part->body($body);
341        push @new_parts, $new_part;
342    }
343
344    my $constructed = (ref $self)->new
345      ( preamble => $new_preamble
346      , parts    => \@new_parts
347      , epilogue => $new_epilogue
348      , based_on => $self
349      );
350
351    $_->container($constructed)
352        foreach @new_parts;
353
354    $constructed;
355}
356
357
358sub attach(@)
359{   my $self  = shift;
360    my $new   = ref($self)->new
361      ( based_on => $self
362      , parts    => [$self->parts, @_]
363      );
364}
365
366
367sub stripSignature(@)
368{   my $self  = shift;
369
370    my @allparts = $self->parts;
371    my @parts    = grep {! $_->body->mimeType->isSignature} @allparts;
372
373    @allparts==@parts ? $self
374    : (ref $self)->new(based_on => $self, parts => \@parts);
375}
376
377#------------------------------------------
378
379
380sub preamble() {shift->{MMBM_preamble}}
381
382
383sub epilogue() {shift->{MMBM_epilogue}}
384
385
386sub parts(;$)
387{   my $self  = shift;
388    return @{$self->{MMBM_parts}} unless @_;
389
390    my $what  = shift;
391    my @parts = @{$self->{MMBM_parts}};
392
393      $what eq 'RECURSE' ? (map {$_->parts('RECURSE')} @parts)
394    : $what eq 'ALL'     ? @parts
395    : $what eq 'DELETED' ? (grep {$_->isDeleted} @parts)
396    : $what eq 'ACTIVE'  ? (grep {not $_->isDeleted} @parts)
397    : ref $what eq 'CODE'? (grep {$what->($_)} @parts)
398    : ($self->log(ERROR => "Unknown criterium $what to select parts."), return ());
399}
400
401
402sub part($) { shift->{MMBM_parts}[shift] }
403
404sub partNumberOf($)
405{   my ($self, $part) = @_;
406    my @parts = $self->parts('ACTIVE');
407    my $msg   = $self->message;
408    unless($msg)
409    {   $self->log(ERROR => 'multipart is not connected');
410        return 'ERROR';
411    }
412    my $base  = $msg->isa('Mail::Message::Part') ? $msg->partNumber.'.' : '';
413    foreach my $partnr (0..@parts)
414    {   return $base.($partnr+1)
415            if $parts[$partnr] == $part;
416    }
417    $self->log(ERROR => 'multipart is not found or not active');
418    'ERROR';
419}
420
421
422sub boundary(;$)
423{   my $self  = shift;
424    my $mime  = $self->type;
425
426    unless(@_)
427    {   my $boundary = $mime->attribute('boundary');
428        return $boundary if defined $boundary;
429    }
430
431    my $boundary = @_ && defined $_[0] ? (shift) : "boundary-".int rand(1000000);
432    $self->type->attribute(boundary => $boundary);
433}
434
435sub endsOnNewline() { 1 }
436
437sub toplevel() { my $msg = shift->message; $msg ? $msg->toplevel : undef}
438
439#-------------------------------------------
440
441
4421;
443