File Coverage

blib/lib/MIME/Lite/Generator.pm
Criterion Covered Total %
statement 120 132 90.9
branch 66 82 80.4
condition 6 9 66.6
subroutine 15 17 88.2
pod 2 12 16.6
total 209 252 82.9


line stmt bran cond sub pod time code
1             package MIME::Lite::Generator;
2              
3 2     2   48187 use strict;
  2         4  
  2         59  
4 2     2   9 use warnings;
  2         2  
  2         50  
5 2     2   12 use Carp;
  2         2  
  2         95  
6 2     2   8 use FileHandle;
  2         3  
  2         10  
7 2     2   613 use MIME::Lite;
  2         3  
  2         2233  
8              
9             our $VERSION = 0.01;
10              
11             sub new {
12 46     46 1 85221 my ( $class, $msg, $is_smtp ) = @_;
13            
14 46         105 my $encoding = uc( $msg->{Attrs}{'content-transfer-encoding'} );
15 46         40 my $chunk_getter;
16 46 100 66     290 if (defined( $msg->{Path} ) || defined( $msg->{FH} ) || defined ( $msg->{Data} )) {
      100        
17 36 100       119 if ($encoding eq 'BINARY') {
    100          
    100          
    100          
    50          
18 4 100       15 $chunk_getter = defined ( $msg->{Data} )
19             ? 'get_encoded_chunk_data_other'
20             : 'get_encoded_chunk_fh_binary';
21             }
22             elsif ($encoding eq '8BIT') {
23 19 100       52 $chunk_getter = defined ( $msg->{Data} )
24             ? 'get_encoded_chunk_data_other'
25             : 'get_encoded_chunk_fh_8bit';
26             }
27             elsif ($encoding eq '7BIT') {
28 4 100       14 $chunk_getter = defined ( $msg->{Data} )
29             ? 'get_encoded_chunk_data_other'
30             : 'get_encoded_chunk_fh_7bit';
31             }
32             elsif ($encoding eq 'QUOTED-PRINTABLE') {
33 4 100       12 $chunk_getter = defined ( $msg->{Data} )
34             ? 'get_encoded_chunk_data_qp'
35             : 'get_encoded_chunk_fh_qp';
36             }
37             elsif ($encoding eq 'BASE64') {
38 5 100       17 $chunk_getter = defined ( $msg->{Data} )
39             ? 'get_encoded_chunk_data_other'
40             : 'get_encoded_chunk_fh_base64';
41             }
42             else {
43 0         0 $chunk_getter = 'get_encoded_chunk_unknown';
44             }
45             }
46             else {
47 10         18 $chunk_getter = 'get_encoded_chunk_nodata';
48             }
49            
50 46 100       401 bless {
51             msg => $msg,
52             is_smtp => $is_smtp,
53             generators => [],
54             has_chunk => 0,
55             state => 'init',
56             encoding => $encoding,
57             chunk_getter => $chunk_getter,
58             last => '',
59             }, ref($class) ? ref($class) : $class;
60             }
61              
62             sub get {
63 1520     1520 1 2941 my $self = shift;
64            
65             ### Do we have generators for embedded/main part(s)
66 1520         1039 while (@{ $self->{generators} }) {
  1520         2451  
67 735         947 my $str_ref = $self->{generators}[0]->get();
68 735 100       2838 return $str_ref if $str_ref;
69            
70 25         24 shift @{ $self->{generators} };
  25         32  
71            
72 25 50       177 if ($self->{boundary}) {
73 25 100       22 if (@{ $self->{generators} }) {
  25         87  
74 15         44 return \"\n--$self->{boundary}\n";
75             }
76            
77             ### Boundary at the end
78 10         37 return \"\n--$self->{boundary}--\n";
79             }
80             }
81            
82             ### What we should to generate
83 785 100       1210 if ($self->{state} eq 'init') {
84 45         61 my $attrs = $self->{msg}{Attrs};
85 45         54 my $sub_attrs = $self->{msg}{SubAttrs};
86 45         28 my $rv;
87 45         49 $self->{state} = 'first';
88            
89             ### Output either the body or the parts.
90             ### Notice that we key off of the content-type! We expect fewer
91             ### accidents that way, since the syntax will always match the MIME type.
92 45         54 my $type = $attrs->{'content-type'};
93 45 100       158 if ( $type =~ m{^multipart/}i ) {
    50          
94 10         23 $self->{boundary} = $sub_attrs->{'content-type'}{'boundary'};
95              
96             ### Preamble:
97 10 50       29 $rv = \($self->{msg}->header_as_string . "\n" . (
98             defined( $self->{msg}{Preamble} )
99             ? $self->{msg}{Preamble}
100             : "This is a multi-part message in MIME format.\n"
101             ) .
102             "\n--$self->{boundary}\n");
103              
104             ### Parts:
105 10         1345 my $part;
106 10         19 foreach $part ( @{ $self->{msg}{Parts} } ) {
  10         26  
107 25         21 push @{ $self->{generators} }, $self->new($part, $self->{out}, $self->{is_smtp});
  25         77  
108             }
109             }
110             elsif ( $type =~ m{^message/} ) {
111 0         0 my @parts = @{ $self->{msg}{Parts} };
  0         0  
112              
113             ### It's a toss-up; try both data and parts:
114 0 0       0 if ( @parts == 0 ) {
    0          
115 0         0 $self->{has_chunk} = 1;
116 0         0 $rv = $self->get_encoded_chunk()
117             }
118             elsif ( @parts == 1 ) {
119 0         0 $self->{generators}[0] = $self->new($parts[0], $self->{out}, $self->{is_smtp});
120 0         0 $rv = $self->{generators}[0]->get();
121             }
122             else {
123 0         0 Carp::croak "can't handle message with >1 part\n";
124             }
125             }
126             else {
127 35         45 $self->{has_chunk} = 1;
128 35         55 $rv = $self->get_encoded_chunk();
129             }
130            
131 45         3597 return $rv;
132             }
133            
134 740 100       1233 return $self->{has_chunk} ? $self->get_encoded_chunk() : undef;
135             }
136              
137             sub get_encoded_chunk {
138 740     740 0 547 my $self = shift;
139            
140 740 100       1053 if ($self->{state} eq 'first') {
141 35         34 $self->{state} = '';
142             ### Open file if necessary:
143 35 100       80 unless (defined $self->{msg}{Data}) {
144 10 50       30 if ( defined( $self->{msg}{Path} ) ) {
145 10   33     65 $self->{fh} = new FileHandle || Carp::croak "can't get new filehandle\n";
146 10 50       351 $self->{fh}->open($self->{msg}{Path})
147             or Carp::croak "open $self->{msg}{Path}: $!\n";
148             }
149             else {
150 0         0 $self->{fh} = $self->{msg}{FH};
151             }
152 10 50       433 CORE::binmode($self->{fh}) if $self->{msg}->binmode;
153             }
154            
155             ### Headers first
156 35         187 return \($self->{msg}->header_as_string . "\n");
157             }
158            
159 705         602 my $chunk_getter = $self->{chunk_getter};
160 705         983 $self->$chunk_getter();
161             }
162              
163             sub get_encoded_chunk_data_qp {
164 4     4 0 6 my $self = shift;
165            
166             ### Encode it line by line:
167 4 100       41 if ($self->{msg}{Data} =~ m{^(.*[\r\n]*)}smg) {
168 2         6 my $line = $1; # copy to avoid weird bug; rt 39334
169 2         47 return \MIME::Lite::encode_qp($line);
170             }
171            
172 2         4 $self->{has_chunk} = 0;
173 2         4 return;
174             }
175              
176             sub get_encoded_chunk_data_other {
177 23     23 0 24 my $self = shift;
178 23         29 $self->{has_chunk} = 0;
179            
180 23 100       53 if ($self->{encoding} eq 'BINARY') {
181 2 50       6 $self->{is_smtp} and $self->{msg}{Data} =~ s/(?!\r)\n\z/\r/;
182 2         6 return \$self->{msg}{Data};
183             }
184            
185 21 100       54 if ($self->{encoding} eq '8BIT') {
186 17         50 return \MIME::Lite::encode_8bit( $self->{msg}{Data} );
187             }
188            
189 4 100       11 if ($self->{encoding} eq '7BIT') {
190 2         8 return \MIME::Lite::encode_7bit( $self->{msg}{Data} );
191             }
192            
193 2 50       7 if ($self->{encoding} eq 'BASE64') {
194 2         10 return \MIME::Lite::encode_base64( $self->{msg}{Data} );
195             }
196             }
197              
198             sub get_encoded_chunk_fh_binary {
199 6     6 0 6 my $self = shift;
200 6         6 my $rv;
201            
202 6 100       70 if ( read( $self->{fh}, $_, 2048 ) ) {
203 4         8 $rv = $self->{last};
204 4         11 $self->{last} = $_;
205             }
206             else {
207 2         10 seek $self->{fh}, 0, 0;
208 2         4 $self->{has_chunk} = 0;
209 2 50       9 if ( length $self->{last} ) {
210 2 50       5 $self->{is_smtp} and $self->{last} =~ s/(?!\r)\n\z/\r/;
211 2         6 $rv = $self->{last};
212             }
213             }
214            
215 6 50       21 return defined($rv) ? \$rv : undef;
216             }
217              
218             sub get_encoded_chunk_fh_8bit {
219 184     184 0 138 my $self = shift;
220            
221 184 100       370 if ( defined( $_ = readline( $self->{fh} ) ) ) {
222 182         263 return \MIME::Lite::encode_8bit($_);
223             }
224            
225 2         4 $self->{has_chunk} = 0;
226 2         7 seek $self->{fh}, 0, 0;
227 2         4 return;
228             }
229              
230             sub get_encoded_chunk_fh_7bit {
231 184     184 0 140 my $self = shift;
232            
233 184 100       373 if ( defined( $_ = readline( $self->{fh} ) ) ) {
234 182         278 return \MIME::Lite::encode_7bit($_);
235             }
236            
237 2         4 $self->{has_chunk} = 0;
238 2         7 seek $self->{fh}, 0, 0;
239 2         4 return;
240             }
241              
242             sub get_encoded_chunk_fh_qp {
243 184     184 0 143 my $self = shift;
244            
245 184 100       371 if ( defined( $_ = readline( $self->{fh} ) ) ) {
246 182         579 return \MIME::Lite::encode_qp($_);
247             }
248            
249 2         5 $self->{has_chunk} = 0;
250 2         6 seek $self->{fh}, 0, 0;
251 2         5 return;
252             }
253              
254             sub get_encoded_chunk_fh_base64 {
255 120     120 0 93 my $self = shift;
256            
257 120 100       244 if ( read( $self->{fh}, $_, 45 ) ) {
258 118         294 return \MIME::Lite::encode_base64($_);
259             }
260            
261 2         4 $self->{has_chunk} = 0;
262 2         7 seek $self->{fh}, 0, 0;
263 2         4 return;
264             }
265              
266             sub get_encoded_chunk_unknown {
267 0     0 0   croak "unsupported encoding: `$_[0]->{encoding}'\n";
268             }
269              
270             sub get_encoded_chunk_nodata {
271 0     0 0   croak "no data in this part\n";
272             }
273              
274             1;
275              
276             __END__