File Coverage

blib/lib/Mail/Message/Construct/Bounce.pm
Criterion Covered Total %
statement 31 41 75.6
branch 4 12 33.3
condition 2 6 33.3
subroutine 7 7 100.0
pod 1 1 100.0
total 45 67 67.1


line stmt bran cond sub pod time code
1             # Copyrights 2001-2022 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 2     2   3511 use vars '$VERSION';
  2         5  
  2         103  
11             $VERSION = '3.012';
12              
13              
14 2     2   10 use strict;
  2         4  
  2         37  
15 2     2   8 use warnings;
  2         3  
  2         43  
16              
17 2     2   9 use Mail::Message::Head::Complete;
  2         3  
  2         55  
18 2     2   10 use Mail::Message::Field;
  2         4  
  2         48  
19 2     2   9 use Carp qw/croak/;
  2         4  
  2         488  
20              
21              
22             sub bounce(@)
23 1     1 1 830 { my $self = shift;
24 1         5 my $bounce = $self->clone;
25 1         4 my $head = $bounce->head;
26              
27 1 0 33     5 if(@_==1 && ref $_[0] && $_[0]->isa('Mail::Message::Head::ResentGroup' ))
      33        
28 0         0 { $head->addResentGroup(shift);
29 0         0 return $bounce;
30             }
31              
32 1         8 my @rgs = $head->resentGroups;
33 1         3 my $rg = $rgs[0];
34              
35 1 50       5 if(defined $rg)
    50          
36 0         0 { $rg->delete; # Remove group to re-add it later: otherwise
37 0         0 while(@_) # field order in header would be disturbed.
38 0         0 { my $field = shift;
39 0 0       0 ref $field ? $rg->set($field) : $rg->set($field, shift);
40             }
41             }
42             elsif(@_)
43 1         9 { $rg = Mail::Message::Head::ResentGroup->new(@_);
44             }
45             else
46 0         0 { $self->log(ERROR => "Method bounce requires To, Cc, or Bcc");
47 0         0 return undef;
48             }
49            
50             #
51             # Add some nice extra fields.
52             #
53              
54 1 50       4 $rg->set(Date => Mail::Message::Field->toDate)
55             unless defined $rg->date;
56              
57 1 50       3 unless(defined $rg->messageId)
58 0         0 { my $msgid = $head->createMessageId;
59 0         0 $rg->set('Message-ID' => "<$msgid>");
60             }
61              
62 1         9 $head->addResentGroup($rg);
63              
64             #
65             # Flag action to original message
66             #
67              
68 1         21 $self->label(passed => 1); # used by some maildir clients
69              
70 1         6 $bounce;
71             }
72              
73             1;