File Coverage

blib/lib/Email/MIME.pm
Criterion Covered Total %
statement 345 353 97.7
branch 95 118 80.5
condition 54 80 67.5
subroutine 57 58 98.2
pod 29 36 80.5
total 580 645 89.9


line stmt bran cond sub pod time code
1 19     19   310805 use 5.008001;
  19         107  
2 19     19   106 use strict;
  19         50  
  19         441  
3 19     19   91 use warnings;
  19         35  
  19         874  
4             package Email::MIME 1.951;
5             # ABSTRACT: easy MIME message handling
6              
7 19     19   9411 use Email::Simple 2.212; # nth header value
  19         91045  
  19         661  
8 19     19   7317 use parent qw(Email::Simple);
  19         4793  
  19         143  
9              
10 19     19   1212 use Carp ();
  19         42  
  19         330  
11 19     19   8963 use Email::MessageID;
  19         26480  
  19         639  
12 19     19   6320 use Email::MIME::Creator;
  19         48  
  19         707  
13 19     19   10088 use Email::MIME::ContentType 1.023; # build_content_type
  19         575769  
  19         1684  
14 19     19   9381 use Email::MIME::Encode;
  19         51  
  19         676  
15 19     19   7691 use Email::MIME::Encodings 1.314;
  19         23410  
  19         539  
16 19     19   135 use Email::MIME::Header;
  19         35  
  19         362  
17 19     19   8056 use Email::MIME::Modifier;
  19         49  
  19         621  
18 19     19   115 use Encode 1.9801 ();
  19         288  
  19         435  
19 19     19   93 use Scalar::Util qw(reftype weaken);
  19         39  
  19         44571  
20              
21             our @CARP_NOT = qw(Email::MIME::ContentType);
22              
23             #pod =head1 SYNOPSIS
24             #pod
25             #pod B Before you read this, maybe you just need L, which is
26             #pod a much easier-to-use tool for building simple email messages that might have
27             #pod attachments or both plain text and HTML. If that doesn't do it for you, then
28             #pod by all means keep reading.
29             #pod
30             #pod use Email::MIME;
31             #pod my $parsed = Email::MIME->new($message);
32             #pod
33             #pod my @parts = $parsed->parts; # These will be Email::MIME objects, too.
34             #pod my $decoded = $parsed->body;
35             #pod my $non_decoded = $parsed->body_raw;
36             #pod
37             #pod my $content_type = $parsed->content_type;
38             #pod
39             #pod ...or...
40             #pod
41             #pod use Email::MIME;
42             #pod use IO::All;
43             #pod
44             #pod # multipart message
45             #pod my @parts = (
46             #pod Email::MIME->create(
47             #pod attributes => {
48             #pod filename => "report.pdf",
49             #pod content_type => "application/pdf",
50             #pod encoding => "quoted-printable",
51             #pod name => "2004-financials.pdf",
52             #pod },
53             #pod body => io( "2004-financials.pdf" )->binary->all,
54             #pod ),
55             #pod Email::MIME->create(
56             #pod attributes => {
57             #pod content_type => "text/plain",
58             #pod disposition => "attachment",
59             #pod charset => "US-ASCII",
60             #pod },
61             #pod body_str => "Hello there!",
62             #pod ),
63             #pod );
64             #pod
65             #pod my $email = Email::MIME->create(
66             #pod header_str => [
67             #pod From => 'casey@geeknest.com',
68             #pod To => [ 'user1@host.com', 'Name ' ],
69             #pod Cc => Email::Address::XS->new("Display Name \N{U+1F600}", 'user@example.com'),
70             #pod ],
71             #pod parts => [ @parts ],
72             #pod );
73             #pod
74             #pod # nesting parts
75             #pod $email->parts_set(
76             #pod [
77             #pod $email->parts,
78             #pod Email::MIME->create( parts => [ @parts ] ),
79             #pod ],
80             #pod );
81             #pod
82             #pod # standard modifications
83             #pod $email->header_str_set( 'X-PoweredBy' => 'RT v3.0' );
84             #pod $email->header_str_set( To => rcpts() );
85             #pod $email->header_str_set( Cc => aux_rcpts() );
86             #pod $email->header_str_set( Bcc => sekrit_rcpts() );
87             #pod
88             #pod # more advanced
89             #pod $_->encoding_set( 'base64' ) for $email->parts;
90             #pod
91             #pod # Quick multipart creation
92             #pod my $email = Email::MIME->create(
93             #pod header_str => [
94             #pod From => 'my@address',
95             #pod To => 'your@address',
96             #pod ],
97             #pod parts => [
98             #pod q[This is part one],
99             #pod q[This is part two],
100             #pod q[These could be binary too],
101             #pod ],
102             #pod );
103             #pod
104             #pod print $email->as_string;
105             #pod
106             #pod =head1 DESCRIPTION
107             #pod
108             #pod This is an extension of the L module, to handle MIME
109             #pod encoded messages. It takes a message as a string, splits it up into its
110             #pod constituent parts, and allows you access to various parts of the
111             #pod message. Headers are decoded from MIME encoding.
112             #pod
113             #pod =head1 METHODS
114             #pod
115             #pod Please see L for the base set of methods. It won't take
116             #pod very long. Added to that, you have:
117             #pod
118             #pod =cut
119              
120             our $CREATOR = 'Email::MIME::Creator';
121              
122             my $NO_ENCODE_RE = qr/
123             \A
124             (?:7bit|8bit|binary)\s*(?:;|$)
125             /ix;
126              
127             sub new {
128 164     164 1 70483 my ($class, $text, $arg, @rest) = @_;
129 164   100     495 $arg ||= {};
130              
131             my $encode_check = exists $arg->{encode_check}
132             ? delete $arg->{encode_check}
133 164 100       447 : Encode::FB_CROAK;
134              
135 164         750 my $self = shift->SUPER::new($text, $arg, @rest);
136 164         1881 $self->encode_check_set($encode_check);
137 164         359 $self->{ct} = parse_content_type($self->content_type_raw);
138 164         24355 $self->parts;
139 164         391 return $self;
140             }
141              
142             #pod =method create
143             #pod
144             #pod my $single = Email::MIME->create(
145             #pod header_str => [ ... ],
146             #pod body_str => '...',
147             #pod attributes => { ... },
148             #pod );
149             #pod
150             #pod my $multi = Email::MIME->create(
151             #pod header_str => [ ... ],
152             #pod parts => [ ... ],
153             #pod attributes => { ... },
154             #pod );
155             #pod
156             #pod This method creates a new MIME part. The C parameter is a list of
157             #pod headers pairs to include in the message. The value for each pair is expected to
158             #pod be a text string that will be MIME-encoded as needed. Alternatively it can be
159             #pod an object with C method which implements conversion of that
160             #pod object to MIME-encoded string. That object method is called with two named
161             #pod input parameters: C and C. It should return
162             #pod MIME-encoded representation of the object. As of 2017-07-25, the
163             #pod header-value-as-object code is very young, and may yet change.
164             #pod
165             #pod In case header name is registered in C<%Email::MIME::Header::header_to_class_map>
166             #pod hash then registered class is used for conversion from Unicode string to 8bit
167             #pod MIME encoding. Value can be either string or array reference to strings.
168             #pod Object is constructed via method C with string value (or values
169             #pod in case of array reference) and converted to MIME-encoded string via
170             #pod C method.
171             #pod
172             #pod A similar C
parameter can be provided in addition to or instead of
173             #pod C. Its values will be used verbatim.
174             #pod
175             #pod C is a hash of MIME attributes to assign to the part, and may
176             #pod override portions of the header set in the C
parameter. The hash keys
177             #pod correspond directly to methods for modifying a message from
178             #pod C. The allowed keys are: content_type, charset, name,
179             #pod format, boundary, encoding, disposition, and filename. They will be mapped to
180             #pod C<"$attr\_set"> for message modification.
181             #pod
182             #pod The C parameter is a list reference containing C
183             #pod objects. Elements of the C list can also be a non-reference
184             #pod string of data. In that case, an C object will be created
185             #pod for you. Simple checks will determine if the part is binary or not, and
186             #pod all parts created in this fashion are encoded with C, just in case.
187             #pod
188             #pod If C is given instead of C, it specifies the body to be used for a
189             #pod flat (subpart-less) MIME message. It is assumed to be a sequence of octets.
190             #pod
191             #pod If C is given instead of C or C, it is assumed to be a
192             #pod character string to be used as the body. If you provide a C
193             #pod parameter, you B provide C and C attributes.
194             #pod
195             #pod =cut
196              
197             my %CT_SETTER = map {; $_ => 1 } qw(
198             content_type charset name format boundary
199             encoding
200             disposition filename
201             );
202              
203             sub create {
204 54     54 1 30444 my ($class, %args) = @_;
205              
206 54         105 my $header = '';
207 54         92 my %headers;
208 54 100       169 if (exists $args{header}) {
209 8         20 my @headers = @{ $args{header} };
  8         28  
210 8 50       40 pop @headers if @headers % 2 == 1;
211 8         48 while (my ($key, $value) = splice @headers, 0, 2) {
212 16         397 $headers{$key} = 1;
213 16         103 $CREATOR->_add_to_header(\$header, $key, $value);
214             }
215             }
216              
217 54 100       468 if (exists $args{header_str}) {
218 11         16 my @headers = @{ $args{header_str} };
  11         32  
219 11 50       34 pop @headers if @headers % 2 == 1;
220 11         40 while (my ($key, $value) = splice @headers, 0, 2) {
221 23         626 $headers{$key} = 1;
222              
223 23         65 $value = Email::MIME::Encode::maybe_mime_encode_header(
224             $key, $value, 'UTF-8'
225             );
226 23         117 $CREATOR->_add_to_header(\$header, $key, $value);
227             }
228             }
229              
230             $CREATOR->_add_to_header(\$header, Date => $CREATOR->_date_header)
231 54 50       764 unless exists $headers{Date};
232 54         48811 $CREATOR->_add_to_header(\$header, 'MIME-Version' => '1.0',);
233              
234 54 100       1435 my %attrs = $args{attributes} ? %{ $args{attributes} } : ();
  31         159  
235              
236             # XXX: This is awful... but if we don't do this, then Email::MIME->new will
237             # end up calling parse_content_type($self->content_type) which will mean
238             # parse_content_type(undef) which, for some reason, returns the default.
239             # It's really sort of mind-boggling. Anyway, the default ends up being
240             # q{text/plain; charset="us-ascii"} so that if content_type is in the
241             # attributes, but not charset, then charset isn't changed and you up with
242             # something that's q{image/jpeg; charset="us-ascii"} and you look like a
243             # moron. -- rjbs, 2009-01-20
244 54 100       153 if (
245 270         597 grep { exists $attrs{$_} } qw(content_type charset name format boundary)
246             ) {
247 30         93 $CREATOR->_add_to_header(\$header, 'Content-Type' => 'text/plain',);
248             }
249              
250 54         795 my %pass_on;
251              
252 54 100       185 if (exists $args{encode_check}) {
253 3         6 $pass_on{encode_check} = $args{encode_check};
254             }
255              
256 54         229 my $email = $class->new($header, \%pass_on);
257              
258 54         235 for my $key (sort keys %attrs) {
259 64         218 $email->content_type_attribute_set($key => $attrs{$key});
260             }
261              
262 54         463 my $body_args = grep { defined $args{$_} } qw(parts body body_str);
  162         382  
263 54 50       143 Carp::confess("only one of parts, body, or body_str may be given")
264             if $body_args > 1;
265              
266 54 100 66     225 if ($args{parts} && @{ $args{parts} }) {
  14 100       53  
    100          
267 14         39 foreach my $part (@{ $args{parts} }) {
  14         43  
268 25 100       119 $part = $CREATOR->_construct_part($part)
269             unless ref($part);
270             }
271 14         58 $email->parts_set($args{parts});
272             } elsif (defined $args{body}) {
273 33         82 $email->body_set($args{body});
274             } elsif (defined $args{body_str}) {
275             Carp::confess("body_str was given, but no charset is defined")
276 6 50       19 unless my $charset = $attrs{charset};
277              
278             Carp::confess("body_str was given, but no encoding is defined")
279 6 50       14 unless $attrs{encoding};
280              
281 6         21 my $body_octets = Encode::encode($attrs{charset}, $args{body_str}, $email->encode_check);
282 4         1707 $email->body_set($body_octets);
283             }
284              
285 52         833 $email;
286             }
287              
288             sub as_string {
289 145     145 1 3002 my $self = shift;
290             return $self->__head->as_string
291 145   50     398 . ($self->{mycrlf} || "\n") # XXX: replace with ->crlf
292             . $self->body_raw;
293             }
294              
295             sub parts {
296 302     302 1 4587 my $self = shift;
297              
298 302 100       970 $self->fill_parts unless $self->{parts};
299              
300 302         407 my @parts = @{ $self->{parts} };
  302         588  
301 302 100       713 @parts = $self unless @parts;
302 302         829 return @parts;
303             }
304              
305             sub subparts {
306 52     52 1 97 my ($self) = @_;
307              
308 52 50       126 $self->fill_parts unless $self->{parts};
309 52         64 my @parts = @{ $self->{parts} };
  52         97  
310 52         138 return @parts;
311             }
312              
313             sub fill_parts {
314 193     193 0 295 my $self = shift;
315              
316 193 100 66     846 if (
317             $self->{ct}{type} eq "multipart"
318             or $self->{ct}{type} eq "message"
319             ) {
320 41         124 $self->parts_multipart;
321             } else {
322 152         344 $self->parts_single_part;
323             }
324              
325 193         279 return $self;
326             }
327              
328             sub body {
329 106     106 1 1689 my $self = shift;
330 106         328 my $body = $self->SUPER::body;
331 106   100     999 my $cte = $self->header("Content-Transfer-Encoding") || '';
332              
333 106         286 $cte =~ s/\A\s+//;
334 106         191 $cte =~ s/\s+\z//;
335 106         153 $cte =~ s/;.+//; # For S/MIME, etc.
336              
337 106 100       266 return $body unless $cte;
338              
339 55 100 66     139 if (!$self->force_decode_hook and $cte =~ $NO_ENCODE_RE) {
340 26         132 return $body;
341             }
342              
343 29 50       196 $body = $self->decode_hook($body) if $self->can("decode_hook");
344              
345 29         101 $body = Email::MIME::Encodings::decode($cte, $body, '7bit');
346 29         938 return $body;
347             }
348              
349             sub parts_single_part {
350 152     152 0 215 my $self = shift;
351 152         341 $self->{parts} = [];
352 152         249 return $self;
353             }
354              
355             sub body_raw {
356 237   66 237 1 11044 return $_[0]->{body_raw} || $_[0]->SUPER::body;
357             }
358              
359             sub body_str {
360 14     14 1 878 my ($self) = @_;
361 14         35 my $encoding = $self->{ct}{attributes}{charset};
362              
363 14 100       37 unless ($encoding) {
364 2 50 33     12 if ($self->{ct}{type} eq 'text'
      66        
365             and
366             ($self->{ct}{subtype} eq 'plain' or $self->{ct}{subtype} eq 'html')
367             ) {
368              
369             # assume that plaintext or html without ANY charset is us-ascii
370 1         4 return $self->body;
371             }
372              
373 1         3 Carp::confess("can't get body as a string for " . $self->content_type);
374             }
375              
376 12         35 my $str = Encode::decode($encoding, $self->body, $self->encode_check);
377 10         1135 return $str;
378             }
379              
380             our $MAX_DEPTH = 10;
381              
382             sub parts_multipart {
383 41     41 0 64 my $self = shift;
384 41         84 my $boundary = $self->{ct}->{attributes}->{boundary};
385              
386 41   100     167 our $DEPTH ||= 0;
387              
388 41 50 33     232 Carp::croak("attempted to parse a MIME message more than $MAX_DEPTH deep")
389             if $MAX_DEPTH && $DEPTH > $MAX_DEPTH;
390              
391             # Take a message, join all its lines together. Now try to Email::MIME->new
392             # it with 1.861 or earlier. Death! It tries to recurse endlessly on the
393             # body, because every time it splits on boundary it gets itself. Obviously
394             # that means it's a bogus message, but a mangled result (or exception) is
395             # better than endless recursion. -- rjbs, 2008-01-07
396 41 50 33     208 return $self->parts_single_part
      33        
397             unless defined $boundary and length $boundary and
398             $self->body_raw =~ /^--\Q$boundary\E\s*$/sm;
399              
400 41         163 $self->{body_raw} = $self->SUPER::body;
401              
402             # rfc1521 7.2.1
403 41         890 my ($body, $epilogue) = split /^--\Q$boundary\E--\s*$/sm, $self->body_raw, 2;
404              
405 41   50     820 my @bits = split /^--\Q$boundary\E\s*$/sm, ($body || '');
406              
407 41         166 $self->SUPER::body_set(undef);
408              
409             # If there are no headers in the potential MIME part, it's just part of the
410             # body. This is a horrible hack, although it's debatable whether it was
411             # better or worse when it was $self->{body} = shift @bits ... -- rjbs,
412             # 2006-11-27
413 41 50 100     487 $self->SUPER::body_set(shift @bits) if index(($bits[0] || ''), ':') == -1;
414              
415 41         277 my $bits = @bits;
416              
417 41         57 my @parts;
418 41         89 for my $bit (@bits) {
419 82         415 $bit =~ s/\A[\n\r]+//smg;
420 82         868 $bit =~ s/(?{mycrlf}\Z//sm;
421 82         178 local $DEPTH = $DEPTH + 1;
422 82         224 my $email = (ref $self)->new($bit, { encode_check => $self->encode_check });
423 82         246 push @parts, $email;
424             }
425              
426 41         100 $self->{parts} = \@parts;
427              
428 41         57 return @{ $self->{parts} };
  41         131  
429             }
430              
431 55     55 0 482 sub force_decode_hook { 0 }
432 29     29 1 60 sub decode_hook { return $_[1] }
433 22     22 1 98 sub content_type { scalar shift->header("Content-type"); }
434 164     164 0 413 sub content_type_raw { scalar shift->header_raw("Content-type"); }
435              
436             sub debug_structure {
437 7     7 1 772 my ($self, $level) = @_;
438 7   100     25 $level ||= 0;
439 7         16 my $rv = " " x (5 * $level);
440 7   100     16 $rv .= "+ " . ($self->content_type || '') . "\n";
441 7         20 my @parts = $self->subparts;
442 7         23 $rv .= $_->debug_structure($level + 1) for @parts;
443 7         29 return $rv;
444             }
445              
446             my %gcache;
447              
448             sub filename {
449 5     5 1 2867 my ($self, $force) = @_;
450 5 100       22 return $gcache{$self} if exists $gcache{$self};
451              
452 4   100     13 my $dis = $self->header_raw("Content-Disposition") || '';
453 4         156 my $attrs = parse_content_disposition($dis)->{attributes};
454             my $name = $attrs->{filename}
455 4   100     453 || $self->{ct}{attributes}{name};
456 4 100 66     21 return $name if $name or !$force;
457             return $gcache{$self} = $self->invent_filename(
458 2         10 $self->{ct}->{type} . "/" . $self->{ct}->{subtype});
459             }
460              
461             my $gname = 0;
462              
463             sub invent_filename {
464 2     2 1 4 my ($self, $ct) = @_;
465 2         12 require MIME::Types;
466 2         10 my $type = MIME::Types->new->type($ct);
467 2   33     101 my $ext = $type && (($type->extensions)[0]);
468 2   50     30 $ext ||= "dat";
469 2         18 return "attachment-$$-" . $gname++ . ".$ext";
470             }
471              
472 164     164 1 8923 sub default_header_class { 'Email::MIME::Header' }
473              
474             sub header_str {
475 26     26 0 9441 my $self = shift;
476 26         64 $self->header_obj->header_str(@_);
477             }
478              
479             sub header_str_set {
480 20     20 1 10268 my $self = shift;
481 20         69 $self->header_obj->header_str_set(@_);
482             }
483              
484             sub header_str_pairs {
485 1     1 1 1711 my $self = shift;
486 1         4 $self->header_obj->header_str_pairs(@_);
487             }
488              
489             sub header_as_obj {
490 14     14 1 81 my $self = shift;
491 14         36 $self->header_obj->header_as_obj(@_);
492             }
493              
494             #pod =method content_type_set
495             #pod
496             #pod $email->content_type_set( 'text/html' );
497             #pod
498             #pod Change the content type. All C header attributes
499             #pod will remain intact.
500             #pod
501             #pod =cut
502              
503             sub content_type_set {
504 28     28 1 1487 my ($self, $ct) = @_;
505 28         78 my $ct_header = parse_content_type($self->header('Content-Type'));
506 28         2536 @{$ct_header}{qw[type subtype]} = split m[/], $ct;
  28         82  
507 28         182 $self->_compose_content_type($ct_header);
508 28         88 $self->_reset_cids;
509 28         138 return $ct;
510             }
511              
512             #pod =method charset_set
513             #pod
514             #pod =method name_set
515             #pod
516             #pod =method format_set
517             #pod
518             #pod =method boundary_set
519             #pod
520             #pod $email->charset_set( 'UTF-8' );
521             #pod $email->name_set( 'some_filename.txt' );
522             #pod $email->format_set( 'flowed' );
523             #pod $email->boundary_set( undef ); # remove the boundary
524             #pod
525             #pod These four methods modify common C attributes. If set to
526             #pod C, the attribute is removed. All other C header
527             #pod information is preserved when modifying an attribute.
528             #pod
529             #pod =cut
530              
531             BEGIN {
532 19     19   98 foreach my $attr (qw[charset name format]) {
533             my $code = sub {
534 16     16   4848 my ($self, $value) = @_;
535 16         51 my $ct_header = parse_content_type($self->header('Content-Type'));
536 16 100       1728 if ($value) {
537 15         115 $ct_header->{attributes}->{$attr} = $value;
538             } else {
539 1         4 delete $ct_header->{attributes}->{$attr};
540             }
541 16         60 $self->_compose_content_type($ct_header);
542 16         64 return $value;
543 57         274 };
544              
545 19     19   193 no strict 'refs'; ## no critic strict
  19         39  
  19         1018  
546 57         97 *{"$attr\_set"} = $code;
  57         39227  
547             }
548             }
549              
550             sub boundary_set {
551 1     1 1 7 my ($self, $value) = @_;
552 1         8 my $ct_header = parse_content_type($self->header('Content-Type'));
553              
554 1 50 33     188 if (defined $value and length $value) {
555 1         4 $ct_header->{attributes}->{boundary} = $value;
556             } else {
557 0         0 delete $ct_header->{attributes}->{boundary};
558             }
559 1         4 $self->_compose_content_type($ct_header);
560              
561 1 50       5 $self->parts_set([ $self->parts ]) if $self->parts > 1;
562             }
563              
564             sub content_type_attribute_set {
565 65     65 0 1111 my ($self, $key, $value) = @_;
566 65         130 $key = lc $key;
567              
568 65 100       189 if ($CT_SETTER{$key}) {
569 62         137 my $method = "$key\_set";
570 62         193 return $self->$method($value);
571             }
572              
573 3         10 my $ct_header = parse_content_type($self->header('Content-Type'));
574 3         360 my $attrs = $ct_header->{attributes};
575              
576 3         11 for my $existing_key (keys %$attrs) {
577 3 50       10 delete $attrs->{$existing_key} if lc $existing_key eq $key;
578             }
579              
580 3 50       15 if ($value) {
581 3         8 $ct_header->{attributes}->{$key} = $value;
582             } else {
583 0         0 delete $ct_header->{attributes}->{$key};
584             }
585 3         11 $self->_compose_content_type($ct_header);
586             }
587              
588             #pod =method encode_check
589             #pod
590             #pod =method encode_check_set
591             #pod
592             #pod $email->encode_check;
593             #pod $email->encode_check_set(0);
594             #pod $email->encode_check_set(Encode::FB_DEFAULT);
595             #pod
596             #pod Gets/sets the current C setting (default: I).
597             #pod This is the parameter passed to L and L
598             #pod when C, C, and C are called.
599             #pod
600             #pod With the default setting, Email::MIME may crash if the claimed charset
601             #pod of a body does not match its contents (for example - utf8 data in a
602             #pod text/plain; charset=us-ascii message).
603             #pod
604             #pod With an C of 0, the unrecognized bytes will instead be
605             #pod replaced with the C (U+0FFFD), and may end up
606             #pod as either that or question marks (?).
607             #pod
608             #pod See L for more information.
609             #pod
610             #pod =cut
611              
612             sub encode_check {
613 102     102 1 197 my ($self) = @_;
614              
615 102         431 return $self->{encode_check};
616             }
617              
618             sub encode_check_set {
619 164     164 1 289 my ($self, $val) = @_;
620              
621 164         307 return $self->{encode_check} = $val;
622             }
623              
624             #pod =method encoding_set
625             #pod
626             #pod $email->encoding_set( 'base64' );
627             #pod $email->encoding_set( 'quoted-printable' );
628             #pod $email->encoding_set( '8bit' );
629             #pod
630             #pod Convert the message body and alter the C
631             #pod header using this method. Your message body, the output of the C
632             #pod method, will remain the same. The raw body, output with the C
633             #pod method, will be changed to reflect the new encoding.
634             #pod
635             #pod =cut
636              
637             sub encoding_set {
638 59     59 1 128 my ($self, $enc) = @_;
639 59   100     243 $enc ||= '7bit';
640 59         136 my $body = $self->body;
641 59         208 $self->header_raw_set('Content-Transfer-Encoding' => $enc);
642 59         2471 $self->body_set($body);
643             }
644              
645             #pod =method body_set
646             #pod
647             #pod $email->body_set( $unencoded_body_string );
648             #pod
649             #pod This method will encode the new body you send using the encoding
650             #pod specified in the C header, then set
651             #pod the body to the new encoded body.
652             #pod
653             #pod This method overrides the default C method.
654             #pod
655             #pod =cut
656              
657             sub body_set {
658 295     295 1 14298 my ($self, $body) = @_;
659 295         457 my $body_ref;
660              
661 295 100       612 if (ref $body) {
662 165 50       680 Carp::croak("provided body reference is not a scalar reference")
663             unless reftype($body) eq 'SCALAR';
664 165         286 $body_ref = $body;
665             } else {
666 130         214 $body_ref = \$body;
667             }
668 295         726 my $enc = $self->header('Content-Transfer-Encoding');
669              
670             # XXX: This is a disgusting hack and needs to be fixed, probably by a
671             # clearer definition and reengineering of Simple construction. The bug
672             # this fixes is an indirect result of the previous behavior in which all
673             # Simple subclasses were free to alter the guts of the Email::Simple
674             # object. -- rjbs, 2007-07-16
675 295 100 100     2303 unless (((caller(1))[3] || '') eq 'Email::Simple::new') {
676 131 100 100     1152 $$body_ref = Email::MIME::Encodings::encode($enc, $$body_ref)
677             unless !$enc || $enc =~ $NO_ENCODE_RE;
678             }
679              
680 295         2268 $self->{body_raw} = $$body_ref;
681 295         843 $self->SUPER::body_set($body_ref);
682             }
683              
684             #pod =method body_str_set
685             #pod
686             #pod $email->body_str_set($unicode_str);
687             #pod
688             #pod This method behaves like C, but assumes that the given value is a
689             #pod Unicode string that should be encoded into the message's charset
690             #pod before being set.
691             #pod
692             #pod The charset must already be set, either manually (via the C
693             #pod argument to C or C) or through the C of a
694             #pod parsed message. If the charset can't be determined, an exception is thrown.
695             #pod
696             #pod =cut
697              
698             sub body_str_set {
699 0     0 1 0 my ($self, $body_str) = @_;
700              
701 0         0 my $ct = parse_content_type($self->content_type);
702             Carp::confess("body_str was given, but no charset is defined")
703 0 0       0 unless my $charset = $ct->{attributes}{charset};
704              
705 0         0 my $body_octets = Encode::encode($charset, $body_str, $self->encode_check);
706 0         0 $self->body_set($body_octets);
707             }
708              
709             #pod =method disposition_set
710             #pod
711             #pod $email->disposition_set( 'attachment' );
712             #pod
713             #pod Alter the C of a message. All header attributes
714             #pod will remain intact.
715             #pod
716             #pod =cut
717              
718             sub disposition_set {
719 8     8 1 541 my ($self, $dis) = @_;
720 8   50     23 $dis ||= 'inline';
721 8         23 my $dis_header = $self->header('Content-Disposition');
722 8 100       38 $dis_header
723             ? ($dis_header =~ s/^([^;]+)/$dis/)
724             : ($dis_header = $dis);
725 8         28 $self->header_raw_set('Content-Disposition' => $dis_header);
726             }
727              
728             #pod =method filename_set
729             #pod
730             #pod $email->filename_set( 'boo.pdf' );
731             #pod
732             #pod Sets the filename attribute in the C header. All other
733             #pod header information is preserved when setting this attribute.
734             #pod
735             #pod =cut
736              
737             sub filename_set {
738 4     4 1 10 my ($self, $filename) = @_;
739 4         11 my $dis_header = $self->header('Content-Disposition');
740 4         11 my ($disposition, $attrs) = ('inline', {});
741 4 50       9 if ($dis_header) {
742 4         13 my $struct = parse_content_disposition($dis_header);
743 4         458 $disposition = $struct->{type};
744 4         10 $attrs = $struct->{attributes};
745             }
746 4 100       12 $filename ? $attrs->{filename} = $filename : delete $attrs->{filename};
747 4         16 my $dis = build_content_disposition({type => $disposition, attributes => $attrs});
748 4         2134 $self->header_raw_set('Content-Disposition' => $dis);
749             }
750              
751             #pod =method parts_set
752             #pod
753             #pod $email->parts_set( \@new_parts );
754             #pod
755             #pod Replaces the parts for an object. Accepts a reference to a list of
756             #pod C objects, representing the new parts. If this message was
757             #pod originally a single part, the C header will be changed to
758             #pod C, and given a new boundary attribute.
759             #pod
760             #pod =cut
761              
762             sub parts_set {
763 29     29 1 125 my ($self, $parts) = @_;
764 29         51 my $body = q{};
765              
766 29         81 my $ct_header = parse_content_type($self->header('Content-Type'));
767              
768 29 100 100     3573 if (@{$parts} > 1 or $ct_header->{type} eq 'multipart') {
  29 50       241  
769              
770             # setup multipart
771             $ct_header->{attributes}->{boundary} = Email::MessageID->new->user
772 25 100 66     216 unless defined $ct_header->{attributes}->{boundary} and length $ct_header->{attributes}->{boundary};
773 25         18719 my $bound = $ct_header->{attributes}->{boundary};
774 25         51 foreach my $part (@{$parts}) {
  25         60  
775 51         170 $body .= "$self->{mycrlf}--$bound$self->{mycrlf}";
776 51         123 $body .= $part->as_string;
777             }
778 25         82 $body .= "$self->{mycrlf}--$bound--$self->{mycrlf}";
779              
780 25 100       55 unless (grep { $ct_header->{type} eq $_ } qw[multipart message]) {
  50         155  
781 10 50       75 if (scalar $self->header('Content-Type')) {
782 0         0 Carp::carp("replacing non-multipart type ($ct_header->{type}/$ct_header->{subtype}) with multipart/mixed");
783             }
784 10         26 @{$ct_header}{qw[type subtype]} = qw[multipart mixed];
  10         30  
785             }
786              
787 25         87 $self->encoding_set('7bit');
788 25         230 delete $ct_header->{attributes}{charset};
789             } elsif (@$parts == 1) { # setup singlepart
790 4         16 $body .= $parts->[0]->body;
791              
792 4         22 my $from_ct = parse_content_type($parts->[0]->header('Content-Type'));
793 4         370 @{$ct_header}{qw[type subtype]} = @{ $from_ct }{qw[type subtype]};
  4         12  
  4         16  
794              
795 4 100       14 if (exists $from_ct->{attributes}{charset}) {
796 2         15 $ct_header->{attributes}{charset} = $from_ct->{attributes}{charset};
797             } else {
798 2         4 delete $ct_header->{attributes}{charset};
799             }
800              
801 4         16 $self->encoding_set($parts->[0]->header('Content-Transfer-Encoding'));
802 4         42 delete $ct_header->{attributes}->{boundary};
803             }
804              
805 29         110 $self->_compose_content_type($ct_header);
806 29         86 $self->body_set($body);
807 29         265 $self->fill_parts;
808 29         99 $self->_reset_cids;
809             }
810              
811             #pod =method parts_add
812             #pod
813             #pod $email->parts_add( \@more_parts );
814             #pod
815             #pod Adds MIME parts onto the current MIME part. This is a simple extension
816             #pod of C to make our lives easier. It accepts an array reference
817             #pod of additional parts.
818             #pod
819             #pod =cut
820              
821             sub parts_add {
822 3     3 1 1479 my ($self, $parts) = @_;
823 3         7 $self->parts_set([ $self->parts, @{$parts}, ]);
  3         18  
824             }
825              
826             #pod =method walk_parts
827             #pod
828             #pod $email->walk_parts(sub {
829             #pod my ($part) = @_;
830             #pod return if $part->subparts; # multipart
831             #pod
832             #pod if ( $part->content_type =~ m[text/html]i ) {
833             #pod my $body = $part->body;
834             #pod $body =~ s/]+>//; # simple filter example
835             #pod $part->body_set( $body );
836             #pod }
837             #pod });
838             #pod
839             #pod Walks through all the MIME parts in a message and applies a callback to
840             #pod each. Accepts a code reference as its only argument. The code reference
841             #pod will be passed a single argument, the current MIME part within the
842             #pod top-level MIME object. All changes will be applied in place.
843             #pod
844             #pod =cut
845              
846             sub walk_parts {
847 10     10 1 2473 my ($self, $callback) = @_;
848              
849 10         19 my %changed;
850              
851             my $walk_weak;
852             my $walk = sub {
853 40     40   69 my ($part) = @_;
854 40         95 $callback->($part);
855              
856 40 100       3874 if (my @orig_subparts = $part->subparts) {
857 14         24 my $differ;
858             my @subparts;
859              
860 14         29 for my $part (@orig_subparts) {
861 30         61 my $str = $part->as_string;
862 30 50       95 next unless my $new = $walk_weak->($part);
863 30 100       61 $differ = 1 if $str ne $new->as_string;
864 30         78 push @subparts, $new;
865             }
866              
867             $differ
868             ||= (@subparts != @orig_subparts)
869             || (grep { $subparts[$_] != $orig_subparts[$_] } (0 .. $#subparts))
870 14   33     71 || (grep { $changed{ 0+$subparts[$_] } } (0 .. $#subparts));
      66        
871              
872 14 100       37 if ($differ) {
873 6         21 $part->parts_set(\@subparts);
874 6         128 $changed{ 0+$part }++;
875             }
876             }
877              
878 40         171 return $part;
879 10         50 };
880              
881 10         20 $walk_weak = $walk;
882 10         38 weaken $walk_weak;
883              
884 10         22 my $rv = $walk->($self);
885              
886 10         109 undef $walk;
887              
888 10         187 return $rv;
889             }
890              
891             sub _compose_content_type {
892 77     77   156 my ($self, $ct_header) = @_;
893 77         405 my $ct = build_content_type({type => $ct_header->{type}, subtype => $ct_header->{subtype}, attributes => $ct_header->{attributes}});
894 77         9398 $self->header_raw_set('Content-Type' => $ct);
895 77         3306 $self->{ct} = $ct_header;
896             }
897              
898             sub _get_cid {
899 39     39   109 Email::MessageID->new->address;
900             }
901              
902             sub _reset_cids {
903 57     57   104 my ($self) = @_;
904              
905 57         153 my $ct_header = parse_content_type($self->header('Content-Type'));
906              
907 57 100       5821 if ($self->parts > 1) {
908 19 100       79 if ($ct_header->{subtype} eq 'alternative') {
909 4         8 my %cids;
910 4         10 for my $part ($self->parts) {
911 9 100       27 my $cid
912             = defined $part->header('Content-ID')
913             ? $part->header('Content-ID')
914             : q{};
915 9         27 $cids{$cid}++;
916             }
917 4 100       28 return if keys(%cids) == 1;
918              
919 1         3 my $cid = $self->_get_cid;
920 1         45 $_->header_raw_set('Content-ID' => "<$cid>") for $self->parts;
921             } else {
922 15         48 foreach ($self->parts) {
923 38         714 my $cid = $self->_get_cid;
924 38 100       1708 $_->header_raw_set('Content-ID' => "<$cid>")
925             unless $_->header('Content-ID');
926             }
927             }
928             }
929             }
930              
931             1;
932              
933             =pod
934              
935             =encoding UTF-8
936              
937             =head1 NAME
938              
939             Email::MIME - easy MIME message handling
940              
941             =head1 VERSION
942              
943             version 1.951
944              
945             =head1 SYNOPSIS
946              
947             B Before you read this, maybe you just need L, which is
948             a much easier-to-use tool for building simple email messages that might have
949             attachments or both plain text and HTML. If that doesn't do it for you, then
950             by all means keep reading.
951              
952             use Email::MIME;
953             my $parsed = Email::MIME->new($message);
954              
955             my @parts = $parsed->parts; # These will be Email::MIME objects, too.
956             my $decoded = $parsed->body;
957             my $non_decoded = $parsed->body_raw;
958              
959             my $content_type = $parsed->content_type;
960              
961             ...or...
962              
963             use Email::MIME;
964             use IO::All;
965              
966             # multipart message
967             my @parts = (
968             Email::MIME->create(
969             attributes => {
970             filename => "report.pdf",
971             content_type => "application/pdf",
972             encoding => "quoted-printable",
973             name => "2004-financials.pdf",
974             },
975             body => io( "2004-financials.pdf" )->binary->all,
976             ),
977             Email::MIME->create(
978             attributes => {
979             content_type => "text/plain",
980             disposition => "attachment",
981             charset => "US-ASCII",
982             },
983             body_str => "Hello there!",
984             ),
985             );
986              
987             my $email = Email::MIME->create(
988             header_str => [
989             From => 'casey@geeknest.com',
990             To => [ 'user1@host.com', 'Name ' ],
991             Cc => Email::Address::XS->new("Display Name \N{U+1F600}", 'user@example.com'),
992             ],
993             parts => [ @parts ],
994             );
995              
996             # nesting parts
997             $email->parts_set(
998             [
999             $email->parts,
1000             Email::MIME->create( parts => [ @parts ] ),
1001             ],
1002             );
1003              
1004             # standard modifications
1005             $email->header_str_set( 'X-PoweredBy' => 'RT v3.0' );
1006             $email->header_str_set( To => rcpts() );
1007             $email->header_str_set( Cc => aux_rcpts() );
1008             $email->header_str_set( Bcc => sekrit_rcpts() );
1009              
1010             # more advanced
1011             $_->encoding_set( 'base64' ) for $email->parts;
1012              
1013             # Quick multipart creation
1014             my $email = Email::MIME->create(
1015             header_str => [
1016             From => 'my@address',
1017             To => 'your@address',
1018             ],
1019             parts => [
1020             q[This is part one],
1021             q[This is part two],
1022             q[These could be binary too],
1023             ],
1024             );
1025              
1026             print $email->as_string;
1027              
1028             =head1 DESCRIPTION
1029              
1030             This is an extension of the L module, to handle MIME
1031             encoded messages. It takes a message as a string, splits it up into its
1032             constituent parts, and allows you access to various parts of the
1033             message. Headers are decoded from MIME encoding.
1034              
1035             =head1 PERL VERSION
1036              
1037             This library should run on perls released even a long time ago. It should work
1038             on any version of perl released in the last five years.
1039              
1040             Although it may work on older versions of perl, no guarantee is made that the
1041             minimum required version will not be increased. The version may be increased
1042             for any reason, and there is no promise that patches will be accepted to lower
1043             the minimum required perl.
1044              
1045             =head1 METHODS
1046              
1047             Please see L for the base set of methods. It won't take
1048             very long. Added to that, you have:
1049              
1050             =head2 create
1051              
1052             my $single = Email::MIME->create(
1053             header_str => [ ... ],
1054             body_str => '...',
1055             attributes => { ... },
1056             );
1057              
1058             my $multi = Email::MIME->create(
1059             header_str => [ ... ],
1060             parts => [ ... ],
1061             attributes => { ... },
1062             );
1063              
1064             This method creates a new MIME part. The C parameter is a list of
1065             headers pairs to include in the message. The value for each pair is expected to
1066             be a text string that will be MIME-encoded as needed. Alternatively it can be
1067             an object with C method which implements conversion of that
1068             object to MIME-encoded string. That object method is called with two named
1069             input parameters: C and C. It should return
1070             MIME-encoded representation of the object. As of 2017-07-25, the
1071             header-value-as-object code is very young, and may yet change.
1072              
1073             In case header name is registered in C<%Email::MIME::Header::header_to_class_map>
1074             hash then registered class is used for conversion from Unicode string to 8bit
1075             MIME encoding. Value can be either string or array reference to strings.
1076             Object is constructed via method C with string value (or values
1077             in case of array reference) and converted to MIME-encoded string via
1078             C method.
1079              
1080             A similar C
parameter can be provided in addition to or instead of
1081             C. Its values will be used verbatim.
1082              
1083             C is a hash of MIME attributes to assign to the part, and may
1084             override portions of the header set in the C
parameter. The hash keys
1085             correspond directly to methods for modifying a message from
1086             C. The allowed keys are: content_type, charset, name,
1087             format, boundary, encoding, disposition, and filename. They will be mapped to
1088             C<"$attr\_set"> for message modification.
1089              
1090             The C parameter is a list reference containing C
1091             objects. Elements of the C list can also be a non-reference
1092             string of data. In that case, an C object will be created
1093             for you. Simple checks will determine if the part is binary or not, and
1094             all parts created in this fashion are encoded with C, just in case.
1095              
1096             If C is given instead of C, it specifies the body to be used for a
1097             flat (subpart-less) MIME message. It is assumed to be a sequence of octets.
1098              
1099             If C is given instead of C or C, it is assumed to be a
1100             character string to be used as the body. If you provide a C
1101             parameter, you B provide C and C attributes.
1102              
1103             =head2 content_type_set
1104              
1105             $email->content_type_set( 'text/html' );
1106              
1107             Change the content type. All C header attributes
1108             will remain intact.
1109              
1110             =head2 charset_set
1111              
1112             =head2 name_set
1113              
1114             =head2 format_set
1115              
1116             =head2 boundary_set
1117              
1118             $email->charset_set( 'UTF-8' );
1119             $email->name_set( 'some_filename.txt' );
1120             $email->format_set( 'flowed' );
1121             $email->boundary_set( undef ); # remove the boundary
1122              
1123             These four methods modify common C attributes. If set to
1124             C, the attribute is removed. All other C header
1125             information is preserved when modifying an attribute.
1126              
1127             =head2 encode_check
1128              
1129             =head2 encode_check_set
1130              
1131             $email->encode_check;
1132             $email->encode_check_set(0);
1133             $email->encode_check_set(Encode::FB_DEFAULT);
1134              
1135             Gets/sets the current C setting (default: I).
1136             This is the parameter passed to L and L
1137             when C, C, and C are called.
1138              
1139             With the default setting, Email::MIME may crash if the claimed charset
1140             of a body does not match its contents (for example - utf8 data in a
1141             text/plain; charset=us-ascii message).
1142              
1143             With an C of 0, the unrecognized bytes will instead be
1144             replaced with the C (U+0FFFD), and may end up
1145             as either that or question marks (?).
1146              
1147             See L for more information.
1148              
1149             =head2 encoding_set
1150              
1151             $email->encoding_set( 'base64' );
1152             $email->encoding_set( 'quoted-printable' );
1153             $email->encoding_set( '8bit' );
1154              
1155             Convert the message body and alter the C
1156             header using this method. Your message body, the output of the C
1157             method, will remain the same. The raw body, output with the C
1158             method, will be changed to reflect the new encoding.
1159              
1160             =head2 body_set
1161              
1162             $email->body_set( $unencoded_body_string );
1163              
1164             This method will encode the new body you send using the encoding
1165             specified in the C header, then set
1166             the body to the new encoded body.
1167              
1168             This method overrides the default C method.
1169              
1170             =head2 body_str_set
1171              
1172             $email->body_str_set($unicode_str);
1173              
1174             This method behaves like C, but assumes that the given value is a
1175             Unicode string that should be encoded into the message's charset
1176             before being set.
1177              
1178             The charset must already be set, either manually (via the C
1179             argument to C or C) or through the C of a
1180             parsed message. If the charset can't be determined, an exception is thrown.
1181              
1182             =head2 disposition_set
1183              
1184             $email->disposition_set( 'attachment' );
1185              
1186             Alter the C of a message. All header attributes
1187             will remain intact.
1188              
1189             =head2 filename_set
1190              
1191             $email->filename_set( 'boo.pdf' );
1192              
1193             Sets the filename attribute in the C header. All other
1194             header information is preserved when setting this attribute.
1195              
1196             =head2 parts_set
1197              
1198             $email->parts_set( \@new_parts );
1199              
1200             Replaces the parts for an object. Accepts a reference to a list of
1201             C objects, representing the new parts. If this message was
1202             originally a single part, the C header will be changed to
1203             C, and given a new boundary attribute.
1204              
1205             =head2 parts_add
1206              
1207             $email->parts_add( \@more_parts );
1208              
1209             Adds MIME parts onto the current MIME part. This is a simple extension
1210             of C to make our lives easier. It accepts an array reference
1211             of additional parts.
1212              
1213             =head2 walk_parts
1214              
1215             $email->walk_parts(sub {
1216             my ($part) = @_;
1217             return if $part->subparts; # multipart
1218              
1219             if ( $part->content_type =~ m[text/html]i ) {
1220             my $body = $part->body;
1221             $body =~ s/]+>//; # simple filter example
1222             $part->body_set( $body );
1223             }
1224             });
1225              
1226             Walks through all the MIME parts in a message and applies a callback to
1227             each. Accepts a code reference as its only argument. The code reference
1228             will be passed a single argument, the current MIME part within the
1229             top-level MIME object. All changes will be applied in place.
1230              
1231             =head2 header
1232              
1233             B Beware this method! In Email::MIME, it means the same as
1234             C, but on an Email::Simple object, it means C. Unless
1235             you always know what kind of object you have, you could get one of two
1236             significantly different behaviors.
1237              
1238             Try to use either C or C as appropriate.
1239              
1240             =head2 header_str_set
1241              
1242             $email->header_str_set($header_name => @value_strings);
1243              
1244             This behaves like C, but expects Unicode (character) strings as
1245             the values to set, rather than pre-encoded byte strings. It will encode them
1246             as MIME encoded-words if they contain any control or 8-bit characters.
1247              
1248             Alternatively, values can be objects with C method. Same as in
1249             method C.
1250              
1251             =head2 header_str_pairs
1252              
1253             my @pairs = $email->header_str_pairs;
1254              
1255             This method behaves like C, returning a list of field
1256             name/value pairs, but the values have been decoded to character strings, when
1257             possible.
1258              
1259             =head2 header_as_obj
1260              
1261             my $first_obj = $email->header_as_obj($field);
1262             my $nth_obj = $email->header_as_obj($field, $index);
1263             my @all_objs = $email->header_as_obj($field);
1264              
1265             my $nth_obj_of_class = $email->header_as_obj($field, $index, $class);
1266             my @all_objs_of_class = $email->header_as_obj($field, undef, $class);
1267              
1268             This method returns an object representation of the header value. It instances
1269             new object via method C of specified class. Input argument
1270             for that class method is list of the raw MIME-encoded values. If class argument
1271             is not specified then class name is taken from the hash
1272             C<%Email::MIME::Header::header_to_class_map> via key field. Use class method
1273             C<< Email::MIME::Header->set_class_for_header($class, $field) >> for adding new
1274             mapping.
1275              
1276             =head2 parts
1277              
1278             This returns a list of C objects reflecting the parts of the
1279             message. If it's a single-part message, you get the original object back.
1280              
1281             In scalar context, this method returns the number of parts.
1282              
1283             This is a stupid method. Don't use it.
1284              
1285             =head2 subparts
1286              
1287             This returns a list of C objects reflecting the parts of the
1288             message. If it's a single-part message, this method returns an empty list.
1289              
1290             In scalar context, this method returns the number of subparts.
1291              
1292             =head2 body
1293              
1294             This decodes and returns the body of the object I. For
1295             top-level objects in multi-part messages, this is highly likely to be something
1296             like "This is a multi-part message in MIME format."
1297              
1298             =head2 body_str
1299              
1300             This decodes both the Content-Transfer-Encoding layer of the body (like the
1301             C method) as well as the charset encoding of the body (unlike the C
1302             method), returning a Unicode string.
1303              
1304             If the charset is known, it is used. If there is no charset but the content
1305             type is either C or C, us-ascii is assumed. Otherwise,
1306             an exception is thrown.
1307              
1308             =head2 body_raw
1309              
1310             This returns the body of the object, but doesn't decode the transfer encoding.
1311              
1312             =head2 decode_hook
1313              
1314             This method is called before the L C method, to
1315             decode the body of non-binary messages (or binary messages, if the
1316             C method returns true). By default, this method does
1317             nothing, but subclasses may define behavior.
1318              
1319             This method could be used to implement the decryption of content in secure
1320             email, for example.
1321              
1322             =head2 content_type
1323              
1324             This is a shortcut for access to the content type header.
1325              
1326             =head2 filename
1327              
1328             This provides the suggested filename for the attachment part. Normally
1329             it will return the filename from the headers, but if C is
1330             passed a true parameter, it will generate an appropriate "stable"
1331             filename if one is not found in the MIME headers.
1332              
1333             =head2 invent_filename
1334              
1335             my $filename = Email::MIME->invent_filename($content_type);
1336              
1337             This routine is used by C to generate filenames for attached files.
1338             It will attempt to choose a reasonable extension, falling back to F.
1339              
1340             =head2 debug_structure
1341              
1342             my $description = $email->debug_structure;
1343              
1344             This method returns a string that describes the structure of the MIME entity.
1345             For example:
1346              
1347             + multipart/alternative; boundary="=_NextPart_2"; charset="BIG-5"
1348             + text/plain
1349             + text/html
1350              
1351             =head1 CONFIGURATION
1352              
1353             The variable C<$Email::MIME::MAX_DEPTH> is the maximum depth of parts that will
1354             be processed. It defaults to 10, already higher than legitimate mail is ever
1355             likely to be. This value may go up over time as the parser is improved.
1356              
1357             =head1 TODO
1358              
1359             All of the Email::MIME-specific guts should move to a single entry on the
1360             object's guts. This will require changes to both Email::MIME and
1361             L, sadly.
1362              
1363             =head1 SEE ALSO
1364              
1365             L, L, L.
1366              
1367             =head1 THANKS
1368              
1369             This module was generously sponsored by Best Practical
1370             (http://www.bestpractical.com/), Pete Sergeant, and Pobox.com.
1371              
1372             =head1 AUTHORS
1373              
1374             =over 4
1375              
1376             =item *
1377              
1378             Ricardo SIGNES
1379              
1380             =item *
1381              
1382             Casey West
1383              
1384             =item *
1385              
1386             Simon Cozens
1387              
1388             =back
1389              
1390             =head1 CONTRIBUTORS
1391              
1392             =for stopwords Alex Vandiver Anirvan Chatterjee Arthur Axel 'fREW' Schmidt Brian Cassidy Damian Lukowski Dan Book David Steinbrunner Dotan Dimet dxdc Eric Wong Geraint Edwards ivulfson Jesse Luehrs Kurt Anderson Lance A. Brown Matthew Horsfall memememomo Michael McClimon Mishrakk Pali Shawn Sorichetti Tomohiro Hosaka
1393              
1394             =over 4
1395              
1396             =item *
1397              
1398             Alex Vandiver
1399              
1400             =item *
1401              
1402             Anirvan Chatterjee
1403              
1404             =item *
1405              
1406             Arthur Axel 'fREW' Schmidt
1407              
1408             =item *
1409              
1410             Brian Cassidy
1411              
1412             =item *
1413              
1414             Damian Lukowski
1415              
1416             =item *
1417              
1418             Dan Book
1419              
1420             =item *
1421              
1422             David Steinbrunner
1423              
1424             =item *
1425              
1426             Dotan Dimet
1427              
1428             =item *
1429              
1430             dxdc
1431              
1432             =item *
1433              
1434             Eric Wong
1435              
1436             =item *
1437              
1438             Geraint Edwards
1439              
1440             =item *
1441              
1442             ivulfson <9122139+ivulfson@users.noreply.github.com>
1443              
1444             =item *
1445              
1446             Jesse Luehrs
1447              
1448             =item *
1449              
1450             Kurt Anderson
1451              
1452             =item *
1453              
1454             Lance A. Brown
1455              
1456             =item *
1457              
1458             Matthew Horsfall
1459              
1460             =item *
1461              
1462             memememomo
1463              
1464             =item *
1465              
1466             Michael McClimon
1467              
1468             =item *
1469              
1470             Mishrakk <48946018+Mishrakk@users.noreply.github.com>
1471              
1472             =item *
1473              
1474             Pali
1475              
1476             =item *
1477              
1478             Shawn Sorichetti
1479              
1480             =item *
1481              
1482             Tomohiro Hosaka
1483              
1484             =back
1485              
1486             =head1 COPYRIGHT AND LICENSE
1487              
1488             This software is copyright (c) 2004 by Simon Cozens and Casey West.
1489              
1490             This is free software; you can redistribute it and/or modify it under
1491             the same terms as the Perl 5 programming language system itself.
1492              
1493             =cut
1494              
1495             __END__