File Coverage

blib/lib/Mail/Message/Head/ResentGroup.pm
Criterion Covered Total %
statement 74 99 74.7
branch 26 60 43.3
condition 1 6 16.6
subroutine 22 33 66.6
pod 24 25 96.0
total 147 223 65.9


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::Head::ResentGroup;
10 3     3   2429 use vars '$VERSION';
  3         7  
  3         264  
11             $VERSION = '3.011';
12              
13 3     3   22 use base 'Mail::Message::Head::FieldGroup';
  3         6  
  3         1074  
14              
15 3     3   23 use strict;
  3         6  
  3         64  
16 3     3   18 use warnings;
  3         5  
  3         83  
17              
18 3     3   19 use Scalar::Util 'weaken';
  3         6  
  3         177  
19 3     3   524 use Mail::Message::Field::Fast;
  3         8  
  3         109  
20              
21 3     3   19 use Sys::Hostname 'hostname';
  3         7  
  3         141  
22 3     3   18 use Mail::Address;
  3         6  
  3         3891  
23              
24              
25             # all lower cased!
26             my @ordered_field_names =
27             ( 'return-path', 'delivered-to' , 'received', 'resent-date'
28             , 'resent-from', 'resent-sender', , 'resent-to', 'resent-cc'
29             , 'resent-bcc', 'resent-message-id'
30             );
31              
32             my %resent_field_names = map { ($_ => 1) } @ordered_field_names;
33              
34             sub init($$)
35 6     6 0 14 { my ($self, $args) = @_;
36              
37 6         25 $self->SUPER::init($args);
38              
39 6         14 $self->{MMHR_real} = $args->{message_head};
40              
41 6 50 33     16 $self->set(Received => $self->createReceived)
42             if $self->orderedFields && ! $self->received;
43              
44 6         30 $self;
45             }
46              
47              
48             sub from($@)
49 4 100   4 1 1663 { return $_[0]->resentFrom if @_ == 1; # backwards compat
50              
51 3         9 my ($class, $from, %args) = @_;
52 3 50       19 my $head = $from->isa('Mail::Message::Head') ? $from : $from->head;
53              
54 3         6 my (@groups, $group, $return_path, $delivered_to);
55              
56 3         13 foreach my $field ($head->orderedFields)
57 24         61 { my $name = $field->name;
58 24 100       60 next unless $resent_field_names{$name};
59              
60 12 100       40 if($name eq 'return-path') { $return_path = $field }
  1 50       3  
    100          
    50          
61 0         0 elsif($name eq 'delivered-to') { $delivered_to = $field }
62             elsif(substr($name, 0, 7) eq 'resent-')
63 8 50       21 { $group->add($field) if defined $group }
64             elsif($name eq 'received')
65             {
66 3         11 $group = Mail::Message::Head::ResentGroup
67             ->new($field, message_head => $head);
68 3         8 push @groups, $group;
69              
70 3 50       8 $group->add($delivered_to) if defined $delivered_to;
71 3         4 undef $delivered_to;
72              
73 3 100       10 $group->add($return_path) if defined $return_path;
74 3         6 undef $return_path;
75             }
76             }
77              
78 3         20 @groups;
79             }
80              
81             #------------------------------------------
82              
83              
84             sub messageHead(;$)
85 4     4 1 9 { my $self = shift;
86 4 100       14 @_ ? $self->{MMHR_real} = shift : $self->{MMHR_real};
87             }
88              
89              
90             sub orderedFields()
91 14     14 1 983 { my $head = shift->head;
92 14 100       35 map { $head->get($_) || () } @ordered_field_names;
  140         292  
93             }
94              
95              
96             sub set($;$)
97 27     27 1 35 { my $self = shift;
98 27         42 my $field;
99              
100 27 100       55 if(@_==1) { $field = shift }
  12         19  
101             else
102 15         31 { my ($fn, $value) = @_;
103 15 100       47 my $name = $resent_field_names{lc $fn} ? $fn : "Resent-$fn";
104 15         44 $field = Mail::Message::Field::Fast->new($name, $value);
105             }
106              
107 27         67 $self->head->set($field);
108 27         65 $field;
109             }
110              
111 1     1 1 3 sub fields() { shift->orderedFields }
112 1     1 1 693 sub fieldNames() { map { $_->Name } shift->orderedFields }
  2         6  
113              
114             sub delete()
115 1     1 1 465 { my $self = shift;
116 1         3 my $head = $self->messageHead;
117 1         4 $head->removeField($_) foreach $self->fields;
118 1         8 $self;
119             }
120              
121              
122 27     27 1 62 sub add(@) { shift->set(@_) }
123              
124              
125 0     0 1 0 sub addFields(@) { shift->notImplemented }
126              
127             #-------------------------------------------
128              
129              
130 0     0 1 0 sub returnPath() { shift->{MMHR_return_path} }
131              
132              
133 0     0 1 0 sub deliveredTo() { shift->head->get('Delivered-To') }
134              
135              
136 6     6 1 18 sub received() { shift->head->get('Received') }
137              
138              
139             sub receivedTimestamp()
140 0 0   0 1 0 { my $received = shift->received or return;
141 0 0       0 my $comment = $received->comment or return;
142 0         0 Mail::Message::Field->dateToTimestamp($comment);
143             }
144              
145              
146 1     1 1 3 sub date($) { shift->head->get('resent-date') }
147              
148              
149             sub dateTimestamp()
150 0 0   0 1 0 { my $date = shift->date or return;
151 0         0 Mail::Message::Field->dateToTimestamp($date->unfoldedBody);
152             }
153              
154              
155             sub resentFrom()
156 1 50   1 1 4 { my $from = shift->head->get('resent-from') or return ();
157 1 50       4 wantarray ? $from->addresses : $from;
158             }
159              
160              
161             sub sender()
162 0 0   0 1 0 { my $sender = shift->head->get('resent-sender') or return ();
163 0 0       0 wantarray ? $sender->addresses : $sender;
164             }
165              
166              
167             sub to()
168 0 0   0 1 0 { my $to = shift->head->get('resent-to') or return ();
169 0 0       0 wantarray ? $to->addresses : $to;
170             }
171              
172              
173             sub cc()
174 0 0   0 1 0 { my $cc = shift->head->get('resent-cc') or return ();
175 0 0       0 wantarray ? $cc->addresses : $cc;
176             }
177              
178              
179             sub bcc()
180 0 0   0 1 0 { my $bcc = shift->head->get('resent-bcc') or return ();
181 0 0       0 wantarray ? $bcc->addresses : $bcc;
182             }
183              
184              
185             sub destinations()
186 0     0 1 0 { my $self = shift;
187 0         0 ($self->to, $self->cc, $self->bcc);
188             }
189              
190              
191 2     2 1 1353 sub messageId() { shift->head->get('resent-message-id') }
192              
193              
194 13     13 1 46 sub isResentGroupFieldName($) { $resent_field_names{lc $_[1]} }
195              
196             #------------------------------------------
197              
198              
199             my $unique_received_id = 'rc'.time;
200              
201             sub createReceived(;$)
202 0     0 1   { my ($self, $domain) = @_;
203              
204 0 0         unless(defined $domain)
205 0   0       { my $sender = ($self->sender)[0] || ($self->resentFrom)[0];
206 0 0         $domain = $sender->host if defined $sender;
207             }
208              
209 0           my $received
210             = 'from ' . $domain
211             . ' by ' . hostname
212             . ' with SMTP'
213             . ' id ' . $unique_received_id++
214             . ' for ' . $self->head->get('Resent-To') # may be wrong
215             . '; '. Mail::Message::Field->toDate;
216              
217 0           $received;
218             }
219              
220             #-------------------------------------------
221              
222              
223             1;