line
stmt
bran
cond
sub
pod
time
code
1
package MIME::Lite 3.038;
2
# ABSTRACT: low-calorie MIME generator
3
9
9
60687
use v5.12.0;
9
36
4
9
9
58
use warnings;
9
34
9
562
5
6
9
9
74
use File::Basename;
9
17
9
2284
7
8
#pod =begin :prelude
9
#pod
10
#pod =head1 WAIT!
11
#pod
12
#pod MIME::Lite is not recommended by its current maintainer. There are a number of
13
#pod alternatives, like Email::MIME or MIME::Entity and Email::Sender, which you
14
#pod should probably use instead. MIME::Lite continues to accrue weird bug reports,
15
#pod and it is not receiving a large amount of refactoring due to the availability
16
#pod of better alternatives. Please consider using something else.
17
#pod
18
#pod =end :prelude
19
#pod
20
#pod =head1 SYNOPSIS
21
#pod
22
#pod Create and send using the default send method for your OS a single-part message:
23
#pod
24
#pod use MIME::Lite;
25
#pod ### Create a new single-part message, to send a GIF file:
26
#pod $msg = MIME::Lite->new(
27
#pod From => 'me@myhost.com',
28
#pod To => 'you@yourhost.com',
29
#pod Cc => 'some@other.com, some@more.com',
30
#pod Subject => 'Helloooooo, nurse!',
31
#pod Type => 'image/gif',
32
#pod Encoding => 'base64',
33
#pod Path => 'hellonurse.gif'
34
#pod );
35
#pod $msg->send; # send via default
36
#pod
37
#pod Create a multipart message (i.e., one with attachments) and send it via SMTP
38
#pod
39
#pod ### Create a new multipart message:
40
#pod $msg = MIME::Lite->new(
41
#pod From => 'me@myhost.com',
42
#pod To => 'you@yourhost.com',
43
#pod Cc => 'some@other.com, some@more.com',
44
#pod Subject => 'A message with 2 parts...',
45
#pod Type => 'multipart/mixed'
46
#pod );
47
#pod
48
#pod ### Add parts (each "attach" has same arguments as "new"):
49
#pod $msg->attach(
50
#pod Type => 'TEXT',
51
#pod Data => "Here's the GIF file you wanted"
52
#pod );
53
#pod $msg->attach(
54
#pod Type => 'image/gif',
55
#pod Path => 'aaa000123.gif',
56
#pod Filename => 'logo.gif',
57
#pod Disposition => 'attachment'
58
#pod );
59
#pod ### use Net::SMTP to do the sending
60
#pod $msg->send('smtp','some.host', Debug=>1 );
61
#pod
62
#pod Output a message:
63
#pod
64
#pod ### Format as a string:
65
#pod $str = $msg->as_string;
66
#pod
67
#pod ### Print to a filehandle (say, a "sendmail" stream):
68
#pod $msg->print(\*SENDMAIL);
69
#pod
70
#pod Send a message:
71
#pod
72
#pod ### Send in the "best" way (the default is to use "sendmail"):
73
#pod $msg->send;
74
#pod ### Send a specific way:
75
#pod $msg->send('type',@args);
76
#pod
77
#pod Specify default send method:
78
#pod
79
#pod MIME::Lite->send('smtp','some.host',Debug=>0);
80
#pod
81
#pod with authentication
82
#pod
83
#pod MIME::Lite->send('smtp','some.host', AuthUser=>$user, AuthPass=>$pass);
84
#pod
85
#pod using SSL
86
#pod
87
#pod MIME::Lite->send('smtp','some.host', SSL => 1, Port => 465 );
88
#pod
89
#pod =head1 DESCRIPTION
90
#pod
91
#pod In the never-ending quest for great taste with fewer calories,
92
#pod we proudly present: I.
93
#pod
94
#pod MIME::Lite is intended as a simple, standalone module for generating
95
#pod (not parsing!) MIME messages... specifically, it allows you to
96
#pod output a simple, decent single- or multi-part message with text or binary
97
#pod attachments. It does not require that you have the Mail:: or MIME::
98
#pod modules installed, but will work with them if they are.
99
#pod
100
#pod You can specify each message part as either the literal data itself (in
101
#pod a scalar or array), or as a string which can be given to open() to get
102
#pod a readable filehandle (e.g., "
103
#pod
104
#pod You don't need to worry about encoding your message data:
105
#pod this module will do that for you. It handles the 5 standard MIME encodings.
106
#pod
107
#pod =head1 EXAMPLES
108
#pod
109
#pod =head2 Create a simple message containing just text
110
#pod
111
#pod $msg = MIME::Lite->new(
112
#pod From =>'me@myhost.com',
113
#pod To =>'you@yourhost.com',
114
#pod Cc =>'some@other.com, some@more.com',
115
#pod Subject =>'Helloooooo, nurse!',
116
#pod Data =>"How's it goin', eh?"
117
#pod );
118
#pod
119
#pod =head2 Create a simple message containing just an image
120
#pod
121
#pod $msg = MIME::Lite->new(
122
#pod From =>'me@myhost.com',
123
#pod To =>'you@yourhost.com',
124
#pod Cc =>'some@other.com, some@more.com',
125
#pod Subject =>'Helloooooo, nurse!',
126
#pod Type =>'image/gif',
127
#pod Encoding =>'base64',
128
#pod Path =>'hellonurse.gif'
129
#pod );
130
#pod
131
#pod
132
#pod =head2 Create a multipart message
133
#pod
134
#pod ### Create the multipart "container":
135
#pod $msg = MIME::Lite->new(
136
#pod From =>'me@myhost.com',
137
#pod To =>'you@yourhost.com',
138
#pod Cc =>'some@other.com, some@more.com',
139
#pod Subject =>'A message with 2 parts...',
140
#pod Type =>'multipart/mixed'
141
#pod );
142
#pod
143
#pod ### Add the text message part:
144
#pod ### (Note that "attach" has same arguments as "new"):
145
#pod $msg->attach(
146
#pod Type =>'TEXT',
147
#pod Data =>"Here's the GIF file you wanted"
148
#pod );
149
#pod
150
#pod ### Add the image part:
151
#pod $msg->attach(
152
#pod Type =>'image/gif',
153
#pod Path =>'aaa000123.gif',
154
#pod Filename =>'logo.gif',
155
#pod Disposition => 'attachment'
156
#pod );
157
#pod
158
#pod
159
#pod =head2 Attach a GIF to a text message
160
#pod
161
#pod This will create a multipart message exactly as above, but using the
162
#pod "attach to singlepart" hack:
163
#pod
164
#pod ### Start with a simple text message:
165
#pod $msg = MIME::Lite->new(
166
#pod From =>'me@myhost.com',
167
#pod To =>'you@yourhost.com',
168
#pod Cc =>'some@other.com, some@more.com',
169
#pod Subject =>'A message with 2 parts...',
170
#pod Type =>'TEXT',
171
#pod Data =>"Here's the GIF file you wanted"
172
#pod );
173
#pod
174
#pod ### Attach a part... the make the message a multipart automatically:
175
#pod $msg->attach(
176
#pod Type =>'image/gif',
177
#pod Path =>'aaa000123.gif',
178
#pod Filename =>'logo.gif'
179
#pod );
180
#pod
181
#pod
182
#pod =head2 Attach a pre-prepared part to a message
183
#pod
184
#pod ### Create a standalone part:
185
#pod $part = MIME::Lite->new(
186
#pod Top => 0,
187
#pod Type =>'text/html',
188
#pod Data =>'Hello ',
189
#pod );
190
#pod $part->attr('content-type.charset' => 'UTF-8');
191
#pod $part->add('X-Comment' => 'A message for you');
192
#pod
193
#pod ### Attach it to any message:
194
#pod $msg->attach($part);
195
#pod
196
#pod
197
#pod =head2 Print a message to a filehandle
198
#pod
199
#pod ### Write it to a filehandle:
200
#pod $msg->print(\*STDOUT);
201
#pod
202
#pod ### Write just the header:
203
#pod $msg->print_header(\*STDOUT);
204
#pod
205
#pod ### Write just the encoded body:
206
#pod $msg->print_body(\*STDOUT);
207
#pod
208
#pod
209
#pod =head2 Print a message into a string
210
#pod
211
#pod ### Get entire message as a string:
212
#pod $str = $msg->as_string;
213
#pod
214
#pod ### Get just the header:
215
#pod $str = $msg->header_as_string;
216
#pod
217
#pod ### Get just the encoded body:
218
#pod $str = $msg->body_as_string;
219
#pod
220
#pod
221
#pod =head2 Send a message
222
#pod
223
#pod ### Send in the "best" way (the default is to use "sendmail"):
224
#pod $msg->send;
225
#pod
226
#pod
227
#pod =head2 Send an HTML document... with images included!
228
#pod
229
#pod $msg = MIME::Lite->new(
230
#pod To =>'you@yourhost.com',
231
#pod Subject =>'HTML with in-line images!',
232
#pod Type =>'multipart/related'
233
#pod );
234
#pod $msg->attach(
235
#pod Type => 'text/html',
236
#pod Data => qq{
237
#pod
238
#pod Here's my image:
239
#pod
240
#pod
241
#pod },
242
#pod );
243
#pod $msg->attach(
244
#pod Type => 'image/gif',
245
#pod Id => 'myimage.gif',
246
#pod Path => '/path/to/somefile.gif',
247
#pod );
248
#pod $msg->send();
249
#pod
250
#pod
251
#pod =head2 Change how messages are sent
252
#pod
253
#pod ### Do something like this in your 'main':
254
#pod if ($I_DONT_HAVE_SENDMAIL) {
255
#pod MIME::Lite->send('smtp', $host, Timeout=>60,
256
#pod AuthUser=>$user, AuthPass=>$pass);
257
#pod }
258
#pod
259
#pod ### Now this will do the right thing:
260
#pod $msg->send; ### will now use Net::SMTP as shown above
261
#pod
262
#pod =head1 PUBLIC INTERFACE
263
#pod
264
#pod =head2 Global configuration
265
#pod
266
#pod To alter the way the entire module behaves, you have the following
267
#pod methods/options:
268
#pod
269
#pod =over 4
270
#pod
271
#pod
272
#pod =item MIME::Lite->field_order()
273
#pod
274
#pod When used as a L, this changes the default
275
#pod order in which headers are output for I messages.
276
#pod However, please consider using the instance method variant instead,
277
#pod so you won't stomp on other message senders in the same application.
278
#pod
279
#pod
280
#pod =item MIME::Lite->quiet()
281
#pod
282
#pod This L can be used to suppress/unsuppress
283
#pod all warnings coming from this module.
284
#pod
285
#pod
286
#pod =item MIME::Lite->send()
287
#pod
288
#pod When used as a L, this can be used to specify
289
#pod a different default mechanism for sending message.
290
#pod The initial default is:
291
#pod
292
#pod MIME::Lite->send("sendmail", "/usr/lib/sendmail -t -oi -oem");
293
#pod
294
#pod However, you should consider the similar but smarter and taint-safe variant:
295
#pod
296
#pod MIME::Lite->send("sendmail");
297
#pod
298
#pod Or, for non-Unix users:
299
#pod
300
#pod MIME::Lite->send("smtp");
301
#pod
302
#pod
303
#pod =item $MIME::Lite::AUTO_CC
304
#pod
305
#pod If true, automatically send to the Cc/Bcc addresses for send_by_smtp().
306
#pod Default is B.
307
#pod
308
#pod
309
#pod =item $MIME::Lite::AUTO_CONTENT_TYPE
310
#pod
311
#pod If true, try to automatically choose the content type from the file name
312
#pod in C/C. In other words, setting this true changes the
313
#pod default C from C<"TEXT"> to C<"AUTO">.
314
#pod
315
#pod Default is B, since we must maintain backwards-compatibility
316
#pod with prior behavior. B consider keeping it false,
317
#pod and just using Type 'AUTO' when you build() or attach().
318
#pod
319
#pod
320
#pod =item $MIME::Lite::AUTO_ENCODE
321
#pod
322
#pod If true, automatically choose the encoding from the content type.
323
#pod Default is B.
324
#pod
325
#pod
326
#pod =item $MIME::Lite::AUTO_VERIFY
327
#pod
328
#pod If true, check paths to attachments right before printing, raising an exception
329
#pod if any path is unreadable.
330
#pod Default is B.
331
#pod
332
#pod
333
#pod =item $MIME::Lite::PARANOID
334
#pod
335
#pod If true, we won't attempt to use MIME::Base64, MIME::QuotedPrint,
336
#pod or MIME::Types, even if they're available.
337
#pod Default is B. Please consider keeping it false,
338
#pod and trusting these other packages to do the right thing.
339
#pod
340
#pod
341
#pod =back
342
#pod
343
#pod =cut
344
345
9
9
65
use Carp ();
9
27
9
331
346
9
9
4720
use FileHandle;
9
122623
9
56
347
348
# GLOBALS, EXTERNAL/CONFIGURATION...
349
350
### Automatically interpret CC/BCC for SMTP:
351
our $AUTO_CC = 1;
352
353
### Automatically choose content type from file name:
354
our $AUTO_CONTENT_TYPE = 0;
355
356
### Automatically choose encoding from content type:
357
our $AUTO_ENCODE = 1;
358
359
### Check paths right before printing:
360
our $AUTO_VERIFY = 1;
361
362
### Set this true if you don't want to use MIME::Base64/QuotedPrint/Types:
363
our $PARANOID = 0;
364
365
### Don't warn me about dangerous activities:
366
our $QUIET = undef;
367
368
### Unsupported (for tester use): don't qualify boundary with time/pid:
369
our $VANILLA = 0;
370
371
our $DEBUG = 0;
372
373
#==============================
374
#==============================
375
#
376
# GLOBALS, INTERNAL...
377
378
my $Sender = "";
379
my $SENDMAIL = "";
380
381
if ( $^O =~ /win32|cygwin/i ) {
382
$Sender = "smtp";
383
} else {
384
### Find sendmail:
385
$Sender = "sendmail";
386
$SENDMAIL = "/usr/lib/sendmail";
387
( -x $SENDMAIL ) or ( $SENDMAIL = "/usr/sbin/sendmail" );
388
( -x $SENDMAIL ) or ( $SENDMAIL = "sendmail" );
389
unless (-x $SENDMAIL) {
390
require File::Spec;
391
for my $dir (File::Spec->path) {
392
if ( -x "$dir/sendmail" ) {
393
$SENDMAIL = "$dir/sendmail";
394
last;
395
}
396
}
397
}
398
unless (-x $SENDMAIL) {
399
undef $SENDMAIL;
400
}
401
}
402
403
### Our sending facilities:
404
my %SenderArgs = (
405
sendmail => [],
406
smtp => [],
407
sub => [],
408
);
409
410
### Boundary counter:
411
my $BCount = 0;
412
413
### Known Mail/MIME fields... these, plus some general forms like
414
### "x-*", are recognized by build():
415
my %KnownField = map { $_ => 1 }
416
qw(
417
bcc cc comments date encrypted
418
from keywords message-id mime-version organization
419
received references reply-to return-path sender
420
subject to in-reply-to
421
422
approved
423
);
424
425
### What external packages do we use for encoding?
426
my @Uses = (
427
"F" . File::Basename->VERSION,
428
);
429
430
### Header order:
431
my @FieldOrder;
432
433
### See if we have/want MIME::Types
434
my $HaveMimeTypes = 0;
435
if ( !$PARANOID and eval "require MIME::Types; MIME::Types->VERSION(1.28);" ) {
436
$HaveMimeTypes = 1;
437
push @Uses, "T$MIME::Types::VERSION";
438
}
439
440
#==============================
441
#==============================
442
#
443
# PRIVATE UTILITY FUNCTIONS...
444
445
#------------------------------
446
#
447
# fold STRING
448
#
449
# Make STRING safe as a field value. Remove leading/trailing whitespace,
450
# and make sure newlines are represented as newline+space
451
452
sub fold {
453
0
0
0
0
my $str = shift;
454
0
0
$str =~ s/^\s*|\s*$//g; ### trim
455
0
0
$str =~ s/\n/\n /g;
456
0
0
$str;
457
}
458
459
#------------------------------
460
#
461
# gen_boundary
462
#
463
# Generate a new boundary to use.
464
# The unsupported $VANILLA is for test purposes only.
465
466
sub gen_boundary {
467
6
100
6
0
36
return ( "_----------=_" . ( $VANILLA ? '' : int(time) . $$ ) . $BCount++ );
468
}
469
470
#------------------------------
471
#
472
# is_mime_field FIELDNAME
473
#
474
# Is this a field I manage?
475
476
sub is_mime_field {
477
39
39
0
163
$_[0] =~ /^(mime\-|content\-)/i;
478
}
479
480
#------------------------------
481
#
482
# extract_full_addrs STRING
483
# extract_only_addrs STRING
484
#
485
# Split STRING into an array of email addresses: somewhat of a KLUDGE.
486
#
487
# Unless paranoid, we try to load the real code before supplying our own.
488
0
0
BEGIN {
489
9
9
14367
my $ATOM = '[^ \000-\037()<>@,;:\134"\056\133\135]+';
490
9
20
my $QSTR = '".*?"';
491
9
24
my $WORD = '(?:' . $QSTR . '|' . $ATOM . ')';
492
9
22
my $DOMAIN = '(?:' . $ATOM . '(?:' . '\\.' . $ATOM . ')*' . ')';
493
9
22
my $LOCALPART = '(?:' . $WORD . '(?:' . '\\.' . $WORD . ')*' . ')';
494
9
19
my $ADDR = '(?:' . $LOCALPART . '@' . $DOMAIN . ')';
495
9
38
my $PHRASE = '(?:' . $WORD . ')+';
496
9
68300
my $SEP = "(?:^\\s*|\\s*,\\s*)"; ### before elems in a list
497
498
sub my_extract_full_addrs {
499
0
0
0
0
my $str = shift;
500
0
0
0
return unless $str;
501
0
0
my @addrs;
502
0
0
$str =~ s/\s/ /g; ### collapse whitespace
503
504
0
0
pos($str) = 0;
505
0
0
while ( $str !~ m{\G\s*\Z}gco ) {
506
### print STDERR "TACKLING: ".substr($str, pos($str))."\n";
507
0
0
0
0
if ( $str =~ m{\G$SEP($PHRASE)\s*<\s*($ADDR)\s*>}gco ) {
0
508
0
0
push @addrs, "$1 <$2>";
509
} elsif ( $str =~ m{\G$SEP($ADDR)}gco or $str =~ m{\G$SEP($ATOM)}gco ) {
510
0
0
push @addrs, $1;
511
} else {
512
0
0
my $problem = substr( $str, pos($str) );
513
0
0
die "can't extract address at <$problem> in <$str>\n";
514
}
515
}
516
0
0
0
return wantarray ? @addrs : $addrs[0];
517
}
518
519
sub my_extract_only_addrs {
520
0
0
0
0
0
my @ret = map { /<([^>]+)>/ ? $1 : $_ } my_extract_full_addrs(@_);
0
0
521
0
0
0
return wantarray ? @ret : $ret[0];
522
}
523
}
524
#------------------------------
525
526
527
if ( !$PARANOID and eval "require Mail::Address" ) {
528
push @Uses, "A$Mail::Address::VERSION";
529
0
0
0
0
0
eval q{
0
50
10
0
0
0
0
10
521670
17
3875
10
389
530
sub extract_full_addrs {
531
my @ret=map { $_->format } Mail::Address->parse($_[0]);
532
return wantarray ? @ret : $ret[0]
533
}
534
sub extract_only_addrs {
535
my @ret=map { $_->address } Mail::Address->parse($_[0]);
536
return wantarray ? @ret : $ret[0]
537
}
538
}; ### q
539
} else {
540
eval q{
541
*extract_full_addrs=*my_extract_full_addrs;
542
*extract_only_addrs=*my_extract_only_addrs;
543
}; ### q
544
} ### if
545
546
#==============================
547
#==============================
548
#
549
# PRIVATE ENCODING FUNCTIONS...
550
551
#------------------------------
552
#
553
# encode_base64 STRING
554
#
555
# Encode the given string using BASE64.
556
# Unless paranoid, we try to load the real code before supplying our own.
557
558
if ( !$PARANOID and eval "require MIME::Base64" ) {
559
MIME::Base64->import(qw(encode_base64));
560
push @Uses, "B$MIME::Base64::VERSION";
561
} else {
562
eval q{
563
sub encode_base64 {
564
my $res = "";
565
my $eol = "\n";
566
567
pos($_[0]) = 0; ### thanks, Andreas!
568
while ($_[0] =~ /(.{1,45})/gs) {
569
$res .= substr(pack('u', $1), 1);
570
chop($res);
571
}
572
$res =~ tr|` -_|AA-Za-z0-9+/|;
573
574
### Fix padding at the end:
575
my $padding = (3 - length($_[0]) % 3) % 3;
576
$res =~ s/.{$padding}$/'=' x $padding/e if $padding;
577
578
### Break encoded string into lines of no more than 76 characters each:
579
$res =~ s/(.{1,76})/$1$eol/g if (length $eol);
580
return $res;
581
} ### sub
582
} ### q
583
} ### if
584
585
#------------------------------
586
#
587
# encode_qp STRING
588
#
589
# Encode the given string, LINE BY LINE, using QUOTED-PRINTABLE.
590
# Stolen from MIME::QuotedPrint by Gisle Aas, with a slight bug fix: we
591
# break lines earlier. Notice that this seems not to work unless
592
# encoding line by line.
593
#
594
# Unless paranoid, we try to load the real code before supplying our own.
595
596
if ( !$PARANOID and eval "require MIME::QuotedPrint" ) {
597
import MIME::QuotedPrint qw(encode_qp);
598
push @Uses, "Q$MIME::QuotedPrint::VERSION";
599
} else {
600
eval q{
601
sub encode_qp {
602
my $res = shift;
603
local($_);
604
$res =~ s/([^ \t\n!-<>-~])/sprintf("=%02X", ord($1))/eg; ### rule #2,#3
605
$res =~ s/([ \t]+)$/
606
join('', map { sprintf("=%02X", ord($_)) }
607
split('', $1)
608
)/egm; ### rule #3 (encode whitespace at eol)
609
610
### rule #5 (lines shorter than 76 chars, but can't break =XX escapes:
611
my $brokenlines = "";
612
$brokenlines .= "$1=\n" while $res =~ s/^(.{70}([^=]{2})?)//; ### 70 was 74
613
$brokenlines =~ s/=\n$// unless length $res;
614
"$brokenlines$res";
615
} ### sub
616
} ### q
617
} ### if
618
619
620
#------------------------------
621
#
622
# encode_8bit STRING
623
#
624
# Encode the given string using 8BIT.
625
# This breaks long lines into shorter ones.
626
627
sub encode_8bit {
628
7
7
0
12
my $str = shift;
629
7
10
$str =~ s/^(.{990})/$1\n/mg;
630
7
21
$str;
631
}
632
633
#------------------------------
634
#
635
# encode_7bit STRING
636
#
637
# Encode the given string using 7BIT.
638
# This NO LONGER protects people through encoding.
639
640
sub encode_7bit {
641
0
0
0
0
my $str = shift;
642
0
0
$str =~ s/[\x80-\xFF]//g;
643
0
0
$str =~ s/^(.{990})/$1\n/mg;
644
0
0
$str;
645
}
646
647
#==============================
648
#==============================
649
650
#pod =head2 Construction
651
#pod
652
#pod =over 4
653
#pod
654
#pod =cut
655
656
657
#------------------------------
658
659
#pod =item new [PARAMHASH]
660
#pod
661
#pod I
662
#pod Create a new message object.
663
#pod
664
#pod If any arguments are given, they are passed into C; otherwise,
665
#pod just the empty object is created.
666
#pod
667
#pod =cut
668
669
670
sub new {
671
25
25
1
1814645
my $class = shift;
672
673
### Create basic object:
674
25
106
my $self = { Attrs => {}, ### MIME attributes
675
SubAttrs => {}, ### MIME sub-attributes
676
Header => [], ### explicit message headers
677
Parts => [], ### array of parts
678
};
679
25
49
bless $self, $class;
680
681
### Build, if needed:
682
25
100
92
return ( @_ ? $self->build(@_) : $self );
683
}
684
685
686
#------------------------------
687
688
#pod =item attach PART
689
#pod
690
#pod =item attach PARAMHASH...
691
#pod
692
#pod I
693
#pod Add a new part to this message, and return the new part.
694
#pod
695
#pod If you supply a single PART argument, it will be regarded
696
#pod as a MIME::Lite object to be attached. Otherwise, this
697
#pod method assumes that you are giving in the pairs of a PARAMHASH
698
#pod which will be sent into C to create the new part.
699
#pod
700
#pod One of the possibly-quite-useful hacks thrown into this is the
701
#pod "attach-to-singlepart" hack: if you attempt to attach a part (let's
702
#pod call it "part 1") to a message that doesn't have a content-type
703
#pod of "multipart" or "message", the following happens:
704
#pod
705
#pod =over 4
706
#pod
707
#pod =item *
708
#pod
709
#pod A new part (call it "part 0") is made.
710
#pod
711
#pod =item *
712
#pod
713
#pod The MIME attributes and data (but I the other headers)
714
#pod are cut from the "self" message, and pasted into "part 0".
715
#pod
716
#pod =item *
717
#pod
718
#pod The "self" is turned into a "multipart/mixed" message.
719
#pod
720
#pod =item *
721
#pod
722
#pod The new "part 0" is added to the "self", and I "part 1" is added.
723
#pod
724
#pod =back
725
#pod
726
#pod One of the nice side-effects is that you can create a text message
727
#pod and then add zero or more attachments to it, much in the same way
728
#pod that a user agent like Netscape allows you to do.
729
#pod
730
#pod =cut
731
732
733
sub attach {
734
10
10
1
38
my $self = shift;
735
10
16
my $attrs = $self->{Attrs};
736
10
14
my $sub_attrs = $self->{SubAttrs};
737
738
### Create new part, if necessary:
739
10
50
45
my $part1 = ( ( @_ == 1 ) ? shift: ref($self)->new( Top => 0, @_ ) );
740
741
### Do the "attach-to-singlepart" hack:
742
10
100
33
if ( $attrs->{'content-type'} !~ m{^(multipart|message)/}i ) {
743
744
### Create part zero:
745
5
30
my $part0 = ref($self)->new;
746
747
### Cut MIME stuff from self, and paste into part zero:
748
5
11
foreach (qw(SubAttrs Attrs Data Path FH)) {
749
25
42
$part0->{$_} = $self->{$_};
750
25
30
delete( $self->{$_} );
751
}
752
5
15
$part0->top_level(0); ### clear top-level attributes
753
754
### Make self a top-level multipart:
755
5
50
20
$attrs = $self->{Attrs} ||= {}; ### reset (sam: bug? this doesn't reset anything since Attrs is already a hash-ref)
756
5
50
31
$sub_attrs = $self->{SubAttrs} ||= {}; ### reset
757
5
10
$attrs->{'content-type'} = 'multipart/mixed';
758
5
14
$sub_attrs->{'content-type'}{'boundary'} = gen_boundary();
759
5
9
$attrs->{'content-transfer-encoding'} = '7bit';
760
5
12
$self->top_level(1); ### activate top-level attributes
761
762
### Add part 0:
763
5
7
push @{ $self->{Parts} }, $part0;
5
16
764
}
765
766
### Add the new part:
767
10
13
push @{ $self->{Parts} }, $part1;
10
16
768
10
19
$part1;
769
}
770
771
#------------------------------
772
773
#pod =item build [PARAMHASH]
774
#pod
775
#pod I
776
#pod Create (or initialize) a MIME message object.
777
#pod Normally, you'll use the following keys in PARAMHASH:
778
#pod
779
#pod * Data, FH, or Path (either one of these, or none if multipart)
780
#pod * Type (e.g., "image/jpeg")
781
#pod * From, To, and Subject (if this is the "top level" of a message)
782
#pod
783
#pod The PARAMHASH can contain the following keys:
784
#pod
785
#pod =over 4
786
#pod
787
#pod =item (fieldname)
788
#pod
789
#pod Any field you want placed in the message header, taken from the
790
#pod standard list of header fields (you don't need to worry about case):
791
#pod
792
#pod Approved Encrypted Received Sender
793
#pod Bcc From References Subject
794
#pod Cc Keywords Reply-To To
795
#pod Comments Message-ID Resent-* X-*
796
#pod Content-* MIME-Version Return-Path
797
#pod Date Organization
798
#pod
799
#pod To give experienced users some veto power, these fields will be set
800
#pod I the ones I set... so be careful: I
801
#pod (like C) unless you know what you're doing!
802
#pod
803
#pod To specify a fieldname that's I in the above list, even one that's
804
#pod identical to an option below, just give it with a trailing C<":">,
805
#pod like C<"My-field:">. When in doubt, that I signals a mail
806
#pod field (and it sort of looks like one too).
807
#pod
808
#pod =item Data
809
#pod
810
#pod I
811
#pod The actual message data. This may be a scalar or a ref to an array of
812
#pod strings; if the latter, the message consists of a simple concatenation
813
#pod of all the strings in the array.
814
#pod
815
#pod =item Datestamp
816
#pod
817
#pod I
818
#pod If given true (or omitted), we force the creation of a C field
819
#pod stamped with the current date/time if this is a top-level message.
820
#pod You may want this if using L.
821
#pod If you don't want this to be done, either provide your own Date
822
#pod or explicitly set this to false.
823
#pod
824
#pod =item Disposition
825
#pod
826
#pod I
827
#pod The content disposition, C<"inline"> or C<"attachment">.
828
#pod The default is C<"inline">.
829
#pod
830
#pod =item Encoding
831
#pod
832
#pod I
833
#pod The content transfer encoding that should be used to encode your data:
834
#pod
835
#pod Use encoding: | If your message contains:
836
#pod ------------------------------------------------------------
837
#pod 7bit | Only 7-bit text, all lines <1000 characters
838
#pod 8bit | 8-bit text, all lines <1000 characters
839
#pod quoted-printable | 8-bit text or long lines (more reliable than "8bit")
840
#pod base64 | Largely non-textual data: a GIF, a tar file, etc.
841
#pod
842
#pod The default is taken from the Type; generally it is "binary" (no
843
#pod encoding) for text/*, message/*, and multipart/*, and "base64" for
844
#pod everything else. A value of C<"binary"> is generally I suitable
845
#pod for sending anything but ASCII text files with lines under 1000
846
#pod characters, so consider using one of the other values instead.
847
#pod
848
#pod In the case of "7bit"/"8bit", long lines are automatically chopped to
849
#pod legal length; in the case of "7bit", all 8-bit characters are
850
#pod automatically I. This may not be what you want, so pick your
851
#pod encoding well! For more info, see L<"A MIME PRIMER">.
852
#pod
853
#pod =item FH
854
#pod
855
#pod I
856
#pod Filehandle containing the data, opened for reading.
857
#pod See "ReadNow" also.
858
#pod
859
#pod =item Filename
860
#pod
861
#pod I
862
#pod The name of the attachment. You can use this to supply a
863
#pod recommended filename for the end-user who is saving the attachment
864
#pod to disk. You only need this if the filename at the end of the
865
#pod "Path" is inadequate, or if you're using "Data" instead of "Path".
866
#pod You should I put path information in here (e.g., no "/"
867
#pod or "\" or ":" characters should be used).
868
#pod
869
#pod =item Id
870
#pod
871
#pod I
872
#pod Same as setting "content-id".
873
#pod
874
#pod =item Length
875
#pod
876
#pod I
877
#pod Set the content length explicitly. Normally, this header is automatically
878
#pod computed, but only under certain circumstances (see L<"Benign limitations">).
879
#pod
880
#pod =item Path
881
#pod
882
#pod I
883
#pod Path to a file containing the data... actually, it can be any open()able
884
#pod expression. If it looks like a path, the last element will automatically
885
#pod be treated as the filename.
886
#pod See "ReadNow" also.
887
#pod
888
#pod =item ReadNow
889
#pod
890
#pod I
891
#pod If true, will open the path and slurp the contents into core now.
892
#pod This is useful if the Path points to a command and you don't want
893
#pod to run the command over and over if outputting the message several
894
#pod times. B raised if the open fails.
895
#pod
896
#pod =item Top
897
#pod
898
#pod I
899
#pod If defined, indicates whether or not this is a "top-level" MIME message.
900
#pod The parts of a multipart message are I top-level.
901
#pod Default is true.
902
#pod
903
#pod =item Type
904
#pod
905
#pod I
906
#pod The MIME content type, or one of these special values (case-sensitive):
907
#pod
908
#pod "TEXT" means "text/plain"
909
#pod "BINARY" means "application/octet-stream"
910
#pod "AUTO" means attempt to guess from the filename, falling back
911
#pod to 'application/octet-stream'. This is good if you have
912
#pod MIME::Types on your system and you have no idea what
913
#pod file might be used for the attachment.
914
#pod
915
#pod The default is C<"TEXT">, but it will be C<"AUTO"> if you set
916
#pod $AUTO_CONTENT_TYPE to true (sorry, but you have to enable
917
#pod it explicitly, since we don't want to break code which depends
918
#pod on the old behavior).
919
#pod
920
#pod =back
921
#pod
922
#pod A picture being worth 1000 words (which
923
#pod is of course 2000 bytes, so it's probably more of an "icon" than a "picture",
924
#pod but I digress...), here are some examples:
925
#pod
926
#pod $msg = MIME::Lite->build(
927
#pod From => 'yelling@inter.com',
928
#pod To => 'stocking@fish.net',
929
#pod Subject => "Hi there!",
930
#pod Type => 'TEXT',
931
#pod Encoding => '7bit',
932
#pod Data => "Just a quick note to say hi!"
933
#pod );
934
#pod
935
#pod $msg = MIME::Lite->build(
936
#pod From => 'dorothy@emerald-city.oz',
937
#pod To => 'gesundheit@edu.edu.edu',
938
#pod Subject => "A gif for U"
939
#pod Type => 'image/gif',
940
#pod Path => "/home/httpd/logo.gif"
941
#pod );
942
#pod
943
#pod $msg = MIME::Lite->build(
944
#pod From => 'laughing@all.of.us',
945
#pod To => 'scarlett@fiddle.dee.de',
946
#pod Subject => "A gzipp'ed tar file",
947
#pod Type => 'x-gzip',
948
#pod Path => "gzip < /usr/inc/somefile.tar |",
949
#pod ReadNow => 1,
950
#pod Filename => "somefile.tgz"
951
#pod );
952
#pod
953
#pod To show you what's really going on, that last example could also
954
#pod have been written:
955
#pod
956
#pod $msg = new MIME::Lite;
957
#pod $msg->build(
958
#pod Type => 'x-gzip',
959
#pod Path => "gzip < /usr/inc/somefile.tar |",
960
#pod ReadNow => 1,
961
#pod Filename => "somefile.tgz"
962
#pod );
963
#pod $msg->add(From => "laughing@all.of.us");
964
#pod $msg->add(To => "scarlett@fiddle.dee.de");
965
#pod $msg->add(Subject => "A gzipp'ed tar file");
966
#pod
967
#pod =cut
968
969
970
sub build {
971
20
20
1
986745
my $self = shift;
972
20
85
my %params = @_;
973
20
45
my @params = @_;
974
20
26
my $key;
975
976
### Miko's note: reorganized to check for exactly one of Data, Path, or FH
977
20
50
83
( defined( $params{Data} ) + defined( $params{Path} ) + defined( $params{FH} ) <= 1 )
978
or Carp::croak "supply exactly zero or one of (Data|Path|FH).\n";
979
980
### Create new instance, if necessary:
981
20
100
56
ref($self) or $self = $self->new;
982
983
984
### CONTENT-TYPE....
985
###
986
987
### Get content-type or content-type-macro:
988
20
66
75
my $type = ( $params{Type} || ( $AUTO_CONTENT_TYPE ? 'AUTO' : 'TEXT' ) );
989
990
### Interpret content-type-macros:
991
20
100
95
if ( $type eq 'TEXT' ) { $type = 'text/plain'; }
13
50
16
50
100
992
0
0
elsif ( $type eq 'HTML' ) { $type = 'text/html'; }
993
0
0
elsif ( $type eq 'BINARY' ) { $type = 'application/octet-stream' }
994
1
7
elsif ( $type eq 'AUTO' ) { $type = $self->suggest_type( $params{Path} ); }
995
996
### We now have a content-type; set it:
997
20
40
$type = lc($type);
998
20
43
my $attrs = $self->{Attrs};
999
20
30
my $sub_attrs = $self->{SubAttrs};
1000
20
38
$attrs->{'content-type'} = $type;
1001
1002
### Get some basic attributes from the content type:
1003
20
42
my $is_multipart = ( $type =~ m{^(multipart)/}i );
1004
1005
### Add in the multipart boundary:
1006
20
100
46
if ($is_multipart) {
1007
1
4
my $boundary = gen_boundary();
1008
1
4
$sub_attrs->{'content-type'}{'boundary'} = $boundary;
1009
}
1010
1011
1012
### CONTENT-ID...
1013
###
1014
20
50
43
if ( defined $params{Id} ) {
1015
0
0
my $id = $params{Id};
1016
0
0
0
$id = "<$id>" unless $id =~ /\A\s*<.*>\s*\z/;
1017
0
0
$attrs->{'content-id'} = $id;
1018
}
1019
1020
1021
### DATA OR PATH...
1022
### Note that we must do this *after* we get the content type,
1023
### in case read_now() is invoked, since it needs the binmode().
1024
1025
### Get data, as...
1026
### ...either literal data:
1027
20
100
56
if ( defined( $params{Data} ) ) {
100
50
1028
13
47
$self->data( $params{Data} );
1029
}
1030
### ...or a path to data:
1031
elsif ( defined( $params{Path} ) ) {
1032
4
20
$self->path( $params{Path} ); ### also sets filename
1033
4
100
16
$self->read_now if $params{ReadNow};
1034
}
1035
### ...or a filehandle to data:
1036
### Miko's note: this part works much like the path routine just above,
1037
elsif ( defined( $params{FH} ) ) {
1038
0
0
$self->fh( $params{FH} );
1039
0
0
0
$self->read_now if $params{ReadNow}; ### implement later
1040
}
1041
1042
1043
### FILENAME... (added by Ian Smith on 8/4/97)
1044
### Need this to make sure the filename is added. The Filename
1045
### attribute is ignored, otherwise.
1046
20
100
51
if ( defined( $params{Filename} ) ) {
1047
1
6
$self->filename( $params{Filename} );
1048
}
1049
1050
1051
### CONTENT-TRANSFER-ENCODING...
1052
###
1053
1054
### Get it:
1055
my $enc =
1056
20
50
125
( $params{Encoding} || ( $AUTO_ENCODE and $self->suggest_encoding($type) ) || 'binary' );
1057
20
55
$attrs->{'content-transfer-encoding'} = lc($enc);
1058
1059
### Sanity check:
1060
20
100
58
if ( $type =~ m{^(multipart|message)/} ) {
1061
1
50
6
( $enc =~ m{^(7bit|8bit|binary)\Z} )
1062
or Carp::croak( "illegal MIME: " . "can't have encoding $enc with type $type\n" );
1063
}
1064
1065
### CONTENT-DISPOSITION...
1066
### Default is inline for single, none for multis:
1067
###
1068
20
66
88
my $disp = ( $params{Disposition} or ( $is_multipart ? undef: 'inline' ) );
1069
20
34
$attrs->{'content-disposition'} = $disp;
1070
1071
### CONTENT-LENGTH...
1072
###
1073
20
27
my $length;
1074
20
50
43
if ( exists( $params{Length} ) ) { ### given by caller:
1075
0
0
$attrs->{'content-length'} = $params{Length};
1076
} else { ### compute it ourselves
1077
20
56
$self->get_length;
1078
}
1079
1080
### Init the top-level fields:
1081
20
100
44
my $is_top = defined( $params{Top} ) ? $params{Top} : 1;
1082
20
59
$self->top_level($is_top);
1083
1084
### Datestamp if desired:
1085
20
30
my $ds_wanted = $params{Datestamp};
1086
20
66
72
my $ds_defaulted = ( $is_top and !exists( $params{Datestamp} ) );
1087
20
100
66
118
if ( ( $ds_wanted or $ds_defaulted ) and !exists( $params{Date} ) ) {
66
1088
10
3775
require Email::Date::Format;
1089
10
20761
$self->add( "date", Email::Date::Format::email_date() );
1090
}
1091
1092
### Set message headers:
1093
20
91
my @paramz = @params;
1094
20
48
my $field;
1095
20
38
while (@paramz) {
1096
49
119
my ( $tag, $value ) = ( shift(@paramz), shift(@paramz) );
1097
49
73
my $lc_tag = lc($tag);
1098
1099
### Get tag, if a tag:
1100
49
50
66
220
if ( $lc_tag =~ /^-(.*)/ ) { ### old style, backwards-compatibility
50
100
1101
0
0
$field = $1;
1102
} elsif ( $lc_tag =~ /^(.*):$/ ) { ### new style
1103
0
0
$field = $1;
1104
} elsif ( $KnownField{$lc_tag} or
1105
$lc_tag =~ m{^(content|resent|x)-.} ){
1106
13
23
$field = $lc_tag;
1107
} else { ### not a field:
1108
36
86
next;
1109
}
1110
1111
### Add it:
1112
13
41
$self->add( $field, $value );
1113
}
1114
1115
### Done!
1116
20
111
$self;
1117
}
1118
1119
#pod =back
1120
#pod
1121
#pod =cut
1122
1123
1124
#==============================
1125
#==============================
1126
1127
#pod =head2 Setting/getting headers and attributes
1128
#pod
1129
#pod =over 4
1130
#pod
1131
#pod =cut
1132
1133
1134
#------------------------------
1135
#
1136
# top_level ONOFF
1137
#
1138
# Set/unset the top-level attributes and headers.
1139
# This affects "MIME-Version", "X-Mailer", and "Date"
1140
1141
sub top_level {
1142
30
30
0
50
my ( $self, $onoff ) = @_;
1143
30
42
my $attrs = $self->{Attrs};
1144
30
100
46
if ($onoff) {
1145
15
40
$attrs->{'mime-version'} = '1.0';
1146
15
50
80
my $uses = ( @Uses ? ( "(" . join( "; ", @Uses ) . ")" ) : '' );
1147
15
100
92
$self->replace( 'X-Mailer' => "MIME::Lite $MIME::Lite::VERSION $uses" )
1148
unless $VANILLA;
1149
} else {
1150
15
20
delete $attrs->{'mime-version'};
1151
15
35
$self->delete('X-Mailer');
1152
15
20
$self->delete('Date');
1153
}
1154
}
1155
1156
#------------------------------
1157
1158
#pod =item add TAG,VALUE
1159
#pod
1160
#pod I
1161
#pod Add field TAG with the given VALUE to the end of the header.
1162
#pod The TAG will be converted to all-lowercase, and the VALUE
1163
#pod will be made "safe" (returns will be given a trailing space).
1164
#pod
1165
#pod B any MIME fields you "add" will override any MIME
1166
#pod attributes I have when it comes time to output those fields.
1167
#pod Normally, you will use this method to add I fields:
1168
#pod
1169
#pod $msg->add("Subject" => "Hi there!");
1170
#pod
1171
#pod Giving VALUE as an arrayref will cause all those values to be added.
1172
#pod This is only useful for special multiple-valued fields like "Received":
1173
#pod
1174
#pod $msg->add("Received" => ["here", "there", "everywhere"]
1175
#pod
1176
#pod Giving VALUE as the empty string adds an invisible placeholder
1177
#pod to the header, which can be used to suppress the output of
1178
#pod the "Content-*" fields or the special "MIME-Version" field.
1179
#pod When suppressing fields, you should use replace() instead of add():
1180
#pod
1181
#pod $msg->replace("Content-disposition" => "");
1182
#pod
1183
#pod I add() is probably going to be more efficient than C,
1184
#pod so you're better off using it for most applications if you are
1185
#pod certain that you don't need to delete() the field first.
1186
#pod
1187
#pod I the name comes from Mail::Header.
1188
#pod
1189
#pod =cut
1190
1191
1192
sub add {
1193
27
27
1
1381
my $self = shift;
1194
27
62
my $tag = lc(shift);
1195
27
45
my $value = shift;
1196
1197
### If a dangerous option, warn them:
1198
27
50
33
68
Carp::carp "Explicitly setting a MIME header field ($tag) is dangerous:\n"
1199
. "use the attr() method instead.\n"
1200
if ( is_mime_field($tag) && !$QUIET );
1201
1202
### Get array of clean values:
1203
my @vals = ( ( ref($value) and ( ref($value) eq 'ARRAY' ) )
1204
27
100
66
114
? @{$value}
1
4
1205
: ( $value . '' )
1206
);
1207
27
83
map { s/\n/\n /g } @vals;
28
82
1208
1209
### Add them:
1210
27
53
foreach (@vals) {
1211
28
39
push @{ $self->{Header} }, [ $tag, $_ ];
28
243
1212
}
1213
}
1214
1215
#------------------------------
1216
1217
#pod =item attr ATTR,[VALUE]
1218
#pod
1219
#pod I
1220
#pod Set MIME attribute ATTR to the string VALUE.
1221
#pod ATTR is converted to all-lowercase.
1222
#pod This method is normally used to set/get MIME attributes:
1223
#pod
1224
#pod $msg->attr("content-type" => "text/html");
1225
#pod $msg->attr("content-type.charset" => "US-ASCII");
1226
#pod $msg->attr("content-type.name" => "homepage.html");
1227
#pod
1228
#pod This would cause the final output to look something like this:
1229
#pod
1230
#pod Content-type: text/html; charset=US-ASCII; name="homepage.html"
1231
#pod
1232
#pod Note that the special empty sub-field tag indicates the anonymous
1233
#pod first sub-field.
1234
#pod
1235
#pod Giving VALUE as undefined will cause the contents of the named
1236
#pod subfield to be deleted.
1237
#pod
1238
#pod Supplying no VALUE argument just returns the attribute's value:
1239
#pod
1240
#pod $type = $msg->attr("content-type"); ### returns "text/html"
1241
#pod $name = $msg->attr("content-type.name"); ### returns "homepage.html"
1242
#pod
1243
#pod =cut
1244
1245
1246
sub attr {
1247
3
3
1
16
my ( $self, $attr, $value ) = @_;
1248
3
8
my $attrs = $self->{Attrs};
1249
1250
3
10
$attr = lc($attr);
1251
1252
### Break attribute name up:
1253
3
43
my ( $tag, $subtag ) = split /\./, $attr;
1254
3
100
15
if (defined($subtag)) {
1255
2
100
12
$attrs = $self->{SubAttrs}{$tag} ||= {};
1256
2
4
$tag = $subtag;
1257
}
1258
1259
### Set or get?
1260
3
100
15
if ( @_ > 2 ) { ### set:
1261
2
50
13
if ( defined($value) ) {
1262
2
7
$attrs->{$tag} = $value;
1263
} else {
1264
0
0
delete $attrs->{$tag};
1265
}
1266
}
1267
1268
### Return current value:
1269
3
13
$attrs->{$tag};
1270
}
1271
1272
sub _safe_attr {
1273
0
0
0
my ( $self, $attr ) = @_;
1274
0
0
0
return defined $self->{Attrs}{$attr} ? $self->{Attrs}{$attr} : '';
1275
}
1276
1277
#------------------------------
1278
1279
#pod =item delete TAG
1280
#pod
1281
#pod I
1282
#pod Delete field TAG with the given VALUE to the end of the header.
1283
#pod The TAG will be converted to all-lowercase.
1284
#pod
1285
#pod $msg->delete("Subject");
1286
#pod
1287
#pod I the name comes from Mail::Header.
1288
#pod
1289
#pod =cut
1290
1291
1292
sub delete {
1293
33
33
1
35
my $self = shift;
1294
33
58
my $tag = lc(shift);
1295
1296
### Delete from the header:
1297
33
52
my $hdr = [];
1298
33
36
my $field;
1299
33
33
foreach $field ( @{ $self->{Header} } ) {
33
58
1300
11
100
34
push @$hdr, $field if ( $field->[0] ne $tag );
1301
}
1302
33
46
$self->{Header} = $hdr;
1303
33
66
$self;
1304
}
1305
1306
1307
#------------------------------
1308
1309
#pod =item field_order FIELD,...FIELD
1310
#pod
1311
#pod I
1312
#pod Change the order in which header fields are output for this object:
1313
#pod
1314
#pod $msg->field_order('from', 'to', 'content-type', 'subject');
1315
#pod
1316
#pod When used as a class method, changes the default settings for
1317
#pod all objects:
1318
#pod
1319
#pod MIME::Lite->field_order('from', 'to', 'content-type', 'subject');
1320
#pod
1321
#pod Case does not matter: all field names will be coerced to lowercase.
1322
#pod In either case, supply the empty array to restore the default ordering.
1323
#pod
1324
#pod =cut
1325
1326
1327
sub field_order {
1328
1
1
1
9
my $self = shift;
1329
1
50
3
if ( ref($self) ) {
1330
1
3
$self->{FieldOrder} = [ map { lc($_) } @_ ];
7
22
1331
} else {
1332
0
0
@FieldOrder = map { lc($_) } @_;
0
0
1333
}
1334
}
1335
1336
#------------------------------
1337
1338
#pod =item fields
1339
#pod
1340
#pod I
1341
#pod Return the full header for the object, as a ref to an array
1342
#pod of C<[TAG, VALUE]> pairs, where each TAG is all-lowercase.
1343
#pod Note that any fields the user has explicitly set will override the
1344
#pod corresponding MIME fields that we would otherwise generate.
1345
#pod So, don't say...
1346
#pod
1347
#pod $msg->set("Content-type" => "text/html; charset=US-ASCII");
1348
#pod
1349
#pod unless you want the above value to override the "Content-type"
1350
#pod MIME field that we would normally generate.
1351
#pod
1352
#pod I I called this "fields" because the header() method of
1353
#pod Mail::Header returns something different, but similar enough to
1354
#pod be confusing.
1355
#pod
1356
#pod You can change the order of the fields: see L.
1357
#pod You really shouldn't need to do this, but some people have to
1358
#pod deal with broken mailers.
1359
#pod
1360
#pod =cut
1361
1362
1363
sub fields {
1364
9
9
1
13
my $self = shift;
1365
9
17
my @fields;
1366
9
16
my $attrs = $self->{Attrs};
1367
9
17
my $sub_attrs = $self->{SubAttrs};
1368
1369
### Get a lookup-hash of all *explicitly-given* fields:
1370
9
15
my %explicit = map { $_->[0] => 1 } @{ $self->{Header} };
15
54
9
23
1371
1372
### Start with any MIME attributes not given explicitly:
1373
9
20
my $tag;
1374
9
15
foreach $tag ( sort keys %{ $self->{Attrs} } ) {
9
57
1375
1376
### Skip if explicit:
1377
41
50
76
next if ( $explicit{$tag} );
1378
1379
# get base attr value or skip if not available
1380
41
69
my $value = $attrs->{$tag};
1381
41
100
104
defined $value or next;
1382
1383
### handle sub-attrs if available
1384
32
100
70
if (my $subs = $sub_attrs->{$tag}) {
1385
$value .= '; ' .
1386
join('; ', map {
1387
7
50
22
/\*$/ ? qq[$_=$subs->{$_}] : qq[$_="$subs->{$_}"]
7
61
1388
} sort keys %$subs);
1389
}
1390
1391
# handle stripping \r\n now since we're not doing it in attr()
1392
# anymore
1393
32
57
$value =~ tr/\r\n//;
1394
1395
### Add to running fields;
1396
32
81
push @fields, [ $tag, $value ];
1397
}
1398
1399
### Add remaining fields (note that we duplicate the array for safety):
1400
9
17
foreach ( @{ $self->{Header} } ) {
9
21
1401
15
24
push @fields, [ @{$_} ];
15
59
1402
}
1403
1404
### Final step:
1405
### If a suggested ordering was given, we "sort" by that ordering.
1406
### The idea is that we give each field a numeric rank, which is
1407
### (1000 * order(field)) + origposition.
1408
9
100
17
my @order = @{ $self->{FieldOrder} || [] }; ### object-specific
9
111
1409
9
100
30
@order or @order = @FieldOrder; ### no? maybe generic
1410
9
100
35
if (@order) { ### either?
1411
1412
### Create hash mapping field names to 1-based rank:
1413
1
5
my %rank = map { $order[$_] => ( 1 + $_ ) } ( 0 .. $#order );
7
37
1414
1415
### Create parallel array to @fields, called @ranked.
1416
### It contains fields tagged with numbers like 2003, where the
1417
### 3 is the original 0-based position, and 2000 indicates that
1418
### we wanted this type of field to go second.
1419
my @ranked = map {
1420
1
66
5
[ ( $_ + 1000 * ( $rank{ lc( $fields[$_][0] ) } || ( 2 + $#order ) ) ), $fields[$_] ]
8
31
1421
} ( 0 .. $#fields );
1422
1423
# foreach (@ranked) {
1424
# print STDERR "RANKED: $_->[0] $_->[1][0] $_->[1][1]\n";
1425
# }
1426
1427
### That was half the Schwartzian transform. Here's the rest:
1428
8
16
@fields = map { $_->[1] }
1429
1
7
sort { $a->[0] <=> $b->[0] } @ranked;
15
26
1430
}
1431
1432
### Done!
1433
9
56
return \@fields;
1434
}
1435
1436
1437
#------------------------------
1438
1439
#pod =item filename [FILENAME]
1440
#pod
1441
#pod I
1442
#pod Set the filename which this data will be reported as.
1443
#pod This actually sets both "standard" attributes.
1444
#pod
1445
#pod With no argument, returns the filename as dictated by the
1446
#pod content-disposition.
1447
#pod
1448
#pod =cut
1449
1450
1451
sub filename {
1452
5
5
1
13
my ( $self, $filename ) = @_;
1453
5
10
my $sub_attrs = $self->{SubAttrs};
1454
1455
5
50
16
if ( @_ > 1 ) {
1456
5
15
$sub_attrs->{'content-type'}{'name'} = $filename;
1457
5
13
$sub_attrs->{'content-disposition'}{'filename'} = $filename;
1458
}
1459
5
20
return $sub_attrs->{'content-disposition'}{'filename'};
1460
}
1461
1462
#------------------------------
1463
1464
#pod =item get TAG,[INDEX]
1465
#pod
1466
#pod I
1467
#pod Get the contents of field TAG, which might have been set
1468
#pod with set() or replace(). Returns the text of the field.
1469
#pod
1470
#pod $ml->get('Subject', 0);
1471
#pod
1472
#pod If the optional 0-based INDEX is given, then we return the INDEX'th
1473
#pod occurrence of field TAG. Otherwise, we look at the context:
1474
#pod In a scalar context, only the first (0th) occurrence of the
1475
#pod field is returned; in an array context, I occurrences are returned.
1476
#pod
1477
#pod I this should only be used with non-MIME fields.
1478
#pod Behavior with MIME fields is TBD, and will raise an exception for now.
1479
#pod
1480
#pod =cut
1481
1482
1483
sub get {
1484
12
12
1
47
my ( $self, $tag, $index ) = @_;
1485
12
28
$tag = lc($tag);
1486
12
50
31
Carp::croak "get: can't be used with MIME fields\n" if is_mime_field($tag);
1487
1488
12
100
25
my @all = map { ( $_->[0] eq $tag ) ? $_->[1] : () } @{ $self->{Header} };
66
167
12
35
1489
12
100
78
( defined($index) ? $all[$index] : ( wantarray ? @all : $all[0] ) );
100
1490
}
1491
1492
#------------------------------
1493
1494
#pod =item get_length
1495
#pod
1496
#pod I
1497
#pod Recompute the content length for the message I,
1498
#pod setting the "content-length" attribute as a side-effect:
1499
#pod
1500
#pod $msg->get_length;
1501
#pod
1502
#pod Returns the length, or undefined if not set.
1503
#pod
1504
#pod I the content length can be difficult to compute, since it
1505
#pod involves assembling the entire encoded body and taking the length
1506
#pod of it (which, in the case of multipart messages, means freezing
1507
#pod all the sub-parts, etc.).
1508
#pod
1509
#pod This method only sets the content length to a defined value if the
1510
#pod message is a singlepart with C<"binary"> encoding, I the body is
1511
#pod available either in-core or as a simple file. Otherwise, the content
1512
#pod length is set to the undefined value.
1513
#pod
1514
#pod Since content-length is not a standard MIME field anyway (that's right, kids:
1515
#pod it's not in the MIME RFCs, it's an HTTP thing), this seems pretty fair.
1516
#pod
1517
#pod =cut
1518
1519
1520
#----
1521
# Miko's note: I wasn't quite sure how to handle this, so I waited to hear
1522
# what you think. Given that the content-length isn't always required,
1523
# and given the performance cost of calculating it from a file handle,
1524
# I thought it might make more sense to add some sort of computelength
1525
# property. If computelength is false, then the length simply isn't
1526
# computed. What do you think?
1527
#
1528
# Eryq's reply: I agree; for now, we can silently leave out the content-type.
1529
1530
sub get_length {
1531
37
37
1
51
my $self = shift;
1532
37
94
my $attrs = $self->{Attrs};
1533
1534
37
110
my $is_multipart = ( $attrs->{'content-type'} =~ m{^multipart/}i );
1535
37
100
145
my $enc = lc( $attrs->{'content-transfer-encoding'} || 'binary' );
1536
37
51
my $length;
1537
37
100
100
130
if ( !$is_multipart && ( $enc eq "binary" ) ) { ### might figure it out cheap:
1538
17
100
49
if ( defined( $self->{Data} ) ) { ### it's in core
50
50
1539
13
21
$length = length( $self->{Data} );
1540
} elsif ( defined( $self->{FH} ) ) { ### it's in a filehandle
1541
### no-op: it's expensive, so don't bother
1542
} elsif ( defined( $self->{Path} ) ) { ### it's a simple file!
1543
4
100
181
$length = ( -s $self->{Path} ) if ( -e $self->{Path} );
1544
}
1545
}
1546
37
60
$attrs->{'content-length'} = $length;
1547
37
61
return $length;
1548
}
1549
1550
#------------------------------
1551
1552
#pod =item parts
1553
#pod
1554
#pod I
1555
#pod Return the parts of this entity, and this entity only.
1556
#pod Returns empty array if this entity has no parts.
1557
#pod
1558
#pod This is B recursive! Parts can have sub-parts; use
1559
#pod parts_DFS() to get everything.
1560
#pod
1561
#pod =cut
1562
1563
1564
sub parts {
1565
9
9
1
11
my $self = shift;
1566
9
50
9
@{ $self->{Parts} || [] };
9
27
1567
}
1568
1569
#------------------------------
1570
1571
#pod =item parts_DFS
1572
#pod
1573
#pod I
1574
#pod Return the list of all MIME::Lite objects included in the entity,
1575
#pod starting with the entity itself, in depth-first-search order.
1576
#pod If this object has no parts, it alone will be returned.
1577
#pod
1578
#pod =cut
1579
1580
1581
sub parts_DFS {
1582
8
8
1
5
my $self = shift;
1583
8
11
return ( $self, map { $_->parts_DFS } $self->parts );
7
12
1584
}
1585
1586
#------------------------------
1587
1588
#pod =item preamble [TEXT]
1589
#pod
1590
#pod I
1591
#pod Get/set the preamble string, assuming that this object has subparts.
1592
#pod Set it to undef for the default string.
1593
#pod
1594
#pod =cut
1595
1596
1597
sub preamble {
1598
0
0
1
0
my $self = shift;
1599
0
0
0
$self->{Preamble} = shift if @_;
1600
0
0
$self->{Preamble};
1601
}
1602
1603
#------------------------------
1604
1605
#pod =item replace TAG,VALUE
1606
#pod
1607
#pod I
1608
#pod Delete all occurrences of fields named TAG, and add a new
1609
#pod field with the given VALUE. TAG is converted to all-lowercase.
1610
#pod
1611
#pod B the special MIME fields (MIME-version, Content-*):
1612
#pod if you "replace" a MIME field, the replacement text will override
1613
#pod the I MIME attributes when it comes time to output that field.
1614
#pod So normally you use attr() to change MIME fields and add()/replace() to
1615
#pod change I fields:
1616
#pod
1617
#pod $msg->replace("Subject" => "Hi there!");
1618
#pod
1619
#pod Giving VALUE as the I will effectively I that
1620
#pod field from being output. This is the correct way to suppress
1621
#pod the special MIME fields:
1622
#pod
1623
#pod $msg->replace("Content-disposition" => "");
1624
#pod
1625
#pod Giving VALUE as I will just cause all explicit values
1626
#pod for TAG to be deleted, without having any new values added.
1627
#pod
1628
#pod I the name of this method comes from Mail::Header.
1629
#pod
1630
#pod =cut
1631
1632
1633
sub replace {
1634
2
2
1
8
my ( $self, $tag, $value ) = @_;
1635
2
10
$self->delete($tag);
1636
2
50
14
$self->add( $tag, $value ) if defined($value);
1637
}
1638
1639
1640
#------------------------------
1641
1642
#pod =item scrub
1643
#pod
1644
#pod I
1645
#pod B
1646
#pod Recursively goes through the "parts" tree of this message and tries
1647
#pod to find MIME attributes that can be removed.
1648
#pod With an array argument, removes exactly those attributes; e.g.:
1649
#pod
1650
#pod $msg->scrub(['content-disposition', 'content-length']);
1651
#pod
1652
#pod Is the same as recursively doing:
1653
#pod
1654
#pod $msg->replace('Content-disposition' => '');
1655
#pod $msg->replace('Content-length' => '');
1656
#pod
1657
#pod =cut
1658
1659
1660
sub scrub {
1661
0
0
1
0
my ( $self, @a ) = @_;
1662
0
0
my ($expl) = @a;
1663
0
0
local $QUIET = 1;
1664
1665
### Scrub me:
1666
0
0
0
0
if ( !@a ) { ### guess
0
1667
1668
### Scrub length always:
1669
0
0
$self->replace( 'content-length', '' );
1670
1671
### Scrub disposition if no filename, or if content-type has same info:
1672
0
0
0
0
if ( !$self->_safe_attr('content-disposition.filename')
1673
|| $self->_safe_attr('content-type.name') )
1674
{
1675
0
0
$self->replace( 'content-disposition', '' );
1676
}
1677
1678
### Scrub encoding if effectively unencoded:
1679
0
0
0
if ( $self->_safe_attr('content-transfer-encoding') =~ /^(7bit|8bit|binary)$/i ) {
1680
0
0
$self->replace( 'content-transfer-encoding', '' );
1681
}
1682
1683
### Scrub charset if US-ASCII:
1684
0
0
0
if ( $self->_safe_attr('content-type.charset') =~ /^(us-ascii)/i ) {
1685
0
0
$self->attr( 'content-type.charset' => undef );
1686
}
1687
1688
### TBD: this is not really right for message/digest:
1689
0
0
0
0
if ( ( keys %{ $self->{Attrs}{'content-type'} } == 1 )
0
0
1690
and ( $self->_safe_attr('content-type') eq 'text/plain' ) )
1691
{
1692
0
0
$self->replace( 'content-type', '' );
1693
}
1694
} elsif ( $expl and ( ref($expl) eq 'ARRAY' ) ) {
1695
0
0
foreach ( @{$expl} ) { $self->replace( $_, '' ); }
0
0
0
0
1696
}
1697
1698
### Scrub my kids:
1699
0
0
foreach ( @{ $self->{Parts} } ) { $_->scrub(@a); }
0
0
0
0
1700
}
1701
1702
#pod =back
1703
#pod
1704
#pod =cut
1705
1706
1707
#==============================
1708
#==============================
1709
1710
#pod =head2 Setting/getting message data
1711
#pod
1712
#pod =over 4
1713
#pod
1714
#pod =cut
1715
1716
1717
#------------------------------
1718
1719
#pod =item binmode [OVERRIDE]
1720
#pod
1721
#pod I
1722
#pod With no argument, returns whether or not it thinks that the data
1723
#pod (as given by the "Path" argument of C) should be read using
1724
#pod binmode() (for example, when C is invoked).
1725
#pod
1726
#pod The default behavior is that any content type other than
1727
#pod C or C is binmode'd; this should in general work fine.
1728
#pod
1729
#pod With a defined argument, this method sets an explicit "override"
1730
#pod value. An undefined argument unsets the override.
1731
#pod The new current value is returned.
1732
#pod
1733
#pod =cut
1734
1735
1736
sub binmode {
1737
2
2
1
4
my $self = shift;
1738
2
50
21
$self->{Binmode} = shift if (@_); ### argument? set override
1739
return ( defined( $self->{Binmode} )
1740
? $self->{Binmode}
1741
2
50
23
: ( $self->{Attrs}{"content-type"} !~ m{^(text|message)/}i )
1742
);
1743
}
1744
1745
#------------------------------
1746
1747
#pod =item data [DATA]
1748
#pod
1749
#pod I
1750
#pod Get/set the literal DATA of the message. The DATA may be
1751
#pod either a scalar, or a reference to an array of scalars (which
1752
#pod will simply be joined).
1753
#pod
1754
#pod I setting the data causes the "content-length" attribute
1755
#pod to be recomputed (possibly to nothing).
1756
#pod
1757
#pod =cut
1758
1759
1760
sub data {
1761
13
13
1
19
my $self = shift;
1762
13
50
27
if (@_) {
1763
13
100
37
$self->{Data} = ( ( ref( $_[0] ) eq 'ARRAY' ) ? join( '', @{ $_[0] } ) : $_[0] );
2
8
1764
13
32
$self->get_length;
1765
}
1766
13
22
$self->{Data};
1767
}
1768
1769
#------------------------------
1770
1771
#pod =item fh [FILEHANDLE]
1772
#pod
1773
#pod I
1774
#pod Get/set the FILEHANDLE which contains the message data.
1775
#pod
1776
#pod Takes a filehandle as an input and stores it in the object.
1777
#pod This routine is similar to path(); one important difference is that
1778
#pod no attempt is made to set the content length.
1779
#pod
1780
#pod =cut
1781
1782
1783
sub fh {
1784
0
0
1
0
my $self = shift;
1785
0
0
0
$self->{FH} = shift if @_;
1786
0
0
$self->{FH};
1787
}
1788
1789
#------------------------------
1790
1791
#pod =item path [PATH]
1792
#pod
1793
#pod I
1794
#pod Get/set the PATH to the message data.
1795
#pod
1796
#pod I setting the path recomputes any existing "content-length" field,
1797
#pod and re-sets the "filename" (to the last element of the path if it
1798
#pod looks like a simple path, and to nothing if not).
1799
#pod
1800
#pod =cut
1801
1802
1803
sub path {
1804
4
4
1
8
my $self = shift;
1805
4
50
12
if (@_) {
1806
1807
### Set the path, and invalidate the content length:
1808
4
10
$self->{Path} = shift;
1809
1810
### Re-set filename, extracting it from path if possible:
1811
4
7
my $filename;
1812
4
100
66
43
if ( $self->{Path} and ( $self->{Path} !~ /\|$/ ) ) { ### non-shell path:
1813
3
12
( $filename = $self->{Path} ) =~ s/^/;
1814
1815
### Consult File::Basename
1816
3
150
$filename = File::Basename::basename($filename);
1817
}
1818
4
56
$self->filename($filename);
1819
1820
### Reset the length:
1821
4
11
$self->get_length;
1822
}
1823
4
8
$self->{Path};
1824
}
1825
1826
#------------------------------
1827
1828
#pod =item resetfh [FILEHANDLE]
1829
#pod
1830
#pod I
1831
#pod Set the current position of the filehandle back to the beginning.
1832
#pod Only applies if you used "FH" in build() or attach() for this message.
1833
#pod
1834
#pod Returns false if unable to reset the filehandle (since not all filehandles
1835
#pod are seekable).
1836
#pod
1837
#pod =cut
1838
1839
1840
#----
1841
# Miko's note: With the Data and Path, the same data could theoretically
1842
# be reused. However, file handles need to be reset to be reused,
1843
# so I added this routine.
1844
#
1845
# Eryq reply: beware... not all filehandles are seekable (think about STDIN)!
1846
1847
sub resetfh {
1848
0
0
1
0
my $self = shift;
1849
0
0
seek( $self->{FH}, 0, 0 );
1850
}
1851
1852
#------------------------------
1853
1854
#pod =item read_now
1855
#pod
1856
#pod I
1857
#pod Forces data from the path/filehandle (as specified by C)
1858
#pod to be read into core immediately, just as though you had given it
1859
#pod literally with the C keyword.
1860
#pod
1861
#pod Note that the in-core data will always be used if available.
1862
#pod
1863
#pod Be aware that everything is slurped into a giant scalar: you may not want
1864
#pod to use this if sending tar files! The benefit of I reading in the data
1865
#pod is that very large files can be handled by this module if left on disk
1866
#pod until the message is output via C or C.
1867
#pod
1868
#pod =cut
1869
1870
1871
sub read_now {
1872
1
1
1
2
my $self = shift;
1873
1
7
local $/ = undef;
1874
1875
1
50
6
if ( $self->{FH} ) { ### data from a filehandle:
50
1876
0
0
my $chunk;
1877
my @chunks;
1878
0
0
0
CORE::binmode( $self->{FH} ) if $self->binmode;
1879
0
0
while ( read( $self->{FH}, $chunk, 1024 ) ) {
1880
0
0
push @chunks, $chunk;
1881
}
1882
0
0
$self->{Data} = join '', @chunks;
1883
} elsif ( $self->{Path} ) { ### data from a path:
1884
1
50
46
open SLURP, $self->{Path} or Carp::croak "open $self->{Path}: $!\n";
1885
1
50
6
CORE::binmode(SLURP) if $self->binmode;
1886
1
86
$self->{Data} = ; ### sssssssssssssslurp...
1887
1
18
close SLURP; ### ...aaaaaaaaahhh!
1888
}
1889
}
1890
1891
#------------------------------
1892
1893
#pod =item sign PARAMHASH
1894
#pod
1895
#pod I
1896
#pod Sign the message. This forces the message to be read into core,
1897
#pod after which the signature is appended to it.
1898
#pod
1899
#pod =over 4
1900
#pod
1901
#pod =item Data
1902
#pod
1903
#pod As in C: the literal signature data.
1904
#pod Can be either a scalar or a ref to an array of scalars.
1905
#pod
1906
#pod =item Path
1907
#pod
1908
#pod As in C: the path to the file.
1909
#pod
1910
#pod =back
1911
#pod
1912
#pod If no arguments are given, the default is:
1913
#pod
1914
#pod Path => "$ENV{HOME}/.signature"
1915
#pod
1916
#pod The content-length is recomputed.
1917
#pod
1918
#pod =cut
1919
1920
1921
sub sign {
1922
0
0
1
0
my $self = shift;
1923
0
0
my %params = @_;
1924
1925
### Default:
1926
0
0
0
@_ or $params{Path} = "$ENV{HOME}/.signature";
1927
1928
### Force message in-core:
1929
0
0
0
defined( $self->{Data} ) or $self->read_now;
1930
1931
### Load signature:
1932
0
0
my $sig;
1933
0
0
0
if ( !defined( $sig = $params{Data} ) ) { ### not given explicitly:
1934
0
0
local $/ = undef;
1935
0
0
0
open SIG, $params{Path} or Carp::croak "open sig $params{Path}: $!\n";
1936
0
0
$sig = ; ### sssssssssssssslurp...
1937
0
0
close SIG; ### ...aaaaaaaaahhh!
1938
}
1939
0
0
0
0
$sig = join( '', @$sig ) if ( ref($sig) and ( ref($sig) eq 'ARRAY' ) );
1940
1941
### Append, following Internet conventions:
1942
0
0
$self->{Data} .= "\n-- \n$sig";
1943
1944
### Re-compute length:
1945
0
0
$self->get_length;
1946
0
0
1;
1947
}
1948
1949
#------------------------------
1950
#
1951
# =item suggest_encoding CONTENTTYPE
1952
#
1953
# I
1954
# Based on the CONTENTTYPE, return a good suggested encoding.
1955
# C and C types have their bodies scanned line-by-line
1956
# for 8-bit characters and long lines; lack of either means that the
1957
# message is 7bit-ok. Other types are chosen independent of their body:
1958
#
1959
# Major type: 7bit ok? Suggested encoding:
1960
# ------------------------------------------------------------
1961
# text yes 7bit
1962
# no quoted-printable
1963
# unknown binary
1964
#
1965
# message yes 7bit
1966
# no binary
1967
# unknown binary
1968
#
1969
# multipart n/a binary (in case some parts are not ok)
1970
#
1971
# (other) n/a base64
1972
#
1973
#=cut
1974
1975
sub suggest_encoding {
1976
20
20
0
59
my ( $self, $ctype ) = @_;
1977
20
38
$ctype = lc($ctype);
1978
1979
### Consult MIME::Types, maybe:
1980
20
50
41
if ($HaveMimeTypes) {
1981
1982
### Mappings contain [suffix,mimetype,encoding]
1983
20
75
my @mappings = MIME::Types::by_mediatype($ctype);
1984
20
100
285680
if ( scalar(@mappings) ) {
1985
### Just pick the first one:
1986
19
27
my ( $suffix, $mimetype, $encoding ) = @{ $mappings[0] };
19
109
1987
19
50
33
207
if ( $encoding
1988
&& $encoding =~ /^(base64|binary|[78]bit|quoted-printable)$/i )
1989
{
1990
19
163
return lc($encoding); ### sanity check
1991
}
1992
}
1993
}
1994
1995
### If we got here, then MIME::Types was no help.
1996
### Extract major type:
1997
1
5
my ($type) = split '/', $ctype;
1998
1
50
33
18
if ( ( $type eq 'text' ) || ( $type eq 'message' ) ) { ### scan message body?
1999
0
0
return 'binary';
2000
} else {
2001
1
50
11
return ( $type eq 'multipart' ) ? 'binary' : 'base64';
2002
}
2003
}
2004
2005
#------------------------------
2006
#
2007
# =item suggest_type PATH
2008
#
2009
# I
2010
# Suggest the content-type for this attached path.
2011
# We always fall back to "application/octet-stream" if no good guess
2012
# can be made, so don't use this if you don't mean it!
2013
#
2014
sub suggest_type {
2015
1
1
0
3
my ( $self, $path ) = @_;
2016
2017
### If there's no path, bail:
2018
1
50
3
$path or return 'application/octet-stream';
2019
2020
### Consult MIME::Types, maybe:
2021
1
50
4
if ($HaveMimeTypes) {
2022
2023
# Mappings contain [mimetype,encoding]:
2024
1
6
my ( $mimetype, $encoding ) = MIME::Types::by_suffix($path);
2025
1
50
33
171
return $mimetype if ( $mimetype && $mimetype =~ /^\S+\/\S+$/ ); ### sanity check
2026
}
2027
### If we got here, then MIME::Types was no help.
2028
### The correct thing to fall back to is the most-generic content type:
2029
0
0
return 'application/octet-stream';
2030
}
2031
2032
#------------------------------
2033
2034
#pod =item verify_data
2035
#pod
2036
#pod I
2037
#pod Verify that all "paths" to attached data exist, recursively.
2038
#pod It might be a good idea for you to do this before a print(), to
2039
#pod prevent accidental partial output if a file might be missing.
2040
#pod Raises exception if any path is not readable.
2041
#pod
2042
#pod =cut
2043
2044
2045
sub verify_data {
2046
18
18
1
33
my $self = shift;
2047
2048
### Verify self:
2049
18
23
my $path = $self->{Path};
2050
18
100
100
52
if ( $path and ( $path !~ /\|$/ ) ) { ### non-shell path:
2051
4
10
$path =~ s/^/;
2052
4
100
189
( -r $path ) or die "$path: not readable\n";
2053
}
2054
2055
### Verify parts:
2056
17
24
foreach my $part ( @{ $self->{Parts} } ) { $part->verify_data }
17
35
8
19
2057
16
24
1;
2058
}
2059
2060
#pod =back
2061
#pod
2062
#pod =cut
2063
2064
2065
#==============================
2066
#==============================
2067
2068
#pod =head2 Output
2069
#pod
2070
#pod =over 4
2071
#pod
2072
#pod =cut
2073
2074
2075
#------------------------------
2076
2077
#pod =item print [OUTHANDLE]
2078
#pod
2079
#pod I
2080
#pod Print the message to the given output handle, or to the currently-selected
2081
#pod filehandle if none was given.
2082
#pod
2083
#pod All OUTHANDLE has to be is a filehandle (possibly a glob ref), or
2084
#pod any object that responds to a print() message.
2085
#pod
2086
#pod =cut
2087
2088
2089
sub print {
2090
8
8
1
17
my ( $self, $out ) = @_;
2091
2092
### Coerce into a printable output handle:
2093
8
34
$out = MIME::Lite::IO_Handle->wrap($out);
2094
2095
### Output head, separator, and body:
2096
8
50
35
$self->verify_data if $AUTO_VERIFY; ### prevents missing parts!
2097
8
28
$out->print( $self->header_as_string );
2098
8
52
$out->print( "\n" );
2099
8
29
$self->print_body($out);
2100
}
2101
2102
#------------------------------
2103
#
2104
# print_for_smtp
2105
#
2106
# Instance method, private.
2107
# Print, but filter out the topmost "Bcc" field.
2108
# This is because qmail apparently doesn't do this for us!
2109
#
2110
sub print_for_smtp {
2111
0
0
0
0
my ( $self, $out ) = @_;
2112
2113
### Coerce into a printable output handle:
2114
0
0
$out = MIME::Lite::IO_Handle->wrap($out);
2115
2116
### Create a safe head:
2117
0
0
my @fields = grep { $_->[0] ne 'bcc' } @{ $self->fields };
0
0
0
0
2118
0
0
my $header = $self->fields_as_string( \@fields );
2119
2120
### Output head, separator, and body:
2121
0
0
$out->print( $header );
2122
0
0
$out->print( "\n" );
2123
0
0
$self->print_body( $out, '1' );
2124
}
2125
2126
#------------------------------
2127
2128
#pod =item print_body [OUTHANDLE] [IS_SMTP]
2129
#pod
2130
#pod I
2131
#pod Print the body of a message to the given output handle, or to
2132
#pod the currently-selected filehandle if none was given.
2133
#pod
2134
#pod All OUTHANDLE has to be is a filehandle (possibly a glob ref), or
2135
#pod any object that responds to a print() message.
2136
#pod
2137
#pod B raised if unable to open any of the input files,
2138
#pod or if a part contains no data, or if an unsupported encoding is
2139
#pod encountered.
2140
#pod
2141
#pod IS_SMPT is a special option to handle SMTP mails a little more
2142
#pod intelligently than other send mechanisms may require. Specifically this
2143
#pod ensures that the last byte sent is NOT '\n' (octal \012) if the last two
2144
#pod bytes are not '\r\n' (\015\012) as this will cause some SMTP servers to
2145
#pod hang.
2146
#pod
2147
#pod =cut
2148
2149
2150
sub print_body {
2151
8
8
1
18
my ( $self, $out, $is_smtp ) = @_;
2152
8
31
my $attrs = $self->{Attrs};
2153
8
15
my $sub_attrs = $self->{SubAttrs};
2154
2155
### Coerce into a printable output handle:
2156
8
21
$out = MIME::Lite::IO_Handle->wrap($out);
2157
2158
### Output either the body or the parts.
2159
### Notice that we key off of the content-type! We expect fewer
2160
### accidents that way, since the syntax will always match the MIME type.
2161
8
18
my $type = $attrs->{'content-type'};
2162
8
100
35
if ( $type =~ m{^multipart/}i ) {
50
2163
2
6
my $boundary = $sub_attrs->{'content-type'}{'boundary'};
2164
2165
### Preamble:
2166
$out->print( defined( $self->{Preamble} )
2167
? $self->{Preamble}
2168
2
50
12
: "This is a multi-part message in MIME format.\n"
2169
);
2170
2171
### Parts:
2172
2
4
my $part;
2173
2
20
foreach $part ( @{ $self->{Parts} } ) {
2
9
2174
2
9
$out->print("\n--$boundary\n");
2175
2
8
$part->print($out);
2176
}
2177
2178
### Epilogue:
2179
2
9
$out->print("\n--$boundary--\n\n");
2180
} elsif ( $type =~ m{^message/} ) {
2181
0
0
my @parts = @{ $self->{Parts} };
0
0
2182
2183
### It's a toss-up; try both data and parts:
2184
0
0
0
if ( @parts == 0 ) { $self->print_simple_body( $out, $is_smtp ) }
0
0
0
2185
0
0
elsif ( @parts == 1 ) { $parts[0]->print($out) }
2186
0
0
else { Carp::croak "can't handle message with >1 part\n"; }
2187
} else {
2188
6
16
$self->print_simple_body( $out, $is_smtp );
2189
}
2190
8
21
1;
2191
}
2192
2193
#------------------------------
2194
#
2195
# print_simple_body [OUTHANDLE]
2196
#
2197
# I
2198
# Print the body of a simple singlepart message to the given
2199
# output handle, or to the currently-selected filehandle if none
2200
# was given.
2201
#
2202
# Note that if you want to print "the portion after
2203
# the header", you don't want this method: you want
2204
# L.
2205
#
2206
# All OUTHANDLE has to be is a filehandle (possibly a glob ref), or
2207
# any object that responds to a print() message.
2208
#
2209
# B raised if unable to open any of the input files,
2210
# or if a part contains no data, or if an unsupported encoding is
2211
# encountered.
2212
#
2213
sub print_simple_body {
2214
6
6
0
12
my ( $self, $out, $is_smtp ) = @_;
2215
6
53
my $attrs = $self->{Attrs};
2216
2217
### Coerce into a printable output handle:
2218
6
16
$out = MIME::Lite::IO_Handle->wrap($out);
2219
2220
### Get content-transfer-encoding:
2221
6
17
my $encoding = uc( $attrs->{'content-transfer-encoding'} );
2222
6
50
0
13
warn "M::L >>> Encoding using $encoding, is_smtp=" . ( $is_smtp || 0 ) . "\n"
2223
if $MIME::Lite::DEBUG;
2224
2225
### Notice that we don't just attempt to slurp the data in from a file:
2226
### by processing files piecemeal, we still enable ourselves to prepare
2227
### very large MIME messages...
2228
2229
### Is the data in-core? If so, blit it out...
2230
6
100
33
17
if ( defined( $self->{Data} ) ) {
50
2231
DATA:
2232
{
2233
5
6
local $_ = $encoding;
5
8
2234
2235
5
50
13
/^BINARY$/ and do {
2236
0
0
0
$is_smtp and $self->{Data} =~ s/(?!\r)\n\z/\r/;
2237
0
0
$out->print( $self->{Data} );
2238
0
0
last DATA;
2239
};
2240
5
50
41
/^8BIT$/ and do {
2241
5
17
$out->print( encode_8bit( $self->{Data} ) );
2242
5
14
last DATA;
2243
};
2244
0
0
0
/^7BIT$/ and do {
2245
0
0
$out->print( encode_7bit( $self->{Data} ) );
2246
0
0
last DATA;
2247
};
2248
0
0
0
/^QUOTED-PRINTABLE$/ and do {
2249
### UNTAINT since m//mg on tainted data loops forever:
2250
0
0
my ($untainted) = ( $self->{Data} =~ m/\A(.*)\Z/s );
2251
2252
### Encode it line by line:
2253
0
0
while ( $untainted =~ m{^(.*[\r\n]*)}smg ) {
2254
### have to do it line by line...
2255
0
0
my $line = $1; # copy to avoid weird bug; rt 39334
2256
0
0
$out->print( encode_qp($line) );
2257
}
2258
0
0
last DATA;
2259
};
2260
0
0
0
/^BASE64/ and do {
2261
0
0
$out->print( encode_base64( $self->{Data} ) );
2262
0
0
last DATA;
2263
};
2264
0
0
Carp::croak "unsupported encoding: `$_'\n";
2265
}
2266
}
2267
2268
### Else, is the data in a file? If so, output piecemeal...
2269
### Miko's note: this routine pretty much works the same with a path
2270
### or a filehandle. the only difference in behaviour is that it does
2271
### not attempt to open anything if it already has a filehandle
2272
elsif ( defined( $self->{Path} ) || defined( $self->{FH} ) ) {
2273
9
9
144
no strict 'refs'; ### in case FH is not an object
9
22
9
41557
2274
1
2
my $DATA;
2275
2276
### Open file if necessary:
2277
1
50
3
if ( defined( $self->{Path} ) ) {
2278
1
33
7
$DATA = new FileHandle || Carp::croak "can't get new filehandle\n";
2279
1
50
46
$DATA->open("$self->{Path}")
2280
or Carp::croak "open $self->{Path}: $!\n";
2281
} else {
2282
0
0
$DATA = $self->{FH};
2283
}
2284
1
50
47
CORE::binmode($DATA) if $self->binmode;
2285
2286
### Encode piece by piece:
2287
PATH:
2288
{
2289
1
2
local $_ = $encoding;
1
2
2290
2291
1
50
2
/^BINARY$/ and do {
2292
0
0
my $last = "";
2293
0
0
while ( read( $DATA, $_, 2048 ) ) {
2294
0
0
0
$out->print($last) if length $last;
2295
0
0
$last = $_;
2296
}
2297
0
0
0
if ( length $last ) {
2298
0
0
0
$is_smtp and $last =~ s/(?!\r)\n\z/\r/;
2299
0
0
$out->print($last);
2300
}
2301
0
0
last PATH;
2302
};
2303
1
50
5
/^8BIT$/ and do {
2304
1
85
$out->print( encode_8bit($_) ) while (<$DATA>);
2305
1
3
last PATH;
2306
};
2307
0
0
0
/^7BIT$/ and do {
2308
0
0
$out->print( encode_7bit($_) ) while (<$DATA>);
2309
0
0
last PATH;
2310
};
2311
0
0
0
/^QUOTED-PRINTABLE$/ and do {
2312
0
0
$out->print( encode_qp($_) ) while (<$DATA>);
2313
0
0
last PATH;
2314
};
2315
0
0
0
/^BASE64$/ and do {
2316
0
0
$out->print( encode_base64($_) ) while ( read( $DATA, $_, 45 ) );
2317
0
0
last PATH;
2318
};
2319
0
0
Carp::croak "unsupported encoding: `$_'\n";
2320
}
2321
2322
### Close file:
2323
1
50
41
close $DATA if defined( $self->{Path} );
2324
}
2325
2326
else {
2327
0
0
Carp::croak "no data in this part\n";
2328
}
2329
6
12
1;
2330
}
2331
2332
#------------------------------
2333
2334
#pod =item print_header [OUTHANDLE]
2335
#pod
2336
#pod I
2337
#pod Print the header of the message to the given output handle,
2338
#pod or to the currently-selected filehandle if none was given.
2339
#pod
2340
#pod All OUTHANDLE has to be is a filehandle (possibly a glob ref), or
2341
#pod any object that responds to a print() message.
2342
#pod
2343
#pod =cut
2344
2345
2346
sub print_header {
2347
0
0
1
0
my ( $self, $out ) = @_;
2348
2349
### Coerce into a printable output handle:
2350
0
0
$out = MIME::Lite::IO_Handle->wrap($out);
2351
2352
### Output the header:
2353
0
0
$out->print( $self->header_as_string );
2354
0
0
1;
2355
}
2356
2357
#------------------------------
2358
2359
#pod =item as_string
2360
#pod
2361
#pod I
2362
#pod Return the entire message as a string, with a header and an encoded body.
2363
#pod
2364
#pod =cut
2365
2366
2367
sub as_string {
2368
6
6
1
69
my $self = shift;
2369
6
12
my $buf = "";
2370
6
56
my $io = ( wrap MIME::Lite::IO_Scalar \$buf);
2371
6
24
$self->print($io);
2372
6
47
return $buf;
2373
}
2374
*stringify = \&as_string; ### backwards compatibility
2375
*stringify = \&as_string; ### ...twice to avoid warnings :)
2376
2377
#------------------------------
2378
2379
#pod =item body_as_string
2380
#pod
2381
#pod I
2382
#pod Return the encoded body as a string.
2383
#pod This is the portion after the header and the blank line.
2384
#pod
2385
#pod I actually prepares the body by "printing" to a scalar.
2386
#pod Proof that you can hand the C methods any blessed object
2387
#pod that responds to a C message.
2388
#pod
2389
#pod =cut
2390
2391
2392
sub body_as_string {
2393
0
0
1
0
my $self = shift;
2394
0
0
my $buf = "";
2395
0
0
my $io = ( wrap MIME::Lite::IO_Scalar \$buf);
2396
0
0
$self->print_body($io);
2397
0
0
return $buf;
2398
}
2399
*stringify_body = \&body_as_string; ### backwards compatibility
2400
*stringify_body = \&body_as_string; ### ...twice to avoid warnings :)
2401
2402
#------------------------------
2403
#
2404
# fields_as_string FIELDS
2405
#
2406
# PRIVATE! Return a stringified version of the given header
2407
# fields, where FIELDS is an arrayref like that returned by fields().
2408
#
2409
sub fields_as_string {
2410
8
8
0
17
my ( $self, $fields ) = @_;
2411
8
21
my $out = "";
2412
8
15
foreach (@$fields) {
2413
39
74
my ( $tag, $value ) = @$_;
2414
39
50
71
next if ( $value eq '' ); ### skip empties
2415
39
163
$tag =~ s/\b([a-z])/uc($1)/ge; ### make pretty
76
219
2416
39
99
$tag =~ s/^mime-/MIME-/i; ### even prettier
2417
39
50
33
92
if (length($value) > 72 && $value !~ /\n/) {
2418
0
0
$value = fold_header($value);
2419
}
2420
39
115
$out .= "$tag: $value\n";
2421
}
2422
8
53
return $out;
2423
}
2424
2425
sub fold_header {
2426
0
0
0
0
local $_ = shift;
2427
0
0
0
my $Eol = shift || "\n";
2428
2429
# Undo any existing folding
2430
0
0
s/\r?\n(\s)/$1/gms;
2431
2432
# Pulled partly from Mail::Message::Field
2433
0
0
my $Folded = '';
2434
0
0
while (1) {
2435
0
0
0
if (length($_) < 72) {
2436
0
0
$Folded .= $_;
2437
0
0
last;
2438
}
2439
# Prefer breaking at ; or ,
2440
s/^(.{18,72}[;,])([ \t])// ||
2441
# Otherwise any space is fine
2442
0
0
0
0
s/^(.{18,72})([ \t])// ||
0
2443
# Hmmm, longer than 72 chars, find up to next whitespace
2444
s/^(.{72,}?)([ \t])// ||
2445
# Ok, better just get everything
2446
s/^(.*)()//;
2447
0
0
$Folded .= $1 . $Eol . $2;
2448
}
2449
2450
# Strip the trailing eol
2451
0
0
$Folded =~ s/${Eol}$//;
2452
2453
0
0
return $Folded;
2454
}
2455
2456
#------------------------------
2457
2458
#pod =item header_as_string
2459
#pod
2460
#pod I
2461
#pod Return the header as a string.
2462
#pod
2463
#pod =cut
2464
2465
2466
sub header_as_string {
2467
8
8
1
12
my $self = shift;
2468
8
27
$self->fields_as_string( $self->fields );
2469
}
2470
*stringify_header = \&header_as_string; ### backwards compatibility
2471
*stringify_header = \&header_as_string; ### ...twice to avoid warnings :)
2472
2473
#pod =back
2474
#pod
2475
#pod =cut
2476
2477
2478
#==============================
2479
#==============================
2480
2481
#pod =head2 Sending
2482
#pod
2483
#pod =over 4
2484
#pod
2485
#pod =cut
2486
2487
2488
#------------------------------
2489
2490
#pod =item send
2491
#pod
2492
#pod =item send HOW, HOWARGS...
2493
#pod
2494
#pod I
2495
#pod This is the principal method for sending mail, and for configuring
2496
#pod how mail will be sent.
2497
#pod
2498
#pod I with a HOW argument and optional HOWARGS, it sets
2499
#pod the default sending mechanism that the no-argument instance method
2500
#pod will use. The HOW is a facility name (B),
2501
#pod and the HOWARGS is interpreted by the facility.
2502
#pod The class method returns the previous HOW and HOWARGS as an array.
2503
#pod
2504
#pod MIME::Lite->send('sendmail', "d:\\programs\\sendmail.exe");
2505
#pod ...
2506
#pod $msg = MIME::Lite->new(...);
2507
#pod $msg->send;
2508
#pod
2509
#pod I
2510
#pod (a HOW argument and optional HOWARGS), sends the message in the
2511
#pod requested manner; e.g.:
2512
#pod
2513
#pod $msg->send('sendmail', "d:\\programs\\sendmail.exe");
2514
#pod
2515
#pod I sends the
2516
#pod message by the default mechanism set up by the class method.
2517
#pod Returns whatever the mail-handling routine returns: this
2518
#pod should be true on success, false/exception on error:
2519
#pod
2520
#pod $msg = MIME::Lite->new(From=>...);
2521
#pod $msg->send || die "you DON'T have mail!";
2522
#pod
2523
#pod On Unix systems (or rather non-Win32 systems), the default
2524
#pod setting is equivalent to:
2525
#pod
2526
#pod MIME::Lite->send("sendmail", "/usr/lib/sendmail -t -oi -oem");
2527
#pod
2528
#pod On Win32 systems the default setting is equivalent to:
2529
#pod
2530
#pod MIME::Lite->send("smtp");
2531
#pod
2532
#pod The assumption is that on Win32 your site/lib/Net/libnet.cfg
2533
#pod file will be preconfigured to use the appropriate SMTP
2534
#pod server. See below for configuring for authentication.
2535
#pod
2536
#pod There are three facilities:
2537
#pod
2538
#pod =over 4
2539
#pod
2540
#pod =item "sendmail", ARGS...
2541
#pod
2542
#pod Send a message by piping it into the "sendmail" command.
2543
#pod Uses the L method, giving it the ARGS.
2544
#pod This usage implements (and deprecates) the C method.
2545
#pod
2546
#pod =item "smtp", [HOSTNAME, [NAMEDPARMS] ]
2547
#pod
2548
#pod Send a message by SMTP, using optional HOSTNAME as SMTP-sending host.
2549
#pod L will be required. Uses the L
2550
#pod method. Any additional arguments passed in will also be passed through to
2551
#pod send_by_smtp. This is useful for things like mail servers requiring
2552
#pod authentication where you can say something like the following
2553
#pod
2554
#pod MIME::Lite->send('smtp', $host, AuthUser=>$user, AuthPass=>$pass);
2555
#pod
2556
#pod which will configure things so future uses of
2557
#pod
2558
#pod $msg->send();
2559
#pod
2560
#pod do the right thing.
2561
#pod
2562
#pod =item "sub", \&SUBREF, ARGS...
2563
#pod
2564
#pod Sends a message MSG by invoking the subroutine SUBREF of your choosing,
2565
#pod with MSG as the first argument, and ARGS following.
2566
#pod
2567
#pod =back
2568
#pod
2569
#pod I let's say you're on an OS which lacks the usual Unix
2570
#pod "sendmail" facility, but you've installed something a lot like it, and
2571
#pod you need to configure your Perl script to use this "sendmail.exe" program.
2572
#pod Do this following in your script's setup:
2573
#pod
2574
#pod MIME::Lite->send('sendmail', "d:\\programs\\sendmail.exe");
2575
#pod
2576
#pod Then, whenever you need to send a message $msg, just say:
2577
#pod
2578
#pod $msg->send;
2579
#pod
2580
#pod That's it. Now, if you ever move your script to a Unix box, all you
2581
#pod need to do is change that line in the setup and you're done.
2582
#pod All of your $msg-Esend invocations will work as expected.
2583
#pod
2584
#pod After sending, the method last_send_successful() can be used to determine
2585
#pod if the send was successful or not.
2586
#pod
2587
#pod =cut
2588
2589
2590
sub send {
2591
2
2
1
594568
my $self = shift;
2592
2
5
my $meth = shift;
2593
2594
2
50
8
if ( ref($self) ) { ### instance method:
2595
0
0
my ( $method, @args );
2596
0
0
0
if (@_) { ### args; use them just this once
2597
0
0
$method = 'send_by_' . $meth;
2598
0
0
@args = @_;
2599
} else { ### no args; use defaults
2600
0
0
$method = "send_by_$Sender";
2601
0
0
0
@args = @{ $SenderArgs{$Sender} || [] };
0
0
2602
}
2603
0
0
0
$self->verify_data if $AUTO_VERIFY; ### prevents missing parts!
2604
0
0
0
Carp::croak "Unknown send method '$meth'" unless $self->can($method);
2605
0
0
return $self->$method(@args);
2606
} else { ### class method:
2607
2
50
8
if (@_) {
2608
2
3
my @old = ( $Sender, @{ $SenderArgs{$Sender} } );
2
8
2609
2
4
$Sender = $meth;
2610
2
6
$SenderArgs{$Sender} = [@_]; ### remaining args
2611
2
8
return @old;
2612
} else {
2613
0
0
Carp::croak "class method send must have HOW... arguments\n";
2614
}
2615
}
2616
}
2617
2618
2619
#------------------------------
2620
2621
#pod =item send_by_sendmail SENDMAILCMD
2622
#pod
2623
#pod =item send_by_sendmail PARAM=>VALUE, ARRAY, HASH...
2624
#pod
2625
#pod I
2626
#pod Send message via an external "sendmail" program
2627
#pod (this will probably only work out-of-the-box on Unix systems).
2628
#pod
2629
#pod Returns true on success, false or exception on error.
2630
#pod
2631
#pod You can specify the program and all its arguments by giving a single
2632
#pod string, SENDMAILCMD. Nothing fancy is done; the message is simply
2633
#pod piped in.
2634
#pod
2635
#pod However, if your needs are a little more advanced, you can specify
2636
#pod zero or more of the following PARAM/VALUE pairs (or a reference to hash
2637
#pod or array of such arguments as well as any combination thereof); a
2638
#pod Unix-style, taint-safe "sendmail" command will be constructed for you:
2639
#pod
2640
#pod =over 4
2641
#pod
2642
#pod =item Sendmail
2643
#pod
2644
#pod Full path to the program to use.
2645
#pod Default is "/usr/lib/sendmail".
2646
#pod
2647
#pod =item BaseArgs
2648
#pod
2649
#pod Ref to the basic array of arguments we start with.
2650
#pod Default is C<["-t", "-oi", "-oem"]>.
2651
#pod
2652
#pod =item SetSender
2653
#pod
2654
#pod Unless this is I given as false, we attempt to automatically
2655
#pod set the C<-f> argument to the first address that can be extracted from
2656
#pod the "From:" field of the message (if there is one).
2657
#pod
2658
#pod I
2659
#pod Suppose we did I use C<-f>, and you gave an explicit "From:"
2660
#pod field in your message: in this case, the sendmail "envelope" would
2661
#pod indicate the I user your process was running under, as a way
2662
#pod of preventing mail forgery. Using the C<-f> switch causes the sender
2663
#pod to be set in the envelope as well.
2664
#pod
2665
#pod I
2666
#pod If sendmail doesn't regard you as a "trusted" user, it will permit
2667
#pod the C<-f> but also add an "X-Authentication-Warning" header to the message
2668
#pod to indicate a forged envelope. To avoid this, you can either
2669
#pod (1) have SetSender be false, or
2670
#pod (2) make yourself a trusted user by adding a C configuration
2671
#pod command to your I file
2672
#pod (e.g.: C if the script is running as user "eryq").
2673
#pod
2674
#pod =item FromSender
2675
#pod
2676
#pod If defined, this is identical to setting SetSender to true,
2677
#pod except that instead of looking at the "From:" field we use
2678
#pod the address given by this option.
2679
#pod Thus:
2680
#pod
2681
#pod FromSender => 'me@myhost.com'
2682
#pod
2683
#pod =back
2684
#pod
2685
#pod After sending, the method last_send_successful() can be used to determine
2686
#pod if the send was successful or not.
2687
#pod
2688
#pod =cut
2689
2690
sub _unfold_stupid_params {
2691
1
1
393247
my $self = shift;
2692
2693
1
2
my %p;
2694
1
6
STUPID_PARAM: for (my $i = 0; $i < @_; $i++) { ## no critic Loop
2695
6
8
my $item = $_[$i];
2696
6
100
14
if (not ref $item) {
100
50
2697
4
9
$p{ $item } = $_[ ++$i ];
2698
} elsif (UNIVERSAL::isa($item, 'HASH')) {
2699
1
5
$p{ $_ } = $item->{ $_ } for keys %$item;
2700
} elsif (UNIVERSAL::isa($item, 'ARRAY')) {
2701
1
2
for (my $j = 0; $j < @$item; $j += 2) {
2702
2
7
$p{ $item->[ $j ] } = $item->[ $j + 1 ];
2703
}
2704
}
2705
}
2706
2707
1
6
return %p;
2708
}
2709
2710
sub send_by_sendmail {
2711
0
0
1
0
my $self = shift;
2712
0
0
my $return;
2713
0
0
0
0
if ( @_ == 1 and !ref $_[0] ) {
2714
### Use the given command...
2715
0
0
my $sendmailcmd = shift @_;
2716
0
0
0
Carp::croak "No sendmail command available" unless $sendmailcmd;
2717
2718
### Do it:
2719
0
0
local *SENDMAIL;
2720
0
0
0
open SENDMAIL, "|$sendmailcmd" or Carp::croak "open |$sendmailcmd: $!\n";
2721
0
0
$self->print( \*SENDMAIL );
2722
0
0
close SENDMAIL;
2723
0
0
0
$return = ( ( $? >> 8 ) ? undef: 1 );
2724
} else { ### Build the command...
2725
0
0
my %p = $self->_unfold_stupid_params(@_);
2726
2727
0
0
0
$p{Sendmail} = $SENDMAIL unless defined $p{Sendmail};
2728
2729
### Start with the command and basic args:
2730
0
0
0
my @cmd = ( $p{Sendmail}, @{ $p{BaseArgs} || [ '-t', '-oi', '-oem' ] } );
0
0
2731
2732
# SetSender default is true
2733
0
0
0
$p{SetSender} = 1 unless defined $p{SetSender};
2734
2735
### See if we are forcibly setting the sender:
2736
0
0
0
$p{SetSender} ||= defined( $p{FromSender} );
2737
2738
### Add the -f argument, unless we're explicitly told NOT to:
2739
0
0
0
if ( $p{SetSender} ) {
2740
0
0
0
my $from = $p{FromSender} || ( $self->get('From') )[0];
2741
0
0
0
if ($from) {
2742
0
0
my ($from_addr) = extract_only_addrs($from);
2743
0
0
0
push @cmd, "-f$from_addr" if $from_addr;
2744
}
2745
}
2746
2747
### Open the command in a taint-safe fashion:
2748
0
0
my $pid = open SENDMAIL, "|-";
2749
0
0
0
defined($pid) or die "open of pipe failed: $!\n";
2750
0
0
0
if ( !$pid ) { ### child
2751
0
0
0
exec(@cmd) or die "can't exec $p{Sendmail}: $!\n";
2752
### NOTREACHED
2753
} else { ### parent
2754
0
0
$self->print( \*SENDMAIL );
2755
0
0
0
close SENDMAIL || die "error closing $p{Sendmail}: $! (exit $?)\n";
2756
0
0
$return = 1;
2757
}
2758
}
2759
0
0
return $self->{last_send_successful} = $return;
2760
}
2761
2762
#------------------------------
2763
2764
#pod =item send_by_smtp HOST, ARGS...
2765
#pod
2766
#pod =item send_by_smtp REF, HOST, ARGS
2767
#pod
2768
#pod I
2769
#pod Send message via SMTP, using Net::SMTP -- which will be required for this
2770
#pod feature.
2771
#pod
2772
#pod HOST is the name of SMTP server to connect to, or undef to have
2773
#pod L use the defaults in Libnet.cfg.
2774
#pod
2775
#pod ARGS are a list of key value pairs which may be selected from the list
2776
#pod below. Many of these are just passed through to specific
2777
#pod L commands and you should review that module for
2778
#pod details.
2779
#pod
2780
#pod Please see L
2781
#pod
2782
#pod =over 4
2783
#pod
2784
#pod =item Hello
2785
#pod
2786
#pod =item LocalAddr
2787
#pod
2788
#pod =item LocalPort
2789
#pod
2790
#pod =item Timeout
2791
#pod
2792
#pod =item Port
2793
#pod
2794
#pod =item ExactAddresses
2795
#pod
2796
#pod =item Debug
2797
#pod
2798
#pod See L for details.
2799
#pod
2800
#pod =item Size
2801
#pod
2802
#pod =item Return
2803
#pod
2804
#pod =item Bits
2805
#pod
2806
#pod =item Transaction
2807
#pod
2808
#pod =item Envelope
2809
#pod
2810
#pod See L for details.
2811
#pod
2812
#pod =item SkipBad
2813
#pod
2814
#pod If true doesn't throw an error when multiple email addresses are provided
2815
#pod and some are not valid. See L
2816
#pod for details.
2817
#pod
2818
#pod =item AuthUser
2819
#pod
2820
#pod Authenticate with L using this username.
2821
#pod
2822
#pod =item AuthPass
2823
#pod
2824
#pod Authenticate with L using this password.
2825
#pod
2826
#pod =item NoAuth
2827
#pod
2828
#pod Normally if AuthUser and AuthPass are defined MIME::Lite will attempt to
2829
#pod use them with the L command to
2830
#pod authenticate the connection, however if this value is true then no
2831
#pod authentication occurs.
2832
#pod
2833
#pod =item To
2834
#pod
2835
#pod Sets the addresses to send to. Can be a string or a reference to an
2836
#pod array of strings. Normally this is extracted from the To: (and Cc: and
2837
#pod Bcc: fields if $AUTO_CC is true).
2838
#pod
2839
#pod This value overrides that.
2840
#pod
2841
#pod =item From
2842
#pod
2843
#pod Sets the email address to send from. Normally this value is extracted
2844
#pod from the Return-Path: or From: field of the mail itself (in that order).
2845
#pod
2846
#pod This value overrides that.
2847
#pod
2848
#pod =back
2849
#pod
2850
#pod I
2851
#pod True on success, croaks with an error message on failure.
2852
#pod
2853
#pod After sending, the method last_send_successful() can be used to determine
2854
#pod if the send was successful or not.
2855
#pod
2856
#pod =cut
2857
2858
2859
# Derived from work by Andrew McRae. Version 0.2 anm 09Sep97
2860
# Copyright 1997 Optimation New Zealand Ltd.
2861
# May be modified/redistributed under the same terms as Perl.
2862
2863
# external opts
2864
my @_mail_opts = qw( Size Return Bits Transaction Envelope );
2865
my @_recip_opts = qw( SkipBad Notify );
2866
my @_net_smtp_opts = qw( Hello LocalAddr LocalPort Timeout
2867
AuthUser AuthPass SSL
2868
Port ExactAddresses Debug );
2869
# internal: qw( NoAuth AuthUser AuthPass To From Host);
2870
2871
sub __opts {
2872
0
0
0
my $args=shift;
2873
0
0
0
return map { exists $args->{$_} ? ( $_ => $args->{$_} ) : () } @_;
0
0
2874
}
2875
2876
sub send_by_smtp {
2877
0
0
1
0
require Net::SMTP;
2878
0
0
my ($self,$hostname,%args) = @_;
2879
# We may need the "From:" and "To:" headers to pass to the
2880
# SMTP mailer also.
2881
0
0
$self->{last_send_successful}=0;
2882
2883
0
0
my @hdr_to = extract_only_addrs( scalar $self->get('To') );
2884
0
0
0
if ($AUTO_CC) {
2885
0
0
foreach my $field (qw(Cc Bcc)) {
2886
0
0
push @hdr_to, extract_only_addrs($_) for $self->get($field);
2887
}
2888
}
2889
0
0
0
Carp::croak "send_by_smtp: nobody to send to for host '$hostname'?!\n"
2890
unless @hdr_to;
2891
2892
0
0
0
$args{To} ||= \@hdr_to;
2893
0
0
0
$args{From} ||= extract_only_addrs( scalar $self->get('Return-Path') );
2894
0
0
0
$args{From} ||= extract_only_addrs( scalar $self->get('From') ) ;
2895
2896
# Create SMTP client.
2897
# MIME::Lite::SMTP is just a wrapper giving a print method
2898
# to the SMTP object.
2899
2900
0
0
my %opts = __opts(\%args, @_net_smtp_opts);
2901
0
0
0
my $smtp = MIME::Lite::SMTP->new( $hostname, %opts )
2902
or Carp::croak "SMTP Failed to connect to mail server: $!\n";
2903
2904
# Possibly authenticate
2905
0
0
0
0
if ( defined $args{AuthUser} and defined $args{AuthPass}
0
2906
and !$args{NoAuth} )
2907
{
2908
0
0
0
if ($smtp->supports('AUTH',500,["Command unknown: 'AUTH'"])) {
2909
$smtp->auth( $args{AuthUser}, $args{AuthPass} )
2910
0
0
0
or die "SMTP auth() command failed: $!\n"
2911
. $smtp->message . "\n";
2912
} else {
2913
0
0
die "SMTP auth() command not supported on $hostname\n";
2914
}
2915
}
2916
2917
# Send the mail command
2918
0
0
%opts = __opts( \%args, @_mail_opts);
2919
0
0
0
$smtp->mail( $args{From}, %opts ? \%opts : () )
0
2920
or die "SMTP mail() command failed: $!\n"
2921
. $smtp->message . "\n";
2922
2923
# Send the recipients command
2924
0
0
%opts = __opts( \%args, @_recip_opts);
2925
0
0
0
$smtp->recipient( @{ $args{To} }, %opts ? \%opts : () )
0
0
0
2926
or die "SMTP recipient() command failed: $!\n"
2927
. $smtp->message . "\n";
2928
2929
# Send the data
2930
0
0
0
$smtp->data()
2931
or die "SMTP data() command failed: $!\n"
2932
. $smtp->message . "\n";
2933
0
0
$self->print_for_smtp($smtp);
2934
2935
# Finish the mail
2936
0
0
0
$smtp->dataend()
2937
or Carp::croak "Net::CMD (Net::SMTP) DATAEND command failed.\n"
2938
. "Last server message was:"
2939
. $smtp->message
2940
. "This probably represents a problem with newline encoding ";
2941
2942
# terminate the session
2943
0
0
$smtp->quit;
2944
2945
0
0
return $self->{last_send_successful} = 1;
2946
}
2947
2948
#pod =item send_by_testfile FILENAME
2949
#pod
2950
#pod I
2951
#pod Print message to a file (namely FILENAME), which will default to
2952
#pod mailer.testfile
2953
#pod If file exists, message will be appended.
2954
#pod
2955
#pod =cut
2956
2957
sub send_by_testfile {
2958
0
0
1
0
my $self = shift;
2959
2960
### Use the default filename...
2961
0
0
my $filename = 'mailer.testfile';
2962
2963
0
0
0
0
if ( @_ == 1 and !ref $_[0] ) {
2964
### Use the given filename if given...
2965
0
0
$filename = shift @_;
2966
0
0
0
Carp::croak "no filename given to send_by_testfile" unless $filename;
2967
}
2968
2969
### Do it:
2970
0
0
local *FILE;
2971
0
0
0
open FILE, ">> $filename" or Carp::croak "open $filename: $!\n";
2972
0
0
$self->print( \*FILE );
2973
0
0
close FILE;
2974
0
0
0
my $return = ( ( $? >> 8 ) ? undef: 1 );
2975
2976
0
0
return $self->{last_send_successful} = $return;
2977
}
2978
2979
#pod =item last_send_successful
2980
#pod
2981
#pod This method will return TRUE if the last send() or send_by_XXX() method call was
2982
#pod successful. It will return defined but false if it was not successful, and undefined
2983
#pod if the object had not been used to send yet.
2984
#pod
2985
#pod =cut
2986
2987
2988
sub last_send_successful {
2989
0
0
1
0
my $self = shift;
2990
0
0
return $self->{last_send_successful};
2991
}
2992
2993
2994
### Provided by Andrew McRae. Version 0.2 anm 09Sep97
2995
### Copyright 1997 Optimation New Zealand Ltd.
2996
### May be modified/redistributed under the same terms as Perl.
2997
### Aditional changes by Yves.
2998
### Until 3.01_03 this was send_by_smtp()
2999
sub send_by_smtp_simple {
3000
0
0
0
0
my ( $self, @args ) = @_;
3001
0
0
$self->{last_send_successful} = 0;
3002
### We need the "From:" and "To:" headers to pass to the SMTP mailer:
3003
0
0
my $hdr = $self->fields();
3004
3005
0
0
my $from_header = $self->get('From');
3006
0
0
my ($from) = extract_only_addrs($from_header);
3007
3008
0
0
0
warn "M::L>>> $from_header => $from" if $MIME::Lite::DEBUG;
3009
3010
3011
0
0
my $to = $self->get('To');
3012
3013
### Sanity check:
3014
0
0
0
defined($to)
3015
or Carp::croak "send_by_smtp: missing 'To:' address\n";
3016
3017
### Get the destinations as a simple array of addresses:
3018
0
0
my @to_all = extract_only_addrs($to);
3019
0
0
0
if ($AUTO_CC) {
3020
0
0
foreach my $field (qw(Cc Bcc)) {
3021
0
0
my $value = $self->get($field);
3022
0
0
0
push @to_all, extract_only_addrs($value)
3023
if defined($value);
3024
}
3025
}
3026
3027
### Create SMTP client:
3028
0
0
require Net::SMTP;
3029
0
0
0
my $smtp = MIME::Lite::SMTP->new(@args)
3030
or Carp::croak("Failed to connect to mail server: $!\n");
3031
0
0
0
$smtp->mail($from)
3032
or Carp::croak( "SMTP MAIL command failed: $!\n" . $smtp->message . "\n" );
3033
0
0
0
$smtp->to(@to_all)
3034
or Carp::croak( "SMTP RCPT command failed: $!\n" . $smtp->message . "\n" );
3035
0
0
0
$smtp->data()
3036
or Carp::croak( "SMTP DATA command failed: $!\n" . $smtp->message . "\n" );
3037
3038
### MIME::Lite can print() to anything with a print() method:
3039
0
0
$self->print_for_smtp($smtp);
3040
3041
0
0
0
$smtp->dataend()
3042
or Carp::croak( "Net::CMD (Net::SMTP) DATAEND command failed.\n"
3043
. "Last server message was:"
3044
. $smtp->message
3045
. "This probably represents a problem with newline encoding " );
3046
0
0
$smtp->quit;
3047
0
0
$self->{last_send_successful} = 1;
3048
0
0
1;
3049
}
3050
3051
#------------------------------
3052
#
3053
# send_by_sub [\&SUBREF, [ARGS...]]
3054
#
3055
# I
3056
# Send the message via an anonymous subroutine.
3057
#
3058
sub send_by_sub {
3059
0
0
0
0
my ( $self, $subref, @args ) = @_;
3060
0
0
$self->{last_send_successful} = &$subref( $self, @args );
3061
3062
}
3063
3064
#------------------------------
3065
3066
#pod =item sendmail COMMAND...
3067
#pod
3068
#pod I
3069
#pod Declare the sender to be "sendmail", and set up the "sendmail" command.
3070
#pod I
3071
#pod
3072
#pod =cut
3073
3074
3075
sub sendmail {
3076
0
0
1
0
my $self = shift;
3077
0
0
$self->send( 'sendmail', join( ' ', @_ ) );
3078
}
3079
3080
#pod =back
3081
#pod
3082
#pod =cut
3083
3084
3085
#==============================
3086
#==============================
3087
3088
#pod =head2 Miscellaneous
3089
#pod
3090
#pod =over 4
3091
#pod
3092
#pod =cut
3093
3094
3095
#------------------------------
3096
3097
#pod =item quiet ONOFF
3098
#pod
3099
#pod I
3100
#pod Suppress/unsuppress all warnings coming from this module.
3101
#pod
3102
#pod MIME::Lite->quiet(1); ### I know what I'm doing
3103
#pod
3104
#pod I recommend that you include that comment as well. And while
3105
#pod you type it, say it out loud: if it doesn't feel right, then maybe
3106
#pod you should reconsider the whole line. C<;-)>
3107
#pod
3108
#pod =cut
3109
3110
3111
sub quiet {
3112
0
0
1
0
my $class = shift;
3113
0
0
0
$QUIET = shift if @_;
3114
0
0
$QUIET;
3115
}
3116
3117
#pod =back
3118
#pod
3119
#pod =cut
3120
3121
3122
#============================================================
3123
3124
package MIME::Lite::SMTP 3.038;
3125
3126
#============================================================
3127
# This class just adds a print() method to Net::SMTP.
3128
# Notice that we don't use/require it until it's needed!
3129
3130
9
9
89
use strict;
9
24
9
435
3131
9
9
80
use vars qw( @ISA );
9
17
9
5368
3132
@ISA = qw(Net::SMTP);
3133
3134
# some of the below is borrowed from Data::Dumper
3135
my %esc = ( "\a" => "\\a",
3136
"\b" => "\\b",
3137
"\t" => "\\t",
3138
"\n" => "\\n",
3139
"\f" => "\\f",
3140
"\r" => "\\r",
3141
"\e" => "\\e",
3142
);
3143
3144
sub _hexify {
3145
0
0
0
local $_ = shift;
3146
0
0
my @split = m/(.{1,16})/gs;
3147
0
0
foreach my $split (@split) {
3148
0
0
( my $txt = $split ) =~ s/([\a\b\t\n\f\r\e])/$esc{$1}/sg;
3149
0
0
$split =~ s/(.)/sprintf("%02X ",ord($1))/sge;
0
0
3150
0
0
print STDERR "M::L >>> $split : $txt\n";
3151
}
3152
}
3153
3154
sub print {
3155
0
0
0
my $smtp = shift;
3156
0
0
0
$MIME::Lite::DEBUG and _hexify( join( "", @_ ) );
3157
0
0
0
$smtp->datasend(@_)
3158
or Carp::croak( "Net::CMD (Net::SMTP) DATASEND command failed.\n"
3159
. "Last server message was:"
3160
. $smtp->message
3161
. "This probably represents a problem with newline encoding " );
3162
}
3163
3164
3165
#============================================================
3166
3167
package MIME::Lite::IO_Handle 3.038;
3168
3169
#============================================================
3170
3171
### Wrap a non-object filehandle inside a blessed, printable interface:
3172
### Does nothing if the given $fh is already a blessed object.
3173
sub wrap {
3174
22
22
33
my ( $class, $fh ) = @_;
3175
9
9
94
no strict 'refs';
9
16
9
7655
3176
3177
### Get default, if necessary:
3178
22
50
58
$fh or $fh = select; ### no filehandle means selected one
3179
22
50
41
ref($fh) or $fh = \*$fh; ### scalar becomes a globref
3180
3181
### Stop right away if already a printable object:
3182
22
50
33
102
return $fh if ( ref($fh) and ( ref($fh) ne 'GLOB' ) );
3183
3184
### Get and return a printable interface:
3185
0
0
bless \$fh, $class; ### wrap it in a printable interface
3186
}
3187
3188
### Print:
3189
sub print {
3190
0
0
0
my $self = shift;
3191
0
0
print {$$self} @_;
0
0
3192
}
3193
3194
3195
#============================================================
3196
3197
package MIME::Lite::IO_Scalar 3.038;
3198
3199
#============================================================
3200
3201
### Wrap a scalar inside a blessed, printable interface:
3202
sub wrap {
3203
6
6
15
my ( $class, $scalarref ) = @_;
3204
6
50
16
defined($scalarref) or $scalarref = \"";
3205
6
16
bless $scalarref, $class;
3206
}
3207
3208
### Print:
3209
sub print {
3210
29
29
41
${$_[0]} .= join( '', @_[1..$#_] );
29
99
3211
29
55
1;
3212
}
3213
3214
3215
#============================================================
3216
3217
package MIME::Lite::IO_ScalarArray 3.038;
3218
3219
#============================================================
3220
3221
### Wrap an array inside a blessed, printable interface:
3222
sub wrap {
3223
0
0
my ( $class, $arrayref ) = @_;
3224
0
0
defined($arrayref) or $arrayref = [];
3225
0
bless $arrayref, $class;
3226
}
3227
3228
### Print:
3229
sub print {
3230
0
0
my $self = shift;
3231
0
push @$self, @_;
3232
0
1;
3233
}
3234
3235
1;
3236
3237
=pod
3238
3239
=encoding UTF-8
3240
3241
=head1 NAME
3242
3243
MIME::Lite - low-calorie MIME generator
3244
3245
=head1 VERSION
3246
3247
version 3.038
3248
3249
=head1 WAIT!
3250
3251
MIME::Lite is not recommended by its current maintainer. There are a number of
3252
alternatives, like Email::MIME or MIME::Entity and Email::Sender, which you
3253
should probably use instead. MIME::Lite continues to accrue weird bug reports,
3254
and it is not receiving a large amount of refactoring due to the availability
3255
of better alternatives. Please consider using something else.
3256
3257
=head1 SYNOPSIS
3258
3259
Create and send using the default send method for your OS a single-part message:
3260
3261
use MIME::Lite;
3262
### Create a new single-part message, to send a GIF file:
3263
$msg = MIME::Lite->new(
3264
From => 'me@myhost.com',
3265
To => 'you@yourhost.com',
3266
Cc => 'some@other.com, some@more.com',
3267
Subject => 'Helloooooo, nurse!',
3268
Type => 'image/gif',
3269
Encoding => 'base64',
3270
Path => 'hellonurse.gif'
3271
);
3272
$msg->send; # send via default
3273
3274
Create a multipart message (i.e., one with attachments) and send it via SMTP
3275
3276
### Create a new multipart message:
3277
$msg = MIME::Lite->new(
3278
From => 'me@myhost.com',
3279
To => 'you@yourhost.com',
3280
Cc => 'some@other.com, some@more.com',
3281
Subject => 'A message with 2 parts...',
3282
Type => 'multipart/mixed'
3283
);
3284
3285
### Add parts (each "attach" has same arguments as "new"):
3286
$msg->attach(
3287
Type => 'TEXT',
3288
Data => "Here's the GIF file you wanted"
3289
);
3290
$msg->attach(
3291
Type => 'image/gif',
3292
Path => 'aaa000123.gif',
3293
Filename => 'logo.gif',
3294
Disposition => 'attachment'
3295
);
3296
### use Net::SMTP to do the sending
3297
$msg->send('smtp','some.host', Debug=>1 );
3298
3299
Output a message:
3300
3301
### Format as a string:
3302
$str = $msg->as_string;
3303
3304
### Print to a filehandle (say, a "sendmail" stream):
3305
$msg->print(\*SENDMAIL);
3306
3307
Send a message:
3308
3309
### Send in the "best" way (the default is to use "sendmail"):
3310
$msg->send;
3311
### Send a specific way:
3312
$msg->send('type',@args);
3313
3314
Specify default send method:
3315
3316
MIME::Lite->send('smtp','some.host',Debug=>0);
3317
3318
with authentication
3319
3320
MIME::Lite->send('smtp','some.host', AuthUser=>$user, AuthPass=>$pass);
3321
3322
using SSL
3323
3324
MIME::Lite->send('smtp','some.host', SSL => 1, Port => 465 );
3325
3326
=head1 DESCRIPTION
3327
3328
In the never-ending quest for great taste with fewer calories,
3329
we proudly present: I.
3330
3331
MIME::Lite is intended as a simple, standalone module for generating
3332
(not parsing!) MIME messages... specifically, it allows you to
3333
output a simple, decent single- or multi-part message with text or binary
3334
attachments. It does not require that you have the Mail:: or MIME::
3335
modules installed, but will work with them if they are.
3336
3337
You can specify each message part as either the literal data itself (in
3338
a scalar or array), or as a string which can be given to open() to get
3339
a readable filehandle (e.g., "
3340
3341
You don't need to worry about encoding your message data:
3342
this module will do that for you. It handles the 5 standard MIME encodings.
3343
3344
=head1 PERL VERSION
3345
3346
This library should run on perls released even a long time ago. It should
3347
work on any version of perl released in the last five years.
3348
3349
Although it may work on older versions of perl, no guarantee is made that the
3350
minimum required version will not be increased. The version may be increased
3351
for any reason, and there is no promise that patches will be accepted to
3352
lower the minimum required perl.
3353
3354
=head1 EXAMPLES
3355
3356
=head2 Create a simple message containing just text
3357
3358
$msg = MIME::Lite->new(
3359
From =>'me@myhost.com',
3360
To =>'you@yourhost.com',
3361
Cc =>'some@other.com, some@more.com',
3362
Subject =>'Helloooooo, nurse!',
3363
Data =>"How's it goin', eh?"
3364
);
3365
3366
=head2 Create a simple message containing just an image
3367
3368
$msg = MIME::Lite->new(
3369
From =>'me@myhost.com',
3370
To =>'you@yourhost.com',
3371
Cc =>'some@other.com, some@more.com',
3372
Subject =>'Helloooooo, nurse!',
3373
Type =>'image/gif',
3374
Encoding =>'base64',
3375
Path =>'hellonurse.gif'
3376
);
3377
3378
=head2 Create a multipart message
3379
3380
### Create the multipart "container":
3381
$msg = MIME::Lite->new(
3382
From =>'me@myhost.com',
3383
To =>'you@yourhost.com',
3384
Cc =>'some@other.com, some@more.com',
3385
Subject =>'A message with 2 parts...',
3386
Type =>'multipart/mixed'
3387
);
3388
3389
### Add the text message part:
3390
### (Note that "attach" has same arguments as "new"):
3391
$msg->attach(
3392
Type =>'TEXT',
3393
Data =>"Here's the GIF file you wanted"
3394
);
3395
3396
### Add the image part:
3397
$msg->attach(
3398
Type =>'image/gif',
3399
Path =>'aaa000123.gif',
3400
Filename =>'logo.gif',
3401
Disposition => 'attachment'
3402
);
3403
3404
=head2 Attach a GIF to a text message
3405
3406
This will create a multipart message exactly as above, but using the
3407
"attach to singlepart" hack:
3408
3409
### Start with a simple text message:
3410
$msg = MIME::Lite->new(
3411
From =>'me@myhost.com',
3412
To =>'you@yourhost.com',
3413
Cc =>'some@other.com, some@more.com',
3414
Subject =>'A message with 2 parts...',
3415
Type =>'TEXT',
3416
Data =>"Here's the GIF file you wanted"
3417
);
3418
3419
### Attach a part... the make the message a multipart automatically:
3420
$msg->attach(
3421
Type =>'image/gif',
3422
Path =>'aaa000123.gif',
3423
Filename =>'logo.gif'
3424
);
3425
3426
=head2 Attach a pre-prepared part to a message
3427
3428
### Create a standalone part:
3429
$part = MIME::Lite->new(
3430
Top => 0,
3431
Type =>'text/html',
3432
Data =>'Hello ',
3433
);
3434
$part->attr('content-type.charset' => 'UTF-8');
3435
$part->add('X-Comment' => 'A message for you');
3436
3437
### Attach it to any message:
3438
$msg->attach($part);
3439
3440
=head2 Print a message to a filehandle
3441
3442
### Write it to a filehandle:
3443
$msg->print(\*STDOUT);
3444
3445
### Write just the header:
3446
$msg->print_header(\*STDOUT);
3447
3448
### Write just the encoded body:
3449
$msg->print_body(\*STDOUT);
3450
3451
=head2 Print a message into a string
3452
3453
### Get entire message as a string:
3454
$str = $msg->as_string;
3455
3456
### Get just the header:
3457
$str = $msg->header_as_string;
3458
3459
### Get just the encoded body:
3460
$str = $msg->body_as_string;
3461
3462
=head2 Send a message
3463
3464
### Send in the "best" way (the default is to use "sendmail"):
3465
$msg->send;
3466
3467
=head2 Send an HTML document... with images included!
3468
3469
$msg = MIME::Lite->new(
3470
To =>'you@yourhost.com',
3471
Subject =>'HTML with in-line images!',
3472
Type =>'multipart/related'
3473
);
3474
$msg->attach(
3475
Type => 'text/html',
3476
Data => qq{
3477
3478
Here's my image:
3479
3480
3481
},
3482
);
3483
$msg->attach(
3484
Type => 'image/gif',
3485
Id => 'myimage.gif',
3486
Path => '/path/to/somefile.gif',
3487
);
3488
$msg->send();
3489
3490
=head2 Change how messages are sent
3491
3492
### Do something like this in your 'main':
3493
if ($I_DONT_HAVE_SENDMAIL) {
3494
MIME::Lite->send('smtp', $host, Timeout=>60,
3495
AuthUser=>$user, AuthPass=>$pass);
3496
}
3497
3498
### Now this will do the right thing:
3499
$msg->send; ### will now use Net::SMTP as shown above
3500
3501
=head1 PUBLIC INTERFACE
3502
3503
=head2 Global configuration
3504
3505
To alter the way the entire module behaves, you have the following
3506
methods/options:
3507
3508
=over 4
3509
3510
=item MIME::Lite->field_order()
3511
3512
When used as a L, this changes the default
3513
order in which headers are output for I messages.
3514
However, please consider using the instance method variant instead,
3515
so you won't stomp on other message senders in the same application.
3516
3517
=item MIME::Lite->quiet()
3518
3519
This L can be used to suppress/unsuppress
3520
all warnings coming from this module.
3521
3522
=item MIME::Lite->send()
3523
3524
When used as a L, this can be used to specify
3525
a different default mechanism for sending message.
3526
The initial default is:
3527
3528
MIME::Lite->send("sendmail", "/usr/lib/sendmail -t -oi -oem");
3529
3530
However, you should consider the similar but smarter and taint-safe variant:
3531
3532
MIME::Lite->send("sendmail");
3533
3534
Or, for non-Unix users:
3535
3536
MIME::Lite->send("smtp");
3537
3538
=item $MIME::Lite::AUTO_CC
3539
3540
If true, automatically send to the Cc/Bcc addresses for send_by_smtp().
3541
Default is B.
3542
3543
=item $MIME::Lite::AUTO_CONTENT_TYPE
3544
3545
If true, try to automatically choose the content type from the file name
3546
in C/C. In other words, setting this true changes the
3547
default C from C<"TEXT"> to C<"AUTO">.
3548
3549
Default is B, since we must maintain backwards-compatibility
3550
with prior behavior. B consider keeping it false,
3551
and just using Type 'AUTO' when you build() or attach().
3552
3553
=item $MIME::Lite::AUTO_ENCODE
3554
3555
If true, automatically choose the encoding from the content type.
3556
Default is B.
3557
3558
=item $MIME::Lite::AUTO_VERIFY
3559
3560
If true, check paths to attachments right before printing, raising an exception
3561
if any path is unreadable.
3562
Default is B.
3563
3564
=item $MIME::Lite::PARANOID
3565
3566
If true, we won't attempt to use MIME::Base64, MIME::QuotedPrint,
3567
or MIME::Types, even if they're available.
3568
Default is B. Please consider keeping it false,
3569
and trusting these other packages to do the right thing.
3570
3571
=back
3572
3573
=head2 Construction
3574
3575
=over 4
3576
3577
=item new [PARAMHASH]
3578
3579
I
3580
Create a new message object.
3581
3582
If any arguments are given, they are passed into C; otherwise,
3583
just the empty object is created.
3584
3585
=item attach PART
3586
3587
=item attach PARAMHASH...
3588
3589
I
3590
Add a new part to this message, and return the new part.
3591
3592
If you supply a single PART argument, it will be regarded
3593
as a MIME::Lite object to be attached. Otherwise, this
3594
method assumes that you are giving in the pairs of a PARAMHASH
3595
which will be sent into C to create the new part.
3596
3597
One of the possibly-quite-useful hacks thrown into this is the
3598
"attach-to-singlepart" hack: if you attempt to attach a part (let's
3599
call it "part 1") to a message that doesn't have a content-type
3600
of "multipart" or "message", the following happens:
3601
3602
=over 4
3603
3604
=item *
3605
3606
A new part (call it "part 0") is made.
3607
3608
=item *
3609
3610
The MIME attributes and data (but I the other headers)
3611
are cut from the "self" message, and pasted into "part 0".
3612
3613
=item *
3614
3615
The "self" is turned into a "multipart/mixed" message.
3616
3617
=item *
3618
3619
The new "part 0" is added to the "self", and I "part 1" is added.
3620
3621
=back
3622
3623
One of the nice side-effects is that you can create a text message
3624
and then add zero or more attachments to it, much in the same way
3625
that a user agent like Netscape allows you to do.
3626
3627
=item build [PARAMHASH]
3628
3629
I
3630
Create (or initialize) a MIME message object.
3631
Normally, you'll use the following keys in PARAMHASH:
3632
3633
* Data, FH, or Path (either one of these, or none if multipart)
3634
* Type (e.g., "image/jpeg")
3635
* From, To, and Subject (if this is the "top level" of a message)
3636
3637
The PARAMHASH can contain the following keys:
3638
3639
=over 4
3640
3641
=item (fieldname)
3642
3643
Any field you want placed in the message header, taken from the
3644
standard list of header fields (you don't need to worry about case):
3645
3646
Approved Encrypted Received Sender
3647
Bcc From References Subject
3648
Cc Keywords Reply-To To
3649
Comments Message-ID Resent-* X-*
3650
Content-* MIME-Version Return-Path
3651
Date Organization
3652
3653
To give experienced users some veto power, these fields will be set
3654
I the ones I set... so be careful: I
3655
(like C) unless you know what you're doing!
3656
3657
To specify a fieldname that's I in the above list, even one that's
3658
identical to an option below, just give it with a trailing C<":">,
3659
like C<"My-field:">. When in doubt, that I signals a mail
3660
field (and it sort of looks like one too).
3661
3662
=item Data
3663
3664
I
3665
The actual message data. This may be a scalar or a ref to an array of
3666
strings; if the latter, the message consists of a simple concatenation
3667
of all the strings in the array.
3668
3669
=item Datestamp
3670
3671
I
3672
If given true (or omitted), we force the creation of a C field
3673
stamped with the current date/time if this is a top-level message.
3674
You may want this if using L.
3675
If you don't want this to be done, either provide your own Date
3676
or explicitly set this to false.
3677
3678
=item Disposition
3679
3680
I
3681
The content disposition, C<"inline"> or C<"attachment">.
3682
The default is C<"inline">.
3683
3684
=item Encoding
3685
3686
I
3687
The content transfer encoding that should be used to encode your data:
3688
3689
Use encoding: | If your message contains:
3690
------------------------------------------------------------
3691
7bit | Only 7-bit text, all lines <1000 characters
3692
8bit | 8-bit text, all lines <1000 characters
3693
quoted-printable | 8-bit text or long lines (more reliable than "8bit")
3694
base64 | Largely non-textual data: a GIF, a tar file, etc.
3695
3696
The default is taken from the Type; generally it is "binary" (no
3697
encoding) for text/*, message/*, and multipart/*, and "base64" for
3698
everything else. A value of C<"binary"> is generally I suitable
3699
for sending anything but ASCII text files with lines under 1000
3700
characters, so consider using one of the other values instead.
3701
3702
In the case of "7bit"/"8bit", long lines are automatically chopped to
3703
legal length; in the case of "7bit", all 8-bit characters are
3704
automatically I. This may not be what you want, so pick your
3705
encoding well! For more info, see L<"A MIME PRIMER">.
3706
3707
=item FH
3708
3709
I
3710
Filehandle containing the data, opened for reading.
3711
See "ReadNow" also.
3712
3713
=item Filename
3714
3715
I
3716
The name of the attachment. You can use this to supply a
3717
recommended filename for the end-user who is saving the attachment
3718
to disk. You only need this if the filename at the end of the
3719
"Path" is inadequate, or if you're using "Data" instead of "Path".
3720
You should I put path information in here (e.g., no "/"
3721
or "\" or ":" characters should be used).
3722
3723
=item Id
3724
3725
I
3726
Same as setting "content-id".
3727
3728
=item Length
3729
3730
I
3731
Set the content length explicitly. Normally, this header is automatically
3732
computed, but only under certain circumstances (see L<"Benign limitations">).
3733
3734
=item Path
3735
3736
I
3737
Path to a file containing the data... actually, it can be any open()able
3738
expression. If it looks like a path, the last element will automatically
3739
be treated as the filename.
3740
See "ReadNow" also.
3741
3742
=item ReadNow
3743
3744
I
3745
If true, will open the path and slurp the contents into core now.
3746
This is useful if the Path points to a command and you don't want
3747
to run the command over and over if outputting the message several
3748
times. B raised if the open fails.
3749
3750
=item Top
3751
3752
I
3753
If defined, indicates whether or not this is a "top-level" MIME message.
3754
The parts of a multipart message are I top-level.
3755
Default is true.
3756
3757
=item Type
3758
3759
I
3760
The MIME content type, or one of these special values (case-sensitive):
3761
3762
"TEXT" means "text/plain"
3763
"BINARY" means "application/octet-stream"
3764
"AUTO" means attempt to guess from the filename, falling back
3765
to 'application/octet-stream'. This is good if you have
3766
MIME::Types on your system and you have no idea what
3767
file might be used for the attachment.
3768
3769
The default is C<"TEXT">, but it will be C<"AUTO"> if you set
3770
$AUTO_CONTENT_TYPE to true (sorry, but you have to enable
3771
it explicitly, since we don't want to break code which depends
3772
on the old behavior).
3773
3774
=back
3775
3776
A picture being worth 1000 words (which
3777
is of course 2000 bytes, so it's probably more of an "icon" than a "picture",
3778
but I digress...), here are some examples:
3779
3780
$msg = MIME::Lite->build(
3781
From => 'yelling@inter.com',
3782
To => 'stocking@fish.net',
3783
Subject => "Hi there!",
3784
Type => 'TEXT',
3785
Encoding => '7bit',
3786
Data => "Just a quick note to say hi!"
3787
);
3788
3789
$msg = MIME::Lite->build(
3790
From => 'dorothy@emerald-city.oz',
3791
To => 'gesundheit@edu.edu.edu',
3792
Subject => "A gif for U"
3793
Type => 'image/gif',
3794
Path => "/home/httpd/logo.gif"
3795
);
3796
3797
$msg = MIME::Lite->build(
3798
From => 'laughing@all.of.us',
3799
To => 'scarlett@fiddle.dee.de',
3800
Subject => "A gzipp'ed tar file",
3801
Type => 'x-gzip',
3802
Path => "gzip < /usr/inc/somefile.tar |",
3803
ReadNow => 1,
3804
Filename => "somefile.tgz"
3805
);
3806
3807
To show you what's really going on, that last example could also
3808
have been written:
3809
3810
$msg = new MIME::Lite;
3811
$msg->build(
3812
Type => 'x-gzip',
3813
Path => "gzip < /usr/inc/somefile.tar |",
3814
ReadNow => 1,
3815
Filename => "somefile.tgz"
3816
);
3817
$msg->add(From => "laughing@all.of.us");
3818
$msg->add(To => "scarlett@fiddle.dee.de");
3819
$msg->add(Subject => "A gzipp'ed tar file");
3820
3821
=back
3822
3823
=head2 Setting/getting headers and attributes
3824
3825
=over 4
3826
3827
=item add TAG,VALUE
3828
3829
I
3830
Add field TAG with the given VALUE to the end of the header.
3831
The TAG will be converted to all-lowercase, and the VALUE
3832
will be made "safe" (returns will be given a trailing space).
3833
3834
B any MIME fields you "add" will override any MIME
3835
attributes I have when it comes time to output those fields.
3836
Normally, you will use this method to add I fields:
3837
3838
$msg->add("Subject" => "Hi there!");
3839
3840
Giving VALUE as an arrayref will cause all those values to be added.
3841
This is only useful for special multiple-valued fields like "Received":
3842
3843
$msg->add("Received" => ["here", "there", "everywhere"]
3844
3845
Giving VALUE as the empty string adds an invisible placeholder
3846
to the header, which can be used to suppress the output of
3847
the "Content-*" fields or the special "MIME-Version" field.
3848
When suppressing fields, you should use replace() instead of add():
3849
3850
$msg->replace("Content-disposition" => "");
3851
3852
I add() is probably going to be more efficient than C,
3853
so you're better off using it for most applications if you are
3854
certain that you don't need to delete() the field first.
3855
3856
I the name comes from Mail::Header.
3857
3858
=item attr ATTR,[VALUE]
3859
3860
I
3861
Set MIME attribute ATTR to the string VALUE.
3862
ATTR is converted to all-lowercase.
3863
This method is normally used to set/get MIME attributes:
3864
3865
$msg->attr("content-type" => "text/html");
3866
$msg->attr("content-type.charset" => "US-ASCII");
3867
$msg->attr("content-type.name" => "homepage.html");
3868
3869
This would cause the final output to look something like this:
3870
3871
Content-type: text/html; charset=US-ASCII; name="homepage.html"
3872
3873
Note that the special empty sub-field tag indicates the anonymous
3874
first sub-field.
3875
3876
Giving VALUE as undefined will cause the contents of the named
3877
subfield to be deleted.
3878
3879
Supplying no VALUE argument just returns the attribute's value:
3880
3881
$type = $msg->attr("content-type"); ### returns "text/html"
3882
$name = $msg->attr("content-type.name"); ### returns "homepage.html"
3883
3884
=item delete TAG
3885
3886
I
3887
Delete field TAG with the given VALUE to the end of the header.
3888
The TAG will be converted to all-lowercase.
3889
3890
$msg->delete("Subject");
3891
3892
I the name comes from Mail::Header.
3893
3894
=item field_order FIELD,...FIELD
3895
3896
I
3897
Change the order in which header fields are output for this object:
3898
3899
$msg->field_order('from', 'to', 'content-type', 'subject');
3900
3901
When used as a class method, changes the default settings for
3902
all objects:
3903
3904
MIME::Lite->field_order('from', 'to', 'content-type', 'subject');
3905
3906
Case does not matter: all field names will be coerced to lowercase.
3907
In either case, supply the empty array to restore the default ordering.
3908
3909
=item fields
3910
3911
I
3912
Return the full header for the object, as a ref to an array
3913
of C<[TAG, VALUE]> pairs, where each TAG is all-lowercase.
3914
Note that any fields the user has explicitly set will override the
3915
corresponding MIME fields that we would otherwise generate.
3916
So, don't say...
3917
3918
$msg->set("Content-type" => "text/html; charset=US-ASCII");
3919
3920
unless you want the above value to override the "Content-type"
3921
MIME field that we would normally generate.
3922
3923
I I called this "fields" because the header() method of
3924
Mail::Header returns something different, but similar enough to
3925
be confusing.
3926
3927
You can change the order of the fields: see L.
3928
You really shouldn't need to do this, but some people have to
3929
deal with broken mailers.
3930
3931
=item filename [FILENAME]
3932
3933
I
3934
Set the filename which this data will be reported as.
3935
This actually sets both "standard" attributes.
3936
3937
With no argument, returns the filename as dictated by the
3938
content-disposition.
3939
3940
=item get TAG,[INDEX]
3941
3942
I
3943
Get the contents of field TAG, which might have been set
3944
with set() or replace(). Returns the text of the field.
3945
3946
$ml->get('Subject', 0);
3947
3948
If the optional 0-based INDEX is given, then we return the INDEX'th
3949
occurrence of field TAG. Otherwise, we look at the context:
3950
In a scalar context, only the first (0th) occurrence of the
3951
field is returned; in an array context, I occurrences are returned.
3952
3953
I this should only be used with non-MIME fields.
3954
Behavior with MIME fields is TBD, and will raise an exception for now.
3955
3956
=item get_length
3957
3958
I
3959
Recompute the content length for the message I,
3960
setting the "content-length" attribute as a side-effect:
3961
3962
$msg->get_length;
3963
3964
Returns the length, or undefined if not set.
3965
3966
I the content length can be difficult to compute, since it
3967
involves assembling the entire encoded body and taking the length
3968
of it (which, in the case of multipart messages, means freezing
3969
all the sub-parts, etc.).
3970
3971
This method only sets the content length to a defined value if the
3972
message is a singlepart with C<"binary"> encoding, I the body is
3973
available either in-core or as a simple file. Otherwise, the content
3974
length is set to the undefined value.
3975
3976
Since content-length is not a standard MIME field anyway (that's right, kids:
3977
it's not in the MIME RFCs, it's an HTTP thing), this seems pretty fair.
3978
3979
=item parts
3980
3981
I
3982
Return the parts of this entity, and this entity only.
3983
Returns empty array if this entity has no parts.
3984
3985
This is B recursive! Parts can have sub-parts; use
3986
parts_DFS() to get everything.
3987
3988
=item parts_DFS
3989
3990
I
3991
Return the list of all MIME::Lite objects included in the entity,
3992
starting with the entity itself, in depth-first-search order.
3993
If this object has no parts, it alone will be returned.
3994
3995
=item preamble [TEXT]
3996
3997
I
3998
Get/set the preamble string, assuming that this object has subparts.
3999
Set it to undef for the default string.
4000
4001
=item replace TAG,VALUE
4002
4003
I
4004
Delete all occurrences of fields named TAG, and add a new
4005
field with the given VALUE. TAG is converted to all-lowercase.
4006
4007
B the special MIME fields (MIME-version, Content-*):
4008
if you "replace" a MIME field, the replacement text will override
4009
the I MIME attributes when it comes time to output that field.
4010
So normally you use attr() to change MIME fields and add()/replace() to
4011
change I fields:
4012
4013
$msg->replace("Subject" => "Hi there!");
4014
4015
Giving VALUE as the I will effectively I that
4016
field from being output. This is the correct way to suppress
4017
the special MIME fields:
4018
4019
$msg->replace("Content-disposition" => "");
4020
4021
Giving VALUE as I will just cause all explicit values
4022
for TAG to be deleted, without having any new values added.
4023
4024
I the name of this method comes from Mail::Header.
4025
4026
=item scrub
4027
4028
I
4029
B
4030
Recursively goes through the "parts" tree of this message and tries
4031
to find MIME attributes that can be removed.
4032
With an array argument, removes exactly those attributes; e.g.:
4033
4034
$msg->scrub(['content-disposition', 'content-length']);
4035
4036
Is the same as recursively doing:
4037
4038
$msg->replace('Content-disposition' => '');
4039
$msg->replace('Content-length' => '');
4040
4041
=back
4042
4043
=head2 Setting/getting message data
4044
4045
=over 4
4046
4047
=item binmode [OVERRIDE]
4048
4049
I
4050
With no argument, returns whether or not it thinks that the data
4051
(as given by the "Path" argument of C) should be read using
4052
binmode() (for example, when C is invoked).
4053
4054
The default behavior is that any content type other than
4055
C or C is binmode'd; this should in general work fine.
4056
4057
With a defined argument, this method sets an explicit "override"
4058
value. An undefined argument unsets the override.
4059
The new current value is returned.
4060
4061
=item data [DATA]
4062
4063
I
4064
Get/set the literal DATA of the message. The DATA may be
4065
either a scalar, or a reference to an array of scalars (which
4066
will simply be joined).
4067
4068
I setting the data causes the "content-length" attribute
4069
to be recomputed (possibly to nothing).
4070
4071
=item fh [FILEHANDLE]
4072
4073
I
4074
Get/set the FILEHANDLE which contains the message data.
4075
4076
Takes a filehandle as an input and stores it in the object.
4077
This routine is similar to path(); one important difference is that
4078
no attempt is made to set the content length.
4079
4080
=item path [PATH]
4081
4082
I
4083
Get/set the PATH to the message data.
4084
4085
I setting the path recomputes any existing "content-length" field,
4086
and re-sets the "filename" (to the last element of the path if it
4087
looks like a simple path, and to nothing if not).
4088
4089
=item resetfh [FILEHANDLE]
4090
4091
I
4092
Set the current position of the filehandle back to the beginning.
4093
Only applies if you used "FH" in build() or attach() for this message.
4094
4095
Returns false if unable to reset the filehandle (since not all filehandles
4096
are seekable).
4097
4098
=item read_now
4099
4100
I
4101
Forces data from the path/filehandle (as specified by C)
4102
to be read into core immediately, just as though you had given it
4103
literally with the C keyword.
4104
4105
Note that the in-core data will always be used if available.
4106
4107
Be aware that everything is slurped into a giant scalar: you may not want
4108
to use this if sending tar files! The benefit of I reading in the data
4109
is that very large files can be handled by this module if left on disk
4110
until the message is output via C or C.
4111
4112
=item sign PARAMHASH
4113
4114
I
4115
Sign the message. This forces the message to be read into core,
4116
after which the signature is appended to it.
4117
4118
=over 4
4119
4120
=item Data
4121
4122
As in C: the literal signature data.
4123
Can be either a scalar or a ref to an array of scalars.
4124
4125
=item Path
4126
4127
As in C: the path to the file.
4128
4129
=back
4130
4131
If no arguments are given, the default is:
4132
4133
Path => "$ENV{HOME}/.signature"
4134
4135
The content-length is recomputed.
4136
4137
=item verify_data
4138
4139
I
4140
Verify that all "paths" to attached data exist, recursively.
4141
It might be a good idea for you to do this before a print(), to
4142
prevent accidental partial output if a file might be missing.
4143
Raises exception if any path is not readable.
4144
4145
=back
4146
4147
=head2 Output
4148
4149
=over 4
4150
4151
=item print [OUTHANDLE]
4152
4153
I
4154
Print the message to the given output handle, or to the currently-selected
4155
filehandle if none was given.
4156
4157
All OUTHANDLE has to be is a filehandle (possibly a glob ref), or
4158
any object that responds to a print() message.
4159
4160
=item print_body [OUTHANDLE] [IS_SMTP]
4161
4162
I
4163
Print the body of a message to the given output handle, or to
4164
the currently-selected filehandle if none was given.
4165
4166
All OUTHANDLE has to be is a filehandle (possibly a glob ref), or
4167
any object that responds to a print() message.
4168
4169
B raised if unable to open any of the input files,
4170
or if a part contains no data, or if an unsupported encoding is
4171
encountered.
4172
4173
IS_SMPT is a special option to handle SMTP mails a little more
4174
intelligently than other send mechanisms may require. Specifically this
4175
ensures that the last byte sent is NOT '\n' (octal \012) if the last two
4176
bytes are not '\r\n' (\015\012) as this will cause some SMTP servers to
4177
hang.
4178
4179
=item print_header [OUTHANDLE]
4180
4181
I
4182
Print the header of the message to the given output handle,
4183
or to the currently-selected filehandle if none was given.
4184
4185
All OUTHANDLE has to be is a filehandle (possibly a glob ref), or
4186
any object that responds to a print() message.
4187
4188
=item as_string
4189
4190
I
4191
Return the entire message as a string, with a header and an encoded body.
4192
4193
=item body_as_string
4194
4195
I
4196
Return the encoded body as a string.
4197
This is the portion after the header and the blank line.
4198
4199
I actually prepares the body by "printing" to a scalar.
4200
Proof that you can hand the C methods any blessed object
4201
that responds to a C message.
4202
4203
=item header_as_string
4204
4205
I
4206
Return the header as a string.
4207
4208
=back
4209
4210
=head2 Sending
4211
4212
=over 4
4213
4214
=item send
4215
4216
=item send HOW, HOWARGS...
4217
4218
I
4219
This is the principal method for sending mail, and for configuring
4220
how mail will be sent.
4221
4222
I with a HOW argument and optional HOWARGS, it sets
4223
the default sending mechanism that the no-argument instance method
4224
will use. The HOW is a facility name (B),
4225
and the HOWARGS is interpreted by the facility.
4226
The class method returns the previous HOW and HOWARGS as an array.
4227
4228
MIME::Lite->send('sendmail', "d:\\programs\\sendmail.exe");
4229
...
4230
$msg = MIME::Lite->new(...);
4231
$msg->send;
4232
4233
I
4234
(a HOW argument and optional HOWARGS), sends the message in the
4235
requested manner; e.g.:
4236
4237
$msg->send('sendmail', "d:\\programs\\sendmail.exe");
4238
4239
I sends the
4240
message by the default mechanism set up by the class method.
4241
Returns whatever the mail-handling routine returns: this
4242
should be true on success, false/exception on error:
4243
4244
$msg = MIME::Lite->new(From=>...);
4245
$msg->send || die "you DON'T have mail!";
4246
4247
On Unix systems (or rather non-Win32 systems), the default
4248
setting is equivalent to:
4249
4250
MIME::Lite->send("sendmail", "/usr/lib/sendmail -t -oi -oem");
4251
4252
On Win32 systems the default setting is equivalent to:
4253
4254
MIME::Lite->send("smtp");
4255
4256
The assumption is that on Win32 your site/lib/Net/libnet.cfg
4257
file will be preconfigured to use the appropriate SMTP
4258
server. See below for configuring for authentication.
4259
4260
There are three facilities:
4261
4262
=over 4
4263
4264
=item "sendmail", ARGS...
4265
4266
Send a message by piping it into the "sendmail" command.
4267
Uses the L method, giving it the ARGS.
4268
This usage implements (and deprecates) the C method.
4269
4270
=item "smtp", [HOSTNAME, [NAMEDPARMS] ]
4271
4272
Send a message by SMTP, using optional HOSTNAME as SMTP-sending host.
4273
L will be required. Uses the L
4274
method. Any additional arguments passed in will also be passed through to
4275
send_by_smtp. This is useful for things like mail servers requiring
4276
authentication where you can say something like the following
4277
4278
MIME::Lite->send('smtp', $host, AuthUser=>$user, AuthPass=>$pass);
4279
4280
which will configure things so future uses of
4281
4282
$msg->send();
4283
4284
do the right thing.
4285
4286
=item "sub", \&SUBREF, ARGS...
4287
4288
Sends a message MSG by invoking the subroutine SUBREF of your choosing,
4289
with MSG as the first argument, and ARGS following.
4290
4291
=back
4292
4293
I let's say you're on an OS which lacks the usual Unix
4294
"sendmail" facility, but you've installed something a lot like it, and
4295
you need to configure your Perl script to use this "sendmail.exe" program.
4296
Do this following in your script's setup:
4297
4298
MIME::Lite->send('sendmail', "d:\\programs\\sendmail.exe");
4299
4300
Then, whenever you need to send a message $msg, just say:
4301
4302
$msg->send;
4303
4304
That's it. Now, if you ever move your script to a Unix box, all you
4305
need to do is change that line in the setup and you're done.
4306
All of your $msg-Esend invocations will work as expected.
4307
4308
After sending, the method last_send_successful() can be used to determine
4309
if the send was successful or not.
4310
4311
=item send_by_sendmail SENDMAILCMD
4312
4313
=item send_by_sendmail PARAM=>VALUE, ARRAY, HASH...
4314
4315
I
4316
Send message via an external "sendmail" program
4317
(this will probably only work out-of-the-box on Unix systems).
4318
4319
Returns true on success, false or exception on error.
4320
4321
You can specify the program and all its arguments by giving a single
4322
string, SENDMAILCMD. Nothing fancy is done; the message is simply
4323
piped in.
4324
4325
However, if your needs are a little more advanced, you can specify
4326
zero or more of the following PARAM/VALUE pairs (or a reference to hash
4327
or array of such arguments as well as any combination thereof); a
4328
Unix-style, taint-safe "sendmail" command will be constructed for you:
4329
4330
=over 4
4331
4332
=item Sendmail
4333
4334
Full path to the program to use.
4335
Default is "/usr/lib/sendmail".
4336
4337
=item BaseArgs
4338
4339
Ref to the basic array of arguments we start with.
4340
Default is C<["-t", "-oi", "-oem"]>.
4341
4342
=item SetSender
4343
4344
Unless this is I given as false, we attempt to automatically
4345
set the C<-f> argument to the first address that can be extracted from
4346
the "From:" field of the message (if there is one).
4347
4348
I
4349
Suppose we did I use C<-f>, and you gave an explicit "From:"
4350
field in your message: in this case, the sendmail "envelope" would
4351
indicate the I user your process was running under, as a way
4352
of preventing mail forgery. Using the C<-f> switch causes the sender
4353
to be set in the envelope as well.
4354
4355
I
4356
If sendmail doesn't regard you as a "trusted" user, it will permit
4357
the C<-f> but also add an "X-Authentication-Warning" header to the message
4358
to indicate a forged envelope. To avoid this, you can either
4359
(1) have SetSender be false, or
4360
(2) make yourself a trusted user by adding a C configuration
4361
command to your I file
4362
(e.g.: C if the script is running as user "eryq").
4363
4364
=item FromSender
4365
4366
If defined, this is identical to setting SetSender to true,
4367
except that instead of looking at the "From:" field we use
4368
the address given by this option.
4369
Thus:
4370
4371
FromSender => 'me@myhost.com'
4372
4373
=back
4374
4375
After sending, the method last_send_successful() can be used to determine
4376
if the send was successful or not.
4377
4378
=item send_by_smtp HOST, ARGS...
4379
4380
=item send_by_smtp REF, HOST, ARGS
4381
4382
I
4383
Send message via SMTP, using Net::SMTP -- which will be required for this
4384
feature.
4385
4386
HOST is the name of SMTP server to connect to, or undef to have
4387
L use the defaults in Libnet.cfg.
4388
4389
ARGS are a list of key value pairs which may be selected from the list
4390
below. Many of these are just passed through to specific
4391
L commands and you should review that module for
4392
details.
4393
4394
Please see L
4395
4396
=over 4
4397
4398
=item Hello
4399
4400
=item LocalAddr
4401
4402
=item LocalPort
4403
4404
=item Timeout
4405
4406
=item Port
4407
4408
=item ExactAddresses
4409
4410
=item Debug
4411
4412
See L for details.
4413
4414
=item Size
4415
4416
=item Return
4417
4418
=item Bits
4419
4420
=item Transaction
4421
4422
=item Envelope
4423
4424
See L for details.
4425
4426
=item SkipBad
4427
4428
If true doesn't throw an error when multiple email addresses are provided
4429
and some are not valid. See L
4430
for details.
4431
4432
=item AuthUser
4433
4434
Authenticate with L using this username.
4435
4436
=item AuthPass
4437
4438
Authenticate with L using this password.
4439
4440
=item NoAuth
4441
4442
Normally if AuthUser and AuthPass are defined MIME::Lite will attempt to
4443
use them with the L command to
4444
authenticate the connection, however if this value is true then no
4445
authentication occurs.
4446
4447
=item To
4448
4449
Sets the addresses to send to. Can be a string or a reference to an
4450
array of strings. Normally this is extracted from the To: (and Cc: and
4451
Bcc: fields if $AUTO_CC is true).
4452
4453
This value overrides that.
4454
4455
=item From
4456
4457
Sets the email address to send from. Normally this value is extracted
4458
from the Return-Path: or From: field of the mail itself (in that order).
4459
4460
This value overrides that.
4461
4462
=back
4463
4464
I
4465
True on success, croaks with an error message on failure.
4466
4467
After sending, the method last_send_successful() can be used to determine
4468
if the send was successful or not.
4469
4470
=item send_by_testfile FILENAME
4471
4472
I
4473
Print message to a file (namely FILENAME), which will default to
4474
mailer.testfile
4475
If file exists, message will be appended.
4476
4477
=item last_send_successful
4478
4479
This method will return TRUE if the last send() or send_by_XXX() method call was
4480
successful. It will return defined but false if it was not successful, and undefined
4481
if the object had not been used to send yet.
4482
4483
=item sendmail COMMAND...
4484
4485
I
4486
Declare the sender to be "sendmail", and set up the "sendmail" command.
4487
I
4488
4489
=back
4490
4491
=head2 Miscellaneous
4492
4493
=over 4
4494
4495
=item quiet ONOFF
4496
4497
I
4498
Suppress/unsuppress all warnings coming from this module.
4499
4500
MIME::Lite->quiet(1); ### I know what I'm doing
4501
4502
I recommend that you include that comment as well. And while
4503
you type it, say it out loud: if it doesn't feel right, then maybe
4504
you should reconsider the whole line. C<;-)>
4505
4506
=back
4507
4508
=head1 NOTES
4509
4510
=head2 How do I prevent "Content" headers from showing up in my mail reader?
4511
4512
Apparently, some people are using mail readers which display the MIME
4513
headers like "Content-disposition", and they want MIME::Lite not
4514
to generate them "because they look ugly".
4515
4516
Sigh.
4517
4518
Y'know, kids, those headers aren't just there for cosmetic purposes.
4519
They help ensure that the message is I correctly by mail
4520
readers. But okay, you asked for it, you got it...
4521
here's how you can suppress the standard MIME headers.
4522
Before you send the message, do this:
4523
4524
$msg->scrub;
4525
4526
You can scrub() any part of a multipart message independently;
4527
just be aware that it works recursively. Before you scrub,
4528
note the rules that I follow:
4529
4530
=over 4
4531
4532
=item Content-type
4533
4534
You can safely scrub the "content-type" attribute if, and only if,
4535
the part is of type "text/plain" with charset "us-ascii".
4536
4537
=item Content-transfer-encoding
4538
4539
You can safely scrub the "content-transfer-encoding" attribute
4540
if, and only if, the part uses "7bit", "8bit", or "binary" encoding.
4541
You are far better off doing this if your lines are under 1000
4542
characters. Generally, that means you I scrub it for plain
4543
text, and you can I scrub this for images, etc.
4544
4545
=item Content-disposition
4546
4547
You can safely scrub the "content-disposition" attribute
4548
if you trust the mail reader to do the right thing when it decides
4549
whether to show an attachment inline or as a link. Be aware
4550
that scrubbing both the content-disposition and the content-type
4551
means that there is no way to "recommend" a filename for the attachment!
4552
4553
B there are reports of brain-dead MUAs out there that
4554
do the wrong thing if you I the content-disposition.
4555
If your attachments keep showing up inline or vice-versa,
4556
try scrubbing this attribute.
4557
4558
=item Content-length
4559
4560
You can always scrub "content-length" safely.
4561
4562
=back
4563
4564
=head2 How do I give my attachment a [different] recommended filename?
4565
4566
By using the Filename option (which is different from Path!):
4567
4568
$msg->attach(Type => "image/gif",
4569
Path => "/here/is/the/real/file.GIF",
4570
Filename => "logo.gif");
4571
4572
You should I put path information in the Filename.
4573
4574
=head2 Working with UTF-8 and other character sets
4575
4576
All text that is added to your mail message should be properly encoded.
4577
MIME::Lite doesn't do this for you. For instance, if you want to
4578
send your mail in UTF-8, where C<$to>, C<$subject> and C<$text> have
4579
these values:
4580
4581
=over
4582
4583
=item *
4584
4585
To: "RamEn NuEez Efoo@bar.comE"
4586
4587
=item *
4588
4589
Subject: "EAquE estE!"
4590
4591
=item *
4592
4593
Text: "EQuieres ganar muchos E's?"
4594
4595
=back
4596
4597
use MIME::Lite;
4598
use Encode qw(encode encode_utf8 );
4599
4600
my $to = "Ram\363n Nu\361ez ";
4601
my $subject = "\241Aqu\355 est\341!";
4602
my $text = "\277Quieres ganar muchos \x{20ac}'s?";
4603
4604
### Create a new message encoded in UTF-8:
4605
my $msg = MIME::Lite->new(
4606
From => 'me@myhost.com',
4607
To => encode( 'MIME-Header', $to ),
4608
Subject => encode( 'MIME-Header', $subject ),
4609
Data => encode_utf8($text)
4610
);
4611
$msg->attr( 'content-type' => 'text/plain; charset=utf-8' );
4612
$msg->send;
4613
4614
B
4615
4616
=over
4617
4618
=item *
4619
4620
The above example assumes that the values you want to encode are in
4621
Perl's "internal" form, i.e. the strings contain decoded UTF-8
4622
characters, not the bytes that represent those characters.
4623
4624
See L, L, L and L for
4625
more.
4626
4627
=item *
4628
4629
If, for the body of the email, you want to use a character set
4630
other than UTF-8, then you should encode appropriately, and set the
4631
correct C, eg:
4632
4633
...
4634
Data => encode('iso-8859-15',$text)
4635
...
4636
4637
$msg->attr( 'content-type' => 'text/plain; charset=iso-8859-15' );
4638
4639
=item *
4640
4641
For the message headers, L only support UTF-8,
4642
but most modern mail clients should be able to handle this. It is not
4643
a problem to have your headers in a different encoding from the message
4644
body.
4645
4646
=back
4647
4648
=head2 Benign limitations
4649
4650
This is "lite", after all...
4651
4652
=over 4
4653
4654
=item *
4655
4656
There's no parsing. Get MIME-tools if you need to parse MIME messages.
4657
4658
=item *
4659
4660
MIME::Lite messages are currently I interchangeable with
4661
either Mail::Internet or MIME::Entity objects. This is a completely
4662
separate module.
4663
4664
=item *
4665
4666
A content-length field is only inserted if the encoding is binary,
4667
the message is a singlepart, and all the document data is available
4668
at C time by virtue of residing in a simple path, or in-core.
4669
Since content-length is not a standard MIME field anyway (that's right, kids:
4670
it's not in the MIME RFCs, it's an HTTP thing), this seems pretty fair.
4671
4672
=item *
4673
4674
MIME::Lite alone cannot help you lose weight. You must supplement
4675
your use of MIME::Lite with a healthy diet and exercise.
4676
4677
=back
4678
4679
=head2 Cheap and easy mailing
4680
4681
I thought putting in a default "sendmail" invocation wasn't too bad an
4682
idea, since a lot of Perlers are on UNIX systems. (As of version 3.02 this is
4683
default only on Non-Win32 boxen. On Win32 boxen the default is to use SMTP and the
4684
defaults specified in the site/lib/Net/libnet.cfg)
4685
4686
The out-of-the-box configuration is:
4687
4688
MIME::Lite->send('sendmail', "/usr/lib/sendmail -t -oi -oem");
4689
4690
By the way, these arguments to sendmail are:
4691
4692
-t Scan message for To:, Cc:, Bcc:, etc.
4693
4694
-oi Do NOT treat a single "." on a line as a message terminator.
4695
As in, "-oi vey, it truncated my message... why?!"
4696
4697
-oem On error, mail back the message (I assume to the
4698
appropriate address, given in the header).
4699
When mail returns, circle is complete. Jai Guru Deva -oem.
4700
4701
Note that these are the same arguments you get if you configure to use
4702
the smarter, taint-safe mailing:
4703
4704
MIME::Lite->send('sendmail');
4705
4706
If you get "X-Authentication-Warning" headers from this, you can forgo
4707
diddling with the envelope by instead specifying:
4708
4709
MIME::Lite->send('sendmail', SetSender=>0);
4710
4711
And, if you're not on a Unix system, or if you'd just rather send mail
4712
some other way, there's always SMTP, which these days probably requires
4713
authentication so you probably need to say
4714
4715
MIME::Lite->send('smtp', "smtp.myisp.net",
4716
AuthUser=>"YourName",AuthPass=>"YourPass" );
4717
4718
Or you can set up your own subroutine to call.
4719
In any case, check out the L method.
4720
4721
=head1 WARNINGS
4722
4723
=head2 Good-vs-bad email addresses with send_by_smtp()
4724
4725
If using L, be aware that unless you
4726
explicitly provide the email addresses to send to and from you will be
4727
forcing MIME::Lite to extract email addresses out of a possible list
4728
provided in the C, C, and C fields. This is tricky
4729
stuff, and as such only the following sorts of addresses will work
4730
reliably:
4731
4732
username
4733
full.name@some.host.com
4734
"Name, Full"
4735
4736
B
4737
MIME::Lite was never intended to be a Mail User Agent, so please
4738
don't expect a full implementation of RFC-822. Restrict yourself to
4739
the common forms of Internet addresses described herein, and you should
4740
be fine. If this is not feasible, then consider using MIME::Lite
4741
to I your message only, and using Net::SMTP explicitly to
4742
I your message.
4743
4744
B
4745
As of MIME::Lite v3.02 the mail name extraction routines have been
4746
beefed up considerably. Furthermore if Mail::Address is provided then
4747
name extraction is done using that. Accordingly the above advice is now
4748
less true than it once was. Funky email names I work properly
4749
now. However the disclaimer remains. Patches welcome. :-)
4750
4751
=head2 Formatting of headers delayed until print()
4752
4753
This class treats a MIME header in the most abstract sense,
4754
as being a collection of high-level attributes. The actual
4755
RFC-822-style header fields are not constructed until it's time
4756
to actually print the darn thing.
4757
4758
=head2 Encoding of data delayed until print()
4759
4760
When you specify message bodies
4761
(in L or L) --
4762
whether by B, B, or B -- be warned that we don't
4763
attempt to open files, read filehandles, or encode the data until
4764
L is invoked.
4765
4766
In the past, this created some confusion for users of sendmail
4767
who gave the wrong path to an attachment body, since enough of
4768
the print() would succeed to get the initial part of the message out.
4769
Nowadays, $AUTO_VERIFY is used to spot-check the Paths given before
4770
the mail facility is employed. A whisker slower, but tons safer.
4771
4772
Note that if you give a message body via FH, and try to print()
4773
a message twice, the second print() will not do the right thing
4774
unless you explicitly rewind the filehandle.
4775
4776
You can get past these difficulties by using the B option,
4777
provided that you have enough memory to handle your messages.
4778
4779
=head2 MIME attributes are separate from header fields!
4780
4781
B the MIME attributes are stored and manipulated separately
4782
from the message header fields; when it comes time to print the
4783
header out, I
4784
would be created from the MIME attributes.> That means that this:
4785
4786
### DANGER ### DANGER ### DANGER ### DANGER ### DANGER ###
4787
$msg->add("Content-type", "text/html; charset=US-ASCII");
4788
4789
will set the exact C<"Content-type"> field in the header I write,
4790
I
4791
4792
I as an escape hatch in case
4793
the code that normally formats MIME header fields isn't doing what
4794
you need. And, like any escape hatch, it's got an alarm on it:
4795
MIME::Lite will warn you if you attempt to C or C
4796
any MIME header field. Use C instead.
4797
4798
=head2 Beware of lines consisting of a single dot
4799
4800
Julian Haight noted that MIME::Lite allows you to compose messages
4801
with lines in the body consisting of a single ".".
4802
This is true: it should be completely harmless so long as "sendmail"
4803
is used with the -oi option (see L<"Cheap and easy mailing">).
4804
4805
However, I don't know if using Net::SMTP to transfer such a message
4806
is equally safe. Feedback is welcomed.
4807
4808
My perspective: I don't want to magically diddle with a user's
4809
message unless absolutely positively necessary.
4810
Some users may want to send files with "." alone on a line;
4811
my well-meaning tinkering could seriously harm them.
4812
4813
=head2 Infinite loops may mean tainted data!
4814
4815
Stefan Sautter noticed a bug in 2.106 where a m//gc match was
4816
failing due to tainted data, leading to an infinite loop inside
4817
MIME::Lite.
4818
4819
I am attempting to correct for this, but be advised that my fix will
4820
silently untaint the data (given the context in which the problem
4821
occurs, this should be benign: I've labelled the source code with
4822
UNTAINT comments for the curious).
4823
4824
So: don't depend on taint-checking to save you from outputting
4825
tainted data in a message.
4826
4827
=head2 Don't tweak the global configuration
4828
4829
Global configuration variables are bad, and should go away.
4830
Until they do, please follow the hints with each setting
4831
on how I to change it.
4832
4833
=head1 A MIME PRIMER
4834
4835
=head2 Content types
4836
4837
The "Type" parameter of C is a I.
4838
This is the actual type of data you are sending.
4839
Generally this is a string of the form C<"majortype/minortype">.
4840
4841
Here are the major MIME types.
4842
A more-comprehensive listing may be found in RFC-2046.
4843
4844
=over 4
4845
4846
=item application
4847
4848
Data which does not fit in any of the other categories, particularly
4849
data to be processed by some type of application program.
4850
C, C, C...
4851
4852
=item audio
4853
4854
Audio data.
4855
C...
4856
4857
=item image
4858
4859
Graphics data.
4860
C, C...
4861
4862
=item message
4863
4864
A message, usually another mail or MIME message.
4865
C...
4866
4867
=item multipart
4868
4869
A message containing other messages.
4870
C, C...
4871
4872
=item text
4873
4874
Textual data, meant for humans to read.
4875
C, C...
4876
4877
=item video
4878
4879
Video or video+audio data.
4880
C...
4881
4882
=back
4883
4884
=head2 Content transfer encodings
4885
4886
The "Encoding" parameter of C.
4887
This is how the message body is packaged up for safe transit.
4888
4889
Here are the 5 major MIME encodings.
4890
A more-comprehensive listing may be found in RFC-2045.
4891
4892
=over 4
4893
4894
=item 7bit
4895
4896
Basically, no I encoding is done. However, this label guarantees that no
4897
8-bit characters are present, and that lines do not exceed 1000 characters
4898
in length.
4899
4900
=item 8bit
4901
4902
Basically, no I encoding is done. The message might contain 8-bit
4903
characters, but this encoding guarantees that lines do not exceed 1000
4904
characters in length.
4905
4906
=item binary
4907
4908
No encoding is done at all. Message might contain 8-bit characters,
4909
and lines might be longer than 1000 characters long.
4910
4911
The most liberal, and the least likely to get through mail gateways.
4912
Use sparingly, or (better yet) not at all.
4913
4914
=item base64
4915
4916
Like "uuencode", but very well-defined. This is how you should send
4917
essentially binary information (tar files, GIFs, JPEGs, etc.).
4918
4919
=item quoted-printable
4920
4921
Useful for encoding messages which are textual in nature, yet which contain
4922
non-ASCII characters (e.g., Latin-1, Latin-2, or any other 8-bit alphabet).
4923
4924
=back
4925
4926
=head1 HELPER MODULES
4927
4928
MIME::Lite works nicely with other certain other modules if they are present.
4929
Good to have installed are the latest L,
4930
L, L,
4931
L, and L.
4932
L is strictly required.
4933
4934
If they aren't present then some functionality won't work, and other features
4935
won't be as efficient or up to date as they could be. Nevertheless they are optional
4936
extras.
4937
4938
=head1 BUNDLED GOODIES
4939
4940
MIME::Lite comes with a number of extra files in the distribution bundle.
4941
This includes examples, and utility modules that you can use to get yourself
4942
started with the module.
4943
4944
The ./examples directory contains a number of snippets in prepared
4945
form, generally they are documented, but they should be easy to understand.
4946
4947
The ./contrib directory contains a companion/tool modules that come bundled
4948
with MIME::Lite, they don't get installed by default. Please review the POD
4949
they come with.
4950
4951
=head1 BUGS
4952
4953
The whole reason that version 3.0 was released was to ensure that MIME::Lite is
4954
up to date and patched. If you find an issue please report it.
4955
4956
As far as I know MIME::Lite doesn't currently have any serious bugs, but my
4957
usage is hardly comprehensive.
4958
4959
Having said that there are a number of open issues for me, mostly caused by the
4960
progress in the community as whole since Eryq last released. The tests are
4961
based around an interesting but non standard test framework. I'd like to change
4962
it over to using Test::More.
4963
4964
Should tests fail please review the ./testout directory, and in any bug reports
4965
please include the output of the relevant file. This is the only redeeming
4966
feature of not using Test::More that I can see.
4967
4968
Bug fixes / Patches / Contribution are welcome, however I probably won't apply
4969
them unless they also have an associated test. This means that if I don't have
4970
the time to write the test the patch won't get applied, so please, include tests
4971
for any patches you provide.
4972
4973
=head1 NUTRITIONAL INFORMATION
4974
4975
For some reason, the US FDA says that this is now required by law
4976
on any products that bear the name "Lite"...
4977
4978
Version 3.0 is now new and improved! The distribution is now 30% smaller!
4979
4980
MIME::Lite |
4981
------------------------------------------------------------
4982
Serving size: | 1 module
4983
Servings per container: | 1
4984
Calories: | 0
4985
Fat: | 0g
4986
Saturated Fat: | 0g
4987
4988
Warning: for consumption by hardware only! May produce
4989
indigestion in humans if taken internally.
4990
4991
=head1 AUTHORS
4992
4993
=over 4
4994
4995
=item *
4996
4997
Ricardo SIGNES
4998
4999
=item *
5000
5001
Eryq
5002
5003
=item *
5004
5005
Yves Orton
5006
5007
=back
5008
5009
=head1 CONTRIBUTORS
5010
5011
=for stopwords Claude Damien Krotkine David Steinbrunner Florian Jan Willamowius John Bokma Karen Etheridge Max Maischein Michael Schout Stevens Peder Stray Peter Heirich Ricardo Signes Tom Hukins
5012
5013
=over 4
5014
5015
=item *
5016
5017
Claude
5018
5019
=item *
5020
5021
Damien Krotkine
5022
5023
=item *
5024
5025
David Steinbrunner
5026
5027
=item *
5028
5029
Florian
5030
5031
=item *
5032
5033
Jan Willamowius
5034
5035
=item *
5036
5037
John Bokma
5038
5039
=item *
5040
5041
Karen Etheridge
5042
5043
=item *
5044
5045
Max Maischein
5046
5047
=item *
5048
5049
Michael Schout
5050
5051
=item *
5052
5053
Michael Stevens
5054
5055
=item *
5056
5057
Peder Stray
5058
5059
=item *
5060
5061
Peter Heirich
5062
5063
=item *
5064
5065
Ricardo Signes
5066
5067
=item *
5068
5069
Tom Hukins
5070
5071
=back
5072
5073
=head1 COPYRIGHT AND LICENSE
5074
5075
This software is copyright (c) 1997 by Eryq, ZeeGee Software, and Yves Orton.
5076
5077
This is free software; you can redistribute it and/or modify it under
5078
the same terms as the Perl 5 programming language system itself.
5079
5080
=cut
5081
5082
__END__