File Coverage

blib/lib/Mail/Message/Convert/MailInternet.pm
Criterion Covered Total %
statement 52 52 100.0
branch 4 6 66.6
condition n/a
subroutine 12 12 100.0
pod 2 2 100.0
total 70 72 97.2


line stmt bran cond sub pod time code
1             # Copyrights 2001-2023 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::Convert::MailInternet;
10 1     1   634 use vars '$VERSION';
  1         3  
  1         63  
11             $VERSION = '3.013';
12              
13 1     1   7 use base 'Mail::Message::Convert';
  1         2  
  1         439  
14              
15 1     1   7 use strict;
  1         2  
  1         19  
16 1     1   5 use warnings;
  1         2  
  1         22  
17              
18 1     1   557 use Mail::Internet;
  1         11146  
  1         37  
19 1     1   7 use Mail::Header;
  1         2  
  1         21  
20 1     1   6 use Mail::Message;
  1         2  
  1         21  
21 1     1   6 use Mail::Message::Head::Complete;
  1         2  
  1         27  
22 1     1   5 use Mail::Message::Body::Lines;
  1         2  
  1         20  
23              
24 1     1   5 use Carp;
  1         2  
  1         432  
25              
26              
27             sub export($@)
28 1     1 1 966 { my ($thing, $message) = (shift, shift);
29              
30 1 50       12 croak "Export message must be a Mail::Message, but is a ".ref($message)."."
31             unless $message->isa('Mail::Message');
32              
33 1         10 my $mi_head = Mail::Header->new;
34              
35 1         51 my $head = $message->head;
36 1         8 foreach my $field ($head->orderedFields)
37 7         770 { $mi_head->add($field->Name, scalar $field->foldedBody);
38             }
39              
40             Mail::Internet->new
41 1         95 ( Header => $mi_head
42             , Body => [ $message->body->lines ]
43             , @_
44             );
45             }
46              
47             #------------------------------------------
48              
49              
50             my @pref_order = qw/From To Cc Subject Date In-Reply-To References
51             Content-Type/;
52              
53             sub from($@)
54 1     1 1 270 { my ($thing, $mi) = (shift, shift);
55              
56 1 50       11 croak "Converting from Mail::Internet but got a ".ref($mi).'.'
57             unless $mi->isa('Mail::Internet');
58              
59 1         13 my $head = Mail::Message::Head::Complete->new;
60 1         3 my $body = Mail::Message::Body::Lines->new(data => [ @{$mi->body} ]);
  1         4  
61              
62 1         5 my $mi_head = $mi->head;
63              
64             # The tags of Mail::Header are unordered, but we prefer some ordering.
65 1         10 my %tags = map {lc $_ => ucfirst $_} $mi_head->tags;
  5         28  
66 1         3 my @tags;
67 1         3 foreach (@pref_order)
68 8 100       30 { push @tags, $_ if delete $tags{lc $_};
69             }
70 1         6 push @tags, sort values %tags;
71            
72 1         4 foreach my $name (@tags)
73             { $head->add($name, $_)
74 5         17 foreach $mi_head->get($name);
75             }
76              
77 1         12 Mail::Message->new(head => $head, body => $body, @_);
78             }
79              
80             #------------------------------------------
81              
82             1;