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;
10use vars '$VERSION';
11$VERSION = '3.011';
12
13# Mail::Message::Body::Construct adds functionality to Mail::Message::Body
14
15use strict;
16use warnings;
17
18use Carp;
19use Mail::Message::Body::String;
20use Mail::Message::Body::Lines;
21
22
23sub foreachLine($)
24{   my ($self, $code) = @_;
25    my $changes = 0;
26    my @result;
27
28    foreach ($self->lines)
29    {   my $becomes = $code->();
30        if(defined $becomes)
31        {   push @result, $becomes;
32            $changes++ if $becomes ne $_;
33        }
34        else {$changes++}
35    }
36
37    $changes
38        or return $self;
39
40    ref($self)->new
41      ( based_on => $self
42      , data     => \@result
43      );
44}
45
46#------------------------------------------
47
48
49sub concatenate(@)
50{   my $self = shift;
51
52    return $self
53        if @_==1;
54
55    my @unified;
56    foreach (@_)
57    {   next unless defined $_;
58        push @unified
59         , !ref $_           ? $_
60         : ref $_ eq 'ARRAY' ? @$_
61         : $_->isa('Mail::Message')       ? $_->body->decoded
62         : $_->isa('Mail::Message::Body') ? $_->decoded
63         : carp "Cannot concatenate element ".$_;
64    }
65
66    ref($self)->new
67      ( based_on  => $self
68      , mime_type => 'text/plain'
69      , data      => join('', @unified)
70      );
71}
72
73#------------------------------------------
74
75
76sub attach(@)
77{   my $self  = shift;
78
79    my @parts;
80    push @parts, shift while @_ && ref $_[0];
81
82    return $self unless @parts;
83    unshift @parts,
84      ( $self->isNested    ? $self->nested
85      : $self->isMultipart ? $self->parts
86      : $self
87      );
88
89    return $parts[0] if @parts==1;
90    Mail::Message::Body::Multipart->new(parts => \@parts, @_);
91}
92
93#------------------------------------------
94
95
96# tests in t/51stripsig.t
97
98sub stripSignature($@)
99{   my ($self, %args) = @_;
100
101    return $self if $self->mimeType->isBinary;
102
103    my $pattern = !defined $args{pattern} ? qr/^--\s?$/
104                : !ref $args{pattern}     ? qr/^\Q${args{pattern}}/
105                :                           $args{pattern};
106
107    my $lines   = $self->lines;   # no copy!
108    my $stop    = defined $args{max_lines}? @$lines - $args{max_lines}
109                : exists $args{max_lines} ? 0
110                :                           @$lines-10;
111
112    $stop = 0 if $stop < 0;
113    my ($sigstart, $found);
114
115    if(ref $pattern eq 'CODE')
116    {   for($sigstart = $#$lines; $sigstart >= $stop; $sigstart--)
117        {   next unless $pattern->($lines->[$sigstart]);
118            $found = 1;
119            last;
120        }
121    }
122    else
123    {   for($sigstart = $#$lines; $sigstart >= $stop; $sigstart--)
124        {   next unless $lines->[$sigstart] =~ $pattern;
125            $found = 1;
126            last;
127        }
128    }
129
130    return $self unless $found;
131
132    my $bodytype = $args{result_type} || ref $self;
133
134    my $stripped = $bodytype->new
135      ( based_on => $self
136      , data     => [ @$lines[0..$sigstart-1] ]
137      );
138
139    return $stripped unless wantarray;
140
141    my $sig      = $bodytype->new
142      ( based_on => $self
143      , data     => [ @$lines[$sigstart..$#$lines] ]
144      );
145
146    ($stripped, $sig);
147}
148
149#------------------------------------------
150
1511;
152