File Coverage

blib/lib/Mail/Message/Part.pm
Criterion Covered Total %
statement 53 65 81.5
branch 11 20 55.0
condition 4 9 44.4
subroutine 12 15 80.0
pod 8 9 88.8
total 88 118 74.5


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::Part;
10 31     31   183 use vars '$VERSION';
  31         43  
  31         1404  
11             $VERSION = '3.012';
12              
13 31     31   160 use base 'Mail::Message';
  31         51  
  31         3265  
14              
15 31     31   186 use strict;
  31         81  
  31         926  
16 31     31   282 use warnings;
  31         62  
  31         931  
17              
18 31     31   165 use Scalar::Util 'weaken';
  31         60  
  31         1548  
19 31     31   443 use Carp;
  31         75  
  31         21151  
20              
21              
22             sub init($)
23 49     49 0 115 { my ($self, $args) = @_;
24 49   66     803 $args->{head} ||= Mail::Message::Head::Complete->new;
25              
26 49         206 $self->SUPER::init($args);
27              
28             confess "No container specified for part.\n"
29 49 50       141 unless exists $args->{container};
30              
31             weaken($self->{MMP_container})
32 49 100       216 if $self->{MMP_container} = $args->{container};
33              
34 49         131 $self;
35             }
36              
37              
38             sub coerce($@)
39 60     60 1 138 { my ($class, $thing, $container) = (shift, shift, shift);
40 60 100       273 if($thing->isa($class))
41 32         114 { $thing->container($container);
42 32         74 return $thing;
43             }
44              
45 28 100       117 return $class->buildFromBody($thing, $container, @_)
46             if $thing->isa('Mail::Message::Body');
47              
48             # Although cloning is a Bad Thing(tm), we must avoid modifying
49             # header fields of messages which reside in a folder.
50 10 50       51 my $message = $thing->isa('Mail::Box::Message') ? $thing->clone : $thing;
51              
52 10         49 my $part = $class->SUPER::coerce($message);
53 10         32 $part->container($container);
54 10         21 $part;
55             }
56              
57              
58             sub buildFromBody($$;@)
59 18     18 1 41 { my ($class, $body, $container) = (shift, shift, shift);
60 18         72 my @log = $body->logSettings;
61              
62 18         159 my $head = Mail::Message::Head::Complete->new(@log);
63 18         59 while(@_)
64 0 0       0 { if(ref $_[0]) {$head->add(shift)}
  0         0  
65 0         0 else {$head->add(shift, shift)}
66             }
67              
68 18         68 my $part = $class->new
69             ( head => $head
70             , container => $container
71             , @log
72             );
73              
74 18         89 $part->body($body);
75 18         50 $part;
76             }
77              
78             sub container(;$)
79 74     74 1 102 { my $self = shift;
80 74 100       178 return $self->{MMP_container} unless @_;
81              
82 65         114 $self->{MMP_container} = shift;
83 65         202 weaken($self->{MMP_container});
84             }
85              
86             sub toplevel()
87 0 0   0 1 0 { my $body = shift->container or return;
88 0 0       0 my $msg = $body->message or return;
89 0         0 $msg->toplevel;
90             }
91              
92             sub isPart() { 1 }
93              
94             sub partNumber()
95 7     7 1 16 { my $self = shift;
96 7 50       14 my $body = $self->container or confess 'no container';
97 7         23 $body->partNumberOf($self);
98             }
99              
100             sub readFromParser($;$)
101 5     5 1 12 { my ($self, $parser, $bodytype) = @_;
102              
103             my $head = $self->readHead($parser)
104             || Mail::Message::Head::Complete->new
105             ( message => $self
106             , field_type => $self->{MM_field_type}
107 5   33     15 , $self->logSettings
108             );
109              
110 5   33     32 my $body = $self->readBody($parser, $head, $bodytype)
111             || Mail::Message::Body::Lines->new(data => []);
112              
113 5         17 $self->head($head);
114 5         14 $self->storeBody($body->contentInfoFrom($head));
115 5         16 $self;
116             }
117              
118             #-----------------
119              
120             sub printEscapedFrom($)
121 0     0 1   { my ($self, $out) = @_;
122 0           $self->head->print($out);
123 0           $self->body->printEscapedFrom($out);
124             }
125              
126              
127             sub destruct()
128 0     0 1   { my $self = shift;
129 0           $self->log(ERROR =>'You cannot destruct message parts, only whole messages');
130 0           undef;
131             }
132              
133             1;