1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
# This code is part of Perl distribution Mail-Message version 4.01.
# The POD got stripped from this file by OODoc version 3.05.
# For contributors see file ChangeLog.
# This software is copyright (c) 2001-2025 by Mark Overmeer.
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later
package Mail::Message::Part;{
our $VERSION = '4.01';
}
use parent 'Mail::Message';
use strict;
use warnings;
use Log::Report 'mail-message', import => [ qw/__x error panic/ ];
use Scalar::Util qw/weaken/;
#--------------------
sub init($)
{ my ($self, $args) = @_;
$args->{head} ||= Mail::Message::Head::Complete->new;
$self->SUPER::init($args);
exists $args->{container}
or error __x"no container specified for part.";
weaken($self->{MMP_container})
if $self->{MMP_container} = $args->{container};
$self;
}
sub coerce($@)
{ my ($class, $thing, $container) = (shift, shift, shift);
if($thing->isa($class))
{ $thing->container($container);
return $thing;
}
return $class->buildFromBody($thing, $container, @_)
if $thing->isa('Mail::Message::Body');
# Although cloning is a Bad Thing(tm), we must avoid modifying
# header fields of messages which reside in a folder.
my $message = $thing->isa('Mail::Box::Message') ? $thing->clone : $thing;
my $part = $class->SUPER::coerce($message);
$part->container($container);
$part;
}
sub buildFromBody($$;@)
{ my ($class, $body, $container) = (shift, shift, shift);
my $head = Mail::Message::Head::Complete->new;
while(@_)
{ if(ref $_[0]) {$head->add(shift)}
else {$head->add(shift, shift)}
}
my $part = $class->new(head => $head, container => $container);
$part->body($body);
$part;
}
sub container(;$)
{ my $self = shift;
@_ or return $self->{MMP_container};
$self->{MMP_container} = shift;
weaken($self->{MMP_container});
}
sub toplevel()
{ my $body = shift->container or return;
my $msg = $body->message or return;
$msg->toplevel;
}
sub isPart() { 1 }
sub partNumber()
{ my $self = shift;
my $body = $self->container or panic 'no container';
$body->partNumberOf($self);
}
sub readFromParser($;$)
{ my ($self, $parser, $bodytype) = @_;
my $head = $self->readHead($parser) //
Mail::Message::Head::Complete->new(message => $self, field_type => $self->{MM_field_type});
my $body = $self->readBody($parser, $head, $bodytype) //
Mail::Message::Body::Lines->new(data => []);
$self->head($head);
$self->storeBody($body->contentInfoFrom($head));
$self;
}
#--------------------
sub printEscapedFrom($)
{ my ($self, $out) = @_;
$self->head->print($out);
$self->body->printEscapedFrom($out);
}
#--------------------
sub destruct()
{ my $self = shift;
error __x"you cannot destruct message parts, only whole messages.";
}
1;
|
