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