File Coverage

blib/lib/Mail/Message/Body/Nested.pm
Criterion Covered Total %
statement 63 83 75.9
branch 8 20 40.0
condition 2 5 40.0
subroutine 22 31 70.9
pod 19 21 90.4
total 114 160 71.2


line stmt bran cond sub pod time code
1             # Copyrights 2001-2021 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.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              
9             package Mail::Message::Body::Nested;
10 31     31   245 use vars '$VERSION';
  31         77  
  31         2093  
11             $VERSION = '3.011';
12              
13 31     31   218 use base 'Mail::Message::Body';
  31         72  
  31         3817  
14              
15 31     31   223 use strict;
  31         81  
  31         930  
16 31     31   189 use warnings;
  31         78  
  31         1241  
17              
18 31     31   196 use Mail::Message::Body::Lines;
  31         91  
  31         1257  
19 31     31   204 use Mail::Message::Part;
  31         78  
  31         968  
20              
21 31     31   193 use Carp;
  31         87  
  31         34225  
22              
23              
24             sub init($)
25 11     11 0 29 { my ($self, $args) = @_;
26 11   50     65 $args->{mime_type} ||= 'message/rfc822';
27              
28 11         49 $self->SUPER::init($args);
29              
30 11         24 my $nested;
31 11 100       34 if(my $raw = $args->{nested})
32 10         48 { $nested = Mail::Message::Part->coerce($raw, $self);
33              
34 10 50       36 croak 'Data not convertible to a message (type is ', ref $raw,")\n"
35             unless defined $nested;
36             }
37              
38 11         41 $self->{MMBN_nested} = $nested;
39 11         52 $self;
40             }
41              
42             sub isNested() {1}
43              
44 0     0 1 0 sub isBinary() { shift->nested->body->isBinary }
45              
46             sub clone()
47 1     1 1 3 { my $self = shift;
48              
49 1         9 ref($self)->new
50             ( $self->logSettings
51             , based_on => $self
52             , nested => $self->nested->clone
53             );
54             }
55              
56 10     10 1 40 sub nrLines() { shift->nested->nrLines }
57              
58 12     12 1 230 sub size() { shift->nested->size }
59              
60             sub string()
61 1     1 1 5 { my $nested = shift->nested;
62 1 50       19 defined $nested ? $nested->string : '';
63             }
64              
65             sub lines()
66 0     0 1 0 { my $nested = shift->nested;
67 0 0       0 defined $nested ? ($nested->lines) : ();
68             }
69              
70             sub file()
71 0     0 1 0 { my $nested = shift->nested;
72 0 0       0 defined $nested ? $nested->file : undef;
73             }
74              
75             sub print(;$)
76 3     3 1 8 { my $self = shift;
77 3   33     12 $self->nested->print(shift || select);
78             }
79              
80             sub partNumberOf($)
81 1     1 1 3 { my ($self, $part) = @_;
82 1         4 $self->message->partNumber;
83             }
84              
85              
86             sub foreachLine($)
87 0     0 1 0 { my ($self, $code) = @_;
88 0         0 $self->log(ERROR => "You cannot use foreachLine on a nested");
89 0         0 confess;
90             }
91              
92 0     0 1 0 sub check() { shift->forNested( sub {$_[1]->check} ) }
  0     0   0  
93              
94             sub encode(@)
95 1     1 1 6 { my ($self, %args) = @_;
96 1     1   9 $self->forNested( sub {$_[1]->encode(%args)} );
  1         7  
97             }
98              
99 6     6 1 25 sub encoded() { shift->forNested( sub {$_[1]->encoded} ) }
  6     6   43  
100              
101             sub read($$$$)
102 1     1 1 4 { my ($self, $parser, $head, $bodytype) = @_;
103              
104 1         4 my $nest = Mail::Message::Part->new(container => undef);
105 1 50       8 $nest->readFromParser($parser, $bodytype)
106             or return;
107              
108 1         6 $nest->container($self);
109 1         4 $self->{MMBN_nested} = $nest;
110 1         6 $self;
111             }
112              
113             sub fileLocation()
114 0     0 1 0 { my $nested = shift->nested;
115              
116 0         0 ( ($nested->head->fileLocation)[0]
117             , ($nested->body->fileLocation)[1]
118             );
119             }
120              
121 2     2 1 10 sub endsOnNewline() { shift->nested->body->endsOnNewline }
122              
123             sub moveLocation($)
124 0     0 1 0 { my $self = shift;
125 0         0 my $nested = $self->nested;
126 0 0       0 my $dist = shift or return $self; # no move
127              
128 0         0 $nested->head->moveLocation($dist);
129 0         0 $nested->body->moveLocation($dist);
130 0         0 $self;
131             }
132              
133              
134 58     58 1 294 sub nested() { shift->{MMBN_nested} }
135              
136              
137             sub forNested($)
138 7     7 1 18 { my ($self, $code) = @_;
139 7         25 my $nested = $self->nested;
140 7         215 my $body = $nested->body;
141              
142 7 50       21 my $new_body = $code->($self, $body)
143             or return;
144              
145 7 100       25 return $self if $new_body == $body;
146              
147 3         20 my $new_nested = Mail::Message::Part->new
148             ( head => $nested->head->clone
149             , container => undef
150             );
151              
152 3         16 $new_nested->body($new_body);
153              
154 3         17 my $created = (ref $self)->new
155             ( based_on => $self
156             , nested => $new_nested
157             );
158              
159 3         13 $new_nested->container($created);
160 3         20 $created;
161             }
162              
163 0 0   0 0   sub toplevel() { my $msg = shift->message; $msg ? $msg->toplevel : undef}
  0            
164              
165             1;