File Coverage

blib/lib/Mail/Message/Construct/Reply.pm
Criterion Covered Total %
statement 94 103 91.2
branch 55 88 62.5
condition 26 53 49.0
subroutine 10 10 100.0
pod 3 3 100.0
total 188 257 73.1


line stmt bran cond sub pod time code
1             # Copyrights 2001-2023 by [Mark Overmeer ].
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.03.
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              
9             package Mail::Message;
10 3     3   2328 use vars '$VERSION';
  3         15  
  3         178  
11             $VERSION = '3.013';
12              
13              
14 3     3   20 use strict;
  3         6  
  3         63  
15 3     3   17 use warnings;
  3         6  
  3         129  
16              
17 3     3   497 use Mail::Message::Body::Multipart;
  3         8  
  3         105  
18 3     3   18 use Mail::Address;
  3         8  
  3         67  
19 3     3   16 use Scalar::Util 'blessed';
  3         13  
  3         4955  
20              
21              
22             # tests in t/55reply1r.t, demo in the examples/ directory
23              
24             sub reply(@)
25 3     3 1 838 { my ($self, %args) = @_;
26              
27 3         8 my $body = $args{body};
28 3   66     12 my $strip = !exists $args{strip_signature} || $args{strip_signature};
29 3   50     10 my $include = $args{include} || 'INLINE';
30              
31 3 50 33     16 if($include eq 'NO')
    50          
32             { # Throw away real body.
33 0 0       0 $body = Mail::Message::Body->new
34             (data => ["\n[The original message is not included]\n\n"])
35             unless defined $body;
36             }
37             elsif($include eq 'INLINE' || $include eq 'ATTACH')
38             {
39 3 50       7 unless(defined $body)
40             { # text attachment
41 3         9 $body = $self->body;
42 3 50 33     20 $body = $body->part(0)->body if $body->isMultipart && $body->parts==1;
43 3 50       13 $body = $body->nested->body if $body->isNested;
44              
45             $body
46             = $strip && ! $body->isMultipart && !$body->isBinary
47             ? $body->decoded->stripSignature
48             ( pattern => $args{strip_signature}
49             , max_lines => $args{max_signature}
50             )
51 3 100 66     67 : $body->decoded;
52             }
53              
54 3 50 33     28 if($include eq 'INLINE' && $body->isMultipart) { $include = 'ATTACH' }
  0 50 33     0  
55             elsif($include eq 'INLINE' && $body->isBinary)
56 0         0 { $include = 'ATTACH';
57 0         0 $body = Mail::Message::Body::Multipart->new(parts => [$body]);
58             }
59              
60 3 50       30 if($include eq 'INLINE')
61             { my $quote
62             = defined $args{quote} ? $args{quote}
63             : exists $args{quote} ? undef
64 3 50       11 : '> ';
    100          
65              
66 3 100       7 if(defined $quote)
67 2 100   2   12 { my $quoting = ref $quote ? $quote : sub {$quote . $_};
  2         6  
68 2         12 $body = $body->foreachLine($quoting);
69             }
70             }
71             }
72             else
73 0         0 { $self->log(ERROR => "Cannot include reply source as $include.");
74 0         0 return;
75             }
76              
77             #
78             # Collect header info
79             #
80              
81 3         12 my $mainhead = $self->toplevel->head;
82              
83             # Where it comes from
84 3         7 my $from = delete $args{From};
85 3 50       9 unless(defined $from)
86 3         10 { my @from = $self->to;
87 3 50       740 $from = \@from if @from;
88             }
89              
90             # To whom to send
91             my $to = delete $args{To}
92 3   33     15 || $mainhead->get('reply-to') || $mainhead->get('from');
93 3 50       9 defined $to or return;
94              
95             # Add Cc
96 3         7 my $cc = delete $args{Cc};
97 3 100 66     12 if(!defined $cc && $args{group_reply})
98 1         6 { my @cc = $self->cc;
99 1 50       203 $cc = [ $self->cc ] if @cc;
100             }
101              
102             # Create a subject
103 3         197 my $srcsub = delete $args{Subject};
104 3 0       15 my $subject
    50          
105             = ! defined $srcsub ? $self->replySubject($self->subject)
106             : ref $srcsub ? $srcsub->($self->subject)
107             : $srcsub;
108              
109             # Create a nice message-id
110 3         6 my $msgid = delete $args{'Message-ID'};
111 3 50 33     9 $msgid = "<$msgid>" if $msgid && $msgid !~ /^\s*\<.*\>\s*$/;
112              
113             # Thread information
114 3         11 my $origid = '<'.$self->messageId.'>';
115 3         10 my $refs = $mainhead->get('references');
116              
117             # Prelude
118             my $prelude
119             = defined $args{prelude} ? $args{prelude}
120             : exists $args{prelude} ? undef
121 3 100       21 : [ $self->replyPrelude($to) ];
    50          
122              
123 3 100 66     26 $prelude = Mail::Message::Body->new(data => $prelude)
124             if defined $prelude && ! blessed $prelude;
125            
126 3         9 my $postlude = $args{postlude};
127 3 50 66     19 $postlude = Mail::Message::Body->new(data => $postlude)
128             if defined $postlude && ! blessed $postlude;
129              
130             #
131             # Create the message.
132             #
133              
134 3         6 my $total;
135 3 50       11 if($include eq 'NO') {$total = $body}
  0 50       0  
136             elsif($include eq 'INLINE')
137 3         6 { my $signature = $args{signature};
138 3 50 33     18 $signature = $signature->body
139             if defined $signature && $signature->isa('Mail::Message');
140              
141 3 50       25 $total = $body->concatenate
142             ( $prelude, $body, $postlude
143             , (defined $signature ? "-- \n" : undef), $signature
144             );
145             }
146 3 50       11 if($include eq 'ATTACH')
147             {
148 0         0 my $intro = $prelude->concatenate
149             ( $prelude
150             , [ "\n", "[Your message is attached]\n" ]
151             , $postlude
152             );
153              
154             $total = Mail::Message::Body::Multipart->new
155 0         0 ( parts => [ $intro, $body, $args{signature} ]
156             );
157             }
158              
159 3   50     11 my $msgtype = $args{message_type} || 'Mail::Message';
160              
161 3 50 50     27 my $reply = $msgtype->buildFromBody
162             ( $total
163             , From => $from || 'Undisclosed senders:;'
164             , To => $to
165             , Subject => $subject
166             , 'In-Reply-To' => $origid
167             , References => ($refs ? "$refs $origid" : $origid)
168             );
169              
170 3         13 my $newhead = $reply->head;
171 3 100       12 $newhead->set(Cc => $cc) if $cc;
172 3 100       18 $newhead->set(Bcc => delete $args{Bcc}) if $args{Bcc};
173             $newhead->add($_ => $args{$_})
174 3         35 for sort grep /^[A-Z]/, keys %args;
175              
176             # Ready
177              
178 3         22 $self->log(PROGRESS => 'Reply created from '.$origid);
179 3         13 $self->label(replied => 1);
180 3         12 $reply;
181             }
182              
183             #------------------------------------------
184              
185              
186             # tests in t/35reply1rs.t
187              
188             sub replySubject($)
189 24     24 1 165 { my ($thing, $subject) = @_;
190 24 100 100     118 $subject = 'your mail' unless defined $subject && length $subject;
191 24         108 my @subject = split /\:/, $subject;
192 24         50 my $re_count = 1;
193              
194             # Strip multiple Re's from the start.
195              
196 24         59 while(@subject)
197 38 100       148 { last if $subject[0] =~ /[A-QS-Za-qs-z][A-DF-Za-df-z]/;
198              
199 14         29 for(shift @subject)
200 14         86 { while( /\bRe(?:\[\s*(\d+)\s*\]|\b)/g )
201 17 100       85 { $re_count += defined $1 ? $1 : 1;
202             }
203             }
204             }
205              
206             # Strip multiple Re's from the end.
207              
208 24 50       54 if(@subject)
209 24         47 { for($subject[-1])
210 24         124 { $re_count++ while s/\s*\(\s*(re|forw)\W*\)\s*$//i;
211             }
212             }
213              
214             # Create the new subject string.
215              
216 24   50     83 my $text = (join ':', @subject) || 'your mail';
217 24         43 for($text)
218 24         68 { s/^\s+//;
219 24         63 s/\s+$//;
220             }
221              
222 24 100       151 $re_count==1 ? "Re: $text" : "Re[$re_count]: $text";
223             }
224              
225             #------------------------------------------
226              
227              
228             sub replyPrelude($)
229 2     2 1 5 { my ($self, $who) = @_;
230            
231 2 50       8 $who = $who->[0] if ref $who eq 'ARRAY';
232              
233 2 50       16 my $user
    50          
    50          
234             = !defined $who ? undef
235             : !ref $who ? (Mail::Address->parse($who))[0]
236             : $who->isa('Mail::Message::Field') ? ($who->addresses)[0]
237             : $who;
238              
239 2 50 33     484 my $from
      33        
240             = ref $user && $user->isa('Mail::Address')
241             ? ($user->name || $user->address || $user->format)
242             : 'someone';
243              
244 2         162 my $time = gmtime $self->timestamp;
245 2         13 "On $time, $from wrote:\n";
246             }
247              
248             1;