File Coverage

blib/lib/MIME/Lite.pm
Criterion Covered Total %
statement 375 672 55.8
branch 142 374 37.9
condition 39 118 33.0
subroutine 47 76 61.8
pod 37 55 67.2
total 640 1295 49.4


line stmt bran cond sub pod time code
1             package MIME::Lite 3.038;
2             # ABSTRACT: low-calorie MIME generator
3 9     9   60687 use v5.12.0;
  9         36  
4 9     9   58 use warnings;
  9         34  
  9         562  
5              
6 9     9   74 use File::Basename;
  9         17  
  9         2284  
7              
8             #pod =begin :prelude
9             #pod
10             #pod =head1 WAIT!
11             #pod
12             #pod MIME::Lite is not recommended by its current maintainer. There are a number of
13             #pod alternatives, like Email::MIME or MIME::Entity and Email::Sender, which you
14             #pod should probably use instead. MIME::Lite continues to accrue weird bug reports,
15             #pod and it is not receiving a large amount of refactoring due to the availability
16             #pod of better alternatives. Please consider using something else.
17             #pod
18             #pod =end :prelude
19             #pod
20             #pod =head1 SYNOPSIS
21             #pod
22             #pod Create and send using the default send method for your OS a single-part message:
23             #pod
24             #pod use MIME::Lite;
25             #pod ### Create a new single-part message, to send a GIF file:
26             #pod $msg = MIME::Lite->new(
27             #pod From => 'me@myhost.com',
28             #pod To => 'you@yourhost.com',
29             #pod Cc => 'some@other.com, some@more.com',
30             #pod Subject => 'Helloooooo, nurse!',
31             #pod Type => 'image/gif',
32             #pod Encoding => 'base64',
33             #pod Path => 'hellonurse.gif'
34             #pod );
35             #pod $msg->send; # send via default
36             #pod
37             #pod Create a multipart message (i.e., one with attachments) and send it via SMTP
38             #pod
39             #pod ### Create a new multipart message:
40             #pod $msg = MIME::Lite->new(
41             #pod From => 'me@myhost.com',
42             #pod To => 'you@yourhost.com',
43             #pod Cc => 'some@other.com, some@more.com',
44             #pod Subject => 'A message with 2 parts...',
45             #pod Type => 'multipart/mixed'
46             #pod );
47             #pod
48             #pod ### Add parts (each "attach" has same arguments as "new"):
49             #pod $msg->attach(
50             #pod Type => 'TEXT',
51             #pod Data => "Here's the GIF file you wanted"
52             #pod );
53             #pod $msg->attach(
54             #pod Type => 'image/gif',
55             #pod Path => 'aaa000123.gif',
56             #pod Filename => 'logo.gif',
57             #pod Disposition => 'attachment'
58             #pod );
59             #pod ### use Net::SMTP to do the sending
60             #pod $msg->send('smtp','some.host', Debug=>1 );
61             #pod
62             #pod Output a message:
63             #pod
64             #pod ### Format as a string:
65             #pod $str = $msg->as_string;
66             #pod
67             #pod ### Print to a filehandle (say, a "sendmail" stream):
68             #pod $msg->print(\*SENDMAIL);
69             #pod
70             #pod Send a message:
71             #pod
72             #pod ### Send in the "best" way (the default is to use "sendmail"):
73             #pod $msg->send;
74             #pod ### Send a specific way:
75             #pod $msg->send('type',@args);
76             #pod
77             #pod Specify default send method:
78             #pod
79             #pod MIME::Lite->send('smtp','some.host',Debug=>0);
80             #pod
81             #pod with authentication
82             #pod
83             #pod MIME::Lite->send('smtp','some.host', AuthUser=>$user, AuthPass=>$pass);
84             #pod
85             #pod using SSL
86             #pod
87             #pod MIME::Lite->send('smtp','some.host', SSL => 1, Port => 465 );
88             #pod
89             #pod =head1 DESCRIPTION
90             #pod
91             #pod In the never-ending quest for great taste with fewer calories,
92             #pod we proudly present: I.
93             #pod
94             #pod MIME::Lite is intended as a simple, standalone module for generating
95             #pod (not parsing!) MIME messages... specifically, it allows you to
96             #pod output a simple, decent single- or multi-part message with text or binary
97             #pod attachments. It does not require that you have the Mail:: or MIME::
98             #pod modules installed, but will work with them if they are.
99             #pod
100             #pod You can specify each message part as either the literal data itself (in
101             #pod a scalar or array), or as a string which can be given to open() to get
102             #pod a readable filehandle (e.g., "
103             #pod
104             #pod You don't need to worry about encoding your message data:
105             #pod this module will do that for you. It handles the 5 standard MIME encodings.
106             #pod
107             #pod =head1 EXAMPLES
108             #pod
109             #pod =head2 Create a simple message containing just text
110             #pod
111             #pod $msg = MIME::Lite->new(
112             #pod From =>'me@myhost.com',
113             #pod To =>'you@yourhost.com',
114             #pod Cc =>'some@other.com, some@more.com',
115             #pod Subject =>'Helloooooo, nurse!',
116             #pod Data =>"How's it goin', eh?"
117             #pod );
118             #pod
119             #pod =head2 Create a simple message containing just an image
120             #pod
121             #pod $msg = MIME::Lite->new(
122             #pod From =>'me@myhost.com',
123             #pod To =>'you@yourhost.com',
124             #pod Cc =>'some@other.com, some@more.com',
125             #pod Subject =>'Helloooooo, nurse!',
126             #pod Type =>'image/gif',
127             #pod Encoding =>'base64',
128             #pod Path =>'hellonurse.gif'
129             #pod );
130             #pod
131             #pod
132             #pod =head2 Create a multipart message
133             #pod
134             #pod ### Create the multipart "container":
135             #pod $msg = MIME::Lite->new(
136             #pod From =>'me@myhost.com',
137             #pod To =>'you@yourhost.com',
138             #pod Cc =>'some@other.com, some@more.com',
139             #pod Subject =>'A message with 2 parts...',
140             #pod Type =>'multipart/mixed'
141             #pod );
142             #pod
143             #pod ### Add the text message part:
144             #pod ### (Note that "attach" has same arguments as "new"):
145             #pod $msg->attach(
146             #pod Type =>'TEXT',
147             #pod Data =>"Here's the GIF file you wanted"
148             #pod );
149             #pod
150             #pod ### Add the image part:
151             #pod $msg->attach(
152             #pod Type =>'image/gif',
153             #pod Path =>'aaa000123.gif',
154             #pod Filename =>'logo.gif',
155             #pod Disposition => 'attachment'
156             #pod );
157             #pod
158             #pod
159             #pod =head2 Attach a GIF to a text message
160             #pod
161             #pod This will create a multipart message exactly as above, but using the
162             #pod "attach to singlepart" hack:
163             #pod
164             #pod ### Start with a simple text message:
165             #pod $msg = MIME::Lite->new(
166             #pod From =>'me@myhost.com',
167             #pod To =>'you@yourhost.com',
168             #pod Cc =>'some@other.com, some@more.com',
169             #pod Subject =>'A message with 2 parts...',
170             #pod Type =>'TEXT',
171             #pod Data =>"Here's the GIF file you wanted"
172             #pod );
173             #pod
174             #pod ### Attach a part... the make the message a multipart automatically:
175             #pod $msg->attach(
176             #pod Type =>'image/gif',
177             #pod Path =>'aaa000123.gif',
178             #pod Filename =>'logo.gif'
179             #pod );
180             #pod
181             #pod
182             #pod =head2 Attach a pre-prepared part to a message
183             #pod
184             #pod ### Create a standalone part:
185             #pod $part = MIME::Lite->new(
186             #pod Top => 0,
187             #pod Type =>'text/html',
188             #pod Data =>'

Hello

',
189             #pod );
190             #pod $part->attr('content-type.charset' => 'UTF-8');
191             #pod $part->add('X-Comment' => 'A message for you');
192             #pod
193             #pod ### Attach it to any message:
194             #pod $msg->attach($part);
195             #pod
196             #pod
197             #pod =head2 Print a message to a filehandle
198             #pod
199             #pod ### Write it to a filehandle:
200             #pod $msg->print(\*STDOUT);
201             #pod
202             #pod ### Write just the header:
203             #pod $msg->print_header(\*STDOUT);
204             #pod
205             #pod ### Write just the encoded body:
206             #pod $msg->print_body(\*STDOUT);
207             #pod
208             #pod
209             #pod =head2 Print a message into a string
210             #pod
211             #pod ### Get entire message as a string:
212             #pod $str = $msg->as_string;
213             #pod
214             #pod ### Get just the header:
215             #pod $str = $msg->header_as_string;
216             #pod
217             #pod ### Get just the encoded body:
218             #pod $str = $msg->body_as_string;
219             #pod
220             #pod
221             #pod =head2 Send a message
222             #pod
223             #pod ### Send in the "best" way (the default is to use "sendmail"):
224             #pod $msg->send;
225             #pod
226             #pod
227             #pod =head2 Send an HTML document... with images included!
228             #pod
229             #pod $msg = MIME::Lite->new(
230             #pod To =>'you@yourhost.com',
231             #pod Subject =>'HTML with in-line images!',
232             #pod Type =>'multipart/related'
233             #pod );
234             #pod $msg->attach(
235             #pod Type => 'text/html',
236             #pod Data => qq{
237             #pod
238             #pod Here's my image:
239             #pod
240             #pod
241             #pod },
242             #pod );
243             #pod $msg->attach(
244             #pod Type => 'image/gif',
245             #pod Id => 'myimage.gif',
246             #pod Path => '/path/to/somefile.gif',
247             #pod );
248             #pod $msg->send();
249             #pod
250             #pod
251             #pod =head2 Change how messages are sent
252             #pod
253             #pod ### Do something like this in your 'main':
254             #pod if ($I_DONT_HAVE_SENDMAIL) {
255             #pod MIME::Lite->send('smtp', $host, Timeout=>60,
256             #pod AuthUser=>$user, AuthPass=>$pass);
257             #pod }
258             #pod
259             #pod ### Now this will do the right thing:
260             #pod $msg->send; ### will now use Net::SMTP as shown above
261             #pod
262             #pod =head1 PUBLIC INTERFACE
263             #pod
264             #pod =head2 Global configuration
265             #pod
266             #pod To alter the way the entire module behaves, you have the following
267             #pod methods/options:
268             #pod
269             #pod =over 4
270             #pod
271             #pod
272             #pod =item MIME::Lite->field_order()
273             #pod
274             #pod When used as a L, this changes the default
275             #pod order in which headers are output for I messages.
276             #pod However, please consider using the instance method variant instead,
277             #pod so you won't stomp on other message senders in the same application.
278             #pod
279             #pod
280             #pod =item MIME::Lite->quiet()
281             #pod
282             #pod This L can be used to suppress/unsuppress
283             #pod all warnings coming from this module.
284             #pod
285             #pod
286             #pod =item MIME::Lite->send()
287             #pod
288             #pod When used as a L, this can be used to specify
289             #pod a different default mechanism for sending message.
290             #pod The initial default is:
291             #pod
292             #pod MIME::Lite->send("sendmail", "/usr/lib/sendmail -t -oi -oem");
293             #pod
294             #pod However, you should consider the similar but smarter and taint-safe variant:
295             #pod
296             #pod MIME::Lite->send("sendmail");
297             #pod
298             #pod Or, for non-Unix users:
299             #pod
300             #pod MIME::Lite->send("smtp");
301             #pod
302             #pod
303             #pod =item $MIME::Lite::AUTO_CC
304             #pod
305             #pod If true, automatically send to the Cc/Bcc addresses for send_by_smtp().
306             #pod Default is B.
307             #pod
308             #pod
309             #pod =item $MIME::Lite::AUTO_CONTENT_TYPE
310             #pod
311             #pod If true, try to automatically choose the content type from the file name
312             #pod in C/C. In other words, setting this true changes the
313             #pod default C from C<"TEXT"> to C<"AUTO">.
314             #pod
315             #pod Default is B, since we must maintain backwards-compatibility
316             #pod with prior behavior. B consider keeping it false,
317             #pod and just using Type 'AUTO' when you build() or attach().
318             #pod
319             #pod
320             #pod =item $MIME::Lite::AUTO_ENCODE
321             #pod
322             #pod If true, automatically choose the encoding from the content type.
323             #pod Default is B.
324             #pod
325             #pod
326             #pod =item $MIME::Lite::AUTO_VERIFY
327             #pod
328             #pod If true, check paths to attachments right before printing, raising an exception
329             #pod if any path is unreadable.
330             #pod Default is B.
331             #pod
332             #pod
333             #pod =item $MIME::Lite::PARANOID
334             #pod
335             #pod If true, we won't attempt to use MIME::Base64, MIME::QuotedPrint,
336             #pod or MIME::Types, even if they're available.
337             #pod Default is B. Please consider keeping it false,
338             #pod and trusting these other packages to do the right thing.
339             #pod
340             #pod
341             #pod =back
342             #pod
343             #pod =cut
344              
345 9     9   65 use Carp ();
  9         27  
  9         331  
346 9     9   4720 use FileHandle;
  9         122623  
  9         56  
347              
348             # GLOBALS, EXTERNAL/CONFIGURATION...
349              
350             ### Automatically interpret CC/BCC for SMTP:
351             our $AUTO_CC = 1;
352              
353             ### Automatically choose content type from file name:
354             our $AUTO_CONTENT_TYPE = 0;
355              
356             ### Automatically choose encoding from content type:
357             our $AUTO_ENCODE = 1;
358              
359             ### Check paths right before printing:
360             our $AUTO_VERIFY = 1;
361              
362             ### Set this true if you don't want to use MIME::Base64/QuotedPrint/Types:
363             our $PARANOID = 0;
364              
365             ### Don't warn me about dangerous activities:
366             our $QUIET = undef;
367              
368             ### Unsupported (for tester use): don't qualify boundary with time/pid:
369             our $VANILLA = 0;
370              
371             our $DEBUG = 0;
372              
373             #==============================
374             #==============================
375             #
376             # GLOBALS, INTERNAL...
377              
378             my $Sender = "";
379             my $SENDMAIL = "";
380              
381             if ( $^O =~ /win32|cygwin/i ) {
382             $Sender = "smtp";
383             } else {
384             ### Find sendmail:
385             $Sender = "sendmail";
386             $SENDMAIL = "/usr/lib/sendmail";
387             ( -x $SENDMAIL ) or ( $SENDMAIL = "/usr/sbin/sendmail" );
388             ( -x $SENDMAIL ) or ( $SENDMAIL = "sendmail" );
389             unless (-x $SENDMAIL) {
390             require File::Spec;
391             for my $dir (File::Spec->path) {
392             if ( -x "$dir/sendmail" ) {
393             $SENDMAIL = "$dir/sendmail";
394             last;
395             }
396             }
397             }
398             unless (-x $SENDMAIL) {
399             undef $SENDMAIL;
400             }
401             }
402              
403             ### Our sending facilities:
404             my %SenderArgs = (
405             sendmail => [],
406             smtp => [],
407             sub => [],
408             );
409              
410             ### Boundary counter:
411             my $BCount = 0;
412              
413             ### Known Mail/MIME fields... these, plus some general forms like
414             ### "x-*", are recognized by build():
415             my %KnownField = map { $_ => 1 }
416             qw(
417             bcc cc comments date encrypted
418             from keywords message-id mime-version organization
419             received references reply-to return-path sender
420             subject to in-reply-to
421              
422             approved
423             );
424              
425             ### What external packages do we use for encoding?
426             my @Uses = (
427             "F" . File::Basename->VERSION,
428             );
429              
430             ### Header order:
431             my @FieldOrder;
432              
433             ### See if we have/want MIME::Types
434             my $HaveMimeTypes = 0;
435             if ( !$PARANOID and eval "require MIME::Types; MIME::Types->VERSION(1.28);" ) {
436             $HaveMimeTypes = 1;
437             push @Uses, "T$MIME::Types::VERSION";
438             }
439              
440             #==============================
441             #==============================
442             #
443             # PRIVATE UTILITY FUNCTIONS...
444              
445             #------------------------------
446             #
447             # fold STRING
448             #
449             # Make STRING safe as a field value. Remove leading/trailing whitespace,
450             # and make sure newlines are represented as newline+space
451              
452             sub fold {
453 0     0 0 0 my $str = shift;
454 0         0 $str =~ s/^\s*|\s*$//g; ### trim
455 0         0 $str =~ s/\n/\n /g;
456 0         0 $str;
457             }
458              
459             #------------------------------
460             #
461             # gen_boundary
462             #
463             # Generate a new boundary to use.
464             # The unsupported $VANILLA is for test purposes only.
465              
466             sub gen_boundary {
467 6 100   6 0 36 return ( "_----------=_" . ( $VANILLA ? '' : int(time) . $$ ) . $BCount++ );
468             }
469              
470             #------------------------------
471             #
472             # is_mime_field FIELDNAME
473             #
474             # Is this a field I manage?
475              
476             sub is_mime_field {
477 39     39 0 163 $_[0] =~ /^(mime\-|content\-)/i;
478             }
479              
480             #------------------------------
481             #
482             # extract_full_addrs STRING
483             # extract_only_addrs STRING
484             #
485             # Split STRING into an array of email addresses: somewhat of a KLUDGE.
486             #
487             # Unless paranoid, we try to load the real code before supplying our own.
488 0         0 BEGIN {
489 9     9   14367 my $ATOM = '[^ \000-\037()<>@,;:\134"\056\133\135]+';
490 9         20 my $QSTR = '".*?"';
491 9         24 my $WORD = '(?:' . $QSTR . '|' . $ATOM . ')';
492 9         22 my $DOMAIN = '(?:' . $ATOM . '(?:' . '\\.' . $ATOM . ')*' . ')';
493 9         22 my $LOCALPART = '(?:' . $WORD . '(?:' . '\\.' . $WORD . ')*' . ')';
494 9         19 my $ADDR = '(?:' . $LOCALPART . '@' . $DOMAIN . ')';
495 9         38 my $PHRASE = '(?:' . $WORD . ')+';
496 9         68300 my $SEP = "(?:^\\s*|\\s*,\\s*)"; ### before elems in a list
497              
498             sub my_extract_full_addrs {
499 0     0 0 0 my $str = shift;
500 0 0       0 return unless $str;
501 0         0 my @addrs;
502 0         0 $str =~ s/\s/ /g; ### collapse whitespace
503              
504 0         0 pos($str) = 0;
505 0         0 while ( $str !~ m{\G\s*\Z}gco ) {
506             ### print STDERR "TACKLING: ".substr($str, pos($str))."\n";
507 0 0 0     0 if ( $str =~ m{\G$SEP($PHRASE)\s*<\s*($ADDR)\s*>}gco ) {
    0          
508 0         0 push @addrs, "$1 <$2>";
509             } elsif ( $str =~ m{\G$SEP($ADDR)}gco or $str =~ m{\G$SEP($ATOM)}gco ) {
510 0         0 push @addrs, $1;
511             } else {
512 0         0 my $problem = substr( $str, pos($str) );
513 0         0 die "can't extract address at <$problem> in <$str>\n";
514             }
515             }
516 0 0       0 return wantarray ? @addrs : $addrs[0];
517             }
518              
519             sub my_extract_only_addrs {
520 0 0   0 0 0 my @ret = map { /<([^>]+)>/ ? $1 : $_ } my_extract_full_addrs(@_);
  0         0  
521 0 0       0 return wantarray ? @ret : $ret[0];
522             }
523             }
524             #------------------------------
525              
526              
527             if ( !$PARANOID and eval "require Mail::Address" ) {
528             push @Uses, "A$Mail::Address::VERSION";
529 0 0   0 0 0 eval q{
  0 50   10 0 0  
  0         0  
  10         521670  
  17         3875  
  10         389  
530             sub extract_full_addrs {
531             my @ret=map { $_->format } Mail::Address->parse($_[0]);
532             return wantarray ? @ret : $ret[0]
533             }
534             sub extract_only_addrs {
535             my @ret=map { $_->address } Mail::Address->parse($_[0]);
536             return wantarray ? @ret : $ret[0]
537             }
538             }; ### q
539             } else {
540             eval q{
541             *extract_full_addrs=*my_extract_full_addrs;
542             *extract_only_addrs=*my_extract_only_addrs;
543             }; ### q
544             } ### if
545              
546             #==============================
547             #==============================
548             #
549             # PRIVATE ENCODING FUNCTIONS...
550              
551             #------------------------------
552             #
553             # encode_base64 STRING
554             #
555             # Encode the given string using BASE64.
556             # Unless paranoid, we try to load the real code before supplying our own.
557              
558             if ( !$PARANOID and eval "require MIME::Base64" ) {
559             MIME::Base64->import(qw(encode_base64));
560             push @Uses, "B$MIME::Base64::VERSION";
561             } else {
562             eval q{
563             sub encode_base64 {
564             my $res = "";
565             my $eol = "\n";
566              
567             pos($_[0]) = 0; ### thanks, Andreas!
568             while ($_[0] =~ /(.{1,45})/gs) {
569             $res .= substr(pack('u', $1), 1);
570             chop($res);
571             }
572             $res =~ tr|` -_|AA-Za-z0-9+/|;
573              
574             ### Fix padding at the end:
575             my $padding = (3 - length($_[0]) % 3) % 3;
576             $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
577              
578             ### Break encoded string into lines of no more than 76 characters each:
579             $res =~ s/(.{1,76})/$1$eol/g if (length $eol);
580             return $res;
581             } ### sub
582             } ### q
583             } ### if
584              
585             #------------------------------
586             #
587             # encode_qp STRING
588             #
589             # Encode the given string, LINE BY LINE, using QUOTED-PRINTABLE.
590             # Stolen from MIME::QuotedPrint by Gisle Aas, with a slight bug fix: we
591             # break lines earlier. Notice that this seems not to work unless
592             # encoding line by line.
593             #
594             # Unless paranoid, we try to load the real code before supplying our own.
595              
596             if ( !$PARANOID and eval "require MIME::QuotedPrint" ) {
597             import MIME::QuotedPrint qw(encode_qp);
598             push @Uses, "Q$MIME::QuotedPrint::VERSION";
599             } else {
600             eval q{
601             sub encode_qp {
602             my $res = shift;
603             local($_);
604             $res =~ s/([^ \t\n!-<>-~])/sprintf("=%02X", ord($1))/eg; ### rule #2,#3
605             $res =~ s/([ \t]+)$/
606             join('', map { sprintf("=%02X", ord($_)) }
607             split('', $1)
608             )/egm; ### rule #3 (encode whitespace at eol)
609              
610             ### rule #5 (lines shorter than 76 chars, but can't break =XX escapes:
611             my $brokenlines = "";
612             $brokenlines .= "$1=\n" while $res =~ s/^(.{70}([^=]{2})?)//; ### 70 was 74
613             $brokenlines =~ s/=\n$// unless length $res;
614             "$brokenlines$res";
615             } ### sub
616             } ### q
617             } ### if
618              
619              
620             #------------------------------
621             #
622             # encode_8bit STRING
623             #
624             # Encode the given string using 8BIT.
625             # This breaks long lines into shorter ones.
626              
627             sub encode_8bit {
628 7     7 0 12 my $str = shift;
629 7         10 $str =~ s/^(.{990})/$1\n/mg;
630 7         21 $str;
631             }
632              
633             #------------------------------
634             #
635             # encode_7bit STRING
636             #
637             # Encode the given string using 7BIT.
638             # This NO LONGER protects people through encoding.
639              
640             sub encode_7bit {
641 0     0 0 0 my $str = shift;
642 0         0 $str =~ s/[\x80-\xFF]//g;
643 0         0 $str =~ s/^(.{990})/$1\n/mg;
644 0         0 $str;
645             }
646              
647             #==============================
648             #==============================
649              
650             #pod =head2 Construction
651             #pod
652             #pod =over 4
653             #pod
654             #pod =cut
655              
656              
657             #------------------------------
658              
659             #pod =item new [PARAMHASH]
660             #pod
661             #pod I
662             #pod Create a new message object.
663             #pod
664             #pod If any arguments are given, they are passed into C; otherwise,
665             #pod just the empty object is created.
666             #pod
667             #pod =cut
668              
669              
670             sub new {
671 25     25 1 1814645 my $class = shift;
672              
673             ### Create basic object:
674 25         106 my $self = { Attrs => {}, ### MIME attributes
675             SubAttrs => {}, ### MIME sub-attributes
676             Header => [], ### explicit message headers
677             Parts => [], ### array of parts
678             };
679 25         49 bless $self, $class;
680              
681             ### Build, if needed:
682 25 100       92 return ( @_ ? $self->build(@_) : $self );
683             }
684              
685              
686             #------------------------------
687              
688             #pod =item attach PART
689             #pod
690             #pod =item attach PARAMHASH...
691             #pod
692             #pod I
693             #pod Add a new part to this message, and return the new part.
694             #pod
695             #pod If you supply a single PART argument, it will be regarded
696             #pod as a MIME::Lite object to be attached. Otherwise, this
697             #pod method assumes that you are giving in the pairs of a PARAMHASH
698             #pod which will be sent into C to create the new part.
699             #pod
700             #pod One of the possibly-quite-useful hacks thrown into this is the
701             #pod "attach-to-singlepart" hack: if you attempt to attach a part (let's
702             #pod call it "part 1") to a message that doesn't have a content-type
703             #pod of "multipart" or "message", the following happens:
704             #pod
705             #pod =over 4
706             #pod
707             #pod =item *
708             #pod
709             #pod A new part (call it "part 0") is made.
710             #pod
711             #pod =item *
712             #pod
713             #pod The MIME attributes and data (but I the other headers)
714             #pod are cut from the "self" message, and pasted into "part 0".
715             #pod
716             #pod =item *
717             #pod
718             #pod The "self" is turned into a "multipart/mixed" message.
719             #pod
720             #pod =item *
721             #pod
722             #pod The new "part 0" is added to the "self", and I "part 1" is added.
723             #pod
724             #pod =back
725             #pod
726             #pod One of the nice side-effects is that you can create a text message
727             #pod and then add zero or more attachments to it, much in the same way
728             #pod that a user agent like Netscape allows you to do.
729             #pod
730             #pod =cut
731              
732              
733             sub attach {
734 10     10 1 38 my $self = shift;
735 10         16 my $attrs = $self->{Attrs};
736 10         14 my $sub_attrs = $self->{SubAttrs};
737              
738             ### Create new part, if necessary:
739 10 50       45 my $part1 = ( ( @_ == 1 ) ? shift: ref($self)->new( Top => 0, @_ ) );
740              
741             ### Do the "attach-to-singlepart" hack:
742 10 100       33 if ( $attrs->{'content-type'} !~ m{^(multipart|message)/}i ) {
743              
744             ### Create part zero:
745 5         30 my $part0 = ref($self)->new;
746              
747             ### Cut MIME stuff from self, and paste into part zero:
748 5         11 foreach (qw(SubAttrs Attrs Data Path FH)) {
749 25         42 $part0->{$_} = $self->{$_};
750 25         30 delete( $self->{$_} );
751             }
752 5         15 $part0->top_level(0); ### clear top-level attributes
753              
754             ### Make self a top-level multipart:
755 5   50     20 $attrs = $self->{Attrs} ||= {}; ### reset (sam: bug? this doesn't reset anything since Attrs is already a hash-ref)
756 5   50     31 $sub_attrs = $self->{SubAttrs} ||= {}; ### reset
757 5         10 $attrs->{'content-type'} = 'multipart/mixed';
758 5         14 $sub_attrs->{'content-type'}{'boundary'} = gen_boundary();
759 5         9 $attrs->{'content-transfer-encoding'} = '7bit';
760 5         12 $self->top_level(1); ### activate top-level attributes
761              
762             ### Add part 0:
763 5         7 push @{ $self->{Parts} }, $part0;
  5         16  
764             }
765              
766             ### Add the new part:
767 10         13 push @{ $self->{Parts} }, $part1;
  10         16  
768 10         19 $part1;
769             }
770              
771             #------------------------------
772              
773             #pod =item build [PARAMHASH]
774             #pod
775             #pod I
776             #pod Create (or initialize) a MIME message object.
777             #pod Normally, you'll use the following keys in PARAMHASH:
778             #pod
779             #pod * Data, FH, or Path (either one of these, or none if multipart)
780             #pod * Type (e.g., "image/jpeg")
781             #pod * From, To, and Subject (if this is the "top level" of a message)
782             #pod
783             #pod The PARAMHASH can contain the following keys:
784             #pod
785             #pod =over 4
786             #pod
787             #pod =item (fieldname)
788             #pod
789             #pod Any field you want placed in the message header, taken from the
790             #pod standard list of header fields (you don't need to worry about case):
791             #pod
792             #pod Approved Encrypted Received Sender
793             #pod Bcc From References Subject
794             #pod Cc Keywords Reply-To To
795             #pod Comments Message-ID Resent-* X-*
796             #pod Content-* MIME-Version Return-Path
797             #pod Date Organization
798             #pod
799             #pod To give experienced users some veto power, these fields will be set
800             #pod I the ones I set... so be careful: I
801             #pod (like C) unless you know what you're doing!
802             #pod
803             #pod To specify a fieldname that's I in the above list, even one that's
804             #pod identical to an option below, just give it with a trailing C<":">,
805             #pod like C<"My-field:">. When in doubt, that I signals a mail
806             #pod field (and it sort of looks like one too).
807             #pod
808             #pod =item Data
809             #pod
810             #pod I
811             #pod The actual message data. This may be a scalar or a ref to an array of
812             #pod strings; if the latter, the message consists of a simple concatenation
813             #pod of all the strings in the array.
814             #pod
815             #pod =item Datestamp
816             #pod
817             #pod I
818             #pod If given true (or omitted), we force the creation of a C field
819             #pod stamped with the current date/time if this is a top-level message.
820             #pod You may want this if using L.
821             #pod If you don't want this to be done, either provide your own Date
822             #pod or explicitly set this to false.
823             #pod
824             #pod =item Disposition
825             #pod
826             #pod I
827             #pod The content disposition, C<"inline"> or C<"attachment">.
828             #pod The default is C<"inline">.
829             #pod
830             #pod =item Encoding
831             #pod
832             #pod I
833             #pod The content transfer encoding that should be used to encode your data:
834             #pod
835             #pod Use encoding: | If your message contains:
836             #pod ------------------------------------------------------------
837             #pod 7bit | Only 7-bit text, all lines <1000 characters
838             #pod 8bit | 8-bit text, all lines <1000 characters
839             #pod quoted-printable | 8-bit text or long lines (more reliable than "8bit")
840             #pod base64 | Largely non-textual data: a GIF, a tar file, etc.
841             #pod
842             #pod The default is taken from the Type; generally it is "binary" (no
843             #pod encoding) for text/*, message/*, and multipart/*, and "base64" for
844             #pod everything else. A value of C<"binary"> is generally I suitable
845             #pod for sending anything but ASCII text files with lines under 1000
846             #pod characters, so consider using one of the other values instead.
847             #pod
848             #pod In the case of "7bit"/"8bit", long lines are automatically chopped to
849             #pod legal length; in the case of "7bit", all 8-bit characters are
850             #pod automatically I. This may not be what you want, so pick your
851             #pod encoding well! For more info, see L<"A MIME PRIMER">.
852             #pod
853             #pod =item FH
854             #pod
855             #pod I
856             #pod Filehandle containing the data, opened for reading.
857             #pod See "ReadNow" also.
858             #pod
859             #pod =item Filename
860             #pod
861             #pod I
862             #pod The name of the attachment. You can use this to supply a
863             #pod recommended filename for the end-user who is saving the attachment
864             #pod to disk. You only need this if the filename at the end of the
865             #pod "Path" is inadequate, or if you're using "Data" instead of "Path".
866             #pod You should I put path information in here (e.g., no "/"
867             #pod or "\" or ":" characters should be used).
868             #pod
869             #pod =item Id
870             #pod
871             #pod I
872             #pod Same as setting "content-id".
873             #pod
874             #pod =item Length
875             #pod
876             #pod I
877             #pod Set the content length explicitly. Normally, this header is automatically
878             #pod computed, but only under certain circumstances (see L<"Benign limitations">).
879             #pod
880             #pod =item Path
881             #pod
882             #pod I
883             #pod Path to a file containing the data... actually, it can be any open()able
884             #pod expression. If it looks like a path, the last element will automatically
885             #pod be treated as the filename.
886             #pod See "ReadNow" also.
887             #pod
888             #pod =item ReadNow
889             #pod
890             #pod I
891             #pod If true, will open the path and slurp the contents into core now.
892             #pod This is useful if the Path points to a command and you don't want
893             #pod to run the command over and over if outputting the message several
894             #pod times. B raised if the open fails.
895             #pod
896             #pod =item Top
897             #pod
898             #pod I
899             #pod If defined, indicates whether or not this is a "top-level" MIME message.
900             #pod The parts of a multipart message are I top-level.
901             #pod Default is true.
902             #pod
903             #pod =item Type
904             #pod
905             #pod I
906             #pod The MIME content type, or one of these special values (case-sensitive):
907             #pod
908             #pod "TEXT" means "text/plain"
909             #pod "BINARY" means "application/octet-stream"
910             #pod "AUTO" means attempt to guess from the filename, falling back
911             #pod to 'application/octet-stream'. This is good if you have
912             #pod MIME::Types on your system and you have no idea what
913             #pod file might be used for the attachment.
914             #pod
915             #pod The default is C<"TEXT">, but it will be C<"AUTO"> if you set
916             #pod $AUTO_CONTENT_TYPE to true (sorry, but you have to enable
917             #pod it explicitly, since we don't want to break code which depends
918             #pod on the old behavior).
919             #pod
920             #pod =back
921             #pod
922             #pod A picture being worth 1000 words (which
923             #pod is of course 2000 bytes, so it's probably more of an "icon" than a "picture",
924             #pod but I digress...), here are some examples:
925             #pod
926             #pod $msg = MIME::Lite->build(
927             #pod From => 'yelling@inter.com',
928             #pod To => 'stocking@fish.net',
929             #pod Subject => "Hi there!",
930             #pod Type => 'TEXT',
931             #pod Encoding => '7bit',
932             #pod Data => "Just a quick note to say hi!"
933             #pod );
934             #pod
935             #pod $msg = MIME::Lite->build(
936             #pod From => 'dorothy@emerald-city.oz',
937             #pod To => 'gesundheit@edu.edu.edu',
938             #pod Subject => "A gif for U"
939             #pod Type => 'image/gif',
940             #pod Path => "/home/httpd/logo.gif"
941             #pod );
942             #pod
943             #pod $msg = MIME::Lite->build(
944             #pod From => 'laughing@all.of.us',
945             #pod To => 'scarlett@fiddle.dee.de',
946             #pod Subject => "A gzipp'ed tar file",
947             #pod Type => 'x-gzip',
948             #pod Path => "gzip < /usr/inc/somefile.tar |",
949             #pod ReadNow => 1,
950             #pod Filename => "somefile.tgz"
951             #pod );
952             #pod
953             #pod To show you what's really going on, that last example could also
954             #pod have been written:
955             #pod
956             #pod $msg = new MIME::Lite;
957             #pod $msg->build(
958             #pod Type => 'x-gzip',
959             #pod Path => "gzip < /usr/inc/somefile.tar |",
960             #pod ReadNow => 1,
961             #pod Filename => "somefile.tgz"
962             #pod );
963             #pod $msg->add(From => "laughing@all.of.us");
964             #pod $msg->add(To => "scarlett@fiddle.dee.de");
965             #pod $msg->add(Subject => "A gzipp'ed tar file");
966             #pod
967             #pod =cut
968              
969              
970             sub build {
971 20     20 1 986745 my $self = shift;
972 20         85 my %params = @_;
973 20         45 my @params = @_;
974 20         26 my $key;
975              
976             ### Miko's note: reorganized to check for exactly one of Data, Path, or FH
977 20 50       83 ( defined( $params{Data} ) + defined( $params{Path} ) + defined( $params{FH} ) <= 1 )
978             or Carp::croak "supply exactly zero or one of (Data|Path|FH).\n";
979              
980             ### Create new instance, if necessary:
981 20 100       56 ref($self) or $self = $self->new;
982              
983              
984             ### CONTENT-TYPE....
985             ###
986              
987             ### Get content-type or content-type-macro:
988 20   66     75 my $type = ( $params{Type} || ( $AUTO_CONTENT_TYPE ? 'AUTO' : 'TEXT' ) );
989              
990             ### Interpret content-type-macros:
991 20 100       95 if ( $type eq 'TEXT' ) { $type = 'text/plain'; }
  13 50       16  
    50          
    100          
992 0         0 elsif ( $type eq 'HTML' ) { $type = 'text/html'; }
993 0         0 elsif ( $type eq 'BINARY' ) { $type = 'application/octet-stream' }
994 1         7 elsif ( $type eq 'AUTO' ) { $type = $self->suggest_type( $params{Path} ); }
995              
996             ### We now have a content-type; set it:
997 20         40 $type = lc($type);
998 20         43 my $attrs = $self->{Attrs};
999 20         30 my $sub_attrs = $self->{SubAttrs};
1000 20         38 $attrs->{'content-type'} = $type;
1001              
1002             ### Get some basic attributes from the content type:
1003 20         42 my $is_multipart = ( $type =~ m{^(multipart)/}i );
1004              
1005             ### Add in the multipart boundary:
1006 20 100       46 if ($is_multipart) {
1007 1         4 my $boundary = gen_boundary();
1008 1         4 $sub_attrs->{'content-type'}{'boundary'} = $boundary;
1009             }
1010              
1011              
1012             ### CONTENT-ID...
1013             ###
1014 20 50       43 if ( defined $params{Id} ) {
1015 0         0 my $id = $params{Id};
1016 0 0       0 $id = "<$id>" unless $id =~ /\A\s*<.*>\s*\z/;
1017 0         0 $attrs->{'content-id'} = $id;
1018             }
1019              
1020              
1021             ### DATA OR PATH...
1022             ### Note that we must do this *after* we get the content type,
1023             ### in case read_now() is invoked, since it needs the binmode().
1024              
1025             ### Get data, as...
1026             ### ...either literal data:
1027 20 100       56 if ( defined( $params{Data} ) ) {
    100          
    50          
1028 13         47 $self->data( $params{Data} );
1029             }
1030             ### ...or a path to data:
1031             elsif ( defined( $params{Path} ) ) {
1032 4         20 $self->path( $params{Path} ); ### also sets filename
1033 4 100       16 $self->read_now if $params{ReadNow};
1034             }
1035             ### ...or a filehandle to data:
1036             ### Miko's note: this part works much like the path routine just above,
1037             elsif ( defined( $params{FH} ) ) {
1038 0         0 $self->fh( $params{FH} );
1039 0 0       0 $self->read_now if $params{ReadNow}; ### implement later
1040             }
1041              
1042              
1043             ### FILENAME... (added by Ian Smith on 8/4/97)
1044             ### Need this to make sure the filename is added. The Filename
1045             ### attribute is ignored, otherwise.
1046 20 100       51 if ( defined( $params{Filename} ) ) {
1047 1         6 $self->filename( $params{Filename} );
1048             }
1049              
1050              
1051             ### CONTENT-TRANSFER-ENCODING...
1052             ###
1053              
1054             ### Get it:
1055             my $enc =
1056 20   50     125 ( $params{Encoding} || ( $AUTO_ENCODE and $self->suggest_encoding($type) ) || 'binary' );
1057 20         55 $attrs->{'content-transfer-encoding'} = lc($enc);
1058              
1059             ### Sanity check:
1060 20 100       58 if ( $type =~ m{^(multipart|message)/} ) {
1061 1 50       6 ( $enc =~ m{^(7bit|8bit|binary)\Z} )
1062             or Carp::croak( "illegal MIME: " . "can't have encoding $enc with type $type\n" );
1063             }
1064              
1065             ### CONTENT-DISPOSITION...
1066             ### Default is inline for single, none for multis:
1067             ###
1068 20   66     88 my $disp = ( $params{Disposition} or ( $is_multipart ? undef: 'inline' ) );
1069 20         34 $attrs->{'content-disposition'} = $disp;
1070              
1071             ### CONTENT-LENGTH...
1072             ###
1073 20         27 my $length;
1074 20 50       43 if ( exists( $params{Length} ) ) { ### given by caller:
1075 0         0 $attrs->{'content-length'} = $params{Length};
1076             } else { ### compute it ourselves
1077 20         56 $self->get_length;
1078             }
1079              
1080             ### Init the top-level fields:
1081 20 100       44 my $is_top = defined( $params{Top} ) ? $params{Top} : 1;
1082 20         59 $self->top_level($is_top);
1083              
1084             ### Datestamp if desired:
1085 20         30 my $ds_wanted = $params{Datestamp};
1086 20   66     72 my $ds_defaulted = ( $is_top and !exists( $params{Datestamp} ) );
1087 20 100 66     118 if ( ( $ds_wanted or $ds_defaulted ) and !exists( $params{Date} ) ) {
      66        
1088 10         3775 require Email::Date::Format;
1089 10         20761 $self->add( "date", Email::Date::Format::email_date() );
1090             }
1091              
1092             ### Set message headers:
1093 20         91 my @paramz = @params;
1094 20         48 my $field;
1095 20         38 while (@paramz) {
1096 49         119 my ( $tag, $value ) = ( shift(@paramz), shift(@paramz) );
1097 49         73 my $lc_tag = lc($tag);
1098              
1099             ### Get tag, if a tag:
1100 49 50 66     220 if ( $lc_tag =~ /^-(.*)/ ) { ### old style, backwards-compatibility
    50          
    100          
1101 0         0 $field = $1;
1102             } elsif ( $lc_tag =~ /^(.*):$/ ) { ### new style
1103 0         0 $field = $1;
1104             } elsif ( $KnownField{$lc_tag} or
1105             $lc_tag =~ m{^(content|resent|x)-.} ){
1106 13         23 $field = $lc_tag;
1107             } else { ### not a field:
1108 36         86 next;
1109             }
1110              
1111             ### Add it:
1112 13         41 $self->add( $field, $value );
1113             }
1114              
1115             ### Done!
1116 20         111 $self;
1117             }
1118              
1119             #pod =back
1120             #pod
1121             #pod =cut
1122              
1123              
1124             #==============================
1125             #==============================
1126              
1127             #pod =head2 Setting/getting headers and attributes
1128             #pod
1129             #pod =over 4
1130             #pod
1131             #pod =cut
1132              
1133              
1134             #------------------------------
1135             #
1136             # top_level ONOFF
1137             #
1138             # Set/unset the top-level attributes and headers.
1139             # This affects "MIME-Version", "X-Mailer", and "Date"
1140              
1141             sub top_level {
1142 30     30 0 50 my ( $self, $onoff ) = @_;
1143 30         42 my $attrs = $self->{Attrs};
1144 30 100       46 if ($onoff) {
1145 15         40 $attrs->{'mime-version'} = '1.0';
1146 15 50       80 my $uses = ( @Uses ? ( "(" . join( "; ", @Uses ) . ")" ) : '' );
1147 15 100       92 $self->replace( 'X-Mailer' => "MIME::Lite $MIME::Lite::VERSION $uses" )
1148             unless $VANILLA;
1149             } else {
1150 15         20 delete $attrs->{'mime-version'};
1151 15         35 $self->delete('X-Mailer');
1152 15         20 $self->delete('Date');
1153             }
1154             }
1155              
1156             #------------------------------
1157              
1158             #pod =item add TAG,VALUE
1159             #pod
1160             #pod I
1161             #pod Add field TAG with the given VALUE to the end of the header.
1162             #pod The TAG will be converted to all-lowercase, and the VALUE
1163             #pod will be made "safe" (returns will be given a trailing space).
1164             #pod
1165             #pod B any MIME fields you "add" will override any MIME
1166             #pod attributes I have when it comes time to output those fields.
1167             #pod Normally, you will use this method to add I fields:
1168             #pod
1169             #pod $msg->add("Subject" => "Hi there!");
1170             #pod
1171             #pod Giving VALUE as an arrayref will cause all those values to be added.
1172             #pod This is only useful for special multiple-valued fields like "Received":
1173             #pod
1174             #pod $msg->add("Received" => ["here", "there", "everywhere"]
1175             #pod
1176             #pod Giving VALUE as the empty string adds an invisible placeholder
1177             #pod to the header, which can be used to suppress the output of
1178             #pod the "Content-*" fields or the special "MIME-Version" field.
1179             #pod When suppressing fields, you should use replace() instead of add():
1180             #pod
1181             #pod $msg->replace("Content-disposition" => "");
1182             #pod
1183             #pod I add() is probably going to be more efficient than C,
1184             #pod so you're better off using it for most applications if you are
1185             #pod certain that you don't need to delete() the field first.
1186             #pod
1187             #pod I the name comes from Mail::Header.
1188             #pod
1189             #pod =cut
1190              
1191              
1192             sub add {
1193 27     27 1 1381 my $self = shift;
1194 27         62 my $tag = lc(shift);
1195 27         45 my $value = shift;
1196              
1197             ### If a dangerous option, warn them:
1198 27 50 33     68 Carp::carp "Explicitly setting a MIME header field ($tag) is dangerous:\n"
1199             . "use the attr() method instead.\n"
1200             if ( is_mime_field($tag) && !$QUIET );
1201              
1202             ### Get array of clean values:
1203             my @vals = ( ( ref($value) and ( ref($value) eq 'ARRAY' ) )
1204 27 100 66     114 ? @{$value}
  1         4  
1205             : ( $value . '' )
1206             );
1207 27         83 map { s/\n/\n /g } @vals;
  28         82  
1208              
1209             ### Add them:
1210 27         53 foreach (@vals) {
1211 28         39 push @{ $self->{Header} }, [ $tag, $_ ];
  28         243  
1212             }
1213             }
1214              
1215             #------------------------------
1216              
1217             #pod =item attr ATTR,[VALUE]
1218             #pod
1219             #pod I
1220             #pod Set MIME attribute ATTR to the string VALUE.
1221             #pod ATTR is converted to all-lowercase.
1222             #pod This method is normally used to set/get MIME attributes:
1223             #pod
1224             #pod $msg->attr("content-type" => "text/html");
1225             #pod $msg->attr("content-type.charset" => "US-ASCII");
1226             #pod $msg->attr("content-type.name" => "homepage.html");
1227             #pod
1228             #pod This would cause the final output to look something like this:
1229             #pod
1230             #pod Content-type: text/html; charset=US-ASCII; name="homepage.html"
1231             #pod
1232             #pod Note that the special empty sub-field tag indicates the anonymous
1233             #pod first sub-field.
1234             #pod
1235             #pod Giving VALUE as undefined will cause the contents of the named
1236             #pod subfield to be deleted.
1237             #pod
1238             #pod Supplying no VALUE argument just returns the attribute's value:
1239             #pod
1240             #pod $type = $msg->attr("content-type"); ### returns "text/html"
1241             #pod $name = $msg->attr("content-type.name"); ### returns "homepage.html"
1242             #pod
1243             #pod =cut
1244              
1245              
1246             sub attr {
1247 3     3 1 16 my ( $self, $attr, $value ) = @_;
1248 3         8 my $attrs = $self->{Attrs};
1249              
1250 3         10 $attr = lc($attr);
1251              
1252             ### Break attribute name up:
1253 3         43 my ( $tag, $subtag ) = split /\./, $attr;
1254 3 100       15 if (defined($subtag)) {
1255 2   100     12 $attrs = $self->{SubAttrs}{$tag} ||= {};
1256 2         4 $tag = $subtag;
1257             }
1258              
1259             ### Set or get?
1260 3 100       15 if ( @_ > 2 ) { ### set:
1261 2 50       13 if ( defined($value) ) {
1262 2         7 $attrs->{$tag} = $value;
1263             } else {
1264 0         0 delete $attrs->{$tag};
1265             }
1266             }
1267              
1268             ### Return current value:
1269 3         13 $attrs->{$tag};
1270             }
1271              
1272             sub _safe_attr {
1273 0     0   0 my ( $self, $attr ) = @_;
1274 0 0       0 return defined $self->{Attrs}{$attr} ? $self->{Attrs}{$attr} : '';
1275             }
1276              
1277             #------------------------------
1278              
1279             #pod =item delete TAG
1280             #pod
1281             #pod I
1282             #pod Delete field TAG with the given VALUE to the end of the header.
1283             #pod The TAG will be converted to all-lowercase.
1284             #pod
1285             #pod $msg->delete("Subject");
1286             #pod
1287             #pod I the name comes from Mail::Header.
1288             #pod
1289             #pod =cut
1290              
1291              
1292             sub delete {
1293 33     33 1 35 my $self = shift;
1294 33         58 my $tag = lc(shift);
1295              
1296             ### Delete from the header:
1297 33         52 my $hdr = [];
1298 33         36 my $field;
1299 33         33 foreach $field ( @{ $self->{Header} } ) {
  33         58  
1300 11 100       34 push @$hdr, $field if ( $field->[0] ne $tag );
1301             }
1302 33         46 $self->{Header} = $hdr;
1303 33         66 $self;
1304             }
1305              
1306              
1307             #------------------------------
1308              
1309             #pod =item field_order FIELD,...FIELD
1310             #pod
1311             #pod I
1312             #pod Change the order in which header fields are output for this object:
1313             #pod
1314             #pod $msg->field_order('from', 'to', 'content-type', 'subject');
1315             #pod
1316             #pod When used as a class method, changes the default settings for
1317             #pod all objects:
1318             #pod
1319             #pod MIME::Lite->field_order('from', 'to', 'content-type', 'subject');
1320             #pod
1321             #pod Case does not matter: all field names will be coerced to lowercase.
1322             #pod In either case, supply the empty array to restore the default ordering.
1323             #pod
1324             #pod =cut
1325              
1326              
1327             sub field_order {
1328 1     1 1 9 my $self = shift;
1329 1 50       3 if ( ref($self) ) {
1330 1         3 $self->{FieldOrder} = [ map { lc($_) } @_ ];
  7         22  
1331             } else {
1332 0         0 @FieldOrder = map { lc($_) } @_;
  0         0  
1333             }
1334             }
1335              
1336             #------------------------------
1337              
1338             #pod =item fields
1339             #pod
1340             #pod I
1341             #pod Return the full header for the object, as a ref to an array
1342             #pod of C<[TAG, VALUE]> pairs, where each TAG is all-lowercase.
1343             #pod Note that any fields the user has explicitly set will override the
1344             #pod corresponding MIME fields that we would otherwise generate.
1345             #pod So, don't say...
1346             #pod
1347             #pod $msg->set("Content-type" => "text/html; charset=US-ASCII");
1348             #pod
1349             #pod unless you want the above value to override the "Content-type"
1350             #pod MIME field that we would normally generate.
1351             #pod
1352             #pod I I called this "fields" because the header() method of
1353             #pod Mail::Header returns something different, but similar enough to
1354             #pod be confusing.
1355             #pod
1356             #pod You can change the order of the fields: see L.
1357             #pod You really shouldn't need to do this, but some people have to
1358             #pod deal with broken mailers.
1359             #pod
1360             #pod =cut
1361              
1362              
1363             sub fields {
1364 9     9 1 13 my $self = shift;
1365 9         17 my @fields;
1366 9         16 my $attrs = $self->{Attrs};
1367 9         17 my $sub_attrs = $self->{SubAttrs};
1368              
1369             ### Get a lookup-hash of all *explicitly-given* fields:
1370 9         15 my %explicit = map { $_->[0] => 1 } @{ $self->{Header} };
  15         54  
  9         23  
1371              
1372             ### Start with any MIME attributes not given explicitly:
1373 9         20 my $tag;
1374 9         15 foreach $tag ( sort keys %{ $self->{Attrs} } ) {
  9         57  
1375              
1376             ### Skip if explicit:
1377 41 50       76 next if ( $explicit{$tag} );
1378              
1379             # get base attr value or skip if not available
1380 41         69 my $value = $attrs->{$tag};
1381 41 100       104 defined $value or next;
1382              
1383             ### handle sub-attrs if available
1384 32 100       70 if (my $subs = $sub_attrs->{$tag}) {
1385             $value .= '; ' .
1386             join('; ', map {
1387 7 50       22 /\*$/ ? qq[$_=$subs->{$_}] : qq[$_="$subs->{$_}"]
  7         61  
1388             } sort keys %$subs);
1389             }
1390              
1391             # handle stripping \r\n now since we're not doing it in attr()
1392             # anymore
1393 32         57 $value =~ tr/\r\n//;
1394              
1395             ### Add to running fields;
1396 32         81 push @fields, [ $tag, $value ];
1397             }
1398              
1399             ### Add remaining fields (note that we duplicate the array for safety):
1400 9         17 foreach ( @{ $self->{Header} } ) {
  9         21  
1401 15         24 push @fields, [ @{$_} ];
  15         59  
1402             }
1403              
1404             ### Final step:
1405             ### If a suggested ordering was given, we "sort" by that ordering.
1406             ### The idea is that we give each field a numeric rank, which is
1407             ### (1000 * order(field)) + origposition.
1408 9 100       17 my @order = @{ $self->{FieldOrder} || [] }; ### object-specific
  9         111  
1409 9 100       30 @order or @order = @FieldOrder; ### no? maybe generic
1410 9 100       35 if (@order) { ### either?
1411              
1412             ### Create hash mapping field names to 1-based rank:
1413 1         5 my %rank = map { $order[$_] => ( 1 + $_ ) } ( 0 .. $#order );
  7         37  
1414              
1415             ### Create parallel array to @fields, called @ranked.
1416             ### It contains fields tagged with numbers like 2003, where the
1417             ### 3 is the original 0-based position, and 2000 indicates that
1418             ### we wanted this type of field to go second.
1419             my @ranked = map {
1420 1   66     5 [ ( $_ + 1000 * ( $rank{ lc( $fields[$_][0] ) } || ( 2 + $#order ) ) ), $fields[$_] ]
  8         31  
1421             } ( 0 .. $#fields );
1422              
1423             # foreach (@ranked) {
1424             # print STDERR "RANKED: $_->[0] $_->[1][0] $_->[1][1]\n";
1425             # }
1426              
1427             ### That was half the Schwartzian transform. Here's the rest:
1428 8         16 @fields = map { $_->[1] }
1429 1         7 sort { $a->[0] <=> $b->[0] } @ranked;
  15         26  
1430             }
1431              
1432             ### Done!
1433 9         56 return \@fields;
1434             }
1435              
1436              
1437             #------------------------------
1438              
1439             #pod =item filename [FILENAME]
1440             #pod
1441             #pod I
1442             #pod Set the filename which this data will be reported as.
1443             #pod This actually sets both "standard" attributes.
1444             #pod
1445             #pod With no argument, returns the filename as dictated by the
1446             #pod content-disposition.
1447             #pod
1448             #pod =cut
1449              
1450              
1451             sub filename {
1452 5     5 1 13 my ( $self, $filename ) = @_;
1453 5         10 my $sub_attrs = $self->{SubAttrs};
1454              
1455 5 50       16 if ( @_ > 1 ) {
1456 5         15 $sub_attrs->{'content-type'}{'name'} = $filename;
1457 5         13 $sub_attrs->{'content-disposition'}{'filename'} = $filename;
1458             }
1459 5         20 return $sub_attrs->{'content-disposition'}{'filename'};
1460             }
1461              
1462             #------------------------------
1463              
1464             #pod =item get TAG,[INDEX]
1465             #pod
1466             #pod I
1467             #pod Get the contents of field TAG, which might have been set
1468             #pod with set() or replace(). Returns the text of the field.
1469             #pod
1470             #pod $ml->get('Subject', 0);
1471             #pod
1472             #pod If the optional 0-based INDEX is given, then we return the INDEX'th
1473             #pod occurrence of field TAG. Otherwise, we look at the context:
1474             #pod In a scalar context, only the first (0th) occurrence of the
1475             #pod field is returned; in an array context, I occurrences are returned.
1476             #pod
1477             #pod I this should only be used with non-MIME fields.
1478             #pod Behavior with MIME fields is TBD, and will raise an exception for now.
1479             #pod
1480             #pod =cut
1481              
1482              
1483             sub get {
1484 12     12 1 47 my ( $self, $tag, $index ) = @_;
1485 12         28 $tag = lc($tag);
1486 12 50       31 Carp::croak "get: can't be used with MIME fields\n" if is_mime_field($tag);
1487              
1488 12 100       25 my @all = map { ( $_->[0] eq $tag ) ? $_->[1] : () } @{ $self->{Header} };
  66         167  
  12         35  
1489 12 100       78 ( defined($index) ? $all[$index] : ( wantarray ? @all : $all[0] ) );
    100          
1490             }
1491              
1492             #------------------------------
1493              
1494             #pod =item get_length
1495             #pod
1496             #pod I
1497             #pod Recompute the content length for the message I,
1498             #pod setting the "content-length" attribute as a side-effect:
1499             #pod
1500             #pod $msg->get_length;
1501             #pod
1502             #pod Returns the length, or undefined if not set.
1503             #pod
1504             #pod I the content length can be difficult to compute, since it
1505             #pod involves assembling the entire encoded body and taking the length
1506             #pod of it (which, in the case of multipart messages, means freezing
1507             #pod all the sub-parts, etc.).
1508             #pod
1509             #pod This method only sets the content length to a defined value if the
1510             #pod message is a singlepart with C<"binary"> encoding, I the body is
1511             #pod available either in-core or as a simple file. Otherwise, the content
1512             #pod length is set to the undefined value.
1513             #pod
1514             #pod Since content-length is not a standard MIME field anyway (that's right, kids:
1515             #pod it's not in the MIME RFCs, it's an HTTP thing), this seems pretty fair.
1516             #pod
1517             #pod =cut
1518              
1519              
1520             #----
1521             # Miko's note: I wasn't quite sure how to handle this, so I waited to hear
1522             # what you think. Given that the content-length isn't always required,
1523             # and given the performance cost of calculating it from a file handle,
1524             # I thought it might make more sense to add some sort of computelength
1525             # property. If computelength is false, then the length simply isn't
1526             # computed. What do you think?
1527             #
1528             # Eryq's reply: I agree; for now, we can silently leave out the content-type.
1529              
1530             sub get_length {
1531 37     37 1 51 my $self = shift;
1532 37         94 my $attrs = $self->{Attrs};
1533              
1534 37         110 my $is_multipart = ( $attrs->{'content-type'} =~ m{^multipart/}i );
1535 37   100     145 my $enc = lc( $attrs->{'content-transfer-encoding'} || 'binary' );
1536 37         51 my $length;
1537 37 100 100     130 if ( !$is_multipart && ( $enc eq "binary" ) ) { ### might figure it out cheap:
1538 17 100       49 if ( defined( $self->{Data} ) ) { ### it's in core
    50          
    50          
1539 13         21 $length = length( $self->{Data} );
1540             } elsif ( defined( $self->{FH} ) ) { ### it's in a filehandle
1541             ### no-op: it's expensive, so don't bother
1542             } elsif ( defined( $self->{Path} ) ) { ### it's a simple file!
1543 4 100       181 $length = ( -s $self->{Path} ) if ( -e $self->{Path} );
1544             }
1545             }
1546 37         60 $attrs->{'content-length'} = $length;
1547 37         61 return $length;
1548             }
1549              
1550             #------------------------------
1551              
1552             #pod =item parts
1553             #pod
1554             #pod I
1555             #pod Return the parts of this entity, and this entity only.
1556             #pod Returns empty array if this entity has no parts.
1557             #pod
1558             #pod This is B recursive! Parts can have sub-parts; use
1559             #pod parts_DFS() to get everything.
1560             #pod
1561             #pod =cut
1562              
1563              
1564             sub parts {
1565 9     9 1 11 my $self = shift;
1566 9 50       9 @{ $self->{Parts} || [] };
  9         27  
1567             }
1568              
1569             #------------------------------
1570              
1571             #pod =item parts_DFS
1572             #pod
1573             #pod I
1574             #pod Return the list of all MIME::Lite objects included in the entity,
1575             #pod starting with the entity itself, in depth-first-search order.
1576             #pod If this object has no parts, it alone will be returned.
1577             #pod
1578             #pod =cut
1579              
1580              
1581             sub parts_DFS {
1582 8     8 1 5 my $self = shift;
1583 8         11 return ( $self, map { $_->parts_DFS } $self->parts );
  7         12  
1584             }
1585              
1586             #------------------------------
1587              
1588             #pod =item preamble [TEXT]
1589             #pod
1590             #pod I
1591             #pod Get/set the preamble string, assuming that this object has subparts.
1592             #pod Set it to undef for the default string.
1593             #pod
1594             #pod =cut
1595              
1596              
1597             sub preamble {
1598 0     0 1 0 my $self = shift;
1599 0 0       0 $self->{Preamble} = shift if @_;
1600 0         0 $self->{Preamble};
1601             }
1602              
1603             #------------------------------
1604              
1605             #pod =item replace TAG,VALUE
1606             #pod
1607             #pod I
1608             #pod Delete all occurrences of fields named TAG, and add a new
1609             #pod field with the given VALUE. TAG is converted to all-lowercase.
1610             #pod
1611             #pod B the special MIME fields (MIME-version, Content-*):
1612             #pod if you "replace" a MIME field, the replacement text will override
1613             #pod the I MIME attributes when it comes time to output that field.
1614             #pod So normally you use attr() to change MIME fields and add()/replace() to
1615             #pod change I fields:
1616             #pod
1617             #pod $msg->replace("Subject" => "Hi there!");
1618             #pod
1619             #pod Giving VALUE as the I will effectively I that
1620             #pod field from being output. This is the correct way to suppress
1621             #pod the special MIME fields:
1622             #pod
1623             #pod $msg->replace("Content-disposition" => "");
1624             #pod
1625             #pod Giving VALUE as I will just cause all explicit values
1626             #pod for TAG to be deleted, without having any new values added.
1627             #pod
1628             #pod I the name of this method comes from Mail::Header.
1629             #pod
1630             #pod =cut
1631              
1632              
1633             sub replace {
1634 2     2 1 8 my ( $self, $tag, $value ) = @_;
1635 2         10 $self->delete($tag);
1636 2 50       14 $self->add( $tag, $value ) if defined($value);
1637             }
1638              
1639              
1640             #------------------------------
1641              
1642             #pod =item scrub
1643             #pod
1644             #pod I
1645             #pod B
1646             #pod Recursively goes through the "parts" tree of this message and tries
1647             #pod to find MIME attributes that can be removed.
1648             #pod With an array argument, removes exactly those attributes; e.g.:
1649             #pod
1650             #pod $msg->scrub(['content-disposition', 'content-length']);
1651             #pod
1652             #pod Is the same as recursively doing:
1653             #pod
1654             #pod $msg->replace('Content-disposition' => '');
1655             #pod $msg->replace('Content-length' => '');
1656             #pod
1657             #pod =cut
1658              
1659              
1660             sub scrub {
1661 0     0 1 0 my ( $self, @a ) = @_;
1662 0         0 my ($expl) = @a;
1663 0         0 local $QUIET = 1;
1664              
1665             ### Scrub me:
1666 0 0 0     0 if ( !@a ) { ### guess
    0          
1667              
1668             ### Scrub length always:
1669 0         0 $self->replace( 'content-length', '' );
1670              
1671             ### Scrub disposition if no filename, or if content-type has same info:
1672 0 0 0     0 if ( !$self->_safe_attr('content-disposition.filename')
1673             || $self->_safe_attr('content-type.name') )
1674             {
1675 0         0 $self->replace( 'content-disposition', '' );
1676             }
1677              
1678             ### Scrub encoding if effectively unencoded:
1679 0 0       0 if ( $self->_safe_attr('content-transfer-encoding') =~ /^(7bit|8bit|binary)$/i ) {
1680 0         0 $self->replace( 'content-transfer-encoding', '' );
1681             }
1682              
1683             ### Scrub charset if US-ASCII:
1684 0 0       0 if ( $self->_safe_attr('content-type.charset') =~ /^(us-ascii)/i ) {
1685 0         0 $self->attr( 'content-type.charset' => undef );
1686             }
1687              
1688             ### TBD: this is not really right for message/digest:
1689 0 0 0     0 if ( ( keys %{ $self->{Attrs}{'content-type'} } == 1 )
  0         0  
1690             and ( $self->_safe_attr('content-type') eq 'text/plain' ) )
1691             {
1692 0         0 $self->replace( 'content-type', '' );
1693             }
1694             } elsif ( $expl and ( ref($expl) eq 'ARRAY' ) ) {
1695 0         0 foreach ( @{$expl} ) { $self->replace( $_, '' ); }
  0         0  
  0         0  
1696             }
1697              
1698             ### Scrub my kids:
1699 0         0 foreach ( @{ $self->{Parts} } ) { $_->scrub(@a); }
  0         0  
  0         0  
1700             }
1701              
1702             #pod =back
1703             #pod
1704             #pod =cut
1705              
1706              
1707             #==============================
1708             #==============================
1709              
1710             #pod =head2 Setting/getting message data
1711             #pod
1712             #pod =over 4
1713             #pod
1714             #pod =cut
1715              
1716              
1717             #------------------------------
1718              
1719             #pod =item binmode [OVERRIDE]
1720             #pod
1721             #pod I
1722             #pod With no argument, returns whether or not it thinks that the data
1723             #pod (as given by the "Path" argument of C) should be read using
1724             #pod binmode() (for example, when C is invoked).
1725             #pod
1726             #pod The default behavior is that any content type other than
1727             #pod C or C is binmode'd; this should in general work fine.
1728             #pod
1729             #pod With a defined argument, this method sets an explicit "override"
1730             #pod value. An undefined argument unsets the override.
1731             #pod The new current value is returned.
1732             #pod
1733             #pod =cut
1734              
1735              
1736             sub binmode {
1737 2     2 1 4 my $self = shift;
1738 2 50       21 $self->{Binmode} = shift if (@_); ### argument? set override
1739             return ( defined( $self->{Binmode} )
1740             ? $self->{Binmode}
1741 2 50       23 : ( $self->{Attrs}{"content-type"} !~ m{^(text|message)/}i )
1742             );
1743             }
1744              
1745             #------------------------------
1746              
1747             #pod =item data [DATA]
1748             #pod
1749             #pod I
1750             #pod Get/set the literal DATA of the message. The DATA may be
1751             #pod either a scalar, or a reference to an array of scalars (which
1752             #pod will simply be joined).
1753             #pod
1754             #pod I setting the data causes the "content-length" attribute
1755             #pod to be recomputed (possibly to nothing).
1756             #pod
1757             #pod =cut
1758              
1759              
1760             sub data {
1761 13     13 1 19 my $self = shift;
1762 13 50       27 if (@_) {
1763 13 100       37 $self->{Data} = ( ( ref( $_[0] ) eq 'ARRAY' ) ? join( '', @{ $_[0] } ) : $_[0] );
  2         8  
1764 13         32 $self->get_length;
1765             }
1766 13         22 $self->{Data};
1767             }
1768              
1769             #------------------------------
1770              
1771             #pod =item fh [FILEHANDLE]
1772             #pod
1773             #pod I
1774             #pod Get/set the FILEHANDLE which contains the message data.
1775             #pod
1776             #pod Takes a filehandle as an input and stores it in the object.
1777             #pod This routine is similar to path(); one important difference is that
1778             #pod no attempt is made to set the content length.
1779             #pod
1780             #pod =cut
1781              
1782              
1783             sub fh {
1784 0     0 1 0 my $self = shift;
1785 0 0       0 $self->{FH} = shift if @_;
1786 0         0 $self->{FH};
1787             }
1788              
1789             #------------------------------
1790              
1791             #pod =item path [PATH]
1792             #pod
1793             #pod I
1794             #pod Get/set the PATH to the message data.
1795             #pod
1796             #pod I setting the path recomputes any existing "content-length" field,
1797             #pod and re-sets the "filename" (to the last element of the path if it
1798             #pod looks like a simple path, and to nothing if not).
1799             #pod
1800             #pod =cut
1801              
1802              
1803             sub path {
1804 4     4 1 8 my $self = shift;
1805 4 50       12 if (@_) {
1806              
1807             ### Set the path, and invalidate the content length:
1808 4         10 $self->{Path} = shift;
1809              
1810             ### Re-set filename, extracting it from path if possible:
1811 4         7 my $filename;
1812 4 100 66     43 if ( $self->{Path} and ( $self->{Path} !~ /\|$/ ) ) { ### non-shell path:
1813 3         12 ( $filename = $self->{Path} ) =~ s/^
1814              
1815             ### Consult File::Basename
1816 3         150 $filename = File::Basename::basename($filename);
1817             }
1818 4         56 $self->filename($filename);
1819              
1820             ### Reset the length:
1821 4         11 $self->get_length;
1822             }
1823 4         8 $self->{Path};
1824             }
1825              
1826             #------------------------------
1827              
1828             #pod =item resetfh [FILEHANDLE]
1829             #pod
1830             #pod I
1831             #pod Set the current position of the filehandle back to the beginning.
1832             #pod Only applies if you used "FH" in build() or attach() for this message.
1833             #pod
1834             #pod Returns false if unable to reset the filehandle (since not all filehandles
1835             #pod are seekable).
1836             #pod
1837             #pod =cut
1838              
1839              
1840             #----
1841             # Miko's note: With the Data and Path, the same data could theoretically
1842             # be reused. However, file handles need to be reset to be reused,
1843             # so I added this routine.
1844             #
1845             # Eryq reply: beware... not all filehandles are seekable (think about STDIN)!
1846              
1847             sub resetfh {
1848 0     0 1 0 my $self = shift;
1849 0         0 seek( $self->{FH}, 0, 0 );
1850             }
1851              
1852             #------------------------------
1853              
1854             #pod =item read_now
1855             #pod
1856             #pod I
1857             #pod Forces data from the path/filehandle (as specified by C)
1858             #pod to be read into core immediately, just as though you had given it
1859             #pod literally with the C keyword.
1860             #pod
1861             #pod Note that the in-core data will always be used if available.
1862             #pod
1863             #pod Be aware that everything is slurped into a giant scalar: you may not want
1864             #pod to use this if sending tar files! The benefit of I reading in the data
1865             #pod is that very large files can be handled by this module if left on disk
1866             #pod until the message is output via C or C.
1867             #pod
1868             #pod =cut
1869              
1870              
1871             sub read_now {
1872 1     1 1 2 my $self = shift;
1873 1         7 local $/ = undef;
1874              
1875 1 50       6 if ( $self->{FH} ) { ### data from a filehandle:
    50          
1876 0         0 my $chunk;
1877             my @chunks;
1878 0 0       0 CORE::binmode( $self->{FH} ) if $self->binmode;
1879 0         0 while ( read( $self->{FH}, $chunk, 1024 ) ) {
1880 0         0 push @chunks, $chunk;
1881             }
1882 0         0 $self->{Data} = join '', @chunks;
1883             } elsif ( $self->{Path} ) { ### data from a path:
1884 1 50       46 open SLURP, $self->{Path} or Carp::croak "open $self->{Path}: $!\n";
1885 1 50       6 CORE::binmode(SLURP) if $self->binmode;
1886 1         86 $self->{Data} = ; ### sssssssssssssslurp...
1887 1         18 close SLURP; ### ...aaaaaaaaahhh!
1888             }
1889             }
1890              
1891             #------------------------------
1892              
1893             #pod =item sign PARAMHASH
1894             #pod
1895             #pod I
1896             #pod Sign the message. This forces the message to be read into core,
1897             #pod after which the signature is appended to it.
1898             #pod
1899             #pod =over 4
1900             #pod
1901             #pod =item Data
1902             #pod
1903             #pod As in C: the literal signature data.
1904             #pod Can be either a scalar or a ref to an array of scalars.
1905             #pod
1906             #pod =item Path
1907             #pod
1908             #pod As in C: the path to the file.
1909             #pod
1910             #pod =back
1911             #pod
1912             #pod If no arguments are given, the default is:
1913             #pod
1914             #pod Path => "$ENV{HOME}/.signature"
1915             #pod
1916             #pod The content-length is recomputed.
1917             #pod
1918             #pod =cut
1919              
1920              
1921             sub sign {
1922 0     0 1 0 my $self = shift;
1923 0         0 my %params = @_;
1924              
1925             ### Default:
1926 0 0       0 @_ or $params{Path} = "$ENV{HOME}/.signature";
1927              
1928             ### Force message in-core:
1929 0 0       0 defined( $self->{Data} ) or $self->read_now;
1930              
1931             ### Load signature:
1932 0         0 my $sig;
1933 0 0       0 if ( !defined( $sig = $params{Data} ) ) { ### not given explicitly:
1934 0         0 local $/ = undef;
1935 0 0       0 open SIG, $params{Path} or Carp::croak "open sig $params{Path}: $!\n";
1936 0         0 $sig = ; ### sssssssssssssslurp...
1937 0         0 close SIG; ### ...aaaaaaaaahhh!
1938             }
1939 0 0 0     0 $sig = join( '', @$sig ) if ( ref($sig) and ( ref($sig) eq 'ARRAY' ) );
1940              
1941             ### Append, following Internet conventions:
1942 0         0 $self->{Data} .= "\n-- \n$sig";
1943              
1944             ### Re-compute length:
1945 0         0 $self->get_length;
1946 0         0 1;
1947             }
1948              
1949             #------------------------------
1950             #
1951             # =item suggest_encoding CONTENTTYPE
1952             #
1953             # I
1954             # Based on the CONTENTTYPE, return a good suggested encoding.
1955             # C and C types have their bodies scanned line-by-line
1956             # for 8-bit characters and long lines; lack of either means that the
1957             # message is 7bit-ok. Other types are chosen independent of their body:
1958             #
1959             # Major type: 7bit ok? Suggested encoding:
1960             # ------------------------------------------------------------
1961             # text yes 7bit
1962             # no quoted-printable
1963             # unknown binary
1964             #
1965             # message yes 7bit
1966             # no binary
1967             # unknown binary
1968             #
1969             # multipart n/a binary (in case some parts are not ok)
1970             #
1971             # (other) n/a base64
1972             #
1973             #=cut
1974              
1975             sub suggest_encoding {
1976 20     20 0 59 my ( $self, $ctype ) = @_;
1977 20         38 $ctype = lc($ctype);
1978              
1979             ### Consult MIME::Types, maybe:
1980 20 50       41 if ($HaveMimeTypes) {
1981              
1982             ### Mappings contain [suffix,mimetype,encoding]
1983 20         75 my @mappings = MIME::Types::by_mediatype($ctype);
1984 20 100       285680 if ( scalar(@mappings) ) {
1985             ### Just pick the first one:
1986 19         27 my ( $suffix, $mimetype, $encoding ) = @{ $mappings[0] };
  19         109  
1987 19 50 33     207 if ( $encoding
1988             && $encoding =~ /^(base64|binary|[78]bit|quoted-printable)$/i )
1989             {
1990 19         163 return lc($encoding); ### sanity check
1991             }
1992             }
1993             }
1994              
1995             ### If we got here, then MIME::Types was no help.
1996             ### Extract major type:
1997 1         5 my ($type) = split '/', $ctype;
1998 1 50 33     18 if ( ( $type eq 'text' ) || ( $type eq 'message' ) ) { ### scan message body?
1999 0         0 return 'binary';
2000             } else {
2001 1 50       11 return ( $type eq 'multipart' ) ? 'binary' : 'base64';
2002             }
2003             }
2004              
2005             #------------------------------
2006             #
2007             # =item suggest_type PATH
2008             #
2009             # I
2010             # Suggest the content-type for this attached path.
2011             # We always fall back to "application/octet-stream" if no good guess
2012             # can be made, so don't use this if you don't mean it!
2013             #
2014             sub suggest_type {
2015 1     1 0 3 my ( $self, $path ) = @_;
2016              
2017             ### If there's no path, bail:
2018 1 50       3 $path or return 'application/octet-stream';
2019              
2020             ### Consult MIME::Types, maybe:
2021 1 50       4 if ($HaveMimeTypes) {
2022              
2023             # Mappings contain [mimetype,encoding]:
2024 1         6 my ( $mimetype, $encoding ) = MIME::Types::by_suffix($path);
2025 1 50 33     171 return $mimetype if ( $mimetype && $mimetype =~ /^\S+\/\S+$/ ); ### sanity check
2026             }
2027             ### If we got here, then MIME::Types was no help.
2028             ### The correct thing to fall back to is the most-generic content type:
2029 0         0 return 'application/octet-stream';
2030             }
2031              
2032             #------------------------------
2033              
2034             #pod =item verify_data
2035             #pod
2036             #pod I
2037             #pod Verify that all "paths" to attached data exist, recursively.
2038             #pod It might be a good idea for you to do this before a print(), to
2039             #pod prevent accidental partial output if a file might be missing.
2040             #pod Raises exception if any path is not readable.
2041             #pod
2042             #pod =cut
2043              
2044              
2045             sub verify_data {
2046 18     18 1 33 my $self = shift;
2047              
2048             ### Verify self:
2049 18         23 my $path = $self->{Path};
2050 18 100 100     52 if ( $path and ( $path !~ /\|$/ ) ) { ### non-shell path:
2051 4         10 $path =~ s/^
2052 4 100       189 ( -r $path ) or die "$path: not readable\n";
2053             }
2054              
2055             ### Verify parts:
2056 17         24 foreach my $part ( @{ $self->{Parts} } ) { $part->verify_data }
  17         35  
  8         19  
2057 16         24 1;
2058             }
2059              
2060             #pod =back
2061             #pod
2062             #pod =cut
2063              
2064              
2065             #==============================
2066             #==============================
2067              
2068             #pod =head2 Output
2069             #pod
2070             #pod =over 4
2071             #pod
2072             #pod =cut
2073              
2074              
2075             #------------------------------
2076              
2077             #pod =item print [OUTHANDLE]
2078             #pod
2079             #pod I
2080             #pod Print the message to the given output handle, or to the currently-selected
2081             #pod filehandle if none was given.
2082             #pod
2083             #pod All OUTHANDLE has to be is a filehandle (possibly a glob ref), or
2084             #pod any object that responds to a print() message.
2085             #pod
2086             #pod =cut
2087              
2088              
2089             sub print {
2090 8     8 1 17 my ( $self, $out ) = @_;
2091              
2092             ### Coerce into a printable output handle:
2093 8         34 $out = MIME::Lite::IO_Handle->wrap($out);
2094              
2095             ### Output head, separator, and body:
2096 8 50       35 $self->verify_data if $AUTO_VERIFY; ### prevents missing parts!
2097 8         28 $out->print( $self->header_as_string );
2098 8         52 $out->print( "\n" );
2099 8         29 $self->print_body($out);
2100             }
2101              
2102             #------------------------------
2103             #
2104             # print_for_smtp
2105             #
2106             # Instance method, private.
2107             # Print, but filter out the topmost "Bcc" field.
2108             # This is because qmail apparently doesn't do this for us!
2109             #
2110             sub print_for_smtp {
2111 0     0 0 0 my ( $self, $out ) = @_;
2112              
2113             ### Coerce into a printable output handle:
2114 0         0 $out = MIME::Lite::IO_Handle->wrap($out);
2115              
2116             ### Create a safe head:
2117 0         0 my @fields = grep { $_->[0] ne 'bcc' } @{ $self->fields };
  0         0  
  0         0  
2118 0         0 my $header = $self->fields_as_string( \@fields );
2119              
2120             ### Output head, separator, and body:
2121 0         0 $out->print( $header );
2122 0         0 $out->print( "\n" );
2123 0         0 $self->print_body( $out, '1' );
2124             }
2125              
2126             #------------------------------
2127              
2128             #pod =item print_body [OUTHANDLE] [IS_SMTP]
2129             #pod
2130             #pod I
2131             #pod Print the body of a message to the given output handle, or to
2132             #pod the currently-selected filehandle if none was given.
2133             #pod
2134             #pod All OUTHANDLE has to be is a filehandle (possibly a glob ref), or
2135             #pod any object that responds to a print() message.
2136             #pod
2137             #pod B raised if unable to open any of the input files,
2138             #pod or if a part contains no data, or if an unsupported encoding is
2139             #pod encountered.
2140             #pod
2141             #pod IS_SMPT is a special option to handle SMTP mails a little more
2142             #pod intelligently than other send mechanisms may require. Specifically this
2143             #pod ensures that the last byte sent is NOT '\n' (octal \012) if the last two
2144             #pod bytes are not '\r\n' (\015\012) as this will cause some SMTP servers to
2145             #pod hang.
2146             #pod
2147             #pod =cut
2148              
2149              
2150             sub print_body {
2151 8     8 1 18 my ( $self, $out, $is_smtp ) = @_;
2152 8         31 my $attrs = $self->{Attrs};
2153 8         15 my $sub_attrs = $self->{SubAttrs};
2154              
2155             ### Coerce into a printable output handle:
2156 8         21 $out = MIME::Lite::IO_Handle->wrap($out);
2157              
2158             ### Output either the body or the parts.
2159             ### Notice that we key off of the content-type! We expect fewer
2160             ### accidents that way, since the syntax will always match the MIME type.
2161 8         18 my $type = $attrs->{'content-type'};
2162 8 100       35 if ( $type =~ m{^multipart/}i ) {
    50          
2163 2         6 my $boundary = $sub_attrs->{'content-type'}{'boundary'};
2164              
2165             ### Preamble:
2166             $out->print( defined( $self->{Preamble} )
2167             ? $self->{Preamble}
2168 2 50       12 : "This is a multi-part message in MIME format.\n"
2169             );
2170              
2171             ### Parts:
2172 2         4 my $part;
2173 2         20 foreach $part ( @{ $self->{Parts} } ) {
  2         9  
2174 2         9 $out->print("\n--$boundary\n");
2175 2         8 $part->print($out);
2176             }
2177              
2178             ### Epilogue:
2179 2         9 $out->print("\n--$boundary--\n\n");
2180             } elsif ( $type =~ m{^message/} ) {
2181 0         0 my @parts = @{ $self->{Parts} };
  0         0  
2182              
2183             ### It's a toss-up; try both data and parts:
2184 0 0       0 if ( @parts == 0 ) { $self->print_simple_body( $out, $is_smtp ) }
  0 0       0  
2185 0         0 elsif ( @parts == 1 ) { $parts[0]->print($out) }
2186 0         0 else { Carp::croak "can't handle message with >1 part\n"; }
2187             } else {
2188 6         16 $self->print_simple_body( $out, $is_smtp );
2189             }
2190 8         21 1;
2191             }
2192              
2193             #------------------------------
2194             #
2195             # print_simple_body [OUTHANDLE]
2196             #
2197             # I
2198             # Print the body of a simple singlepart message to the given
2199             # output handle, or to the currently-selected filehandle if none
2200             # was given.
2201             #
2202             # Note that if you want to print "the portion after
2203             # the header", you don't want this method: you want
2204             # L.
2205             #
2206             # All OUTHANDLE has to be is a filehandle (possibly a glob ref), or
2207             # any object that responds to a print() message.
2208             #
2209             # B raised if unable to open any of the input files,
2210             # or if a part contains no data, or if an unsupported encoding is
2211             # encountered.
2212             #
2213             sub print_simple_body {
2214 6     6 0 12 my ( $self, $out, $is_smtp ) = @_;
2215 6         53 my $attrs = $self->{Attrs};
2216              
2217             ### Coerce into a printable output handle:
2218 6         16 $out = MIME::Lite::IO_Handle->wrap($out);
2219              
2220             ### Get content-transfer-encoding:
2221 6         17 my $encoding = uc( $attrs->{'content-transfer-encoding'} );
2222 6 50 0     13 warn "M::L >>> Encoding using $encoding, is_smtp=" . ( $is_smtp || 0 ) . "\n"
2223             if $MIME::Lite::DEBUG;
2224              
2225             ### Notice that we don't just attempt to slurp the data in from a file:
2226             ### by processing files piecemeal, we still enable ourselves to prepare
2227             ### very large MIME messages...
2228              
2229             ### Is the data in-core? If so, blit it out...
2230 6 100 33     17 if ( defined( $self->{Data} ) ) {
    50          
2231             DATA:
2232             {
2233 5         6 local $_ = $encoding;
  5         8  
2234              
2235 5 50       13 /^BINARY$/ and do {
2236 0 0       0 $is_smtp and $self->{Data} =~ s/(?!\r)\n\z/\r/;
2237 0         0 $out->print( $self->{Data} );
2238 0         0 last DATA;
2239             };
2240 5 50       41 /^8BIT$/ and do {
2241 5         17 $out->print( encode_8bit( $self->{Data} ) );
2242 5         14 last DATA;
2243             };
2244 0 0       0 /^7BIT$/ and do {
2245 0         0 $out->print( encode_7bit( $self->{Data} ) );
2246 0         0 last DATA;
2247             };
2248 0 0       0 /^QUOTED-PRINTABLE$/ and do {
2249             ### UNTAINT since m//mg on tainted data loops forever:
2250 0         0 my ($untainted) = ( $self->{Data} =~ m/\A(.*)\Z/s );
2251              
2252             ### Encode it line by line:
2253 0         0 while ( $untainted =~ m{^(.*[\r\n]*)}smg ) {
2254             ### have to do it line by line...
2255 0         0 my $line = $1; # copy to avoid weird bug; rt 39334
2256 0         0 $out->print( encode_qp($line) );
2257             }
2258 0         0 last DATA;
2259             };
2260 0 0       0 /^BASE64/ and do {
2261 0         0 $out->print( encode_base64( $self->{Data} ) );
2262 0         0 last DATA;
2263             };
2264 0         0 Carp::croak "unsupported encoding: `$_'\n";
2265             }
2266             }
2267              
2268             ### Else, is the data in a file? If so, output piecemeal...
2269             ### Miko's note: this routine pretty much works the same with a path
2270             ### or a filehandle. the only difference in behaviour is that it does
2271             ### not attempt to open anything if it already has a filehandle
2272             elsif ( defined( $self->{Path} ) || defined( $self->{FH} ) ) {
2273 9     9   144 no strict 'refs'; ### in case FH is not an object
  9         22  
  9         41557  
2274 1         2 my $DATA;
2275              
2276             ### Open file if necessary:
2277 1 50       3 if ( defined( $self->{Path} ) ) {
2278 1   33     7 $DATA = new FileHandle || Carp::croak "can't get new filehandle\n";
2279 1 50       46 $DATA->open("$self->{Path}")
2280             or Carp::croak "open $self->{Path}: $!\n";
2281             } else {
2282 0         0 $DATA = $self->{FH};
2283             }
2284 1 50       47 CORE::binmode($DATA) if $self->binmode;
2285              
2286             ### Encode piece by piece:
2287             PATH:
2288             {
2289 1         2 local $_ = $encoding;
  1         2  
2290              
2291 1 50       2 /^BINARY$/ and do {
2292 0         0 my $last = "";
2293 0         0 while ( read( $DATA, $_, 2048 ) ) {
2294 0 0       0 $out->print($last) if length $last;
2295 0         0 $last = $_;
2296             }
2297 0 0       0 if ( length $last ) {
2298 0 0       0 $is_smtp and $last =~ s/(?!\r)\n\z/\r/;
2299 0         0 $out->print($last);
2300             }
2301 0         0 last PATH;
2302             };
2303 1 50       5 /^8BIT$/ and do {
2304 1         85 $out->print( encode_8bit($_) ) while (<$DATA>);
2305 1         3 last PATH;
2306             };
2307 0 0       0 /^7BIT$/ and do {
2308 0         0 $out->print( encode_7bit($_) ) while (<$DATA>);
2309 0         0 last PATH;
2310             };
2311 0 0       0 /^QUOTED-PRINTABLE$/ and do {
2312 0         0 $out->print( encode_qp($_) ) while (<$DATA>);
2313 0         0 last PATH;
2314             };
2315 0 0       0 /^BASE64$/ and do {
2316 0         0 $out->print( encode_base64($_) ) while ( read( $DATA, $_, 45 ) );
2317 0         0 last PATH;
2318             };
2319 0         0 Carp::croak "unsupported encoding: `$_'\n";
2320             }
2321              
2322             ### Close file:
2323 1 50       41 close $DATA if defined( $self->{Path} );
2324             }
2325              
2326             else {
2327 0         0 Carp::croak "no data in this part\n";
2328             }
2329 6         12 1;
2330             }
2331              
2332             #------------------------------
2333              
2334             #pod =item print_header [OUTHANDLE]
2335             #pod
2336             #pod I
2337             #pod Print the header of the message to the given output handle,
2338             #pod or to the currently-selected filehandle if none was given.
2339             #pod
2340             #pod All OUTHANDLE has to be is a filehandle (possibly a glob ref), or
2341             #pod any object that responds to a print() message.
2342             #pod
2343             #pod =cut
2344              
2345              
2346             sub print_header {
2347 0     0 1 0 my ( $self, $out ) = @_;
2348              
2349             ### Coerce into a printable output handle:
2350 0         0 $out = MIME::Lite::IO_Handle->wrap($out);
2351              
2352             ### Output the header:
2353 0         0 $out->print( $self->header_as_string );
2354 0         0 1;
2355             }
2356              
2357             #------------------------------
2358              
2359             #pod =item as_string
2360             #pod
2361             #pod I
2362             #pod Return the entire message as a string, with a header and an encoded body.
2363             #pod
2364             #pod =cut
2365              
2366              
2367             sub as_string {
2368 6     6 1 69 my $self = shift;
2369 6         12 my $buf = "";
2370 6         56 my $io = ( wrap MIME::Lite::IO_Scalar \$buf);
2371 6         24 $self->print($io);
2372 6         47 return $buf;
2373             }
2374             *stringify = \&as_string; ### backwards compatibility
2375             *stringify = \&as_string; ### ...twice to avoid warnings :)
2376              
2377             #------------------------------
2378              
2379             #pod =item body_as_string
2380             #pod
2381             #pod I
2382             #pod Return the encoded body as a string.
2383             #pod This is the portion after the header and the blank line.
2384             #pod
2385             #pod I actually prepares the body by "printing" to a scalar.
2386             #pod Proof that you can hand the C methods any blessed object
2387             #pod that responds to a C message.
2388             #pod
2389             #pod =cut
2390              
2391              
2392             sub body_as_string {
2393 0     0 1 0 my $self = shift;
2394 0         0 my $buf = "";
2395 0         0 my $io = ( wrap MIME::Lite::IO_Scalar \$buf);
2396 0         0 $self->print_body($io);
2397 0         0 return $buf;
2398             }
2399             *stringify_body = \&body_as_string; ### backwards compatibility
2400             *stringify_body = \&body_as_string; ### ...twice to avoid warnings :)
2401              
2402             #------------------------------
2403             #
2404             # fields_as_string FIELDS
2405             #
2406             # PRIVATE! Return a stringified version of the given header
2407             # fields, where FIELDS is an arrayref like that returned by fields().
2408             #
2409             sub fields_as_string {
2410 8     8 0 17 my ( $self, $fields ) = @_;
2411 8         21 my $out = "";
2412 8         15 foreach (@$fields) {
2413 39         74 my ( $tag, $value ) = @$_;
2414 39 50       71 next if ( $value eq '' ); ### skip empties
2415 39         163 $tag =~ s/\b([a-z])/uc($1)/ge; ### make pretty
  76         219  
2416 39         99 $tag =~ s/^mime-/MIME-/i; ### even prettier
2417 39 50 33     92 if (length($value) > 72 && $value !~ /\n/) {
2418 0         0 $value = fold_header($value);
2419             }
2420 39         115 $out .= "$tag: $value\n";
2421             }
2422 8         53 return $out;
2423             }
2424              
2425             sub fold_header {
2426 0     0 0 0 local $_ = shift;
2427 0   0     0 my $Eol = shift || "\n";
2428              
2429             # Undo any existing folding
2430 0         0 s/\r?\n(\s)/$1/gms;
2431              
2432             # Pulled partly from Mail::Message::Field
2433 0         0 my $Folded = '';
2434 0         0 while (1) {
2435 0 0       0 if (length($_) < 72) {
2436 0         0 $Folded .= $_;
2437 0         0 last;
2438             }
2439             # Prefer breaking at ; or ,
2440             s/^(.{18,72}[;,])([ \t])// ||
2441             # Otherwise any space is fine
2442 0 0 0     0 s/^(.{18,72})([ \t])// ||
      0        
2443             # Hmmm, longer than 72 chars, find up to next whitespace
2444             s/^(.{72,}?)([ \t])// ||
2445             # Ok, better just get everything
2446             s/^(.*)()//;
2447 0         0 $Folded .= $1 . $Eol . $2;
2448             }
2449              
2450             # Strip the trailing eol
2451 0         0 $Folded =~ s/${Eol}$//;
2452              
2453 0         0 return $Folded;
2454             }
2455              
2456             #------------------------------
2457              
2458             #pod =item header_as_string
2459             #pod
2460             #pod I
2461             #pod Return the header as a string.
2462             #pod
2463             #pod =cut
2464              
2465              
2466             sub header_as_string {
2467 8     8 1 12 my $self = shift;
2468 8         27 $self->fields_as_string( $self->fields );
2469             }
2470             *stringify_header = \&header_as_string; ### backwards compatibility
2471             *stringify_header = \&header_as_string; ### ...twice to avoid warnings :)
2472              
2473             #pod =back
2474             #pod
2475             #pod =cut
2476              
2477              
2478             #==============================
2479             #==============================
2480              
2481             #pod =head2 Sending
2482             #pod
2483             #pod =over 4
2484             #pod
2485             #pod =cut
2486              
2487              
2488             #------------------------------
2489              
2490             #pod =item send
2491             #pod
2492             #pod =item send HOW, HOWARGS...
2493             #pod
2494             #pod I
2495             #pod This is the principal method for sending mail, and for configuring
2496             #pod how mail will be sent.
2497             #pod
2498             #pod I with a HOW argument and optional HOWARGS, it sets
2499             #pod the default sending mechanism that the no-argument instance method
2500             #pod will use. The HOW is a facility name (B),
2501             #pod and the HOWARGS is interpreted by the facility.
2502             #pod The class method returns the previous HOW and HOWARGS as an array.
2503             #pod
2504             #pod MIME::Lite->send('sendmail', "d:\\programs\\sendmail.exe");
2505             #pod ...
2506             #pod $msg = MIME::Lite->new(...);
2507             #pod $msg->send;
2508             #pod
2509             #pod I
2510             #pod (a HOW argument and optional HOWARGS), sends the message in the
2511             #pod requested manner; e.g.:
2512             #pod
2513             #pod $msg->send('sendmail', "d:\\programs\\sendmail.exe");
2514             #pod
2515             #pod I sends the
2516             #pod message by the default mechanism set up by the class method.
2517             #pod Returns whatever the mail-handling routine returns: this
2518             #pod should be true on success, false/exception on error:
2519             #pod
2520             #pod $msg = MIME::Lite->new(From=>...);
2521             #pod $msg->send || die "you DON'T have mail!";
2522             #pod
2523             #pod On Unix systems (or rather non-Win32 systems), the default
2524             #pod setting is equivalent to:
2525             #pod
2526             #pod MIME::Lite->send("sendmail", "/usr/lib/sendmail -t -oi -oem");
2527             #pod
2528             #pod On Win32 systems the default setting is equivalent to:
2529             #pod
2530             #pod MIME::Lite->send("smtp");
2531             #pod
2532             #pod The assumption is that on Win32 your site/lib/Net/libnet.cfg
2533             #pod file will be preconfigured to use the appropriate SMTP
2534             #pod server. See below for configuring for authentication.
2535             #pod
2536             #pod There are three facilities:
2537             #pod
2538             #pod =over 4
2539             #pod
2540             #pod =item "sendmail", ARGS...
2541             #pod
2542             #pod Send a message by piping it into the "sendmail" command.
2543             #pod Uses the L method, giving it the ARGS.
2544             #pod This usage implements (and deprecates) the C method.
2545             #pod
2546             #pod =item "smtp", [HOSTNAME, [NAMEDPARMS] ]
2547             #pod
2548             #pod Send a message by SMTP, using optional HOSTNAME as SMTP-sending host.
2549             #pod L will be required. Uses the L
2550             #pod method. Any additional arguments passed in will also be passed through to
2551             #pod send_by_smtp. This is useful for things like mail servers requiring
2552             #pod authentication where you can say something like the following
2553             #pod
2554             #pod MIME::Lite->send('smtp', $host, AuthUser=>$user, AuthPass=>$pass);
2555             #pod
2556             #pod which will configure things so future uses of
2557             #pod
2558             #pod $msg->send();
2559             #pod
2560             #pod do the right thing.
2561             #pod
2562             #pod =item "sub", \&SUBREF, ARGS...
2563             #pod
2564             #pod Sends a message MSG by invoking the subroutine SUBREF of your choosing,
2565             #pod with MSG as the first argument, and ARGS following.
2566             #pod
2567             #pod =back
2568             #pod
2569             #pod I let's say you're on an OS which lacks the usual Unix
2570             #pod "sendmail" facility, but you've installed something a lot like it, and
2571             #pod you need to configure your Perl script to use this "sendmail.exe" program.
2572             #pod Do this following in your script's setup:
2573             #pod
2574             #pod MIME::Lite->send('sendmail', "d:\\programs\\sendmail.exe");
2575             #pod
2576             #pod Then, whenever you need to send a message $msg, just say:
2577             #pod
2578             #pod $msg->send;
2579             #pod
2580             #pod That's it. Now, if you ever move your script to a Unix box, all you
2581             #pod need to do is change that line in the setup and you're done.
2582             #pod All of your $msg-Esend invocations will work as expected.
2583             #pod
2584             #pod After sending, the method last_send_successful() can be used to determine
2585             #pod if the send was successful or not.
2586             #pod
2587             #pod =cut
2588              
2589              
2590             sub send {
2591 2     2 1 594568 my $self = shift;
2592 2         5 my $meth = shift;
2593              
2594 2 50       8 if ( ref($self) ) { ### instance method:
2595 0         0 my ( $method, @args );
2596 0 0       0 if (@_) { ### args; use them just this once
2597 0         0 $method = 'send_by_' . $meth;
2598 0         0 @args = @_;
2599             } else { ### no args; use defaults
2600 0         0 $method = "send_by_$Sender";
2601 0 0       0 @args = @{ $SenderArgs{$Sender} || [] };
  0         0  
2602             }
2603 0 0       0 $self->verify_data if $AUTO_VERIFY; ### prevents missing parts!
2604 0 0       0 Carp::croak "Unknown send method '$meth'" unless $self->can($method);
2605 0         0 return $self->$method(@args);
2606             } else { ### class method:
2607 2 50       8 if (@_) {
2608 2         3 my @old = ( $Sender, @{ $SenderArgs{$Sender} } );
  2         8  
2609 2         4 $Sender = $meth;
2610 2         6 $SenderArgs{$Sender} = [@_]; ### remaining args
2611 2         8 return @old;
2612             } else {
2613 0         0 Carp::croak "class method send must have HOW... arguments\n";
2614             }
2615             }
2616             }
2617              
2618              
2619             #------------------------------
2620              
2621             #pod =item send_by_sendmail SENDMAILCMD
2622             #pod
2623             #pod =item send_by_sendmail PARAM=>VALUE, ARRAY, HASH...
2624             #pod
2625             #pod I
2626             #pod Send message via an external "sendmail" program
2627             #pod (this will probably only work out-of-the-box on Unix systems).
2628             #pod
2629             #pod Returns true on success, false or exception on error.
2630             #pod
2631             #pod You can specify the program and all its arguments by giving a single
2632             #pod string, SENDMAILCMD. Nothing fancy is done; the message is simply
2633             #pod piped in.
2634             #pod
2635             #pod However, if your needs are a little more advanced, you can specify
2636             #pod zero or more of the following PARAM/VALUE pairs (or a reference to hash
2637             #pod or array of such arguments as well as any combination thereof); a
2638             #pod Unix-style, taint-safe "sendmail" command will be constructed for you:
2639             #pod
2640             #pod =over 4
2641             #pod
2642             #pod =item Sendmail
2643             #pod
2644             #pod Full path to the program to use.
2645             #pod Default is "/usr/lib/sendmail".
2646             #pod
2647             #pod =item BaseArgs
2648             #pod
2649             #pod Ref to the basic array of arguments we start with.
2650             #pod Default is C<["-t", "-oi", "-oem"]>.
2651             #pod
2652             #pod =item SetSender
2653             #pod
2654             #pod Unless this is I given as false, we attempt to automatically
2655             #pod set the C<-f> argument to the first address that can be extracted from
2656             #pod the "From:" field of the message (if there is one).
2657             #pod
2658             #pod I
2659             #pod Suppose we did I use C<-f>, and you gave an explicit "From:"
2660             #pod field in your message: in this case, the sendmail "envelope" would
2661             #pod indicate the I user your process was running under, as a way
2662             #pod of preventing mail forgery. Using the C<-f> switch causes the sender
2663             #pod to be set in the envelope as well.
2664             #pod
2665             #pod I
2666             #pod If sendmail doesn't regard you as a "trusted" user, it will permit
2667             #pod the C<-f> but also add an "X-Authentication-Warning" header to the message
2668             #pod to indicate a forged envelope. To avoid this, you can either
2669             #pod (1) have SetSender be false, or
2670             #pod (2) make yourself a trusted user by adding a C configuration
2671             #pod command to your I file
2672             #pod (e.g.: C if the script is running as user "eryq").
2673             #pod
2674             #pod =item FromSender
2675             #pod
2676             #pod If defined, this is identical to setting SetSender to true,
2677             #pod except that instead of looking at the "From:" field we use
2678             #pod the address given by this option.
2679             #pod Thus:
2680             #pod
2681             #pod FromSender => 'me@myhost.com'
2682             #pod
2683             #pod =back
2684             #pod
2685             #pod After sending, the method last_send_successful() can be used to determine
2686             #pod if the send was successful or not.
2687             #pod
2688             #pod =cut
2689              
2690             sub _unfold_stupid_params {
2691 1     1   393247 my $self = shift;
2692              
2693 1         2 my %p;
2694 1         6 STUPID_PARAM: for (my $i = 0; $i < @_; $i++) { ## no critic Loop
2695 6         8 my $item = $_[$i];
2696 6 100       14 if (not ref $item) {
    100          
    50          
2697 4         9 $p{ $item } = $_[ ++$i ];
2698             } elsif (UNIVERSAL::isa($item, 'HASH')) {
2699 1         5 $p{ $_ } = $item->{ $_ } for keys %$item;
2700             } elsif (UNIVERSAL::isa($item, 'ARRAY')) {
2701 1         2 for (my $j = 0; $j < @$item; $j += 2) {
2702 2         7 $p{ $item->[ $j ] } = $item->[ $j + 1 ];
2703             }
2704             }
2705             }
2706              
2707 1         6 return %p;
2708             }
2709              
2710             sub send_by_sendmail {
2711 0     0 1 0 my $self = shift;
2712 0         0 my $return;
2713 0 0 0     0 if ( @_ == 1 and !ref $_[0] ) {
2714             ### Use the given command...
2715 0         0 my $sendmailcmd = shift @_;
2716 0 0       0 Carp::croak "No sendmail command available" unless $sendmailcmd;
2717              
2718             ### Do it:
2719 0         0 local *SENDMAIL;
2720 0 0       0 open SENDMAIL, "|$sendmailcmd" or Carp::croak "open |$sendmailcmd: $!\n";
2721 0         0 $self->print( \*SENDMAIL );
2722 0         0 close SENDMAIL;
2723 0 0       0 $return = ( ( $? >> 8 ) ? undef: 1 );
2724             } else { ### Build the command...
2725 0         0 my %p = $self->_unfold_stupid_params(@_);
2726              
2727 0 0       0 $p{Sendmail} = $SENDMAIL unless defined $p{Sendmail};
2728              
2729             ### Start with the command and basic args:
2730 0 0       0 my @cmd = ( $p{Sendmail}, @{ $p{BaseArgs} || [ '-t', '-oi', '-oem' ] } );
  0         0  
2731              
2732             # SetSender default is true
2733 0 0       0 $p{SetSender} = 1 unless defined $p{SetSender};
2734              
2735             ### See if we are forcibly setting the sender:
2736 0   0     0 $p{SetSender} ||= defined( $p{FromSender} );
2737              
2738             ### Add the -f argument, unless we're explicitly told NOT to:
2739 0 0       0 if ( $p{SetSender} ) {
2740 0   0     0 my $from = $p{FromSender} || ( $self->get('From') )[0];
2741 0 0       0 if ($from) {
2742 0         0 my ($from_addr) = extract_only_addrs($from);
2743 0 0       0 push @cmd, "-f$from_addr" if $from_addr;
2744             }
2745             }
2746              
2747             ### Open the command in a taint-safe fashion:
2748 0         0 my $pid = open SENDMAIL, "|-";
2749 0 0       0 defined($pid) or die "open of pipe failed: $!\n";
2750 0 0       0 if ( !$pid ) { ### child
2751 0 0       0 exec(@cmd) or die "can't exec $p{Sendmail}: $!\n";
2752             ### NOTREACHED
2753             } else { ### parent
2754 0         0 $self->print( \*SENDMAIL );
2755 0 0       0 close SENDMAIL || die "error closing $p{Sendmail}: $! (exit $?)\n";
2756 0         0 $return = 1;
2757             }
2758             }
2759 0         0 return $self->{last_send_successful} = $return;
2760             }
2761              
2762             #------------------------------
2763              
2764             #pod =item send_by_smtp HOST, ARGS...
2765             #pod
2766             #pod =item send_by_smtp REF, HOST, ARGS
2767             #pod
2768             #pod I
2769             #pod Send message via SMTP, using Net::SMTP -- which will be required for this
2770             #pod feature.
2771             #pod
2772             #pod HOST is the name of SMTP server to connect to, or undef to have
2773             #pod L use the defaults in Libnet.cfg.
2774             #pod
2775             #pod ARGS are a list of key value pairs which may be selected from the list
2776             #pod below. Many of these are just passed through to specific
2777             #pod L commands and you should review that module for
2778             #pod details.
2779             #pod
2780             #pod Please see L
2781             #pod
2782             #pod =over 4
2783             #pod
2784             #pod =item Hello
2785             #pod
2786             #pod =item LocalAddr
2787             #pod
2788             #pod =item LocalPort
2789             #pod
2790             #pod =item Timeout
2791             #pod
2792             #pod =item Port
2793             #pod
2794             #pod =item ExactAddresses
2795             #pod
2796             #pod =item Debug
2797             #pod
2798             #pod See L for details.
2799             #pod
2800             #pod =item Size
2801             #pod
2802             #pod =item Return
2803             #pod
2804             #pod =item Bits
2805             #pod
2806             #pod =item Transaction
2807             #pod
2808             #pod =item Envelope
2809             #pod
2810             #pod See L for details.
2811             #pod
2812             #pod =item SkipBad
2813             #pod
2814             #pod If true doesn't throw an error when multiple email addresses are provided
2815             #pod and some are not valid. See L
2816             #pod for details.
2817             #pod
2818             #pod =item AuthUser
2819             #pod
2820             #pod Authenticate with L using this username.
2821             #pod
2822             #pod =item AuthPass
2823             #pod
2824             #pod Authenticate with L using this password.
2825             #pod
2826             #pod =item NoAuth
2827             #pod
2828             #pod Normally if AuthUser and AuthPass are defined MIME::Lite will attempt to
2829             #pod use them with the L command to
2830             #pod authenticate the connection, however if this value is true then no
2831             #pod authentication occurs.
2832             #pod
2833             #pod =item To
2834             #pod
2835             #pod Sets the addresses to send to. Can be a string or a reference to an
2836             #pod array of strings. Normally this is extracted from the To: (and Cc: and
2837             #pod Bcc: fields if $AUTO_CC is true).
2838             #pod
2839             #pod This value overrides that.
2840             #pod
2841             #pod =item From
2842             #pod
2843             #pod Sets the email address to send from. Normally this value is extracted
2844             #pod from the Return-Path: or From: field of the mail itself (in that order).
2845             #pod
2846             #pod This value overrides that.
2847             #pod
2848             #pod =back
2849             #pod
2850             #pod I
2851             #pod True on success, croaks with an error message on failure.
2852             #pod
2853             #pod After sending, the method last_send_successful() can be used to determine
2854             #pod if the send was successful or not.
2855             #pod
2856             #pod =cut
2857              
2858              
2859             # Derived from work by Andrew McRae. Version 0.2 anm 09Sep97
2860             # Copyright 1997 Optimation New Zealand Ltd.
2861             # May be modified/redistributed under the same terms as Perl.
2862              
2863             # external opts
2864             my @_mail_opts = qw( Size Return Bits Transaction Envelope );
2865             my @_recip_opts = qw( SkipBad Notify );
2866             my @_net_smtp_opts = qw( Hello LocalAddr LocalPort Timeout
2867             AuthUser AuthPass SSL
2868             Port ExactAddresses Debug );
2869             # internal: qw( NoAuth AuthUser AuthPass To From Host);
2870              
2871             sub __opts {
2872 0     0   0 my $args=shift;
2873 0 0       0 return map { exists $args->{$_} ? ( $_ => $args->{$_} ) : () } @_;
  0         0  
2874             }
2875              
2876             sub send_by_smtp {
2877 0     0 1 0 require Net::SMTP;
2878 0         0 my ($self,$hostname,%args) = @_;
2879             # We may need the "From:" and "To:" headers to pass to the
2880             # SMTP mailer also.
2881 0         0 $self->{last_send_successful}=0;
2882              
2883 0         0 my @hdr_to = extract_only_addrs( scalar $self->get('To') );
2884 0 0       0 if ($AUTO_CC) {
2885 0         0 foreach my $field (qw(Cc Bcc)) {
2886 0         0 push @hdr_to, extract_only_addrs($_) for $self->get($field);
2887             }
2888             }
2889 0 0       0 Carp::croak "send_by_smtp: nobody to send to for host '$hostname'?!\n"
2890             unless @hdr_to;
2891              
2892 0   0     0 $args{To} ||= \@hdr_to;
2893 0   0     0 $args{From} ||= extract_only_addrs( scalar $self->get('Return-Path') );
2894 0   0     0 $args{From} ||= extract_only_addrs( scalar $self->get('From') ) ;
2895              
2896             # Create SMTP client.
2897             # MIME::Lite::SMTP is just a wrapper giving a print method
2898             # to the SMTP object.
2899              
2900 0         0 my %opts = __opts(\%args, @_net_smtp_opts);
2901 0 0       0 my $smtp = MIME::Lite::SMTP->new( $hostname, %opts )
2902             or Carp::croak "SMTP Failed to connect to mail server: $!\n";
2903              
2904             # Possibly authenticate
2905 0 0 0     0 if ( defined $args{AuthUser} and defined $args{AuthPass}
      0        
2906             and !$args{NoAuth} )
2907             {
2908 0 0       0 if ($smtp->supports('AUTH',500,["Command unknown: 'AUTH'"])) {
2909             $smtp->auth( $args{AuthUser}, $args{AuthPass} )
2910 0 0       0 or die "SMTP auth() command failed: $!\n"
2911             . $smtp->message . "\n";
2912             } else {
2913 0         0 die "SMTP auth() command not supported on $hostname\n";
2914             }
2915             }
2916              
2917             # Send the mail command
2918 0         0 %opts = __opts( \%args, @_mail_opts);
2919 0 0       0 $smtp->mail( $args{From}, %opts ? \%opts : () )
    0          
2920             or die "SMTP mail() command failed: $!\n"
2921             . $smtp->message . "\n";
2922              
2923             # Send the recipients command
2924 0         0 %opts = __opts( \%args, @_recip_opts);
2925 0 0       0 $smtp->recipient( @{ $args{To} }, %opts ? \%opts : () )
  0 0       0  
2926             or die "SMTP recipient() command failed: $!\n"
2927             . $smtp->message . "\n";
2928              
2929             # Send the data
2930 0 0       0 $smtp->data()
2931             or die "SMTP data() command failed: $!\n"
2932             . $smtp->message . "\n";
2933 0         0 $self->print_for_smtp($smtp);
2934              
2935             # Finish the mail
2936 0 0       0 $smtp->dataend()
2937             or Carp::croak "Net::CMD (Net::SMTP) DATAEND command failed.\n"
2938             . "Last server message was:"
2939             . $smtp->message
2940             . "This probably represents a problem with newline encoding ";
2941              
2942             # terminate the session
2943 0         0 $smtp->quit;
2944              
2945 0         0 return $self->{last_send_successful} = 1;
2946             }
2947              
2948             #pod =item send_by_testfile FILENAME
2949             #pod
2950             #pod I
2951             #pod Print message to a file (namely FILENAME), which will default to
2952             #pod mailer.testfile
2953             #pod If file exists, message will be appended.
2954             #pod
2955             #pod =cut
2956              
2957             sub send_by_testfile {
2958 0     0 1 0 my $self = shift;
2959              
2960             ### Use the default filename...
2961 0         0 my $filename = 'mailer.testfile';
2962              
2963 0 0 0     0 if ( @_ == 1 and !ref $_[0] ) {
2964             ### Use the given filename if given...
2965 0         0 $filename = shift @_;
2966 0 0       0 Carp::croak "no filename given to send_by_testfile" unless $filename;
2967             }
2968              
2969             ### Do it:
2970 0         0 local *FILE;
2971 0 0       0 open FILE, ">> $filename" or Carp::croak "open $filename: $!\n";
2972 0         0 $self->print( \*FILE );
2973 0         0 close FILE;
2974 0 0       0 my $return = ( ( $? >> 8 ) ? undef: 1 );
2975              
2976 0         0 return $self->{last_send_successful} = $return;
2977             }
2978              
2979             #pod =item last_send_successful
2980             #pod
2981             #pod This method will return TRUE if the last send() or send_by_XXX() method call was
2982             #pod successful. It will return defined but false if it was not successful, and undefined
2983             #pod if the object had not been used to send yet.
2984             #pod
2985             #pod =cut
2986              
2987              
2988             sub last_send_successful {
2989 0     0 1 0 my $self = shift;
2990 0         0 return $self->{last_send_successful};
2991             }
2992              
2993              
2994             ### Provided by Andrew McRae. Version 0.2 anm 09Sep97
2995             ### Copyright 1997 Optimation New Zealand Ltd.
2996             ### May be modified/redistributed under the same terms as Perl.
2997             ### Aditional changes by Yves.
2998             ### Until 3.01_03 this was send_by_smtp()
2999             sub send_by_smtp_simple {
3000 0     0 0 0 my ( $self, @args ) = @_;
3001 0         0 $self->{last_send_successful} = 0;
3002             ### We need the "From:" and "To:" headers to pass to the SMTP mailer:
3003 0         0 my $hdr = $self->fields();
3004              
3005 0         0 my $from_header = $self->get('From');
3006 0         0 my ($from) = extract_only_addrs($from_header);
3007              
3008 0 0       0 warn "M::L>>> $from_header => $from" if $MIME::Lite::DEBUG;
3009              
3010              
3011 0         0 my $to = $self->get('To');
3012              
3013             ### Sanity check:
3014 0 0       0 defined($to)
3015             or Carp::croak "send_by_smtp: missing 'To:' address\n";
3016              
3017             ### Get the destinations as a simple array of addresses:
3018 0         0 my @to_all = extract_only_addrs($to);
3019 0 0       0 if ($AUTO_CC) {
3020 0         0 foreach my $field (qw(Cc Bcc)) {
3021 0         0 my $value = $self->get($field);
3022 0 0       0 push @to_all, extract_only_addrs($value)
3023             if defined($value);
3024             }
3025             }
3026              
3027             ### Create SMTP client:
3028 0         0 require Net::SMTP;
3029 0 0       0 my $smtp = MIME::Lite::SMTP->new(@args)
3030             or Carp::croak("Failed to connect to mail server: $!\n");
3031 0 0       0 $smtp->mail($from)
3032             or Carp::croak( "SMTP MAIL command failed: $!\n" . $smtp->message . "\n" );
3033 0 0       0 $smtp->to(@to_all)
3034             or Carp::croak( "SMTP RCPT command failed: $!\n" . $smtp->message . "\n" );
3035 0 0       0 $smtp->data()
3036             or Carp::croak( "SMTP DATA command failed: $!\n" . $smtp->message . "\n" );
3037              
3038             ### MIME::Lite can print() to anything with a print() method:
3039 0         0 $self->print_for_smtp($smtp);
3040              
3041 0 0       0 $smtp->dataend()
3042             or Carp::croak( "Net::CMD (Net::SMTP) DATAEND command failed.\n"
3043             . "Last server message was:"
3044             . $smtp->message
3045             . "This probably represents a problem with newline encoding " );
3046 0         0 $smtp->quit;
3047 0         0 $self->{last_send_successful} = 1;
3048 0         0 1;
3049             }
3050              
3051             #------------------------------
3052             #
3053             # send_by_sub [\&SUBREF, [ARGS...]]
3054             #
3055             # I
3056             # Send the message via an anonymous subroutine.
3057             #
3058             sub send_by_sub {
3059 0     0 0 0 my ( $self, $subref, @args ) = @_;
3060 0         0 $self->{last_send_successful} = &$subref( $self, @args );
3061              
3062             }
3063              
3064             #------------------------------
3065              
3066             #pod =item sendmail COMMAND...
3067             #pod
3068             #pod I
3069             #pod Declare the sender to be "sendmail", and set up the "sendmail" command.
3070             #pod I
3071             #pod
3072             #pod =cut
3073              
3074              
3075             sub sendmail {
3076 0     0 1 0 my $self = shift;
3077 0         0 $self->send( 'sendmail', join( ' ', @_ ) );
3078             }
3079              
3080             #pod =back
3081             #pod
3082             #pod =cut
3083              
3084              
3085             #==============================
3086             #==============================
3087              
3088             #pod =head2 Miscellaneous
3089             #pod
3090             #pod =over 4
3091             #pod
3092             #pod =cut
3093              
3094              
3095             #------------------------------
3096              
3097             #pod =item quiet ONOFF
3098             #pod
3099             #pod I
3100             #pod Suppress/unsuppress all warnings coming from this module.
3101             #pod
3102             #pod MIME::Lite->quiet(1); ### I know what I'm doing
3103             #pod
3104             #pod I recommend that you include that comment as well. And while
3105             #pod you type it, say it out loud: if it doesn't feel right, then maybe
3106             #pod you should reconsider the whole line. C<;-)>
3107             #pod
3108             #pod =cut
3109              
3110              
3111             sub quiet {
3112 0     0 1 0 my $class = shift;
3113 0 0       0 $QUIET = shift if @_;
3114 0         0 $QUIET;
3115             }
3116              
3117             #pod =back
3118             #pod
3119             #pod =cut
3120              
3121              
3122             #============================================================
3123              
3124             package MIME::Lite::SMTP 3.038;
3125              
3126             #============================================================
3127             # This class just adds a print() method to Net::SMTP.
3128             # Notice that we don't use/require it until it's needed!
3129              
3130 9     9   89 use strict;
  9         24  
  9         435  
3131 9     9   80 use vars qw( @ISA );
  9         17  
  9         5368  
3132             @ISA = qw(Net::SMTP);
3133              
3134             # some of the below is borrowed from Data::Dumper
3135             my %esc = ( "\a" => "\\a",
3136             "\b" => "\\b",
3137             "\t" => "\\t",
3138             "\n" => "\\n",
3139             "\f" => "\\f",
3140             "\r" => "\\r",
3141             "\e" => "\\e",
3142             );
3143              
3144             sub _hexify {
3145 0     0   0 local $_ = shift;
3146 0         0 my @split = m/(.{1,16})/gs;
3147 0         0 foreach my $split (@split) {
3148 0         0 ( my $txt = $split ) =~ s/([\a\b\t\n\f\r\e])/$esc{$1}/sg;
3149 0         0 $split =~ s/(.)/sprintf("%02X ",ord($1))/sge;
  0         0  
3150 0         0 print STDERR "M::L >>> $split : $txt\n";
3151             }
3152             }
3153              
3154             sub print {
3155 0     0   0 my $smtp = shift;
3156 0 0       0 $MIME::Lite::DEBUG and _hexify( join( "", @_ ) );
3157 0 0       0 $smtp->datasend(@_)
3158             or Carp::croak( "Net::CMD (Net::SMTP) DATASEND command failed.\n"
3159             . "Last server message was:"
3160             . $smtp->message
3161             . "This probably represents a problem with newline encoding " );
3162             }
3163              
3164              
3165             #============================================================
3166              
3167             package MIME::Lite::IO_Handle 3.038;
3168              
3169             #============================================================
3170              
3171             ### Wrap a non-object filehandle inside a blessed, printable interface:
3172             ### Does nothing if the given $fh is already a blessed object.
3173             sub wrap {
3174 22     22   33 my ( $class, $fh ) = @_;
3175 9     9   94 no strict 'refs';
  9         16  
  9         7655  
3176              
3177             ### Get default, if necessary:
3178 22 50       58 $fh or $fh = select; ### no filehandle means selected one
3179 22 50       41 ref($fh) or $fh = \*$fh; ### scalar becomes a globref
3180              
3181             ### Stop right away if already a printable object:
3182 22 50 33     102 return $fh if ( ref($fh) and ( ref($fh) ne 'GLOB' ) );
3183              
3184             ### Get and return a printable interface:
3185 0         0 bless \$fh, $class; ### wrap it in a printable interface
3186             }
3187              
3188             ### Print:
3189             sub print {
3190 0     0   0 my $self = shift;
3191 0         0 print {$$self} @_;
  0         0  
3192             }
3193              
3194              
3195             #============================================================
3196              
3197             package MIME::Lite::IO_Scalar 3.038;
3198              
3199             #============================================================
3200              
3201             ### Wrap a scalar inside a blessed, printable interface:
3202             sub wrap {
3203 6     6   15 my ( $class, $scalarref ) = @_;
3204 6 50       16 defined($scalarref) or $scalarref = \"";
3205 6         16 bless $scalarref, $class;
3206             }
3207              
3208             ### Print:
3209             sub print {
3210 29     29   41 ${$_[0]} .= join( '', @_[1..$#_] );
  29         99  
3211 29         55 1;
3212             }
3213              
3214              
3215             #============================================================
3216              
3217             package MIME::Lite::IO_ScalarArray 3.038;
3218              
3219             #============================================================
3220              
3221             ### Wrap an array inside a blessed, printable interface:
3222             sub wrap {
3223 0     0     my ( $class, $arrayref ) = @_;
3224 0 0         defined($arrayref) or $arrayref = [];
3225 0           bless $arrayref, $class;
3226             }
3227              
3228             ### Print:
3229             sub print {
3230 0     0     my $self = shift;
3231 0           push @$self, @_;
3232 0           1;
3233             }
3234              
3235             1;
3236              
3237             =pod
3238              
3239             =encoding UTF-8
3240              
3241             =head1 NAME
3242              
3243             MIME::Lite - low-calorie MIME generator
3244              
3245             =head1 VERSION
3246              
3247             version 3.038
3248              
3249             =head1 WAIT!
3250              
3251             MIME::Lite is not recommended by its current maintainer. There are a number of
3252             alternatives, like Email::MIME or MIME::Entity and Email::Sender, which you
3253             should probably use instead. MIME::Lite continues to accrue weird bug reports,
3254             and it is not receiving a large amount of refactoring due to the availability
3255             of better alternatives. Please consider using something else.
3256              
3257             =head1 SYNOPSIS
3258              
3259             Create and send using the default send method for your OS a single-part message:
3260              
3261             use MIME::Lite;
3262             ### Create a new single-part message, to send a GIF file:
3263             $msg = MIME::Lite->new(
3264             From => 'me@myhost.com',
3265             To => 'you@yourhost.com',
3266             Cc => 'some@other.com, some@more.com',
3267             Subject => 'Helloooooo, nurse!',
3268             Type => 'image/gif',
3269             Encoding => 'base64',
3270             Path => 'hellonurse.gif'
3271             );
3272             $msg->send; # send via default
3273              
3274             Create a multipart message (i.e., one with attachments) and send it via SMTP
3275              
3276             ### Create a new multipart message:
3277             $msg = MIME::Lite->new(
3278             From => 'me@myhost.com',
3279             To => 'you@yourhost.com',
3280             Cc => 'some@other.com, some@more.com',
3281             Subject => 'A message with 2 parts...',
3282             Type => 'multipart/mixed'
3283             );
3284              
3285             ### Add parts (each "attach" has same arguments as "new"):
3286             $msg->attach(
3287             Type => 'TEXT',
3288             Data => "Here's the GIF file you wanted"
3289             );
3290             $msg->attach(
3291             Type => 'image/gif',
3292             Path => 'aaa000123.gif',
3293             Filename => 'logo.gif',
3294             Disposition => 'attachment'
3295             );
3296             ### use Net::SMTP to do the sending
3297             $msg->send('smtp','some.host', Debug=>1 );
3298              
3299             Output a message:
3300              
3301             ### Format as a string:
3302             $str = $msg->as_string;
3303              
3304             ### Print to a filehandle (say, a "sendmail" stream):
3305             $msg->print(\*SENDMAIL);
3306              
3307             Send a message:
3308              
3309             ### Send in the "best" way (the default is to use "sendmail"):
3310             $msg->send;
3311             ### Send a specific way:
3312             $msg->send('type',@args);
3313              
3314             Specify default send method:
3315              
3316             MIME::Lite->send('smtp','some.host',Debug=>0);
3317              
3318             with authentication
3319              
3320             MIME::Lite->send('smtp','some.host', AuthUser=>$user, AuthPass=>$pass);
3321              
3322             using SSL
3323              
3324             MIME::Lite->send('smtp','some.host', SSL => 1, Port => 465 );
3325              
3326             =head1 DESCRIPTION
3327              
3328             In the never-ending quest for great taste with fewer calories,
3329             we proudly present: I.
3330              
3331             MIME::Lite is intended as a simple, standalone module for generating
3332             (not parsing!) MIME messages... specifically, it allows you to
3333             output a simple, decent single- or multi-part message with text or binary
3334             attachments. It does not require that you have the Mail:: or MIME::
3335             modules installed, but will work with them if they are.
3336              
3337             You can specify each message part as either the literal data itself (in
3338             a scalar or array), or as a string which can be given to open() to get
3339             a readable filehandle (e.g., "
3340              
3341             You don't need to worry about encoding your message data:
3342             this module will do that for you. It handles the 5 standard MIME encodings.
3343              
3344             =head1 PERL VERSION
3345              
3346             This library should run on perls released even a long time ago. It should
3347             work on any version of perl released in the last five years.
3348              
3349             Although it may work on older versions of perl, no guarantee is made that the
3350             minimum required version will not be increased. The version may be increased
3351             for any reason, and there is no promise that patches will be accepted to
3352             lower the minimum required perl.
3353              
3354             =head1 EXAMPLES
3355              
3356             =head2 Create a simple message containing just text
3357              
3358             $msg = MIME::Lite->new(
3359             From =>'me@myhost.com',
3360             To =>'you@yourhost.com',
3361             Cc =>'some@other.com, some@more.com',
3362             Subject =>'Helloooooo, nurse!',
3363             Data =>"How's it goin', eh?"
3364             );
3365              
3366             =head2 Create a simple message containing just an image
3367              
3368             $msg = MIME::Lite->new(
3369             From =>'me@myhost.com',
3370             To =>'you@yourhost.com',
3371             Cc =>'some@other.com, some@more.com',
3372             Subject =>'Helloooooo, nurse!',
3373             Type =>'image/gif',
3374             Encoding =>'base64',
3375             Path =>'hellonurse.gif'
3376             );
3377              
3378             =head2 Create a multipart message
3379              
3380             ### Create the multipart "container":
3381             $msg = MIME::Lite->new(
3382             From =>'me@myhost.com',
3383             To =>'you@yourhost.com',
3384             Cc =>'some@other.com, some@more.com',
3385             Subject =>'A message with 2 parts...',
3386             Type =>'multipart/mixed'
3387             );
3388              
3389             ### Add the text message part:
3390             ### (Note that "attach" has same arguments as "new"):
3391             $msg->attach(
3392             Type =>'TEXT',
3393             Data =>"Here's the GIF file you wanted"
3394             );
3395              
3396             ### Add the image part:
3397             $msg->attach(
3398             Type =>'image/gif',
3399             Path =>'aaa000123.gif',
3400             Filename =>'logo.gif',
3401             Disposition => 'attachment'
3402             );
3403              
3404             =head2 Attach a GIF to a text message
3405              
3406             This will create a multipart message exactly as above, but using the
3407             "attach to singlepart" hack:
3408              
3409             ### Start with a simple text message:
3410             $msg = MIME::Lite->new(
3411             From =>'me@myhost.com',
3412             To =>'you@yourhost.com',
3413             Cc =>'some@other.com, some@more.com',
3414             Subject =>'A message with 2 parts...',
3415             Type =>'TEXT',
3416             Data =>"Here's the GIF file you wanted"
3417             );
3418              
3419             ### Attach a part... the make the message a multipart automatically:
3420             $msg->attach(
3421             Type =>'image/gif',
3422             Path =>'aaa000123.gif',
3423             Filename =>'logo.gif'
3424             );
3425              
3426             =head2 Attach a pre-prepared part to a message
3427              
3428             ### Create a standalone part:
3429             $part = MIME::Lite->new(
3430             Top => 0,
3431             Type =>'text/html',
3432             Data =>'

Hello

',
3433             );
3434             $part->attr('content-type.charset' => 'UTF-8');
3435             $part->add('X-Comment' => 'A message for you');
3436              
3437             ### Attach it to any message:
3438             $msg->attach($part);
3439              
3440             =head2 Print a message to a filehandle
3441              
3442             ### Write it to a filehandle:
3443             $msg->print(\*STDOUT);
3444              
3445             ### Write just the header:
3446             $msg->print_header(\*STDOUT);
3447              
3448             ### Write just the encoded body:
3449             $msg->print_body(\*STDOUT);
3450              
3451             =head2 Print a message into a string
3452              
3453             ### Get entire message as a string:
3454             $str = $msg->as_string;
3455              
3456             ### Get just the header:
3457             $str = $msg->header_as_string;
3458              
3459             ### Get just the encoded body:
3460             $str = $msg->body_as_string;
3461              
3462             =head2 Send a message
3463              
3464             ### Send in the "best" way (the default is to use "sendmail"):
3465             $msg->send;
3466              
3467             =head2 Send an HTML document... with images included!
3468              
3469             $msg = MIME::Lite->new(
3470             To =>'you@yourhost.com',
3471             Subject =>'HTML with in-line images!',
3472             Type =>'multipart/related'
3473             );
3474             $msg->attach(
3475             Type => 'text/html',
3476             Data => qq{
3477            
3478             Here's my image:
3479            
3480            
3481             },
3482             );
3483             $msg->attach(
3484             Type => 'image/gif',
3485             Id => 'myimage.gif',
3486             Path => '/path/to/somefile.gif',
3487             );
3488             $msg->send();
3489              
3490             =head2 Change how messages are sent
3491              
3492             ### Do something like this in your 'main':
3493             if ($I_DONT_HAVE_SENDMAIL) {
3494             MIME::Lite->send('smtp', $host, Timeout=>60,
3495             AuthUser=>$user, AuthPass=>$pass);
3496             }
3497              
3498             ### Now this will do the right thing:
3499             $msg->send; ### will now use Net::SMTP as shown above
3500              
3501             =head1 PUBLIC INTERFACE
3502              
3503             =head2 Global configuration
3504              
3505             To alter the way the entire module behaves, you have the following
3506             methods/options:
3507              
3508             =over 4
3509              
3510             =item MIME::Lite->field_order()
3511              
3512             When used as a L, this changes the default
3513             order in which headers are output for I messages.
3514             However, please consider using the instance method variant instead,
3515             so you won't stomp on other message senders in the same application.
3516              
3517             =item MIME::Lite->quiet()
3518              
3519             This L can be used to suppress/unsuppress
3520             all warnings coming from this module.
3521              
3522             =item MIME::Lite->send()
3523              
3524             When used as a L, this can be used to specify
3525             a different default mechanism for sending message.
3526             The initial default is:
3527              
3528             MIME::Lite->send("sendmail", "/usr/lib/sendmail -t -oi -oem");
3529              
3530             However, you should consider the similar but smarter and taint-safe variant:
3531              
3532             MIME::Lite->send("sendmail");
3533              
3534             Or, for non-Unix users:
3535              
3536             MIME::Lite->send("smtp");
3537              
3538             =item $MIME::Lite::AUTO_CC
3539              
3540             If true, automatically send to the Cc/Bcc addresses for send_by_smtp().
3541             Default is B.
3542              
3543             =item $MIME::Lite::AUTO_CONTENT_TYPE
3544              
3545             If true, try to automatically choose the content type from the file name
3546             in C/C. In other words, setting this true changes the
3547             default C from C<"TEXT"> to C<"AUTO">.
3548              
3549             Default is B, since we must maintain backwards-compatibility
3550             with prior behavior. B consider keeping it false,
3551             and just using Type 'AUTO' when you build() or attach().
3552              
3553             =item $MIME::Lite::AUTO_ENCODE
3554              
3555             If true, automatically choose the encoding from the content type.
3556             Default is B.
3557              
3558             =item $MIME::Lite::AUTO_VERIFY
3559              
3560             If true, check paths to attachments right before printing, raising an exception
3561             if any path is unreadable.
3562             Default is B.
3563              
3564             =item $MIME::Lite::PARANOID
3565              
3566             If true, we won't attempt to use MIME::Base64, MIME::QuotedPrint,
3567             or MIME::Types, even if they're available.
3568             Default is B. Please consider keeping it false,
3569             and trusting these other packages to do the right thing.
3570              
3571             =back
3572              
3573             =head2 Construction
3574              
3575             =over 4
3576              
3577             =item new [PARAMHASH]
3578              
3579             I
3580             Create a new message object.
3581              
3582             If any arguments are given, they are passed into C; otherwise,
3583             just the empty object is created.
3584              
3585             =item attach PART
3586              
3587             =item attach PARAMHASH...
3588              
3589             I
3590             Add a new part to this message, and return the new part.
3591              
3592             If you supply a single PART argument, it will be regarded
3593             as a MIME::Lite object to be attached. Otherwise, this
3594             method assumes that you are giving in the pairs of a PARAMHASH
3595             which will be sent into C to create the new part.
3596              
3597             One of the possibly-quite-useful hacks thrown into this is the
3598             "attach-to-singlepart" hack: if you attempt to attach a part (let's
3599             call it "part 1") to a message that doesn't have a content-type
3600             of "multipart" or "message", the following happens:
3601              
3602             =over 4
3603              
3604             =item *
3605              
3606             A new part (call it "part 0") is made.
3607              
3608             =item *
3609              
3610             The MIME attributes and data (but I the other headers)
3611             are cut from the "self" message, and pasted into "part 0".
3612              
3613             =item *
3614              
3615             The "self" is turned into a "multipart/mixed" message.
3616              
3617             =item *
3618              
3619             The new "part 0" is added to the "self", and I "part 1" is added.
3620              
3621             =back
3622              
3623             One of the nice side-effects is that you can create a text message
3624             and then add zero or more attachments to it, much in the same way
3625             that a user agent like Netscape allows you to do.
3626              
3627             =item build [PARAMHASH]
3628              
3629             I
3630             Create (or initialize) a MIME message object.
3631             Normally, you'll use the following keys in PARAMHASH:
3632              
3633             * Data, FH, or Path (either one of these, or none if multipart)
3634             * Type (e.g., "image/jpeg")
3635             * From, To, and Subject (if this is the "top level" of a message)
3636              
3637             The PARAMHASH can contain the following keys:
3638              
3639             =over 4
3640              
3641             =item (fieldname)
3642              
3643             Any field you want placed in the message header, taken from the
3644             standard list of header fields (you don't need to worry about case):
3645              
3646             Approved Encrypted Received Sender
3647             Bcc From References Subject
3648             Cc Keywords Reply-To To
3649             Comments Message-ID Resent-* X-*
3650             Content-* MIME-Version Return-Path
3651             Date Organization
3652              
3653             To give experienced users some veto power, these fields will be set
3654             I the ones I set... so be careful: I
3655             (like C) unless you know what you're doing!
3656              
3657             To specify a fieldname that's I in the above list, even one that's
3658             identical to an option below, just give it with a trailing C<":">,
3659             like C<"My-field:">. When in doubt, that I signals a mail
3660             field (and it sort of looks like one too).
3661              
3662             =item Data
3663              
3664             I
3665             The actual message data. This may be a scalar or a ref to an array of
3666             strings; if the latter, the message consists of a simple concatenation
3667             of all the strings in the array.
3668              
3669             =item Datestamp
3670              
3671             I
3672             If given true (or omitted), we force the creation of a C field
3673             stamped with the current date/time if this is a top-level message.
3674             You may want this if using L.
3675             If you don't want this to be done, either provide your own Date
3676             or explicitly set this to false.
3677              
3678             =item Disposition
3679              
3680             I
3681             The content disposition, C<"inline"> or C<"attachment">.
3682             The default is C<"inline">.
3683              
3684             =item Encoding
3685              
3686             I
3687             The content transfer encoding that should be used to encode your data:
3688              
3689             Use encoding: | If your message contains:
3690             ------------------------------------------------------------
3691             7bit | Only 7-bit text, all lines <1000 characters
3692             8bit | 8-bit text, all lines <1000 characters
3693             quoted-printable | 8-bit text or long lines (more reliable than "8bit")
3694             base64 | Largely non-textual data: a GIF, a tar file, etc.
3695              
3696             The default is taken from the Type; generally it is "binary" (no
3697             encoding) for text/*, message/*, and multipart/*, and "base64" for
3698             everything else. A value of C<"binary"> is generally I suitable
3699             for sending anything but ASCII text files with lines under 1000
3700             characters, so consider using one of the other values instead.
3701              
3702             In the case of "7bit"/"8bit", long lines are automatically chopped to
3703             legal length; in the case of "7bit", all 8-bit characters are
3704             automatically I. This may not be what you want, so pick your
3705             encoding well! For more info, see L<"A MIME PRIMER">.
3706              
3707             =item FH
3708              
3709             I
3710             Filehandle containing the data, opened for reading.
3711             See "ReadNow" also.
3712              
3713             =item Filename
3714              
3715             I
3716             The name of the attachment. You can use this to supply a
3717             recommended filename for the end-user who is saving the attachment
3718             to disk. You only need this if the filename at the end of the
3719             "Path" is inadequate, or if you're using "Data" instead of "Path".
3720             You should I put path information in here (e.g., no "/"
3721             or "\" or ":" characters should be used).
3722              
3723             =item Id
3724              
3725             I
3726             Same as setting "content-id".
3727              
3728             =item Length
3729              
3730             I
3731             Set the content length explicitly. Normally, this header is automatically
3732             computed, but only under certain circumstances (see L<"Benign limitations">).
3733              
3734             =item Path
3735              
3736             I
3737             Path to a file containing the data... actually, it can be any open()able
3738             expression. If it looks like a path, the last element will automatically
3739             be treated as the filename.
3740             See "ReadNow" also.
3741              
3742             =item ReadNow
3743              
3744             I
3745             If true, will open the path and slurp the contents into core now.
3746             This is useful if the Path points to a command and you don't want
3747             to run the command over and over if outputting the message several
3748             times. B raised if the open fails.
3749              
3750             =item Top
3751              
3752             I
3753             If defined, indicates whether or not this is a "top-level" MIME message.
3754             The parts of a multipart message are I top-level.
3755             Default is true.
3756              
3757             =item Type
3758              
3759             I
3760             The MIME content type, or one of these special values (case-sensitive):
3761              
3762             "TEXT" means "text/plain"
3763             "BINARY" means "application/octet-stream"
3764             "AUTO" means attempt to guess from the filename, falling back
3765             to 'application/octet-stream'. This is good if you have
3766             MIME::Types on your system and you have no idea what
3767             file might be used for the attachment.
3768              
3769             The default is C<"TEXT">, but it will be C<"AUTO"> if you set
3770             $AUTO_CONTENT_TYPE to true (sorry, but you have to enable
3771             it explicitly, since we don't want to break code which depends
3772             on the old behavior).
3773              
3774             =back
3775              
3776             A picture being worth 1000 words (which
3777             is of course 2000 bytes, so it's probably more of an "icon" than a "picture",
3778             but I digress...), here are some examples:
3779              
3780             $msg = MIME::Lite->build(
3781             From => 'yelling@inter.com',
3782             To => 'stocking@fish.net',
3783             Subject => "Hi there!",
3784             Type => 'TEXT',
3785             Encoding => '7bit',
3786             Data => "Just a quick note to say hi!"
3787             );
3788              
3789             $msg = MIME::Lite->build(
3790             From => 'dorothy@emerald-city.oz',
3791             To => 'gesundheit@edu.edu.edu',
3792             Subject => "A gif for U"
3793             Type => 'image/gif',
3794             Path => "/home/httpd/logo.gif"
3795             );
3796              
3797             $msg = MIME::Lite->build(
3798             From => 'laughing@all.of.us',
3799             To => 'scarlett@fiddle.dee.de',
3800             Subject => "A gzipp'ed tar file",
3801             Type => 'x-gzip',
3802             Path => "gzip < /usr/inc/somefile.tar |",
3803             ReadNow => 1,
3804             Filename => "somefile.tgz"
3805             );
3806              
3807             To show you what's really going on, that last example could also
3808             have been written:
3809              
3810             $msg = new MIME::Lite;
3811             $msg->build(
3812             Type => 'x-gzip',
3813             Path => "gzip < /usr/inc/somefile.tar |",
3814             ReadNow => 1,
3815             Filename => "somefile.tgz"
3816             );
3817             $msg->add(From => "laughing@all.of.us");
3818             $msg->add(To => "scarlett@fiddle.dee.de");
3819             $msg->add(Subject => "A gzipp'ed tar file");
3820              
3821             =back
3822              
3823             =head2 Setting/getting headers and attributes
3824              
3825             =over 4
3826              
3827             =item add TAG,VALUE
3828              
3829             I
3830             Add field TAG with the given VALUE to the end of the header.
3831             The TAG will be converted to all-lowercase, and the VALUE
3832             will be made "safe" (returns will be given a trailing space).
3833              
3834             B any MIME fields you "add" will override any MIME
3835             attributes I have when it comes time to output those fields.
3836             Normally, you will use this method to add I fields:
3837              
3838             $msg->add("Subject" => "Hi there!");
3839              
3840             Giving VALUE as an arrayref will cause all those values to be added.
3841             This is only useful for special multiple-valued fields like "Received":
3842              
3843             $msg->add("Received" => ["here", "there", "everywhere"]
3844              
3845             Giving VALUE as the empty string adds an invisible placeholder
3846             to the header, which can be used to suppress the output of
3847             the "Content-*" fields or the special "MIME-Version" field.
3848             When suppressing fields, you should use replace() instead of add():
3849              
3850             $msg->replace("Content-disposition" => "");
3851              
3852             I add() is probably going to be more efficient than C,
3853             so you're better off using it for most applications if you are
3854             certain that you don't need to delete() the field first.
3855              
3856             I the name comes from Mail::Header.
3857              
3858             =item attr ATTR,[VALUE]
3859              
3860             I
3861             Set MIME attribute ATTR to the string VALUE.
3862             ATTR is converted to all-lowercase.
3863             This method is normally used to set/get MIME attributes:
3864              
3865             $msg->attr("content-type" => "text/html");
3866             $msg->attr("content-type.charset" => "US-ASCII");
3867             $msg->attr("content-type.name" => "homepage.html");
3868              
3869             This would cause the final output to look something like this:
3870              
3871             Content-type: text/html; charset=US-ASCII; name="homepage.html"
3872              
3873             Note that the special empty sub-field tag indicates the anonymous
3874             first sub-field.
3875              
3876             Giving VALUE as undefined will cause the contents of the named
3877             subfield to be deleted.
3878              
3879             Supplying no VALUE argument just returns the attribute's value:
3880              
3881             $type = $msg->attr("content-type"); ### returns "text/html"
3882             $name = $msg->attr("content-type.name"); ### returns "homepage.html"
3883              
3884             =item delete TAG
3885              
3886             I
3887             Delete field TAG with the given VALUE to the end of the header.
3888             The TAG will be converted to all-lowercase.
3889              
3890             $msg->delete("Subject");
3891              
3892             I the name comes from Mail::Header.
3893              
3894             =item field_order FIELD,...FIELD
3895              
3896             I
3897             Change the order in which header fields are output for this object:
3898              
3899             $msg->field_order('from', 'to', 'content-type', 'subject');
3900              
3901             When used as a class method, changes the default settings for
3902             all objects:
3903              
3904             MIME::Lite->field_order('from', 'to', 'content-type', 'subject');
3905              
3906             Case does not matter: all field names will be coerced to lowercase.
3907             In either case, supply the empty array to restore the default ordering.
3908              
3909             =item fields
3910              
3911             I
3912             Return the full header for the object, as a ref to an array
3913             of C<[TAG, VALUE]> pairs, where each TAG is all-lowercase.
3914             Note that any fields the user has explicitly set will override the
3915             corresponding MIME fields that we would otherwise generate.
3916             So, don't say...
3917              
3918             $msg->set("Content-type" => "text/html; charset=US-ASCII");
3919              
3920             unless you want the above value to override the "Content-type"
3921             MIME field that we would normally generate.
3922              
3923             I I called this "fields" because the header() method of
3924             Mail::Header returns something different, but similar enough to
3925             be confusing.
3926              
3927             You can change the order of the fields: see L.
3928             You really shouldn't need to do this, but some people have to
3929             deal with broken mailers.
3930              
3931             =item filename [FILENAME]
3932              
3933             I
3934             Set the filename which this data will be reported as.
3935             This actually sets both "standard" attributes.
3936              
3937             With no argument, returns the filename as dictated by the
3938             content-disposition.
3939              
3940             =item get TAG,[INDEX]
3941              
3942             I
3943             Get the contents of field TAG, which might have been set
3944             with set() or replace(). Returns the text of the field.
3945              
3946             $ml->get('Subject', 0);
3947              
3948             If the optional 0-based INDEX is given, then we return the INDEX'th
3949             occurrence of field TAG. Otherwise, we look at the context:
3950             In a scalar context, only the first (0th) occurrence of the
3951             field is returned; in an array context, I occurrences are returned.
3952              
3953             I this should only be used with non-MIME fields.
3954             Behavior with MIME fields is TBD, and will raise an exception for now.
3955              
3956             =item get_length
3957              
3958             I
3959             Recompute the content length for the message I,
3960             setting the "content-length" attribute as a side-effect:
3961              
3962             $msg->get_length;
3963              
3964             Returns the length, or undefined if not set.
3965              
3966             I the content length can be difficult to compute, since it
3967             involves assembling the entire encoded body and taking the length
3968             of it (which, in the case of multipart messages, means freezing
3969             all the sub-parts, etc.).
3970              
3971             This method only sets the content length to a defined value if the
3972             message is a singlepart with C<"binary"> encoding, I the body is
3973             available either in-core or as a simple file. Otherwise, the content
3974             length is set to the undefined value.
3975              
3976             Since content-length is not a standard MIME field anyway (that's right, kids:
3977             it's not in the MIME RFCs, it's an HTTP thing), this seems pretty fair.
3978              
3979             =item parts
3980              
3981             I
3982             Return the parts of this entity, and this entity only.
3983             Returns empty array if this entity has no parts.
3984              
3985             This is B recursive! Parts can have sub-parts; use
3986             parts_DFS() to get everything.
3987              
3988             =item parts_DFS
3989              
3990             I
3991             Return the list of all MIME::Lite objects included in the entity,
3992             starting with the entity itself, in depth-first-search order.
3993             If this object has no parts, it alone will be returned.
3994              
3995             =item preamble [TEXT]
3996              
3997             I
3998             Get/set the preamble string, assuming that this object has subparts.
3999             Set it to undef for the default string.
4000              
4001             =item replace TAG,VALUE
4002              
4003             I
4004             Delete all occurrences of fields named TAG, and add a new
4005             field with the given VALUE. TAG is converted to all-lowercase.
4006              
4007             B the special MIME fields (MIME-version, Content-*):
4008             if you "replace" a MIME field, the replacement text will override
4009             the I MIME attributes when it comes time to output that field.
4010             So normally you use attr() to change MIME fields and add()/replace() to
4011             change I fields:
4012              
4013             $msg->replace("Subject" => "Hi there!");
4014              
4015             Giving VALUE as the I will effectively I that
4016             field from being output. This is the correct way to suppress
4017             the special MIME fields:
4018              
4019             $msg->replace("Content-disposition" => "");
4020              
4021             Giving VALUE as I will just cause all explicit values
4022             for TAG to be deleted, without having any new values added.
4023              
4024             I the name of this method comes from Mail::Header.
4025              
4026             =item scrub
4027              
4028             I
4029             B
4030             Recursively goes through the "parts" tree of this message and tries
4031             to find MIME attributes that can be removed.
4032             With an array argument, removes exactly those attributes; e.g.:
4033              
4034             $msg->scrub(['content-disposition', 'content-length']);
4035              
4036             Is the same as recursively doing:
4037              
4038             $msg->replace('Content-disposition' => '');
4039             $msg->replace('Content-length' => '');
4040              
4041             =back
4042              
4043             =head2 Setting/getting message data
4044              
4045             =over 4
4046              
4047             =item binmode [OVERRIDE]
4048              
4049             I
4050             With no argument, returns whether or not it thinks that the data
4051             (as given by the "Path" argument of C) should be read using
4052             binmode() (for example, when C is invoked).
4053              
4054             The default behavior is that any content type other than
4055             C or C is binmode'd; this should in general work fine.
4056              
4057             With a defined argument, this method sets an explicit "override"
4058             value. An undefined argument unsets the override.
4059             The new current value is returned.
4060              
4061             =item data [DATA]
4062              
4063             I
4064             Get/set the literal DATA of the message. The DATA may be
4065             either a scalar, or a reference to an array of scalars (which
4066             will simply be joined).
4067              
4068             I setting the data causes the "content-length" attribute
4069             to be recomputed (possibly to nothing).
4070              
4071             =item fh [FILEHANDLE]
4072              
4073             I
4074             Get/set the FILEHANDLE which contains the message data.
4075              
4076             Takes a filehandle as an input and stores it in the object.
4077             This routine is similar to path(); one important difference is that
4078             no attempt is made to set the content length.
4079              
4080             =item path [PATH]
4081              
4082             I
4083             Get/set the PATH to the message data.
4084              
4085             I setting the path recomputes any existing "content-length" field,
4086             and re-sets the "filename" (to the last element of the path if it
4087             looks like a simple path, and to nothing if not).
4088              
4089             =item resetfh [FILEHANDLE]
4090              
4091             I
4092             Set the current position of the filehandle back to the beginning.
4093             Only applies if you used "FH" in build() or attach() for this message.
4094              
4095             Returns false if unable to reset the filehandle (since not all filehandles
4096             are seekable).
4097              
4098             =item read_now
4099              
4100             I
4101             Forces data from the path/filehandle (as specified by C)
4102             to be read into core immediately, just as though you had given it
4103             literally with the C keyword.
4104              
4105             Note that the in-core data will always be used if available.
4106              
4107             Be aware that everything is slurped into a giant scalar: you may not want
4108             to use this if sending tar files! The benefit of I reading in the data
4109             is that very large files can be handled by this module if left on disk
4110             until the message is output via C or C.
4111              
4112             =item sign PARAMHASH
4113              
4114             I
4115             Sign the message. This forces the message to be read into core,
4116             after which the signature is appended to it.
4117              
4118             =over 4
4119              
4120             =item Data
4121              
4122             As in C: the literal signature data.
4123             Can be either a scalar or a ref to an array of scalars.
4124              
4125             =item Path
4126              
4127             As in C: the path to the file.
4128              
4129             =back
4130              
4131             If no arguments are given, the default is:
4132              
4133             Path => "$ENV{HOME}/.signature"
4134              
4135             The content-length is recomputed.
4136              
4137             =item verify_data
4138              
4139             I
4140             Verify that all "paths" to attached data exist, recursively.
4141             It might be a good idea for you to do this before a print(), to
4142             prevent accidental partial output if a file might be missing.
4143             Raises exception if any path is not readable.
4144              
4145             =back
4146              
4147             =head2 Output
4148              
4149             =over 4
4150              
4151             =item print [OUTHANDLE]
4152              
4153             I
4154             Print the message to the given output handle, or to the currently-selected
4155             filehandle if none was given.
4156              
4157             All OUTHANDLE has to be is a filehandle (possibly a glob ref), or
4158             any object that responds to a print() message.
4159              
4160             =item print_body [OUTHANDLE] [IS_SMTP]
4161              
4162             I
4163             Print the body of a message to the given output handle, or to
4164             the currently-selected filehandle if none was given.
4165              
4166             All OUTHANDLE has to be is a filehandle (possibly a glob ref), or
4167             any object that responds to a print() message.
4168              
4169             B raised if unable to open any of the input files,
4170             or if a part contains no data, or if an unsupported encoding is
4171             encountered.
4172              
4173             IS_SMPT is a special option to handle SMTP mails a little more
4174             intelligently than other send mechanisms may require. Specifically this
4175             ensures that the last byte sent is NOT '\n' (octal \012) if the last two
4176             bytes are not '\r\n' (\015\012) as this will cause some SMTP servers to
4177             hang.
4178              
4179             =item print_header [OUTHANDLE]
4180              
4181             I
4182             Print the header of the message to the given output handle,
4183             or to the currently-selected filehandle if none was given.
4184              
4185             All OUTHANDLE has to be is a filehandle (possibly a glob ref), or
4186             any object that responds to a print() message.
4187              
4188             =item as_string
4189              
4190             I
4191             Return the entire message as a string, with a header and an encoded body.
4192              
4193             =item body_as_string
4194              
4195             I
4196             Return the encoded body as a string.
4197             This is the portion after the header and the blank line.
4198              
4199             I actually prepares the body by "printing" to a scalar.
4200             Proof that you can hand the C methods any blessed object
4201             that responds to a C message.
4202              
4203             =item header_as_string
4204              
4205             I
4206             Return the header as a string.
4207              
4208             =back
4209              
4210             =head2 Sending
4211              
4212             =over 4
4213              
4214             =item send
4215              
4216             =item send HOW, HOWARGS...
4217              
4218             I
4219             This is the principal method for sending mail, and for configuring
4220             how mail will be sent.
4221              
4222             I with a HOW argument and optional HOWARGS, it sets
4223             the default sending mechanism that the no-argument instance method
4224             will use. The HOW is a facility name (B),
4225             and the HOWARGS is interpreted by the facility.
4226             The class method returns the previous HOW and HOWARGS as an array.
4227              
4228             MIME::Lite->send('sendmail', "d:\\programs\\sendmail.exe");
4229             ...
4230             $msg = MIME::Lite->new(...);
4231             $msg->send;
4232              
4233             I
4234             (a HOW argument and optional HOWARGS), sends the message in the
4235             requested manner; e.g.:
4236              
4237             $msg->send('sendmail', "d:\\programs\\sendmail.exe");
4238              
4239             I sends the
4240             message by the default mechanism set up by the class method.
4241             Returns whatever the mail-handling routine returns: this
4242             should be true on success, false/exception on error:
4243              
4244             $msg = MIME::Lite->new(From=>...);
4245             $msg->send || die "you DON'T have mail!";
4246              
4247             On Unix systems (or rather non-Win32 systems), the default
4248             setting is equivalent to:
4249              
4250             MIME::Lite->send("sendmail", "/usr/lib/sendmail -t -oi -oem");
4251              
4252             On Win32 systems the default setting is equivalent to:
4253              
4254             MIME::Lite->send("smtp");
4255              
4256             The assumption is that on Win32 your site/lib/Net/libnet.cfg
4257             file will be preconfigured to use the appropriate SMTP
4258             server. See below for configuring for authentication.
4259              
4260             There are three facilities:
4261              
4262             =over 4
4263              
4264             =item "sendmail", ARGS...
4265              
4266             Send a message by piping it into the "sendmail" command.
4267             Uses the L method, giving it the ARGS.
4268             This usage implements (and deprecates) the C method.
4269              
4270             =item "smtp", [HOSTNAME, [NAMEDPARMS] ]
4271              
4272             Send a message by SMTP, using optional HOSTNAME as SMTP-sending host.
4273             L will be required. Uses the L
4274             method. Any additional arguments passed in will also be passed through to
4275             send_by_smtp. This is useful for things like mail servers requiring
4276             authentication where you can say something like the following
4277              
4278             MIME::Lite->send('smtp', $host, AuthUser=>$user, AuthPass=>$pass);
4279              
4280             which will configure things so future uses of
4281              
4282             $msg->send();
4283              
4284             do the right thing.
4285              
4286             =item "sub", \&SUBREF, ARGS...
4287              
4288             Sends a message MSG by invoking the subroutine SUBREF of your choosing,
4289             with MSG as the first argument, and ARGS following.
4290              
4291             =back
4292              
4293             I let's say you're on an OS which lacks the usual Unix
4294             "sendmail" facility, but you've installed something a lot like it, and
4295             you need to configure your Perl script to use this "sendmail.exe" program.
4296             Do this following in your script's setup:
4297              
4298             MIME::Lite->send('sendmail', "d:\\programs\\sendmail.exe");
4299              
4300             Then, whenever you need to send a message $msg, just say:
4301              
4302             $msg->send;
4303              
4304             That's it. Now, if you ever move your script to a Unix box, all you
4305             need to do is change that line in the setup and you're done.
4306             All of your $msg-Esend invocations will work as expected.
4307              
4308             After sending, the method last_send_successful() can be used to determine
4309             if the send was successful or not.
4310              
4311             =item send_by_sendmail SENDMAILCMD
4312              
4313             =item send_by_sendmail PARAM=>VALUE, ARRAY, HASH...
4314              
4315             I
4316             Send message via an external "sendmail" program
4317             (this will probably only work out-of-the-box on Unix systems).
4318              
4319             Returns true on success, false or exception on error.
4320              
4321             You can specify the program and all its arguments by giving a single
4322             string, SENDMAILCMD. Nothing fancy is done; the message is simply
4323             piped in.
4324              
4325             However, if your needs are a little more advanced, you can specify
4326             zero or more of the following PARAM/VALUE pairs (or a reference to hash
4327             or array of such arguments as well as any combination thereof); a
4328             Unix-style, taint-safe "sendmail" command will be constructed for you:
4329              
4330             =over 4
4331              
4332             =item Sendmail
4333              
4334             Full path to the program to use.
4335             Default is "/usr/lib/sendmail".
4336              
4337             =item BaseArgs
4338              
4339             Ref to the basic array of arguments we start with.
4340             Default is C<["-t", "-oi", "-oem"]>.
4341              
4342             =item SetSender
4343              
4344             Unless this is I given as false, we attempt to automatically
4345             set the C<-f> argument to the first address that can be extracted from
4346             the "From:" field of the message (if there is one).
4347              
4348             I
4349             Suppose we did I use C<-f>, and you gave an explicit "From:"
4350             field in your message: in this case, the sendmail "envelope" would
4351             indicate the I user your process was running under, as a way
4352             of preventing mail forgery. Using the C<-f> switch causes the sender
4353             to be set in the envelope as well.
4354              
4355             I
4356             If sendmail doesn't regard you as a "trusted" user, it will permit
4357             the C<-f> but also add an "X-Authentication-Warning" header to the message
4358             to indicate a forged envelope. To avoid this, you can either
4359             (1) have SetSender be false, or
4360             (2) make yourself a trusted user by adding a C configuration
4361             command to your I file
4362             (e.g.: C if the script is running as user "eryq").
4363              
4364             =item FromSender
4365              
4366             If defined, this is identical to setting SetSender to true,
4367             except that instead of looking at the "From:" field we use
4368             the address given by this option.
4369             Thus:
4370              
4371             FromSender => 'me@myhost.com'
4372              
4373             =back
4374              
4375             After sending, the method last_send_successful() can be used to determine
4376             if the send was successful or not.
4377              
4378             =item send_by_smtp HOST, ARGS...
4379              
4380             =item send_by_smtp REF, HOST, ARGS
4381              
4382             I
4383             Send message via SMTP, using Net::SMTP -- which will be required for this
4384             feature.
4385              
4386             HOST is the name of SMTP server to connect to, or undef to have
4387             L use the defaults in Libnet.cfg.
4388              
4389             ARGS are a list of key value pairs which may be selected from the list
4390             below. Many of these are just passed through to specific
4391             L commands and you should review that module for
4392             details.
4393              
4394             Please see L
4395              
4396             =over 4
4397              
4398             =item Hello
4399              
4400             =item LocalAddr
4401              
4402             =item LocalPort
4403              
4404             =item Timeout
4405              
4406             =item Port
4407              
4408             =item ExactAddresses
4409              
4410             =item Debug
4411              
4412             See L for details.
4413              
4414             =item Size
4415              
4416             =item Return
4417              
4418             =item Bits
4419              
4420             =item Transaction
4421              
4422             =item Envelope
4423              
4424             See L for details.
4425              
4426             =item SkipBad
4427              
4428             If true doesn't throw an error when multiple email addresses are provided
4429             and some are not valid. See L
4430             for details.
4431              
4432             =item AuthUser
4433              
4434             Authenticate with L using this username.
4435              
4436             =item AuthPass
4437              
4438             Authenticate with L using this password.
4439              
4440             =item NoAuth
4441              
4442             Normally if AuthUser and AuthPass are defined MIME::Lite will attempt to
4443             use them with the L command to
4444             authenticate the connection, however if this value is true then no
4445             authentication occurs.
4446              
4447             =item To
4448              
4449             Sets the addresses to send to. Can be a string or a reference to an
4450             array of strings. Normally this is extracted from the To: (and Cc: and
4451             Bcc: fields if $AUTO_CC is true).
4452              
4453             This value overrides that.
4454              
4455             =item From
4456              
4457             Sets the email address to send from. Normally this value is extracted
4458             from the Return-Path: or From: field of the mail itself (in that order).
4459              
4460             This value overrides that.
4461              
4462             =back
4463              
4464             I
4465             True on success, croaks with an error message on failure.
4466              
4467             After sending, the method last_send_successful() can be used to determine
4468             if the send was successful or not.
4469              
4470             =item send_by_testfile FILENAME
4471              
4472             I
4473             Print message to a file (namely FILENAME), which will default to
4474             mailer.testfile
4475             If file exists, message will be appended.
4476              
4477             =item last_send_successful
4478              
4479             This method will return TRUE if the last send() or send_by_XXX() method call was
4480             successful. It will return defined but false if it was not successful, and undefined
4481             if the object had not been used to send yet.
4482              
4483             =item sendmail COMMAND...
4484              
4485             I
4486             Declare the sender to be "sendmail", and set up the "sendmail" command.
4487             I
4488              
4489             =back
4490              
4491             =head2 Miscellaneous
4492              
4493             =over 4
4494              
4495             =item quiet ONOFF
4496              
4497             I
4498             Suppress/unsuppress all warnings coming from this module.
4499              
4500             MIME::Lite->quiet(1); ### I know what I'm doing
4501              
4502             I recommend that you include that comment as well. And while
4503             you type it, say it out loud: if it doesn't feel right, then maybe
4504             you should reconsider the whole line. C<;-)>
4505              
4506             =back
4507              
4508             =head1 NOTES
4509              
4510             =head2 How do I prevent "Content" headers from showing up in my mail reader?
4511              
4512             Apparently, some people are using mail readers which display the MIME
4513             headers like "Content-disposition", and they want MIME::Lite not
4514             to generate them "because they look ugly".
4515              
4516             Sigh.
4517              
4518             Y'know, kids, those headers aren't just there for cosmetic purposes.
4519             They help ensure that the message is I correctly by mail
4520             readers. But okay, you asked for it, you got it...
4521             here's how you can suppress the standard MIME headers.
4522             Before you send the message, do this:
4523              
4524             $msg->scrub;
4525              
4526             You can scrub() any part of a multipart message independently;
4527             just be aware that it works recursively. Before you scrub,
4528             note the rules that I follow:
4529              
4530             =over 4
4531              
4532             =item Content-type
4533              
4534             You can safely scrub the "content-type" attribute if, and only if,
4535             the part is of type "text/plain" with charset "us-ascii".
4536              
4537             =item Content-transfer-encoding
4538              
4539             You can safely scrub the "content-transfer-encoding" attribute
4540             if, and only if, the part uses "7bit", "8bit", or "binary" encoding.
4541             You are far better off doing this if your lines are under 1000
4542             characters. Generally, that means you I scrub it for plain
4543             text, and you can I scrub this for images, etc.
4544              
4545             =item Content-disposition
4546              
4547             You can safely scrub the "content-disposition" attribute
4548             if you trust the mail reader to do the right thing when it decides
4549             whether to show an attachment inline or as a link. Be aware
4550             that scrubbing both the content-disposition and the content-type
4551             means that there is no way to "recommend" a filename for the attachment!
4552              
4553             B there are reports of brain-dead MUAs out there that
4554             do the wrong thing if you I the content-disposition.
4555             If your attachments keep showing up inline or vice-versa,
4556             try scrubbing this attribute.
4557              
4558             =item Content-length
4559              
4560             You can always scrub "content-length" safely.
4561              
4562             =back
4563              
4564             =head2 How do I give my attachment a [different] recommended filename?
4565              
4566             By using the Filename option (which is different from Path!):
4567              
4568             $msg->attach(Type => "image/gif",
4569             Path => "/here/is/the/real/file.GIF",
4570             Filename => "logo.gif");
4571              
4572             You should I put path information in the Filename.
4573              
4574             =head2 Working with UTF-8 and other character sets
4575              
4576             All text that is added to your mail message should be properly encoded.
4577             MIME::Lite doesn't do this for you. For instance, if you want to
4578             send your mail in UTF-8, where C<$to>, C<$subject> and C<$text> have
4579             these values:
4580              
4581             =over
4582              
4583             =item *
4584              
4585             To: "RamEn NuEez Efoo@bar.comE"
4586              
4587             =item *
4588              
4589             Subject: "EAquE estE!"
4590              
4591             =item *
4592              
4593             Text: "EQuieres ganar muchos E's?"
4594              
4595             =back
4596              
4597             use MIME::Lite;
4598             use Encode qw(encode encode_utf8 );
4599              
4600             my $to = "Ram\363n Nu\361ez ";
4601             my $subject = "\241Aqu\355 est\341!";
4602             my $text = "\277Quieres ganar muchos \x{20ac}'s?";
4603              
4604             ### Create a new message encoded in UTF-8:
4605             my $msg = MIME::Lite->new(
4606             From => 'me@myhost.com',
4607             To => encode( 'MIME-Header', $to ),
4608             Subject => encode( 'MIME-Header', $subject ),
4609             Data => encode_utf8($text)
4610             );
4611             $msg->attr( 'content-type' => 'text/plain; charset=utf-8' );
4612             $msg->send;
4613              
4614             B
4615              
4616             =over
4617              
4618             =item *
4619              
4620             The above example assumes that the values you want to encode are in
4621             Perl's "internal" form, i.e. the strings contain decoded UTF-8
4622             characters, not the bytes that represent those characters.
4623              
4624             See L, L, L and L for
4625             more.
4626              
4627             =item *
4628              
4629             If, for the body of the email, you want to use a character set
4630             other than UTF-8, then you should encode appropriately, and set the
4631             correct C, eg:
4632              
4633             ...
4634             Data => encode('iso-8859-15',$text)
4635             ...
4636              
4637             $msg->attr( 'content-type' => 'text/plain; charset=iso-8859-15' );
4638              
4639             =item *
4640              
4641             For the message headers, L only support UTF-8,
4642             but most modern mail clients should be able to handle this. It is not
4643             a problem to have your headers in a different encoding from the message
4644             body.
4645              
4646             =back
4647              
4648             =head2 Benign limitations
4649              
4650             This is "lite", after all...
4651              
4652             =over 4
4653              
4654             =item *
4655              
4656             There's no parsing. Get MIME-tools if you need to parse MIME messages.
4657              
4658             =item *
4659              
4660             MIME::Lite messages are currently I interchangeable with
4661             either Mail::Internet or MIME::Entity objects. This is a completely
4662             separate module.
4663              
4664             =item *
4665              
4666             A content-length field is only inserted if the encoding is binary,
4667             the message is a singlepart, and all the document data is available
4668             at C time by virtue of residing in a simple path, or in-core.
4669             Since content-length is not a standard MIME field anyway (that's right, kids:
4670             it's not in the MIME RFCs, it's an HTTP thing), this seems pretty fair.
4671              
4672             =item *
4673              
4674             MIME::Lite alone cannot help you lose weight. You must supplement
4675             your use of MIME::Lite with a healthy diet and exercise.
4676              
4677             =back
4678              
4679             =head2 Cheap and easy mailing
4680              
4681             I thought putting in a default "sendmail" invocation wasn't too bad an
4682             idea, since a lot of Perlers are on UNIX systems. (As of version 3.02 this is
4683             default only on Non-Win32 boxen. On Win32 boxen the default is to use SMTP and the
4684             defaults specified in the site/lib/Net/libnet.cfg)
4685              
4686             The out-of-the-box configuration is:
4687              
4688             MIME::Lite->send('sendmail', "/usr/lib/sendmail -t -oi -oem");
4689              
4690             By the way, these arguments to sendmail are:
4691              
4692             -t Scan message for To:, Cc:, Bcc:, etc.
4693              
4694             -oi Do NOT treat a single "." on a line as a message terminator.
4695             As in, "-oi vey, it truncated my message... why?!"
4696              
4697             -oem On error, mail back the message (I assume to the
4698             appropriate address, given in the header).
4699             When mail returns, circle is complete. Jai Guru Deva -oem.
4700              
4701             Note that these are the same arguments you get if you configure to use
4702             the smarter, taint-safe mailing:
4703              
4704             MIME::Lite->send('sendmail');
4705              
4706             If you get "X-Authentication-Warning" headers from this, you can forgo
4707             diddling with the envelope by instead specifying:
4708              
4709             MIME::Lite->send('sendmail', SetSender=>0);
4710              
4711             And, if you're not on a Unix system, or if you'd just rather send mail
4712             some other way, there's always SMTP, which these days probably requires
4713             authentication so you probably need to say
4714              
4715             MIME::Lite->send('smtp', "smtp.myisp.net",
4716             AuthUser=>"YourName",AuthPass=>"YourPass" );
4717              
4718             Or you can set up your own subroutine to call.
4719             In any case, check out the L method.
4720              
4721             =head1 WARNINGS
4722              
4723             =head2 Good-vs-bad email addresses with send_by_smtp()
4724              
4725             If using L, be aware that unless you
4726             explicitly provide the email addresses to send to and from you will be
4727             forcing MIME::Lite to extract email addresses out of a possible list
4728             provided in the C, C, and C fields. This is tricky
4729             stuff, and as such only the following sorts of addresses will work
4730             reliably:
4731              
4732             username
4733             full.name@some.host.com
4734             "Name, Full"
4735              
4736             B
4737             MIME::Lite was never intended to be a Mail User Agent, so please
4738             don't expect a full implementation of RFC-822. Restrict yourself to
4739             the common forms of Internet addresses described herein, and you should
4740             be fine. If this is not feasible, then consider using MIME::Lite
4741             to I your message only, and using Net::SMTP explicitly to
4742             I your message.
4743              
4744             B
4745             As of MIME::Lite v3.02 the mail name extraction routines have been
4746             beefed up considerably. Furthermore if Mail::Address is provided then
4747             name extraction is done using that. Accordingly the above advice is now
4748             less true than it once was. Funky email names I work properly
4749             now. However the disclaimer remains. Patches welcome. :-)
4750              
4751             =head2 Formatting of headers delayed until print()
4752              
4753             This class treats a MIME header in the most abstract sense,
4754             as being a collection of high-level attributes. The actual
4755             RFC-822-style header fields are not constructed until it's time
4756             to actually print the darn thing.
4757              
4758             =head2 Encoding of data delayed until print()
4759              
4760             When you specify message bodies
4761             (in L or L) --
4762             whether by B, B, or B -- be warned that we don't
4763             attempt to open files, read filehandles, or encode the data until
4764             L is invoked.
4765              
4766             In the past, this created some confusion for users of sendmail
4767             who gave the wrong path to an attachment body, since enough of
4768             the print() would succeed to get the initial part of the message out.
4769             Nowadays, $AUTO_VERIFY is used to spot-check the Paths given before
4770             the mail facility is employed. A whisker slower, but tons safer.
4771              
4772             Note that if you give a message body via FH, and try to print()
4773             a message twice, the second print() will not do the right thing
4774             unless you explicitly rewind the filehandle.
4775              
4776             You can get past these difficulties by using the B option,
4777             provided that you have enough memory to handle your messages.
4778              
4779             =head2 MIME attributes are separate from header fields!
4780              
4781             B the MIME attributes are stored and manipulated separately
4782             from the message header fields; when it comes time to print the
4783             header out, I
4784             would be created from the MIME attributes.> That means that this:
4785              
4786             ### DANGER ### DANGER ### DANGER ### DANGER ### DANGER ###
4787             $msg->add("Content-type", "text/html; charset=US-ASCII");
4788              
4789             will set the exact C<"Content-type"> field in the header I write,
4790             I
4791              
4792             I as an escape hatch in case
4793             the code that normally formats MIME header fields isn't doing what
4794             you need. And, like any escape hatch, it's got an alarm on it:
4795             MIME::Lite will warn you if you attempt to C or C
4796             any MIME header field. Use C instead.
4797              
4798             =head2 Beware of lines consisting of a single dot
4799              
4800             Julian Haight noted that MIME::Lite allows you to compose messages
4801             with lines in the body consisting of a single ".".
4802             This is true: it should be completely harmless so long as "sendmail"
4803             is used with the -oi option (see L<"Cheap and easy mailing">).
4804              
4805             However, I don't know if using Net::SMTP to transfer such a message
4806             is equally safe. Feedback is welcomed.
4807              
4808             My perspective: I don't want to magically diddle with a user's
4809             message unless absolutely positively necessary.
4810             Some users may want to send files with "." alone on a line;
4811             my well-meaning tinkering could seriously harm them.
4812              
4813             =head2 Infinite loops may mean tainted data!
4814              
4815             Stefan Sautter noticed a bug in 2.106 where a m//gc match was
4816             failing due to tainted data, leading to an infinite loop inside
4817             MIME::Lite.
4818              
4819             I am attempting to correct for this, but be advised that my fix will
4820             silently untaint the data (given the context in which the problem
4821             occurs, this should be benign: I've labelled the source code with
4822             UNTAINT comments for the curious).
4823              
4824             So: don't depend on taint-checking to save you from outputting
4825             tainted data in a message.
4826              
4827             =head2 Don't tweak the global configuration
4828              
4829             Global configuration variables are bad, and should go away.
4830             Until they do, please follow the hints with each setting
4831             on how I to change it.
4832              
4833             =head1 A MIME PRIMER
4834              
4835             =head2 Content types
4836              
4837             The "Type" parameter of C is a I.
4838             This is the actual type of data you are sending.
4839             Generally this is a string of the form C<"majortype/minortype">.
4840              
4841             Here are the major MIME types.
4842             A more-comprehensive listing may be found in RFC-2046.
4843              
4844             =over 4
4845              
4846             =item application
4847              
4848             Data which does not fit in any of the other categories, particularly
4849             data to be processed by some type of application program.
4850             C, C, C...
4851              
4852             =item audio
4853              
4854             Audio data.
4855             C
4856              
4857             =item image
4858              
4859             Graphics data.
4860             C, C...
4861              
4862             =item message
4863              
4864             A message, usually another mail or MIME message.
4865             C...
4866              
4867             =item multipart
4868              
4869             A message containing other messages.
4870             C, C...
4871              
4872             =item text
4873              
4874             Textual data, meant for humans to read.
4875             C, C...
4876              
4877             =item video
4878              
4879             Video or video+audio data.
4880             C
4881              
4882             =back
4883              
4884             =head2 Content transfer encodings
4885              
4886             The "Encoding" parameter of C.
4887             This is how the message body is packaged up for safe transit.
4888              
4889             Here are the 5 major MIME encodings.
4890             A more-comprehensive listing may be found in RFC-2045.
4891              
4892             =over 4
4893              
4894             =item 7bit
4895              
4896             Basically, no I encoding is done. However, this label guarantees that no
4897             8-bit characters are present, and that lines do not exceed 1000 characters
4898             in length.
4899              
4900             =item 8bit
4901              
4902             Basically, no I encoding is done. The message might contain 8-bit
4903             characters, but this encoding guarantees that lines do not exceed 1000
4904             characters in length.
4905              
4906             =item binary
4907              
4908             No encoding is done at all. Message might contain 8-bit characters,
4909             and lines might be longer than 1000 characters long.
4910              
4911             The most liberal, and the least likely to get through mail gateways.
4912             Use sparingly, or (better yet) not at all.
4913              
4914             =item base64
4915              
4916             Like "uuencode", but very well-defined. This is how you should send
4917             essentially binary information (tar files, GIFs, JPEGs, etc.).
4918              
4919             =item quoted-printable
4920              
4921             Useful for encoding messages which are textual in nature, yet which contain
4922             non-ASCII characters (e.g., Latin-1, Latin-2, or any other 8-bit alphabet).
4923              
4924             =back
4925              
4926             =head1 HELPER MODULES
4927              
4928             MIME::Lite works nicely with other certain other modules if they are present.
4929             Good to have installed are the latest L,
4930             L, L,
4931             L, and L.
4932             L is strictly required.
4933              
4934             If they aren't present then some functionality won't work, and other features
4935             won't be as efficient or up to date as they could be. Nevertheless they are optional
4936             extras.
4937              
4938             =head1 BUNDLED GOODIES
4939              
4940             MIME::Lite comes with a number of extra files in the distribution bundle.
4941             This includes examples, and utility modules that you can use to get yourself
4942             started with the module.
4943              
4944             The ./examples directory contains a number of snippets in prepared
4945             form, generally they are documented, but they should be easy to understand.
4946              
4947             The ./contrib directory contains a companion/tool modules that come bundled
4948             with MIME::Lite, they don't get installed by default. Please review the POD
4949             they come with.
4950              
4951             =head1 BUGS
4952              
4953             The whole reason that version 3.0 was released was to ensure that MIME::Lite is
4954             up to date and patched. If you find an issue please report it.
4955              
4956             As far as I know MIME::Lite doesn't currently have any serious bugs, but my
4957             usage is hardly comprehensive.
4958              
4959             Having said that there are a number of open issues for me, mostly caused by the
4960             progress in the community as whole since Eryq last released. The tests are
4961             based around an interesting but non standard test framework. I'd like to change
4962             it over to using Test::More.
4963              
4964             Should tests fail please review the ./testout directory, and in any bug reports
4965             please include the output of the relevant file. This is the only redeeming
4966             feature of not using Test::More that I can see.
4967              
4968             Bug fixes / Patches / Contribution are welcome, however I probably won't apply
4969             them unless they also have an associated test. This means that if I don't have
4970             the time to write the test the patch won't get applied, so please, include tests
4971             for any patches you provide.
4972              
4973             =head1 NUTRITIONAL INFORMATION
4974              
4975             For some reason, the US FDA says that this is now required by law
4976             on any products that bear the name "Lite"...
4977              
4978             Version 3.0 is now new and improved! The distribution is now 30% smaller!
4979              
4980             MIME::Lite |
4981             ------------------------------------------------------------
4982             Serving size: | 1 module
4983             Servings per container: | 1
4984             Calories: | 0
4985             Fat: | 0g
4986             Saturated Fat: | 0g
4987              
4988             Warning: for consumption by hardware only! May produce
4989             indigestion in humans if taken internally.
4990              
4991             =head1 AUTHORS
4992              
4993             =over 4
4994              
4995             =item *
4996              
4997             Ricardo SIGNES
4998              
4999             =item *
5000              
5001             Eryq
5002              
5003             =item *
5004              
5005             Yves Orton
5006              
5007             =back
5008              
5009             =head1 CONTRIBUTORS
5010              
5011             =for stopwords Claude Damien Krotkine David Steinbrunner Florian Jan Willamowius John Bokma Karen Etheridge Max Maischein Michael Schout Stevens Peder Stray Peter Heirich Ricardo Signes Tom Hukins
5012              
5013             =over 4
5014              
5015             =item *
5016              
5017             Claude
5018              
5019             =item *
5020              
5021             Damien Krotkine
5022              
5023             =item *
5024              
5025             David Steinbrunner
5026              
5027             =item *
5028              
5029             Florian
5030              
5031             =item *
5032              
5033             Jan Willamowius
5034              
5035             =item *
5036              
5037             John Bokma
5038              
5039             =item *
5040              
5041             Karen Etheridge
5042              
5043             =item *
5044              
5045             Max Maischein
5046              
5047             =item *
5048              
5049             Michael Schout
5050              
5051             =item *
5052              
5053             Michael Stevens
5054              
5055             =item *
5056              
5057             Peder Stray
5058              
5059             =item *
5060              
5061             Peter Heirich
5062              
5063             =item *
5064              
5065             Ricardo Signes
5066              
5067             =item *
5068              
5069             Tom Hukins
5070              
5071             =back
5072              
5073             =head1 COPYRIGHT AND LICENSE
5074              
5075             This software is copyright (c) 1997 by Eryq, ZeeGee Software, and Yves Orton.
5076              
5077             This is free software; you can redistribute it and/or modify it under
5078             the same terms as the Perl 5 programming language system itself.
5079              
5080             =cut
5081              
5082             __END__