aboutsummaryrefslogtreecommitdiffstats
path: root/Perl/MIME
diff options
context:
space:
mode:
authorBas Zoetekouw <bas>2008-12-18 10:05:35 +0000
committerBas Zoetekouw <bas>2008-12-18 10:05:35 +0000
commitd70e386f098c2b1ee2ad5720ce92f68ad7322e58 (patch)
treeb5ee363f3fc5252f16960039f16464651627a018 /Perl/MIME
parent47a603dba15d9a58bfd712e39a7c9baa97fb25e7 (diff)
Updated embedded MIME::Lite (from debian version 3.023-1) and added dependency
Email::Date::Format (from debian package 1.002-1). CVS version numbers Perl/MIME/EmailDateFormat.pm: INITIAL -> 1.1 Perl/MIME/Lite.pm: 1.1 -> 1.2
Diffstat (limited to 'Perl/MIME')
-rw-r--r--Perl/MIME/EmailDateFormat.pm130
-rw-r--r--Perl/MIME/Lite.pm2874
2 files changed, 1628 insertions, 1376 deletions
diff --git a/Perl/MIME/EmailDateFormat.pm b/Perl/MIME/EmailDateFormat.pm
new file mode 100644
index 00000000000..234d28d091b
--- /dev/null
+++ b/Perl/MIME/EmailDateFormat.pm
@@ -0,0 +1,130 @@
+use 5.006;
+use strict;
+use warnings;
+
+# fix the name so we can put this in the webwml repo under Perl/MIME
+#package Email::Date::Format;
+package MIME::EmailDateFormat;
+
+our $VERSION = '1.002';
+our @EXPORT_OK = qw[email_date email_gmdate];
+
+use Exporter;
+BEGIN { our @ISA = 'Exporter' }
+use Time::Local ();
+
+=head1 NAME
+
+Email::Date::Format - produce RFC 2822 date strings
+
+=head1 SYNOPSIS
+
+ use Email::Date::Format qw(email_date);
+
+ my $header = email_date($date->epoch);
+
+ Email::Simple->create(
+ header => [
+ Date => $header,
+ ],
+ body => '...',
+ );
+
+=head1 DESCRIPTION
+
+This module provides a simple means for generating an RFC 2822 compliant
+datetime string. (In case you care, they're not RFC 822 dates, because they
+use a four digit year, which is not allowed in RFC 822.)
+
+=head2 FUNCTIONS
+
+=over 4
+
+=item email_date
+
+ my $date = email_date; # now
+ my $date = email_date( time - 60*60 ); # one hour ago
+
+C<email_date> accepts an epoch value, such as the one returned by C<time>.
+It returns a string representing the date and time of the input, as
+specified in RFC 2822. If no input value is provided, the current value
+of C<time> is used.
+
+C<format_date> is exported only if requested.
+
+=item email_gmdate
+
+ my $date = email_gmdate;
+
+C<email_gmdate> is identical to C<email_date>, but it will return a string
+indicating the time in Greenwich Mean Time, rather than local time.
+
+C<format_gmdate> is exported only if requested.
+
+=cut
+
+sub _tz_diff {
+ my ($time) = @_;
+
+ my $diff = Time::Local::timegm(localtime $time)
+ - Time::Local::timegm(gmtime $time);
+
+ my $direc = $diff < 0 ? '-' : '+';
+ $diff = abs $diff;
+ my $tz_hr = int( $diff / 3600 );
+ my $tz_mi = int( $diff / 60 - $tz_hr * 60 );
+
+ return ($direc, $tz_hr, $tz_mi);
+}
+
+sub _format_date {
+ my ($local) = @_;
+
+ sub {
+ my ($time) = @_;
+ $time = time unless defined $time;
+
+ my ($sec, $min, $hour, $mday, $mon, $year, $wday)
+ = $local ? (localtime $time) : (gmtime $time);
+
+ my $day = (qw[Sun Mon Tue Wed Thu Fri Sat])[$wday];
+ my $month = (qw[Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec])[$mon];
+ $year += 1900;
+
+ my ($direc, $tz_hr, $tz_mi) = $local ? _tz_diff($time)
+ : ('+', 0, 0);
+
+ sprintf "%s, %d %s %d %02d:%02d:%02d %s%02d%02d",
+ $day, $mday, $month, $year, $hour, $min, $sec, $direc, $tz_hr, $tz_mi;
+ }
+}
+
+BEGIN {
+ *email_date = _format_date(1);
+ *email_gmdate = _format_date(0);
+};
+
+1;
+
+__END__
+
+=back
+
+=head1 PERL EMAIL PROJECT
+
+This module is maintained by the Perl Email Project
+
+L<http://emailproject.perl.org/wiki/Email::Date::Format>
+
+=head1 AUTHOR
+
+Ricardo SIGNES, <F<rjbs@cpan.org>>.
+
+Adapted from Email::Date, by Casey West.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2007, Ricarod SIGNES. This module is free software; you can
+redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
diff --git a/Perl/MIME/Lite.pm b/Perl/MIME/Lite.pm
index 26903c3d202..50097ee27ab 100644
--- a/Perl/MIME/Lite.pm
+++ b/Perl/MIME/Lite.pm
@@ -1,75 +1,87 @@
package MIME::Lite;
-
+use strict;
+require 5.004; ### for /c modifier in m/\G.../gc modifier
=head1 NAME
MIME::Lite - low-calorie MIME generator
-
=head1 SYNOPSIS
- use MIME::Lite;
-
-Create a single-part message:
+Create and send using the default send method for your OS a single-part message:
+ use MIME::Lite;
### Create a new single-part message, to send a GIF file:
$msg = MIME::Lite->new(
- From =>'me@myhost.com',
- To =>'you@yourhost.com',
- Cc =>'some@other.com, some@more.com',
- Subject =>'Helloooooo, nurse!',
- Type =>'image/gif',
- Encoding =>'base64',
- Path =>'hellonurse.gif'
- );
-
-Create a multipart message (i.e., one with attachments):
+ From => 'me@myhost.com',
+ To => 'you@yourhost.com',
+ Cc => 'some@other.com, some@more.com',
+ Subject => 'Helloooooo, nurse!',
+ Type => 'image/gif',
+ Encoding => 'base64',
+ Path => 'hellonurse.gif'
+ );
+ $msg->send; # send via default
+
+Create a multipart message (i.e., one with attachments) and send it SMTP
### Create a new multipart message:
- $msg = MIME::Lite->new(
- From =>'me@myhost.com',
- To =>'you@yourhost.com',
- Cc =>'some@other.com, some@more.com',
- Subject =>'A message with 2 parts...',
- Type =>'multipart/mixed'
- );
-
+ $msg = MIME::Lite->new(
+ From => 'me@myhost.com',
+ To => 'you@yourhost.com',
+ Cc => 'some@other.com, some@more.com',
+ Subject => 'A message with 2 parts...',
+ Type => 'multipart/mixed'
+ );
+
### Add parts (each "attach" has same arguments as "new"):
- $msg->attach(Type =>'TEXT',
- Data =>"Here's the GIF file you wanted"
- );
- $msg->attach(Type =>'image/gif',
- Path =>'aaa000123.gif',
- Filename =>'logo.gif',
- Disposition => 'attachment'
- );
+ $msg->attach(
+ Type => 'TEXT',
+ Data => "Here's the GIF file you wanted"
+ );
+ $msg->attach(
+ Type => 'image/gif',
+ Path => 'aaa000123.gif',
+ Filename => 'logo.gif',
+ Disposition => 'attachment'
+ );
+ ### use Net:SMTP to do the sending
+ $msg->send('smtp','some.host', Debug=>1 );
Output a message:
### Format as a string:
$str = $msg->as_string;
-
+
### Print to a filehandle (say, a "sendmail" stream):
$msg->print(\*SENDMAIL);
-
Send a message:
### Send in the "best" way (the default is to use "sendmail"):
$msg->send;
-
+ ### Send a specific way:
+ $msg->send('type',@args);
+
+Specify default send method:
+
+ MIME::Lite->send('smtp','some.host',Debug=>0);
+
+with authentication
+ MIME::Lite->send('smtp','some.host',
+ AuthUser=>$user, AuthPass=>$pass);
=head1 DESCRIPTION
In the never-ending quest for great taste with fewer calories,
-we proudly present: I<MIME::Lite>.
+we proudly present: I<MIME::Lite>.
MIME::Lite is intended as a simple, standalone module for generating
(not parsing!) MIME messages... specifically, it allows you to
output a simple, decent single- or multi-part message with text or binary
attachments. It does not require that you have the Mail:: or MIME::
-modules installed.
+modules installed, but will work with them if they are.
You can specify each message part as either the literal data itself (in
a scalar or array), or as a string which can be given to open() to get
@@ -78,93 +90,91 @@ a readable filehandle (e.g., "<filename" or "somecommand|").
You don't need to worry about encoding your message data:
this module will do that for you. It handles the 5 standard MIME encodings.
-If you need more sophisticated behavior, please get the MIME-tools
-package instead. I will be more likely to add stuff to that toolkit
-over this one.
-
-
=head1 EXAMPLES
=head2 Create a simple message containing just text
$msg = MIME::Lite->new(
- From =>'me@myhost.com',
- To =>'you@yourhost.com',
- Cc =>'some@other.com, some@more.com',
- Subject =>'Helloooooo, nurse!',
- Data =>"How's it goin', eh?"
- );
+ From =>'me@myhost.com',
+ To =>'you@yourhost.com',
+ Cc =>'some@other.com, some@more.com',
+ Subject =>'Helloooooo, nurse!',
+ Data =>"How's it goin', eh?"
+ );
=head2 Create a simple message containing just an image
$msg = MIME::Lite->new(
- From =>'me@myhost.com',
- To =>'you@yourhost.com',
- Cc =>'some@other.com, some@more.com',
- Subject =>'Helloooooo, nurse!',
- Type =>'image/gif',
- Encoding =>'base64',
- Path =>'hellonurse.gif'
- );
+ From =>'me@myhost.com',
+ To =>'you@yourhost.com',
+ Cc =>'some@other.com, some@more.com',
+ Subject =>'Helloooooo, nurse!',
+ Type =>'image/gif',
+ Encoding =>'base64',
+ Path =>'hellonurse.gif'
+ );
=head2 Create a multipart message
### Create the multipart "container":
- $msg = MIME::Lite->new(
- From =>'me@myhost.com',
- To =>'you@yourhost.com',
- Cc =>'some@other.com, some@more.com',
- Subject =>'A message with 2 parts...',
- Type =>'multipart/mixed'
- );
-
+ $msg = MIME::Lite->new(
+ From =>'me@myhost.com',
+ To =>'you@yourhost.com',
+ Cc =>'some@other.com, some@more.com',
+ Subject =>'A message with 2 parts...',
+ Type =>'multipart/mixed'
+ );
+
### Add the text message part:
### (Note that "attach" has same arguments as "new"):
- $msg->attach(Type =>'TEXT',
- Data =>"Here's the GIF file you wanted"
- );
-
+ $msg->attach(
+ Type =>'TEXT',
+ Data =>"Here's the GIF file you wanted"
+ );
+
### Add the image part:
- $msg->attach(Type =>'image/gif',
- Path =>'aaa000123.gif',
- Filename =>'logo.gif',
- Disposition => 'attachment'
- );
+ $msg->attach(
+ Type =>'image/gif',
+ Path =>'aaa000123.gif',
+ Filename =>'logo.gif',
+ Disposition => 'attachment'
+ );
=head2 Attach a GIF to a text message
-This will create a multipart message exactly as above, but using the
+This will create a multipart message exactly as above, but using the
"attach to singlepart" hack:
### Start with a simple text message:
$msg = MIME::Lite->new(
- From =>'me@myhost.com',
- To =>'you@yourhost.com',
- Cc =>'some@other.com, some@more.com',
- Subject =>'A message with 2 parts...',
- Type =>'TEXT',
- Data =>"Here's the GIF file you wanted"
- );
-
+ From =>'me@myhost.com',
+ To =>'you@yourhost.com',
+ Cc =>'some@other.com, some@more.com',
+ Subject =>'A message with 2 parts...',
+ Type =>'TEXT',
+ Data =>"Here's the GIF file you wanted"
+ );
+
### Attach a part... the make the message a multipart automatically:
- $msg->attach(Type =>'image/gif',
- Path =>'aaa000123.gif',
- Filename =>'logo.gif'
- );
+ $msg->attach(
+ Type =>'image/gif',
+ Path =>'aaa000123.gif',
+ Filename =>'logo.gif'
+ );
=head2 Attach a pre-prepared part to a message
### Create a standalone part:
$part = MIME::Lite->new(
- Type =>'text/html',
- Data =>'<H1>Hello</H1>',
- );
- $part->attr('content-type.charset' => 'UTF8');
+ Type =>'text/html',
+ Data =>'<H1>Hello</H1>',
+ );
+ $part->attr('content-type.charset' => 'UTF-8');
$part->add('X-Comment' => 'A message for you');
-
+
### Attach it to any message:
$msg->attach($part);
@@ -172,23 +182,23 @@ This will create a multipart message exactly as above, but using the
=head2 Print a message to a filehandle
### Write it to a filehandle:
- $msg->print(\*STDOUT);
-
+ $msg->print(\*STDOUT);
+
### Write just the header:
- $msg->print_header(\*STDOUT);
-
+ $msg->print_header(\*STDOUT);
+
### Write just the encoded body:
- $msg->print_body(\*STDOUT);
+ $msg->print_body(\*STDOUT);
=head2 Print a message into a string
### Get entire message as a string:
$str = $msg->as_string;
-
+
### Get just the header:
$str = $msg->header_as_string;
-
+
### Get just the encoded body:
$str = $msg->body_as_string;
@@ -202,20 +212,24 @@ This will create a multipart message exactly as above, but using the
=head2 Send an HTML document... with images included!
$msg = MIME::Lite->new(
- To =>'you@yourhost.com',
- Subject =>'HTML with in-line images!',
- Type =>'multipart/related'
- );
- $msg->attach(Type => 'text/html',
- Data => qq{ <body>
- Here's <i>my</i> image:
- <img src="cid:myimage.gif">
- </body> }
- );
- $msg->attach(Type => 'image/gif',
- Id => 'myimage.gif',
- Path => '/path/to/somefile.gif',
- );
+ To =>'you@yourhost.com',
+ Subject =>'HTML with in-line images!',
+ Type =>'multipart/related'
+ );
+ $msg->attach(
+ Type => 'text/html',
+ Data => qq{
+ <body>
+ Here's <i>my</i> image:
+ <img src="cid:myimage.gif">
+ </body>
+ },
+ );
+ $msg->attach(
+ Type => 'image/gif',
+ Id => 'myimage.gif',
+ Path => '/path/to/somefile.gif',
+ );
$msg->send();
@@ -223,17 +237,13 @@ This will create a multipart message exactly as above, but using the
### Do something like this in your 'main':
if ($I_DONT_HAVE_SENDMAIL) {
- MIME::Lite->send('smtp', "smtp.myisp.net", Timeout=>60);
+ MIME::Lite->send('smtp', $host, Timeout=>60
+ AuthUser=>$user, AuthPass=>$pass);
}
-
+
### Now this will do the right thing:
$msg->send; ### will now use Net::SMTP as shown above
-
-
-
-
-
=head1 PUBLIC INTERFACE
=head2 Global configuration
@@ -246,7 +256,7 @@ methods/options:
=item MIME::Lite->field_order()
-When used as a L<classmethod|/field_order>, this changes the default
+When used as a L<classmethod|/field_order>, this changes the default
order in which headers are output for I<all> messages.
However, please consider using the instance method variant instead,
so you won't stomp on other message senders in the same application.
@@ -254,14 +264,14 @@ so you won't stomp on other message senders in the same application.
=item MIME::Lite->quiet()
-This L<classmethod|/quiet> can be used to suppress/unsuppress
+This L<classmethod|/quiet> can be used to suppress/unsuppress
all warnings coming from this module.
=item MIME::Lite->send()
-When used as a L<classmethod|/send>, this can be used to specify
-a different default mechanism for sending message.
+When used as a L<classmethod|/send>, this can be used to specify
+a different default mechanism for sending message.
The initial default is:
MIME::Lite->send("sendmail", "/usr/lib/sendmail -t -oi -oem");
@@ -287,7 +297,7 @@ If true, try to automatically choose the content type from the file name
in C<new()>/C<build()>. In other words, setting this true changes the
default C<Type> from C<"TEXT"> to C<"AUTO">.
-Default is B<false>, since we must maintain backwards-compatibility
+Default is B<false>, since we must maintain backwards-compatibility
with prior behavior. B<Please> consider keeping it false,
and just using Type 'AUTO' when you build() or attach().
@@ -317,32 +327,24 @@ and trusting these other packages to do the right thing.
=cut
-require 5.004; ### for /c modifier in m/\G.../gc modifier
-
use Carp ();
use FileHandle;
-use strict;
use vars qw(
- $AUTO_CC
- $AUTO_CONTENT_TYPE
- $AUTO_ENCODE
- $AUTO_VERIFY
- $PARANOID
- $QUIET
- $VANILLA
- $VERSION
- );
-
+ $AUTO_CC
+ $AUTO_CONTENT_TYPE
+ $AUTO_ENCODE
+ $AUTO_VERIFY
+ $PARANOID
+ $QUIET
+ $VANILLA
+ $VERSION
+ $DEBUG
+);
-#==============================
-#==============================
-#
# GLOBALS, EXTERNAL/CONFIGURATION...
-
-### The package version, both in 1.23 style *and* usable by MakeMaker:
-$VERSION = substr q$Revision$, 10;
+$VERSION = '3.023';
### Automatically interpret CC/BCC for SMTP:
$AUTO_CC = 1;
@@ -365,39 +367,59 @@ $QUIET = undef;
### Unsupported (for tester use): don't qualify boundary with time/pid:
$VANILLA = 0;
+$MIME::Lite::DEBUG = 0;
#==============================
#==============================
#
# GLOBALS, INTERNAL...
-### Find sendmail:
-my $SENDMAIL = "/usr/lib/sendmail";
-(-x $SENDMAIL) or ($SENDMAIL = "/usr/sbin/sendmail");
-(-x $SENDMAIL) or ($SENDMAIL = "sendmail");
+my $Sender = "";
+my $SENDMAIL = "";
+
+if ( $^O =~ /win32|cygwin/i ) {
+ $Sender = "smtp";
+} else {
+ ### Find sendmail:
+ $Sender = "sendmail";
+ $SENDMAIL = "/usr/lib/sendmail";
+ ( -x $SENDMAIL ) or ( $SENDMAIL = "/usr/sbin/sendmail" );
+ ( -x $SENDMAIL ) or ( $SENDMAIL = "sendmail" );
+ unless (-x $SENDMAIL) {
+ require File::Spec;
+ for my $dir (File::Spec->path) {
+ if ( -x "$dir/sendmail" ) {
+ $SENDMAIL = "$dir/sendmail";
+ last;
+ }
+ }
+ }
+ unless (-x $SENDMAIL) {
+ undef $SENDMAIL;
+ }
+}
### Our sending facilities:
-my $Sender = "sendmail";
my %SenderArgs = (
- "sendmail" => ["$SENDMAIL -t -oi -oem"],
- "smtp" => [],
- "sub" => [],
+ sendmail => [$SENDMAIL ? "$SENDMAIL -t -oi -oem" : undef],
+ smtp => [],
+ sub => [],
);
### Boundary counter:
my $BCount = 0;
-### Known Mail/MIME fields... these, plus some general forms like
+### Known Mail/MIME fields... these, plus some general forms like
### "x-*", are recognized by build():
-my %KnownField = map {$_=>1}
-qw(
- bcc cc comments date encrypted
- from keywords message-id mime-version organization
- received references reply-to return-path sender
- subject to
-
- approved
- );
+my %KnownField = map { $_ => 1 }
+ qw(
+ bcc cc comments date encrypted
+ from keywords message-id mime-version organization
+ received references reply-to return-path sender
+ subject to
+
+ approved
+);
### What external packages do we use for encoding?
my @Uses;
@@ -407,16 +429,16 @@ my @FieldOrder;
### See if we have File::Basename
my $HaveFileBasename = 0;
-if (eval "require File::Basename") { # not affected by $PARANOID, core Perl
- $HaveFileBasename = 1;
- push @Uses, "F$File::Basename::VERSION";
+if ( eval "require File::Basename" ) { # not affected by $PARANOID, core Perl
+ $HaveFileBasename = 1;
+ push @Uses, "F$File::Basename::VERSION";
}
### See if we have/want MIME::Types
my $HaveMimeTypes = 0;
-if (!$PARANOID and eval "require MIME::Types") {
- $HaveMimeTypes = 1;
- push @Uses, "T$MIME::Types::VERSION";
+if ( !$PARANOID and eval "require MIME::Types; MIME::Types->VERSION(1.004);" ) {
+ $HaveMimeTypes = 1;
+ push @Uses, "T$MIME::Types::VERSION";
}
#==============================
@@ -424,7 +446,7 @@ if (!$PARANOID and eval "require MIME::Types") {
#
# PRIVATE UTILITY FUNCTIONS...
-#------------------------------
+#------------------------------
#
# fold STRING
#
@@ -434,7 +456,7 @@ if (!$PARANOID and eval "require MIME::Types") {
sub fold {
my $str = shift;
$str =~ s/^\s*|\s*$//g; ### trim
- $str =~ s/\n/\n /g;
+ $str =~ s/\n/\n /g;
$str;
}
@@ -446,18 +468,7 @@ sub fold {
# The unsupported $VANILLA is for test purposes only.
sub gen_boundary {
- return ("_----------=_".($VANILLA ? '' : int(time).$$).$BCount++);
-}
-
-#------------------------------
-#
-# known_field FIELDNAME
-#
-# Is this a recognized Mail/MIME field?
-
-sub known_field {
- my $field = lc(shift);
- $KnownField{$field} or ($field =~ m{^(content|resent|x)-.});
+ return ( "_----------=_" . ( $VANILLA ? '' : int(time) . $$ ) . $BCount++ );
}
#------------------------------
@@ -472,57 +483,69 @@ sub is_mime_field {
#------------------------------
#
-# extract_addrs STRING
+# extract_full_addrs STRING
+# extract_only_addrs STRING
#
# Split STRING into an array of email addresses: somewhat of a KLUDGE.
#
# Unless paranoid, we try to load the real code before supplying our own.
+BEGIN {
+ my $ATOM = '[^ \000-\037()<>@,;:\134"\056\133\135]+';
+ my $QSTR = '".*?"';
+ my $WORD = '(?:' . $QSTR . '|' . $ATOM . ')';
+ my $DOMAIN = '(?:' . $ATOM . '(?:' . '\\.' . $ATOM . ')*' . ')';
+ my $LOCALPART = '(?:' . $WORD . '(?:' . '\\.' . $WORD . ')*' . ')';
+ my $ADDR = '(?:' . $LOCALPART . '@' . $DOMAIN . ')';
+ my $PHRASE = '(?:' . $WORD . ')+';
+ my $SEP = "(?:^\\s*|\\s*,\\s*)"; ### before elems in a list
+
+ sub my_extract_full_addrs {
+ my $str = shift;
+ return unless $str;
+ my @addrs;
+ $str =~ s/\s/ /g; ### collapse whitespace
+
+ pos($str) = 0;
+ while ( $str !~ m{\G\s*\Z}gco ) {
+ ### print STDERR "TACKLING: ".substr($str, pos($str))."\n";
+ if ( $str =~ m{\G$SEP($PHRASE)\s*<\s*($ADDR)\s*>}gco ) {
+ push @addrs, "$1 <$2>";
+ } elsif ( $str =~ m{\G$SEP($ADDR)}gco or $str =~ m{\G$SEP($ATOM)}gco ) {
+ push @addrs, $1;
+ } else {
+ my $problem = substr( $str, pos($str) );
+ die "can't extract address at <$problem> in <$str>\n";
+ }
+ }
+ return wantarray ? @addrs : $addrs[0];
+ }
-my $ATOM = '[^ \000-\037()<>@,;:\134"\056\133\135]+';
-my $QSTR = '".*?"';
-my $WORD = '(?:' . $QSTR . '|' . $ATOM . ')';
-my $DOMAIN = '(?:' . $ATOM . '(?:' . '\\.' . $ATOM . ')*' . ')';
-my $LOCALPART = '(?:' . $WORD . '(?:' . '\\.' . $WORD . ')*' . ')';
-my $ADDR = '(?:' . $LOCALPART . '@' . $DOMAIN . ')';
-my $PHRASE = '(?:' . $WORD . ')+';
-my $SEP = "(?:^\\s*|\\s*,\\s*)"; ### before elems in a list
-
-sub my_extract_addrs {
- my $str = shift;
- my @addrs;
- $str =~ s/\s/ /g; ### collapse whitespace
-
- pos($str) = 0;
- while ($str !~ m{\G\s*\Z}gco) {
- ### print STDERR "TACKLING: ".substr($str, pos($str))."\n";
- if ($str =~ m{\G$SEP$PHRASE\s*<\s*($ADDR)\s*>}gco) {push @addrs,$1}
- elsif ($str =~ m{\G$SEP($ADDR)}gco) {push @addrs,$1}
- elsif ($str =~ m{\G$SEP($ATOM)}gco) {push @addrs,$1}
- else {
- my $problem = substr($str, pos($str));
- die "can't extract address at <$problem> in <$str>\n";
- }
+ sub my_extract_only_addrs {
+ my @ret = map { /<([^>]+)>/ ? $1 : $_ } my_extract_full_addrs(@_);
+ return wantarray ? @ret : $ret[0];
}
- return @addrs;
}
+#------------------------------
-if (eval "require Mail::Address") {
+
+if ( !$PARANOID and eval "require Mail::Address" ) {
push @Uses, "A$Mail::Address::VERSION";
eval q{
- sub extract_addrs {
- return map { $_->format } Mail::Address->parse($_[0]);
- }
- }; ### q
-}
-else {
+ sub extract_full_addrs {
+ my @ret=map { $_->format } Mail::Address->parse($_[0]);
+ return wantarray ? @ret : $ret[0]
+ }
+ sub extract_only_addrs {
+ my @ret=map { $_->address } Mail::Address->parse($_[0]);
+ return wantarray ? @ret : $ret[0]
+ }
+ }; ### q
+} else {
eval q{
- sub extract_addrs {
- return my_extract_addrs(@_);
- }
- }; ### q
-} ### if
-
-
+ *extract_full_addrs=*my_extract_full_addrs;
+ *extract_only_addrs=*my_extract_only_addrs;
+ }; ### q
+} ### if
#==============================
#==============================
@@ -536,33 +559,32 @@ else {
# Encode the given string using BASE64.
# Unless paranoid, we try to load the real code before supplying our own.
-if (!$PARANOID and eval "require MIME::Base64") {
+if ( !$PARANOID and eval "require MIME::Base64" ) {
import MIME::Base64 qw(encode_base64);
push @Uses, "B$MIME::Base64::VERSION";
-}
-else {
+} else {
eval q{
-sub encode_base64 {
- my $res = "";
- my $eol = "\n";
-
- pos($_[0]) = 0; ### thanks, Andreas!
- while ($_[0] =~ /(.{1,45})/gs) {
- $res .= substr(pack('u', $1), 1);
- chop($res);
- }
- $res =~ tr|` -_|AA-Za-z0-9+/|;
-
- ### Fix padding at the end:
- my $padding = (3 - length($_[0]) % 3) % 3;
- $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
-
- ### Break encoded string into lines of no more than 76 characters each:
- $res =~ s/(.{1,76})/$1$eol/g if (length $eol);
- return $res;
-} ### sub
- } ### q
-} ### if
+ sub encode_base64 {
+ my $res = "";
+ my $eol = "\n";
+
+ pos($_[0]) = 0; ### thanks, Andreas!
+ while ($_[0] =~ /(.{1,45})/gs) {
+ $res .= substr(pack('u', $1), 1);
+ chop($res);
+ }
+ $res =~ tr|` -_|AA-Za-z0-9+/|;
+
+ ### Fix padding at the end:
+ my $padding = (3 - length($_[0]) % 3) % 3;
+ $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
+
+ ### Break encoded string into lines of no more than 76 characters each:
+ $res =~ s/(.{1,76})/$1$eol/g if (length $eol);
+ return $res;
+ } ### sub
+ } ### q
+} ### if
#------------------------------
#
@@ -575,29 +597,28 @@ sub encode_base64 {
#
# Unless paranoid, we try to load the real code before supplying our own.
-if (!$PARANOID and eval "require MIME::QuotedPrint") {
+if ( !$PARANOID and eval "require MIME::QuotedPrint" ) {
import MIME::QuotedPrint qw(encode_qp);
push @Uses, "Q$MIME::QuotedPrint::VERSION";
-}
-else {
+} else {
eval q{
-sub encode_qp {
- my $res = shift;
- local($_);
- $res =~ s/([^ \t\n!-<>-~])/sprintf("=%02X", ord($1))/eg; ### rule #2,#3
- $res =~ s/([ \t]+)$/
- join('', map { sprintf("=%02X", ord($_)) }
- split('', $1)
- )/egm; ### rule #3 (encode whitespace at eol)
-
- ### rule #5 (lines shorter than 76 chars, but can't break =XX escapes:
- my $brokenlines = "";
- $brokenlines .= "$1=\n" while $res =~ s/^(.{70}([^=]{2})?)//; ### 70 was 74
- $brokenlines =~ s/=\n$// unless length $res;
- "$brokenlines$res";
-} ### sub
- } ### q
-} ### if
+ sub encode_qp {
+ my $res = shift;
+ local($_);
+ $res =~ s/([^ \t\n!-<>-~])/sprintf("=%02X", ord($1))/eg; ### rule #2,#3
+ $res =~ s/([ \t]+)$/
+ join('', map { sprintf("=%02X", ord($_)) }
+ split('', $1)
+ )/egm; ### rule #3 (encode whitespace at eol)
+
+ ### rule #5 (lines shorter than 76 chars, but can't break =XX escapes:
+ my $brokenlines = "";
+ $brokenlines .= "$1=\n" while $res =~ s/^(.{70}([^=]{2})?)//; ### 70 was 74
+ $brokenlines =~ s/=\n$// unless length $res;
+ "$brokenlines$res";
+ } ### sub
+ } ### q
+} ### if
#------------------------------
@@ -622,7 +643,7 @@ sub encode_8bit {
sub encode_7bit {
my $str = shift;
- $str =~ s/[\x80-\xFF]//g;
+ $str =~ s/[\x80-\xFF]//g;
$str =~ s/^(.{990})/$1\n/mg;
$str;
}
@@ -642,26 +663,27 @@ sub encode_7bit {
=item new [PARAMHASH]
I<Class method, constructor.>
-Create a new message object.
+Create a new message object.
If any arguments are given, they are passed into C<build()>; otherwise,
just the empty object is created.
=cut
+
sub new {
my $class = shift;
### Create basic object:
- my $self = {
- Attrs => {}, ### MIME attributes
- Header => [], ### explicit message headers
- Parts => [], ### array of parts
- };
+ my $self = { Attrs => {}, ### MIME attributes
+ SubAttrs => {}, ### MIME sub-attributes
+ Header => [], ### explicit message headers
+ Parts => [], ### array of parts
+ };
bless $self, $class;
### Build, if needed:
- return (@_ ? $self->build(@_) : $self);
+ return ( @_ ? $self->build(@_) : $self );
}
@@ -679,7 +701,7 @@ as a MIME::Lite object to be attached. Otherwise, this
method assumes that you are giving in the pairs of a PARAMHASH
which will be sent into C<new()> to create the new part.
-One of the possibly-quite-useful hacks thrown into this is the
+One of the possibly-quite-useful hacks thrown into this is the
"attach-to-singlepart" hack: if you attempt to attach a part (let's
call it "part 1") to a message that doesn't have a content-type
of "multipart" or "message", the following happens:
@@ -711,37 +733,42 @@ that a user agent like Netscape allows you to do.
=cut
+
sub attach {
my $self = shift;
+ my $attrs = $self->{Attrs};
+ my $sub_attrs = $self->{SubAttrs};
### Create new part, if necessary:
- my $part1 = ((@_ == 1) ? shift : ref($self)->new(Top=>0, @_));
+ my $part1 = ( ( @_ == 1 ) ? shift: ref($self)->new( Top => 0, @_ ) );
### Do the "attach-to-singlepart" hack:
- if ($self->attr('content-type') !~ m{^(multipart|message)/}i) {
-
- ### Create part zero:
- my $part0 = ref($self)->new;
-
- ### Cut MIME stuff from self, and paste into part zero:
- foreach (qw(Attrs Data Path FH)) {
- $part0->{$_} = $self->{$_}; delete($self->{$_});
- }
- $part0->top_level(0); ### clear top-level attributes
-
- ### Make self a top-level multipart:
- $self->{Attrs} ||= {}; ### reset
- $self->attr('content-type' => 'multipart/mixed');
- $self->attr('content-type.boundary' => gen_boundary());
- $self->attr('content-transfer-encoding' => '7bit');
- $self->top_level(1); ### activate top-level attributes
-
- ### Add part 0:
- push @{$self->{Parts}}, $part0;
+ if ( $attrs->{'content-type'} !~ m{^(multipart|message)/}i ) {
+
+ ### Create part zero:
+ my $part0 = ref($self)->new;
+
+ ### Cut MIME stuff from self, and paste into part zero:
+ foreach (qw(SubAttrs Attrs Data Path FH)) {
+ $part0->{$_} = $self->{$_};
+ delete( $self->{$_} );
+ }
+ $part0->top_level(0); ### clear top-level attributes
+
+ ### Make self a top-level multipart:
+ $attrs = $self->{Attrs} ||= {}; ### reset (sam: bug? this doesn't reset anything since Attrs is already a hash-ref)
+ $sub_attrs = $self->{SubAttrs} ||= {}; ### reset
+ $attrs->{'content-type'} = 'multipart/mixed';
+ $sub_attrs->{'content-type'}{'boundary'} = gen_boundary();
+ $attrs->{'content-transfer-encoding'} = '7bit';
+ $self->top_level(1); ### activate top-level attributes
+
+ ### Add part 0:
+ push @{ $self->{Parts} }, $part0;
}
### Add the new part:
- push @{$self->{Parts}}, $part1;
+ push @{ $self->{Parts} }, $part1;
$part1;
}
@@ -750,7 +777,7 @@ sub attach {
=item build [PARAMHASH]
I<Class/instance method, initializer.>
-Create (or initialize) a MIME message object.
+Create (or initialize) a MIME message object.
Normally, you'll use the following keys in PARAMHASH:
* Data, FH, or Path (either one of these, or none if multipart)
@@ -766,35 +793,35 @@ The PARAMHASH can contain the following keys:
Any field you want placed in the message header, taken from the
standard list of header fields (you don't need to worry about case):
- Approved Encrypted Received Sender
- Bcc From References Subject
- Cc Keywords Reply-To To
+ Approved Encrypted Received Sender
+ Bcc From References Subject
+ Cc Keywords Reply-To To
Comments Message-ID Resent-* X-*
- Content-* MIME-Version Return-Path
+ Content-* MIME-Version Return-Path
Date Organization
-To give experienced users some veto power, these fields will be set
+To give experienced users some veto power, these fields will be set
I<after> the ones I set... so be careful: I<don't set any MIME fields>
(like C<Content-type>) unless you know what you're doing!
To specify a fieldname that's I<not> in the above list, even one that's
identical to an option below, just give it with a trailing C<":">,
-like C<"My-field:">. When in doubt, that I<always> signals a mail
+like C<"My-field:">. When in doubt, that I<always> signals a mail
field (and it sort of looks like one too).
=item Data
I<Alternative to "Path" or "FH".>
The actual message data. This may be a scalar or a ref to an array of
-strings; if the latter, the message consists of a simple concatenation
+strings; if the latter, the message consists of a simple concatenation
of all the strings in the array.
=item Datestamp
I<Optional.>
-If given true (or omitted), we force the creation of a C<Date:> field
-stamped with the current date/time if this is a top-level message.
-You may want this if using L<send_by_smtp()|/send_by_smtp>.
+If given true (or omitted), we force the creation of a C<Date:> field
+stamped with the current date/time if this is a top-level message.
+You may want this if using L<send_by_smtp()|/send_by_smtp>.
If you don't want this to be done, either provide your own Date
or explicitly set this to false.
@@ -836,11 +863,11 @@ See "ReadNow" also.
=item Filename
I<Optional.>
-The name of the attachment. You can use this to supply a
-recommended filename for the end-user who is saving the attachment
-to disk. You only need this if the filename at the end of the
+The name of the attachment. You can use this to supply a
+recommended filename for the end-user who is saving the attachment
+to disk. You only need this if the filename at the end of the
"Path" is inadequate, or if you're using "Data" instead of "Path".
-You should I<not> put path information in here (e.g., no "/"
+You should I<not> put path information in here (e.g., no "/"
or "\" or ":" characters should be used).
=item Id
@@ -858,15 +885,15 @@ computed, but only under certain circumstances (see L<"Limitations">).
I<Alternative to "Data" or "FH".>
Path to a file containing the data... actually, it can be any open()able
-expression. If it looks like a path, the last element will automatically
-be treated as the filename.
+expression. If it looks like a path, the last element will automatically
+be treated as the filename.
See "ReadNow" also.
=item ReadNow
I<Optional, for use with "Path".>
If true, will open the path and slurp the contents into core now.
-This is useful if the Path points to a command and you don't want
+This is useful if the Path points to a command and you don't want
to run the command over and over if outputting the message several
times. B<Fatal exception> raised if the open fails.
@@ -890,8 +917,8 @@ The MIME content type, or one of these special values (case-sensitive):
file might be used for the attachment.
The default is C<"TEXT">, but it will be C<"AUTO"> if you set
-$AUTO_CONTENT_TYPE to true (sorry, but you have to enable
-it explicitly, since we don't want to break code which depends
+$AUTO_CONTENT_TYPE to true (sorry, but you have to enable
+it explicitly, since we don't want to break code which depends
on the old behavior).
=back
@@ -900,53 +927,59 @@ A picture being worth 1000 words (which
is of course 2000 bytes, so it's probably more of an "icon" than a "picture",
but I digress...), here are some examples:
- $msg = MIME::Lite->build(
- From => 'yelling@inter.com',
- To => 'stocking@fish.net',
- Subject => "Hi there!",
- Type => 'TEXT',
- Encoding => '7bit',
- Data => "Just a quick note to say hi!");
-
$msg = MIME::Lite->build(
- From => 'dorothy@emerald-city.oz',
- To => 'gesundheit@edu.edu.edu',
- Subject => "A gif for U"
- Type => 'image/gif',
- Path => "/home/httpd/logo.gif");
-
- $msg = MIME::Lite->build(
- From => 'laughing@all.of.us',
- To => 'scarlett@fiddle.dee.de',
- Subject => "A gzipp'ed tar file",
- Type => 'x-gzip',
- Path => "gzip < /usr/inc/somefile.tar |",
- ReadNow => 1,
- Filename => "somefile.tgz");
-
-To show you what's really going on, that last example could also
+ From => 'yelling@inter.com',
+ To => 'stocking@fish.net',
+ Subject => "Hi there!",
+ Type => 'TEXT',
+ Encoding => '7bit',
+ Data => "Just a quick note to say hi!"
+ );
+
+ $msg = MIME::Lite->build(
+ From => 'dorothy@emerald-city.oz',
+ To => 'gesundheit@edu.edu.edu',
+ Subject => "A gif for U"
+ Type => 'image/gif',
+ Path => "/home/httpd/logo.gif"
+ );
+
+ $msg = MIME::Lite->build(
+ From => 'laughing@all.of.us',
+ To => 'scarlett@fiddle.dee.de',
+ Subject => "A gzipp'ed tar file",
+ Type => 'x-gzip',
+ Path => "gzip < /usr/inc/somefile.tar |",
+ ReadNow => 1,
+ Filename => "somefile.tgz"
+ );
+
+To show you what's really going on, that last example could also
have been written:
$msg = new MIME::Lite;
- $msg->build(Type => 'x-gzip',
- Path => "gzip < /usr/inc/somefile.tar |",
- ReadNow => 1,
- Filename => "somefile.tgz");
+ $msg->build(
+ Type => 'x-gzip',
+ Path => "gzip < /usr/inc/somefile.tar |",
+ ReadNow => 1,
+ Filename => "somefile.tgz"
+ );
$msg->add(From => "laughing@all.of.us");
$msg->add(To => "scarlett@fiddle.dee.de");
- $msg->add(Subject => "A gzipp'ed tar file");
+ $msg->add(Subject => "A gzipp'ed tar file");
=cut
+
sub build {
- my $self = shift;
+ my $self = shift;
my %params = @_;
my @params = @_;
my $key;
### Miko's note: reorganized to check for exactly one of Data, Path, or FH
- (defined($params{Data})+defined($params{Path})+defined($params{FH}) <= 1)
- or Carp::croak "supply exactly zero or one of (Data|Path|FH).\n";
+ ( defined( $params{Data} ) + defined( $params{Path} ) + defined( $params{FH} ) <= 1 )
+ or Carp::croak "supply exactly zero or one of (Data|Path|FH).\n";
### Create new instance, if necessary:
ref($self) or $self = $self->new;
@@ -956,130 +989,133 @@ sub build {
###
### Get content-type or content-type-macro:
- my $type = ($params{Type} || ($AUTO_CONTENT_TYPE ? 'AUTO' : 'TEXT'));
+ my $type = ( $params{Type} || ( $AUTO_CONTENT_TYPE ? 'AUTO' : 'TEXT' ) );
### Interpret content-type-macros:
- if ($type eq 'TEXT') { $type = 'text/plain'; }
- elsif ($type eq 'BINARY') { $type = 'application/octet-stream' }
- elsif ($type eq 'AUTO') { $type = $self->suggest_type($params{Path}); }
+ if ( $type eq 'TEXT' ) { $type = 'text/plain'; }
+ elsif ( $type eq 'HTML' ) { $type = 'text/html'; }
+ elsif ( $type eq 'BINARY' ) { $type = 'application/octet-stream' }
+ elsif ( $type eq 'AUTO' ) { $type = $self->suggest_type( $params{Path} ); }
### We now have a content-type; set it:
$type = lc($type);
- $self->attr('content-type' => $type);
-
+ my $attrs = $self->{Attrs};
+ my $sub_attrs = $self->{SubAttrs};
+ $attrs->{'content-type'} = $type;
+
### Get some basic attributes from the content type:
- my $is_multipart = ($type =~ m{^(multipart)/}i);
+ my $is_multipart = ( $type =~ m{^(multipart)/}i );
### Add in the multipart boundary:
if ($is_multipart) {
- my $boundary = gen_boundary();
- $self->attr('content-type.boundary' => $boundary);
+ my $boundary = gen_boundary();
+ $sub_attrs->{'content-type'}{'boundary'} = $boundary;
}
### CONTENT-ID...
###
- $self->attr('content-id' => $params{Id}) if defined($params{Id});
+ if ( defined $params{Id} ) {
+ my $id = $params{Id};
+ $id = "<$id>" unless $id =~ /\A\s*<.*>\s*\z/;
+ $attrs->{'content-id'} = $id;
+ }
### DATA OR PATH...
- ### Note that we must do this *after* we get the content type,
+ ### Note that we must do this *after* we get the content type,
### in case read_now() is invoked, since it needs the binmode().
### Get data, as...
### ...either literal data:
- if (defined($params{Data})) {
- $self->data($params{Data});
+ if ( defined( $params{Data} ) ) {
+ $self->data( $params{Data} );
}
### ...or a path to data:
- elsif (defined($params{Path})) {
- $self->path($params{Path}); ### also sets filename
- $self->read_now if $params{ReadNow};
+ elsif ( defined( $params{Path} ) ) {
+ $self->path( $params{Path} ); ### also sets filename
+ $self->read_now if $params{ReadNow};
}
### ...or a filehandle to data:
### Miko's note: this part works much like the path routine just above,
- elsif (defined($params{FH})) {
- $self->fh($params{FH});
- $self->read_now if $params{ReadNow}; ### implement later
+ elsif ( defined( $params{FH} ) ) {
+ $self->fh( $params{FH} );
+ $self->read_now if $params{ReadNow}; ### implement later
}
-
+
### FILENAME... (added by Ian Smith <ian@safeway.dircon.co.uk> on 8/4/97)
### Need this to make sure the filename is added. The Filename
### attribute is ignored, otherwise.
- if (defined($params{Filename})) {
- $self->filename($params{Filename});
+ if ( defined( $params{Filename} ) ) {
+ $self->filename( $params{Filename} );
}
-
+
### CONTENT-TRANSFER-ENCODING...
###
### Get it:
- my $enc = ($params{Encoding} ||
- ($AUTO_ENCODE and $self->suggest_encoding($type)) ||
- 'binary');
- $self->attr('content-transfer-encoding' => lc($enc));
-
+ my $enc =
+ ( $params{Encoding} || ( $AUTO_ENCODE and $self->suggest_encoding($type) ) || 'binary' );
+ $attrs->{'content-transfer-encoding'} = lc($enc);
+
### Sanity check:
- if ($type =~ m{^(multipart|message)/}) {
- ($enc =~ m{^(7bit|8bit|binary)\Z}) or
- Carp::croak("illegal MIME: ".
- "can't have encoding $enc with type $type\n");
+ if ( $type =~ m{^(multipart|message)/} ) {
+ ( $enc =~ m{^(7bit|8bit|binary)\Z} )
+ or Carp::croak( "illegal MIME: " . "can't have encoding $enc with type $type\n" );
}
### CONTENT-DISPOSITION...
### Default is inline for single, none for multis:
###
- my $disp = ($params{Disposition} or ($is_multipart ? undef : 'inline'));
- $self->attr('content-disposition' => $disp);
+ my $disp = ( $params{Disposition} or ( $is_multipart ? undef: 'inline' ) );
+ $attrs->{'content-disposition'} = $disp;
### CONTENT-LENGTH...
###
my $length;
- if (exists($params{Length})) { ### given by caller:
- $self->attr('content-length' => $params{Length});
- }
- else { ### compute it ourselves
- $self->get_length;
+ if ( exists( $params{Length} ) ) { ### given by caller:
+ $attrs->{'content-length'} = $params{Length};
+ } else { ### compute it ourselves
+ $self->get_length;
}
### Init the top-level fields:
- my $is_top = defined($params{Top}) ? $params{Top} : 1;
+ my $is_top = defined( $params{Top} ) ? $params{Top} : 1;
$self->top_level($is_top);
### Datestamp if desired:
- my $ds_wanted = $params{Datestamp};
- my $ds_defaulted = ($is_top and !exists($params{Datestamp}));
- if (($ds_wanted or $ds_defaulted) and !exists($params{Date})) {
- my ($u_wdy, $u_mon, $u_mdy, $u_time, $u_y4) =
- split /\s+/, gmtime().""; ### should be non-locale-dependent
- my $date = "$u_wdy, $u_mdy $u_mon $u_y4 $u_time UT";
- $self->add("date", $date);
+ my $ds_wanted = $params{Datestamp};
+ my $ds_defaulted = ( $is_top and !exists( $params{Datestamp} ) );
+ if ( ( $ds_wanted or $ds_defaulted ) and !exists( $params{Date} ) ) {
+ # name was changed to fit this in Perl/MIME in the webwml repo
+ #require Email::Date::Format;
+ require MIME::EmailDateFormat;
+ $self->add( "date", MIME::EmailDateFormat::email_date() );
}
-
+
### Set message headers:
my @paramz = @params;
my $field;
while (@paramz) {
- my ($tag, $value) = (shift(@paramz), shift(@paramz));
-
- ### Get tag, if a tag:
- if ($tag =~ /^-(.*)/) { ### old style, backwards-compatibility
- $field = lc($1);
- }
- elsif ($tag =~ /^(.*):$/) { ### new style
- $field = lc($1);
- }
- elsif (known_field($field = lc($tag))) { ### known field
- ### no-op
- }
- else { ### not a field:
- next;
- }
-
- ### Add it:
- $self->add($field, $value);
+ my ( $tag, $value ) = ( shift(@paramz), shift(@paramz) );
+ my $lc_tag = lc($tag);
+
+ ### Get tag, if a tag:
+ if ( $lc_tag =~ /^-(.*)/ ) { ### old style, backwards-compatibility
+ $field = $1;
+ } elsif ( $lc_tag =~ /^(.*):$/ ) { ### new style
+ $field = $1;
+ } elsif ( $KnownField{$lc_tag} or
+ $lc_tag =~ m{^(content|resent|x)-.} ){
+ $field = $lc_tag;
+ } else { ### not a field:
+ next;
+ }
+
+ ### Add it:
+ $self->add( $field, $value );
}
### Done!
@@ -1100,6 +1136,7 @@ sub build {
=cut
+
#------------------------------
#
# top_level ONOFF
@@ -1108,16 +1145,16 @@ sub build {
# This affects "MIME-Version" and "X-Mailer".
sub top_level {
- my ($self, $onoff) = @_;
+ my ( $self, $onoff ) = @_;
+ my $attrs = $self->{Attrs};
if ($onoff) {
- $self->attr('MIME-Version' => '1.0');
- my $uses = (@Uses ? ("(" . join("; ", @Uses) . ")") : '');
- $self->replace('X-Mailer' => "MIME::Lite $VERSION $uses")
- unless $VANILLA;
- }
- else {
- $self->attr('MIME-Version' => undef);
- $self->delete('X-Mailer');
+ $attrs->{'MIME-Version'} = '1.0';
+ my $uses = ( @Uses ? ( "(" . join( "; ", @Uses ) . ")" ) : '' );
+ $self->replace( 'X-Mailer' => "MIME::Lite $VERSION $uses" )
+ unless $VANILLA;
+ } else {
+ delete $attrs->{'MIME-Version'};
+ $self->delete('X-Mailer');
}
}
@@ -1126,8 +1163,8 @@ sub top_level {
=item add TAG,VALUE
I<Instance method.>
-Add field TAG with the given VALUE to the end of the header.
-The TAG will be converted to all-lowercase, and the VALUE
+Add field TAG with the given VALUE to the end of the header.
+The TAG will be converted to all-lowercase, and the VALUE
will be made "safe" (returns will be given a trailing space).
B<Beware:> any MIME fields you "add" will override any MIME
@@ -1142,39 +1179,41 @@ This is only useful for special multiple-valued fields like "Received":
$msg->add("Received" => ["here", "there", "everywhere"]
Giving VALUE as the empty string adds an invisible placeholder
-to the header, which can be used to suppress the output of
+to the header, which can be used to suppress the output of
the "Content-*" fields or the special "MIME-Version" field.
When suppressing fields, you should use replace() instead of add():
$msg->replace("Content-disposition" => "");
I<Note:> add() is probably going to be more efficient than C<replace()>,
-so you're better off using it for most applications if you are
+so you're better off using it for most applications if you are
certain that you don't need to delete() the field first.
I<Note:> the name comes from Mail::Header.
=cut
+
sub add {
- my $self = shift;
- my $tag = lc(shift);
+ my $self = shift;
+ my $tag = lc(shift);
my $value = shift;
### If a dangerous option, warn them:
- Carp::carp "Explicitly setting a MIME header field ($tag) is dangerous:\n".
- "use the attr() method instead.\n"
- if (is_mime_field($tag) && !$QUIET);
+ Carp::carp "Explicitly setting a MIME header field ($tag) is dangerous:\n"
+ . "use the attr() method instead.\n"
+ if ( is_mime_field($tag) && !$QUIET );
### Get array of clean values:
- my @vals = ((ref($value) and (ref($value) eq 'ARRAY'))
- ? @{$value}
- : ($value.''));
+ my @vals = ( ( ref($value) and ( ref($value) eq 'ARRAY' ) )
+ ? @{$value}
+ : ( $value . '' )
+ );
map { s/\n/\n /g } @vals;
### Add them:
foreach (@vals) {
- push @{$self->{Header}}, [$tag, $_];
+ push @{ $self->{Header} }, [ $tag, $_ ];
}
}
@@ -1183,7 +1222,7 @@ sub add {
=item attr ATTR,[VALUE]
I<Instance method.>
-Set MIME attribute ATTR to the string VALUE.
+Set MIME attribute ATTR to the string VALUE.
ATTR is converted to all-lowercase.
This method is normally used to set/get MIME attributes:
@@ -1195,7 +1234,7 @@ This would cause the final output to look something like this:
Content-type: text/html; charset=US-ASCII; name="homepage.html"
-Note that the special empty sub-field tag indicates the anonymous
+Note that the special empty sub-field tag indicates the anonymous
first sub-field.
Giving VALUE as undefined will cause the contents of the named
@@ -1208,32 +1247,36 @@ Supplying no VALUE argument just returns the attribute's value:
=cut
+
sub attr {
- my ($self, $attr, $value) = @_;
+ my ( $self, $attr, $value ) = @_;
+ my $attrs = $self->{Attrs};
+
$attr = lc($attr);
### Break attribute name up:
- my ($tag, $subtag) = split /\./, $attr;
- defined($subtag) or $subtag = '';
+ my ( $tag, $subtag ) = split /\./, $attr;
+ if (defined($subtag)) {
+ $attrs = $self->{SubAttrs}{$tag} ||= {};
+ $tag = $subtag;
+ }
### Set or get?
- if (@_ > 2) { ### set:
- $self->{Attrs}{$tag} ||= {}; ### force hash
- delete $self->{Attrs}{$tag}{$subtag}; ### delete first
- if (defined($value)) { ### set...
- $value =~ s/[\r\n]//g; ### make clean
- $self->{Attrs}{$tag}{$subtag} = $value;
- }
+ if ( @_ > 2 ) { ### set:
+ if ( defined($value) ) {
+ $attrs->{$tag} = $value;
+ } else {
+ delete $attrs->{$tag};
+ }
}
-
+
### Return current value:
- $self->{Attrs}{$tag}{$subtag};
+ $attrs->{$tag};
}
sub _safe_attr {
- my ($self, $attr) = @_;
- my $v = $self->attr($attr);
- defined($v) ? $v : '';
+ my ( $self, $attr ) = @_;
+ return defined $self->{Attrs}{$attr} ? $self->{Attrs}{$attr} : '';
}
#------------------------------
@@ -1241,7 +1284,7 @@ sub _safe_attr {
=item delete TAG
I<Instance method.>
-Delete field TAG with the given VALUE to the end of the header.
+Delete field TAG with the given VALUE to the end of the header.
The TAG will be converted to all-lowercase.
$msg->delete("Subject");
@@ -1250,15 +1293,16 @@ I<Note:> the name comes from Mail::Header.
=cut
+
sub delete {
my $self = shift;
- my $tag = lc(shift);
+ my $tag = lc(shift);
### Delete from the header:
my $hdr = [];
my $field;
- foreach $field (@{$self->{Header}}) {
- push @$hdr, $field if ($field->[0] ne $tag);
+ foreach $field ( @{ $self->{Header} } ) {
+ push @$hdr, $field if ( $field->[0] ne $tag );
}
$self->{Header} = $hdr;
$self;
@@ -1269,7 +1313,7 @@ sub delete {
=item field_order FIELD,...FIELD
-I<Class/instance method.>
+I<Class/instance method.>
Change the order in which header fields are output for this object:
$msg->field_order('from', 'to', 'content-type', 'subject');
@@ -1284,10 +1328,14 @@ In either case, supply the empty array to restore the default ordering.
=cut
+
sub field_order {
my $self = shift;
- if (ref($self)) { $self->{FieldOrder} = [ map { lc($_) } @_ ] }
- else { @FieldOrder = map { lc($_) } @_ }
+ if ( ref($self) ) {
+ $self->{FieldOrder} = [ map { lc($_) } @_ ];
+ } else {
+ @FieldOrder = map { lc($_) } @_;
+ }
}
#------------------------------
@@ -1296,9 +1344,9 @@ sub field_order {
I<Instance method.>
Return the full header for the object, as a ref to an array
-of C<[TAG, VALUE]> pairs, where each TAG is all-lowercase.
-Note that any fields the user has explicitly set will override the
-corresponding MIME fields that we would otherwise generate.
+of C<[TAG, VALUE]> pairs, where each TAG is all-lowercase.
+Note that any fields the user has explicitly set will override the
+corresponding MIME fields that we would otherwise generate.
So, don't say...
$msg->set("Content-type" => "text/html; charset=US-ASCII");
@@ -1307,79 +1355,81 @@ unless you want the above value to override the "Content-type"
MIME field that we would normally generate.
I<Note:> I called this "fields" because the header() method of
-Mail::Header returns something different, but similar enough to
+Mail::Header returns something different, but similar enough to
be confusing.
-You can change the order of the fields: see L</field_order>.
+You can change the order of the fields: see L</field_order>.
You really shouldn't need to do this, but some people have to
deal with broken mailers.
=cut
+
sub fields {
my $self = shift;
my @fields;
-
+ my $attrs = $self->{Attrs};
+ my $sub_attrs = $self->{SubAttrs};
+
### Get a lookup-hash of all *explicitly-given* fields:
- my %explicit = map { $_->[0] => 1 } @{$self->{Header}};
-
+ my %explicit = map { $_->[0] => 1 } @{ $self->{Header} };
+
### Start with any MIME attributes not given explicitly:
my $tag;
- foreach $tag (sort keys %{$self->{Attrs}}) {
-
- ### Skip if explicit:
- next if ($explicit{$tag});
-
- ### Skip if no subtags:
- my @subtags = keys %{$self->{Attrs}{$tag}};
- @subtags or next;
-
- ### Create string:
- my $value;
- defined($value = $self->{Attrs}{$tag}{''}) or next; ### need default
- foreach (sort @subtags) {
- next if ($_ eq '');
- $value .= qq{; $_="$self->{Attrs}{$tag}{$_}"};
- }
-
- ### Add to running fields;
- push @fields, [$tag, $value];
+ foreach $tag ( sort keys %{ $self->{Attrs} } ) {
+
+ ### Skip if explicit:
+ next if ( $explicit{$tag} );
+
+ # get base attr value or skip if not available
+ my $value = $attrs->{$tag};
+ defined $value or next;
+
+ ### handle sub-attrs if available
+ if (my $subs = $sub_attrs->{$tag}) {
+ $value .= '; ' .
+ join('; ', map { qq{$_="$subs->{$_}"} } sort keys %$subs);
+ }
+
+ # handle stripping \r\n now since we're not doing it in attr()
+ # anymore
+ $value =~ tr/\r\n//;
+
+ ### Add to running fields;
+ push @fields, [ $tag, $value ];
}
-
+
### Add remaining fields (note that we duplicate the array for safety):
- foreach (@{$self->{Header}}) {
- push @fields, [@{$_}];
+ foreach ( @{ $self->{Header} } ) {
+ push @fields, [ @{$_} ];
}
- ### Final step:
+ ### Final step:
### If a suggested ordering was given, we "sort" by that ordering.
### The idea is that we give each field a numeric rank, which is
### (1000 * order(field)) + origposition.
- my @order = @{$self->{FieldOrder} || []}; ### object-specific
+ my @order = @{ $self->{FieldOrder} || [] }; ### object-specific
@order or @order = @FieldOrder; ### no? maybe generic
if (@order) { ### either?
- ### Create hash mapping field names to 1-based rank:
- my %rank = map {$order[$_] => (1+$_)} (0..$#order);
-
- ### Create parallel array to @fields, called @ranked.
- ### It contains fields tagged with numbers like 2003, where the
- ### 3 is the original 0-based position, and 2000 indicates that
- ### we wanted ths type of field to go second.
- my @ranked = map {
- [
- ($_ + 1000*($rank{lc($fields[$_][0])} || (2+$#order))),
- $fields[$_]
- ]
- } (0..$#fields);
- # foreach (@ranked) {
- # print STDERR "RANKED: $_->[0] $_->[1][0] $_->[1][1]\n";
- # }
-
- ### That was half the Schwartzian transform. Here's the rest:
- @fields = map { $_->[1] }
- sort { $a->[0] <=> $b->[0] }
- @ranked;
+ ### Create hash mapping field names to 1-based rank:
+ my %rank = map { $order[$_] => ( 1 + $_ ) } ( 0 .. $#order );
+
+ ### Create parallel array to @fields, called @ranked.
+ ### It contains fields tagged with numbers like 2003, where the
+ ### 3 is the original 0-based position, and 2000 indicates that
+ ### we wanted ths type of field to go second.
+ my @ranked = map {
+ [ ( $_ + 1000 * ( $rank{ lc( $fields[$_][0] ) } || ( 2 + $#order ) ) ), $fields[$_] ]
+ } ( 0 .. $#fields );
+
+ # foreach (@ranked) {
+ # print STDERR "RANKED: $_->[0] $_->[1][0] $_->[1][1]\n";
+ # }
+
+ ### That was half the Schwartzian transform. Here's the rest:
+ @fields = map { $_->[1] }
+ sort { $a->[0] <=> $b->[0] } @ranked;
}
### Done!
@@ -1395,18 +1445,21 @@ I<Instance method.>
Set the filename which this data will be reported as.
This actually sets both "standard" attributes.
-With no argument, returns the filename as dictated by the
+With no argument, returns the filename as dictated by the
content-disposition.
=cut
+
sub filename {
- my ($self, $filename) = @_;
- if (@_ > 1) {
- $self->attr('content-type.name' => $filename);
- $self->attr('content-disposition.filename' => $filename);
+ my ( $self, $filename ) = @_;
+ my $sub_attrs = $self->{SubAttrs};
+
+ if ( @_ > 1 ) {
+ $sub_attrs->{'content-type'}{'name'} = $filename;
+ $sub_attrs->{'content-disposition'}{'filename'} = $filename;
}
- $self->attr('content-disposition.filename');
+ return $sub_attrs->{'content-disposition'}{'filename'};
}
#------------------------------
@@ -1414,28 +1467,29 @@ sub filename {
=item get TAG,[INDEX]
I<Instance method.>
-Get the contents of field TAG, which might have been set
+Get the contents of field TAG, which might have been set
with set() or replace(). Returns the text of the field.
$ml->get('Subject', 0);
If the optional 0-based INDEX is given, then we return the INDEX'th
occurence of field TAG. Otherwise, we look at the context:
-In a scalar context, only the first (0th) occurence of the
-field is returned; in an array context, I<all> occurences are returned.
+In a scalar context, only the first (0th) occurence of the
+field is returned; in an array context, I<all> occurences are returned.
I<Warning:> this should only be used with non-MIME fields.
Behavior with MIME fields is TBD, and will raise an exception for now.
=cut
+
sub get {
- my ($self, $tag, $index) = @_;
- $tag = lc($tag);
+ my ( $self, $tag, $index ) = @_;
+ $tag = lc($tag);
Carp::croak "get: can't be used with MIME fields\n" if is_mime_field($tag);
-
- my @all = map { ($_->[0] eq $tag) ? $_->[1] : ()} @{$self->{Header}};
- (defined($index) ? $all[$index] : (wantarray ? @all : $all[0]));
+
+ my @all = map { ( $_->[0] eq $tag ) ? $_->[1] : () } @{ $self->{Header} };
+ ( defined($index) ? $all[$index] : ( wantarray ? @all : $all[0] ) );
}
#------------------------------
@@ -1443,17 +1497,17 @@ sub get {
=item get_length
I<Instance method.>
-Recompute the content length for the message I<if the process is trivial>,
+Recompute the content length for the message I<if the process is trivial>,
setting the "content-length" attribute as a side-effect:
$msg->get_length;
Returns the length, or undefined if not set.
-I<Note:> the content length can be difficult to compute, since it
+I<Note:> the content length can be difficult to compute, since it
involves assembling the entire encoded body and taking the length
of it (which, in the case of multipart messages, means freezing
-all the sub-parts, etc.).
+all the sub-parts, etc.).
This method only sets the content length to a defined value if the
message is a singlepart with C<"binary"> encoding, I<and> the body is
@@ -1465,34 +1519,34 @@ it's not in the MIME RFCs, it's an HTTP thing), this seems pretty fair.
=cut
+
#----
-# Miko's note: I wasn't quite sure how to handle this, so I waited to hear
-# what you think. Given that the content-length isn't always required,
+# Miko's note: I wasn't quite sure how to handle this, so I waited to hear
+# what you think. Given that the content-length isn't always required,
# and given the performance cost of calculating it from a file handle,
-# I thought it might make more sense to add some some sort of computelength
-# property. If computelength is false, then the length simply isn't
+# I thought it might make more sense to add some some sort of computelength
+# property. If computelength is false, then the length simply isn't
# computed. What do you think?
#
# Eryq's reply: I agree; for now, we can silently leave out the content-type.
sub get_length {
my $self = shift;
+ my $attrs = $self->{Attrs};
- my $is_multipart = ($self->attr('content-type') =~ m{^multipart/}i);
- my $enc = lc($self->attr('content-transfer-encoding') || 'binary');
+ my $is_multipart = ( $attrs->{'content-type'} =~ m{^multipart/}i );
+ my $enc = lc( $attrs->{'content-transfer-encoding'} || 'binary' );
my $length;
- if (!$is_multipart && ($enc eq "binary")){ ### might figure it out cheap:
- if (defined($self->{Data})) { ### it's in core
- $length = length($self->{Data});
- }
- elsif (defined($self->{FH})) { ### it's in a filehandle
- ### no-op: it's expensive, so don't bother
- }
- elsif (defined($self->{Path})) { ### it's a simple file!
- $length = (-s $self->{Path}) if (-e $self->{Path});
- }
+ if ( !$is_multipart && ( $enc eq "binary" ) ) { ### might figure it out cheap:
+ if ( defined( $self->{Data} ) ) { ### it's in core
+ $length = length( $self->{Data} );
+ } elsif ( defined( $self->{FH} ) ) { ### it's in a filehandle
+ ### no-op: it's expensive, so don't bother
+ } elsif ( defined( $self->{Path} ) ) { ### it's a simple file!
+ $length = ( -s $self->{Path} ) if ( -e $self->{Path} );
+ }
}
- $self->attr('content-length' => $length);
+ $attrs->{'content-length'} = $length;
return $length;
}
@@ -1509,9 +1563,10 @@ parts_DFS() to get everything.
=cut
+
sub parts {
my $self = shift;
- @{$self->{Parts} || []};
+ @{ $self->{Parts} || [] };
}
#------------------------------
@@ -1520,14 +1575,15 @@ sub parts {
I<Instance method.>
Return the list of all MIME::Lite objects included in the entity,
-starting with the entity itself, in depth-first-search order.
+starting with the entity itself, in depth-first-search order.
If this object has no parts, it alone will be returned.
=cut
+
sub parts_DFS {
my $self = shift;
- return ($self, map { $_->parts_DFS } $self->parts);
+ return ( $self, map { $_->parts_DFS } $self->parts );
}
#------------------------------
@@ -1540,6 +1596,7 @@ Set it to undef for the default string.
=cut
+
sub preamble {
my $self = shift;
$self->{Preamble} = shift if @_;
@@ -1555,16 +1612,16 @@ Delete all occurences of fields named TAG, and add a new
field with the given VALUE. TAG is converted to all-lowercase.
B<Beware> the special MIME fields (MIME-version, Content-*):
-if you "replace" a MIME field, the replacement text will override
+if you "replace" a MIME field, the replacement text will override
the I<actual> MIME attributes when it comes time to output that field.
-So normally you use attr() to change MIME fields and add()/replace() to
+So normally you use attr() to change MIME fields and add()/replace() to
change I<non-MIME> fields:
$msg->replace("Subject" => "Hi there!");
Giving VALUE as the I<empty string> will effectively I<prevent> that
field from being output. This is the correct way to suppress
-the special MIME fields:
+the special MIME fields:
$msg->replace("Content-disposition" => "");
@@ -1575,10 +1632,11 @@ I<Note:> the name of this method comes from Mail::Header.
=cut
+
sub replace {
- my ($self, $tag, $value) = @_;
+ my ( $self, $tag, $value ) = @_;
$self->delete($tag);
- $self->add($tag, $value) if defined($value);
+ $self->add( $tag, $value ) if defined($value);
}
@@ -1588,8 +1646,8 @@ sub replace {
I<Instance method.>
B<This is Alpha code. If you use it, please let me know how it goes.>
-Recursively goes through the "parts" tree of this message and tries
-to find MIME attributes that can be removed.
+Recursively goes through the "parts" tree of this message and tries
+to find MIME attributes that can be removed.
With an array argument, removes exactly those attributes; e.g.:
$msg->scrub(['content-disposition', 'content-length']);
@@ -1601,46 +1659,47 @@ Is the same as recursively doing:
=cut
+
sub scrub {
- my ($self, @a) = @_;
+ my ( $self, @a ) = @_;
my ($expl) = @a;
local $QUIET = 1;
### Scrub me:
- if (!@a) { ### guess
-
- ### Scrub length always:
- $self->replace('content-length', '');
-
- ### Scrub disposition if no filename, or if content-type has same info:
- if (!$self->_safe_attr('content-disposition.filename') ||
- $self->_safe_attr('content-type.name')) {
- $self->replace('content-disposition', '');
- }
-
- ### Scrub encoding if effectively unencoded:
- if ($self->_safe_attr('content-transfer-encoding') =~
- /^(7bit|8bit|binary)$/i) {
- $self->replace('content-transfer-encoding', '');
- }
-
- ### Scrub charset if US-ASCII:
- if ($self->_safe_attr('content-type.charset') =~ /^(us-ascii)/i) {
- $self->attr('content-type.charset' => undef);
- }
-
- ### TBD: this is not really right for message/digest:
- if ((keys %{$self->{Attrs}{'content-type'}} == 1) and
- ($self->_safe_attr('content-type') eq 'text/plain')) {
- $self->replace('content-type', '');
- }
- }
- elsif ($expl and (ref($expl) eq 'ARRAY')) {
- foreach (@{$expl}) { $self->replace($_, ''); }
+ if ( !@a ) { ### guess
+
+ ### Scrub length always:
+ $self->replace( 'content-length', '' );
+
+ ### Scrub disposition if no filename, or if content-type has same info:
+ if ( !$self->_safe_attr('content-disposition.filename')
+ || $self->_safe_attr('content-type.name') )
+ {
+ $self->replace( 'content-disposition', '' );
+ }
+
+ ### Scrub encoding if effectively unencoded:
+ if ( $self->_safe_attr('content-transfer-encoding') =~ /^(7bit|8bit|binary)$/i ) {
+ $self->replace( 'content-transfer-encoding', '' );
+ }
+
+ ### Scrub charset if US-ASCII:
+ if ( $self->_safe_attr('content-type.charset') =~ /^(us-ascii)/i ) {
+ $self->attr( 'content-type.charset' => undef );
+ }
+
+ ### TBD: this is not really right for message/digest:
+ if ( ( keys %{ $self->{Attrs}{'content-type'} } == 1 )
+ and ( $self->_safe_attr('content-type') eq 'text/plain' ) )
+ {
+ $self->replace( 'content-type', '' );
+ }
+ } elsif ( $expl and ( ref($expl) eq 'ARRAY' ) ) {
+ foreach ( @{$expl} ) { $self->replace( $_, '' ); }
}
### Scrub my kids:
- foreach (@{$self->{Parts}}) { $_->scrub(@a); }
+ foreach ( @{ $self->{Parts} } ) { $_->scrub(@a); }
}
=back
@@ -1657,16 +1716,17 @@ sub scrub {
=cut
+
#------------------------------
=item binmode [OVERRIDE]
I<Instance method.>
-With no argument, returns whether or not it thinks that the data
-(as given by the "Path" argument of C<build()>) should be read using
+With no argument, returns whether or not it thinks that the data
+(as given by the "Path" argument of C<build()>) should be read using
binmode() (for example, when C<read_now()> is invoked).
-The default behavior is that any content type other than
+The default behavior is that any content type other than
C<text/*> or C<message/*> is binmode'd; this should in general work fine.
With a defined argument, this method sets an explicit "override"
@@ -1675,12 +1735,14 @@ The new current value is returned.
=cut
+
sub binmode {
my $self = shift;
- $self->{Binmode} = shift if (@_); ### argument? set override
- return (defined($self->{Binmode})
- ? $self->{Binmode}
- : ($self->attr("content-type") !~ m{^(text|message)/}i));
+ $self->{Binmode} = shift if (@_); ### argument? set override
+ return ( defined( $self->{Binmode} )
+ ? $self->{Binmode}
+ : ( $self->{Attrs}{"content-type"} !~ m{^(text|message)/}i )
+ );
}
#------------------------------
@@ -1690,18 +1752,19 @@ sub binmode {
I<Instance method.>
Get/set the literal DATA of the message. The DATA may be
either a scalar, or a reference to an array of scalars (which
-will simply be joined).
+will simply be joined).
I<Warning:> setting the data causes the "content-length" attribute
to be recomputed (possibly to nothing).
=cut
+
sub data {
my $self = shift;
if (@_) {
- $self->{Data} = ((ref($_[0]) eq 'ARRAY') ? join('', @{$_[0]}) : $_[0]);
- $self->get_length;
+ $self->{Data} = ( ( ref( $_[0] ) eq 'ARRAY' ) ? join( '', @{ $_[0] } ) : $_[0] );
+ $self->get_length;
}
$self->{Data};
}
@@ -1714,11 +1777,12 @@ I<Instance method.>
Get/set the FILEHANDLE which contains the message data.
Takes a filehandle as an input and stores it in the object.
-This routine is similar to path(); one important difference is that
-no attempt is made to set the content length.
+This routine is similar to path(); one important difference is that
+no attempt is made to set the content length.
=cut
+
sub fh {
my $self = shift;
$self->{FH} = shift if @_;
@@ -1738,30 +1802,30 @@ looks like a simple path, and to nothing if not).
=cut
+
sub path {
my $self = shift;
if (@_) {
- ### Set the path, and invalidate the content length:
- $self->{Path} = shift;
-
- ### Re-set filename, extracting it from path if possible:
- my $filename;
- if ($self->{Path} and ($self->{Path} !~ /\|$/)) { ### non-shell path:
- ($filename = $self->{Path}) =~ s/^<//;
-
- ### Consult File::Basename, maybe:
- if ($HaveFileBasename) {
- $filename = File::Basename::basename($filename);
- }
- else {
- ($filename) = ($filename =~ m{([^\/]+)\Z});
- }
- }
- $self->filename($filename);
-
- ### Reset the length:
- $self->get_length;
+ ### Set the path, and invalidate the content length:
+ $self->{Path} = shift;
+
+ ### Re-set filename, extracting it from path if possible:
+ my $filename;
+ if ( $self->{Path} and ( $self->{Path} !~ /\|$/ ) ) { ### non-shell path:
+ ( $filename = $self->{Path} ) =~ s/^<//;
+
+ ### Consult File::Basename, maybe:
+ if ($HaveFileBasename) {
+ $filename = File::Basename::basename($filename);
+ } else {
+ ($filename) = ( $filename =~ m{([^\/]+)\Z} );
+ }
+ }
+ $self->filename($filename);
+
+ ### Reset the length:
+ $self->get_length;
}
$self->{Path};
}
@@ -1771,7 +1835,7 @@ sub path {
=item resetfh [FILEHANDLE]
I<Instance method.>
-Set the current position of the filehandle back to the beginning.
+Set the current position of the filehandle back to the beginning.
Only applies if you used "FH" in build() or attach() for this message.
Returns false if unable to reset the filehandle (since not all filehandles
@@ -1779,54 +1843,55 @@ are seekable).
=cut
+
#----
-# Miko's note: With the Data and Path, the same data could theoretically
-# be reused. However, file handles need to be reset to be reused,
+# Miko's note: With the Data and Path, the same data could theoretically
+# be reused. However, file handles need to be reset to be reused,
# so I added this routine.
#
# Eryq reply: beware... not all filehandles are seekable (think about STDIN)!
sub resetfh {
my $self = shift;
- seek($self->{FH},0,0);
+ seek( $self->{FH}, 0, 0 );
}
#------------------------------
-=item read_now
+=item read_now
I<Instance method.>
Forces data from the path/filehandle (as specified by C<build()>)
to be read into core immediately, just as though you had given it
-literally with the C<Data> keyword.
+literally with the C<Data> keyword.
Note that the in-core data will always be used if available.
-Be aware that everything is slurped into a giant scalar: you may not want
-to use this if sending tar files! The benefit of I<not> reading in the data
+Be aware that everything is slurped into a giant scalar: you may not want
+to use this if sending tar files! The benefit of I<not> reading in the data
is that very large files can be handled by this module if left on disk
until the message is output via C<print()> or C<print_body()>.
=cut
+
sub read_now {
my $self = shift;
local $/ = undef;
-
- if ($self->{FH}) { ### data from a filehandle:
- my $chunk;
- my @chunks;
- CORE::binmode($self->{FH}) if $self->binmode;
- while (read($self->{FH}, $chunk, 1024)) {
- push @chunks, $chunk;
- }
- $self->{Data} = join '', @chunks;
- }
- elsif ($self->{Path}) { ### data from a path:
- open SLURP, $self->{Path} or Carp::croak "open $self->{Path}: $!\n";
- CORE::binmode(SLURP) if $self->binmode;
- $self->{Data} = <SLURP>; ### sssssssssssssslurp...
- close SLURP; ### ...aaaaaaaaahhh!
+
+ if ( $self->{FH} ) { ### data from a filehandle:
+ my $chunk;
+ my @chunks;
+ CORE::binmode( $self->{FH} ) if $self->binmode;
+ while ( read( $self->{FH}, $chunk, 1024 ) ) {
+ push @chunks, $chunk;
+ }
+ $self->{Data} = join '', @chunks;
+ } elsif ( $self->{Path} ) { ### data from a path:
+ open SLURP, $self->{Path} or Carp::croak "open $self->{Path}: $!\n";
+ CORE::binmode(SLURP) if $self->binmode;
+ $self->{Data} = <SLURP>; ### sssssssssssssslurp...
+ close SLURP; ### ...aaaaaaaaahhh!
}
}
@@ -1859,25 +1924,26 @@ The content-length is recomputed.
=cut
+
sub sign {
- my $self = shift;
+ my $self = shift;
my %params = @_;
### Default:
@_ or $params{Path} = "$ENV{HOME}/.signature";
### Force message in-core:
- defined($self->{Data}) or $self->read_now;
+ defined( $self->{Data} ) or $self->read_now;
### Load signature:
my $sig;
- if (!defined($sig = $params{Data})) { ### not given explicitly:
- local $/ = undef;
- open SIG, $params{Path} or Carp::croak "open sig $params{Path}: $!\n";
- $sig = <SIG>; ### sssssssssssssslurp...
- close SIG; ### ...aaaaaaaaahhh!
- }
- $sig = join('',@$sig) if (ref($sig) and (ref($sig) eq 'ARRAY'));
+ if ( !defined( $sig = $params{Data} ) ) { ### not given explicitly:
+ local $/ = undef;
+ open SIG, $params{Path} or Carp::croak "open sig $params{Path}: $!\n";
+ $sig = <SIG>; ### sssssssssssssslurp...
+ close SIG; ### ...aaaaaaaaahhh!
+ }
+ $sig = join( '', @$sig ) if ( ref($sig) and ( ref($sig) eq 'ARRAY' ) );
### Append, following Internet conventions:
$self->{Data} .= "\n-- \n$sig";
@@ -1900,11 +1966,11 @@ sub sign {
# Major type: 7bit ok? Suggested encoding:
# ------------------------------------------------------------
# text yes 7bit
-# no quoted-printable
+# no quoted-printable
# unknown binary
#
# message yes 7bit
-# no binary
+# no binary
# unknown binary
#
# multipart n/a binary (in case some parts are not ok)
@@ -1914,32 +1980,32 @@ sub sign {
#=cut
sub suggest_encoding {
- my ($self, $ctype) = @_;
+ my ( $self, $ctype ) = @_;
$ctype = lc($ctype);
### Consult MIME::Types, maybe:
if ($HaveMimeTypes) {
-
- ### Mappings contain [suffix,mimetype,encoding]
- my @mappings = MIME::Types::by_mediatype($ctype);
- if (scalar(@mappings)) {
- ### Just pick the first one:
- my ($suffix, $mimetype, $encoding) = @{$mappings[0]};
- if ($encoding &&
- $encoding =~/^(base64|binary|[78]bit|quoted-printable)$/i) {
- return lc($encoding); ### sanity check
- }
- }
+
+ ### Mappings contain [suffix,mimetype,encoding]
+ my @mappings = MIME::Types::by_mediatype($ctype);
+ if ( scalar(@mappings) ) {
+ ### Just pick the first one:
+ my ( $suffix, $mimetype, $encoding ) = @{ $mappings[0] };
+ if ( $encoding
+ && $encoding =~ /^(base64|binary|[78]bit|quoted-printable)$/i )
+ {
+ return lc($encoding); ### sanity check
+ }
+ }
}
### If we got here, then MIME::Types was no help.
### Extract major type:
my ($type) = split '/', $ctype;
- if (($type eq 'text') || ($type eq 'message')) { ### scan message body?
- return 'binary';
- }
- else {
- return ($type eq 'multipart') ? 'binary' : 'base64';
+ if ( ( $type eq 'text' ) || ( $type eq 'message' ) ) { ### scan message body?
+ return 'binary';
+ } else {
+ return ( $type eq 'multipart' ) ? 'binary' : 'base64';
}
}
@@ -1953,24 +2019,18 @@ sub suggest_encoding {
# can be made, so don't use this if you don't mean it!
#
sub suggest_type {
- my ($self, $path) = @_;
+ my ( $self, $path ) = @_;
### If there's no path, bail:
$path or return 'application/octet-stream';
### Consult MIME::Types, maybe:
if ($HaveMimeTypes) {
- # Mappings contain [mimetype,encoding]:
- my @mappings = MIME::Types::by_suffix($path);
- if (scalar(@mappings)) {
- ### Just pick the first one:
- my ($mimetype, $encoding) = @{$mappings[0]};
- if ($mimetype && $mimetype =~ /^\S+\/\S+$/) {
- return $mimetype; ### sanity check
- }
- }
+
+ # Mappings contain [mimetype,encoding]:
+ my ( $mimetype, $encoding ) = MIME::Types::by_suffix($path);
+ return $mimetype if ( $mimetype && $mimetype =~ /^\S+\/\S+$/ ); ### sanity check
}
-
### If we got here, then MIME::Types was no help.
### The correct thing to fall back to is the most-generic content type:
return 'application/octet-stream';
@@ -1981,25 +2041,26 @@ sub suggest_type {
=item verify_data
I<Instance method.>
-Verify that all "paths" to attached data exist, recursively.
+Verify that all "paths" to attached data exist, recursively.
It might be a good idea for you to do this before a print(), to
prevent accidental partial output if a file might be missing.
Raises exception if any path is not readable.
=cut
+
sub verify_data {
my $self = shift;
### Verify self:
my $path = $self->{Path};
- if ($path and ($path !~ /\|$/)) { ### non-shell path:
- $path =~ s/^<//;
- (-r $path) or die "$path: not readable\n";
+ if ( $path and ( $path !~ /\|$/ ) ) { ### non-shell path:
+ $path =~ s/^<//;
+ ( -r $path ) or die "$path: not readable\n";
}
### Verify parts:
- foreach my $part (@{$self->{Parts}}) { $part->verify_data }
+ foreach my $part ( @{ $self->{Parts} } ) { $part->verify_data }
1;
}
@@ -2017,28 +2078,30 @@ sub verify_data {
=cut
+
#------------------------------
=item print [OUTHANDLE]
-I<Instance method.>
+I<Instance method.>
Print the message to the given output handle, or to the currently-selected
filehandle if none was given.
-All OUTHANDLE has to be is a filehandle (possibly a glob ref), or
+All OUTHANDLE has to be is a filehandle (possibly a glob ref), or
any object that responds to a print() message.
=cut
+
sub print {
- my ($self, $out) = @_;
+ my ( $self, $out ) = @_;
### Coerce into a printable output handle:
- $out = wrap MIME::Lite::IO_Handle $out;
+ $out = MIME::Lite::IO_Handle->wrap($out);
### Output head, separator, and body:
- $self->verify_data if $AUTO_VERIFY; ### prevents missing parts!
- $out->print($self->header_as_string, "\n");
+ $self->verify_data if $AUTO_VERIFY; ### prevents missing parts!
+ $out->print( $self->header_as_string, "\n" );
$self->print_body($out);
}
@@ -2051,75 +2114,83 @@ sub print {
# This is because qmail apparently doesn't do this for us!
#
sub print_for_smtp {
- my ($self, $out) = @_;
+ my ( $self, $out ) = @_;
### Coerce into a printable output handle:
- $out = wrap MIME::Lite::IO_Handle $out;
-
+ $out = MIME::Lite::IO_Handle->wrap($out);
+
### Create a safe head:
- my @fields = grep { $_->[0] ne 'bcc' } @{$self->fields};
- my $header = $self->fields_as_string(\@fields);
+ my @fields = grep { $_->[0] ne 'bcc' } @{ $self->fields };
+ my $header = $self->fields_as_string( \@fields );
### Output head, separator, and body:
- $out->print($header, "\n");
- $self->print_body($out);
+ $out->print( $header, "\n" );
+ $self->print_body( $out, '1' );
}
#------------------------------
-=item print_body [OUTHANDLE]
+=item print_body [OUTHANDLE] [IS_SMTP]
-I<Instance method.>
-Print the body of a message to the given output handle, or to
-the currently-selected filehandle if none was given.
+I<Instance method.>
+Print the body of a message to the given output handle, or to
+the currently-selected filehandle if none was given.
-All OUTHANDLE has to be is a filehandle (possibly a glob ref), or
+All OUTHANDLE has to be is a filehandle (possibly a glob ref), or
any object that responds to a print() message.
B<Fatal exception> raised if unable to open any of the input files,
-or if a part contains no data, or if an unsupported encoding is
+or if a part contains no data, or if an unsupported encoding is
encountered.
+IS_SMPT is a special option to handle SMTP mails a little more
+intelligently than other send mechanisms may require. Specifically this
+ensures that the last byte sent is NOT '\n' (octal \012) if the last two
+bytes are not '\r\n' (\015\012) as this will cause some SMTP servers to
+hang.
+
=cut
+
sub print_body {
- my ($self, $out) = @_;
+ my ( $self, $out, $is_smtp ) = @_;
+ my $attrs = $self->{Attrs};
+ my $sub_attrs = $self->{SubAttrs};
### Coerce into a printable output handle:
- $out = wrap MIME::Lite::IO_Handle $out;
+ $out = MIME::Lite::IO_Handle->wrap($out);
### Output either the body or the parts.
- ### Notice that we key off of the content-type! We expect fewer
+ ### Notice that we key off of the content-type! We expect fewer
### accidents that way, since the syntax will always match the MIME type.
- my $type = $self->attr('content-type');
- if ($type =~ m{^multipart/}i) {
- my $boundary = $self->attr('content-type.boundary');
-
- ### Preamble:
- $out->print(defined($self->{Preamble})
- ? $self->{Preamble}
- : "This is a multi-part message in MIME format.\n");
-
- ### Parts:
- my $part;
- foreach $part (@{$self->{Parts}}) {
- $out->print("\n--$boundary\n");
- $part->print($out);
- }
-
- ### Epilogue:
- $out->print("\n--$boundary--\n\n");
- }
- elsif ($type =~ m{^message/}) {
- my @parts = @{$self->{Parts}};
+ my $type = $attrs->{'content-type'};
+ if ( $type =~ m{^multipart/}i ) {
+ my $boundary = $sub_attrs->{'content-type'}{'boundary'};
+
+ ### Preamble:
+ $out->print( defined( $self->{Preamble} )
+ ? $self->{Preamble}
+ : "This is a multi-part message in MIME format.\n"
+ );
+
+ ### Parts:
+ my $part;
+ foreach $part ( @{ $self->{Parts} } ) {
+ $out->print("\n--$boundary\n");
+ $part->print($out);
+ }
- ### It's a toss-up; try both data and parts:
- if (@parts == 0) { $self->print_simple_body($out) }
- elsif (@parts == 1) { $parts[0]->print($out) }
- else { Carp::croak "can't handle message with >1 part\n"; }
- }
- else {
- $self->print_simple_body($out);
+ ### Epilogue:
+ $out->print("\n--$boundary--\n\n");
+ } elsif ( $type =~ m{^message/} ) {
+ my @parts = @{ $self->{Parts} };
+
+ ### It's a toss-up; try both data and parts:
+ if ( @parts == 0 ) { $self->print_simple_body( $out, $is_smtp ) }
+ elsif ( @parts == 1 ) { $parts[0]->print($out) }
+ else { Carp::croak "can't handle message with >1 part\n"; }
+ } else {
+ $self->print_simple_body( $out, $is_smtp );
}
1;
}
@@ -2129,121 +2200,136 @@ sub print_body {
# print_simple_body [OUTHANDLE]
#
# I<Instance method, private.>
-# Print the body of a simple singlepart message to the given
-# output handle, or to the currently-selected filehandle if none
-# was given.
+# Print the body of a simple singlepart message to the given
+# output handle, or to the currently-selected filehandle if none
+# was given.
#
# Note that if you want to print "the portion after
-# the header", you don't want this method: you want
+# the header", you don't want this method: you want
# L<print_body()|/print_body>.
#
-# All OUTHANDLE has to be is a filehandle (possibly a glob ref), or
+# All OUTHANDLE has to be is a filehandle (possibly a glob ref), or
# any object that responds to a print() message.
#
# B<Fatal exception> raised if unable to open any of the input files,
-# or if a part contains no data, or if an unsupported encoding is
+# or if a part contains no data, or if an unsupported encoding is
# encountered.
#
sub print_simple_body {
- my ($self, $out) = @_;
+ my ( $self, $out, $is_smtp ) = @_;
+ my $attrs = $self->{Attrs};
### Coerce into a printable output handle:
- $out = wrap MIME::Lite::IO_Handle $out;
+ $out = MIME::Lite::IO_Handle->wrap($out);
### Get content-transfer-encoding:
- my $encoding = uc($self->attr('content-transfer-encoding'));
+ my $encoding = uc( $attrs->{'content-transfer-encoding'} );
+ warn "M::L >>> Encoding using $encoding, is_smtp=" . ( $is_smtp || 0 ) . "\n"
+ if $MIME::Lite::DEBUG;
### Notice that we don't just attempt to slurp the data in from a file:
### by processing files piecemeal, we still enable ourselves to prepare
### very large MIME messages...
### Is the data in-core? If so, blit it out...
- if (defined($self->{Data})) {
- DATA:
- { local $_ = $encoding;
-
- /^BINARY$/ and do {
- $out->print($self->{Data});
- last DATA;
- };
- /^8BIT$/ and do {
- $out->print(encode_8bit($self->{Data}));
- last DATA;
- };
- /^7BIT$/ and do {
- $out->print(encode_7bit($self->{Data}));
- last DATA;
- };
- /^QUOTED-PRINTABLE$/ and do {
- ### UNTAINT since m//mg on tainted data loops forever:
- my ($untainted) = ($self->{Data} =~ m/\A(.*)\Z/s);
-
- ### Encode it line by line:
- while ($untainted =~ m{^(.*[\r\n]*)}mg) {
- $out->print(encode_qp($1)); ### have to do it line by line...
- }
- last DATA;
- };
- /^BASE64/ and do {
- $out->print(encode_base64($self->{Data}));
- last DATA;
- };
- Carp::croak "unsupported encoding: `$_'\n";
+ if ( defined( $self->{Data} ) ) {
+ DATA:
+ {
+ local $_ = $encoding;
+
+ /^BINARY$/ and do {
+ $is_smtp and $self->{Data} =~ s/(?!\r)\n\z/\r/;
+ $out->print( $self->{Data} );
+ last DATA;
+ };
+ /^8BIT$/ and do {
+ $out->print( encode_8bit( $self->{Data} ) );
+ last DATA;
+ };
+ /^7BIT$/ and do {
+ $out->print( encode_7bit( $self->{Data} ) );
+ last DATA;
+ };
+ /^QUOTED-PRINTABLE$/ and do {
+ ### UNTAINT since m//mg on tainted data loops forever:
+ my ($untainted) = ( $self->{Data} =~ m/\A(.*)\Z/s );
+
+ ### Encode it line by line:
+ while ( $untainted =~ m{^(.*[\r\n]*)}smg ) {
+ ### have to do it line by line...
+ my $line = $1; # copy to avoid weird bug; rt 39334
+ $out->print( encode_qp($line) );
+ }
+ last DATA;
+ };
+ /^BASE64/ and do {
+ $out->print( encode_base64( $self->{Data} ) );
+ last DATA;
+ };
+ Carp::croak "unsupported encoding: `$_'\n";
}
}
### Else, is the data in a file? If so, output piecemeal...
- ### Miko's note: this routine pretty much works the same with a path
- ### or a filehandle. the only difference in behaviour is that it does
+ ### Miko's note: this routine pretty much works the same with a path
+ ### or a filehandle. the only difference in behaviour is that it does
### not attempt to open anything if it already has a filehandle
- elsif (defined($self->{Path}) || defined($self->{FH})) {
- no strict 'refs'; ### in case FH is not an object
- my $DATA;
-
- ### Open file if necessary:
- if (defined($self->{Path})) {
- $DATA = new FileHandle || Carp::croak "can't get new filehandle\n";
- $DATA->open("$self->{Path}") or
- Carp::croak "open $self->{Path}: $!\n";
- }
- else {
- $DATA=$self->{FH};
- }
- CORE::binmode($DATA) if $self->binmode;
-
- ### Encode piece by piece:
- PATH:
- { local $_ = $encoding;
-
- /^BINARY$/ and do {
- $out->print($_) while read($DATA, $_, 2048);
- last PATH;
- };
- /^8BIT$/ and do {
- $out->print(encode_8bit($_)) while (<$DATA>);
- last PATH;
- };
- /^7BIT$/ and do {
- $out->print(encode_7bit($_)) while (<$DATA>);
- last PATH;
- };
- /^QUOTED-PRINTABLE$/ and do {
- $out->print(encode_qp($_)) while (<$DATA>);
- last PATH;
- };
- /^BASE64$/ and do {
- $out->print(encode_base64($_)) while (read($DATA, $_, 45));
- last PATH;
- };
- Carp::croak "unsupported encoding: `$_'\n";
- }
-
- ### Close file:
- close $DATA if defined($self->{Path});
+ elsif ( defined( $self->{Path} ) || defined( $self->{FH} ) ) {
+ no strict 'refs'; ### in case FH is not an object
+ my $DATA;
+
+ ### Open file if necessary:
+ if ( defined( $self->{Path} ) ) {
+ $DATA = new FileHandle || Carp::croak "can't get new filehandle\n";
+ $DATA->open("$self->{Path}")
+ or Carp::croak "open $self->{Path}: $!\n";
+ } else {
+ $DATA = $self->{FH};
+ }
+ CORE::binmode($DATA) if $self->binmode;
+
+ ### Encode piece by piece:
+ PATH:
+ {
+ local $_ = $encoding;
+
+ /^BINARY$/ and do {
+ my $last = "";
+ while ( read( $DATA, $_, 2048 ) ) {
+ $out->print($last) if length $last;
+ $last = $_;
+ }
+ if ( length $last ) {
+ $is_smtp and $last =~ s/(?!\r)\n\z/\r/;
+ $out->print($last);
+ }
+ last PATH;
+ };
+ /^8BIT$/ and do {
+ $out->print( encode_8bit($_) ) while (<$DATA>);
+ last PATH;
+ };
+ /^7BIT$/ and do {
+ $out->print( encode_7bit($_) ) while (<$DATA>);
+ last PATH;
+ };
+ /^QUOTED-PRINTABLE$/ and do {
+ $out->print( encode_qp($_) ) while (<$DATA>);
+ last PATH;
+ };
+ /^BASE64$/ and do {
+ $out->print( encode_base64($_) ) while ( read( $DATA, $_, 45 ) );
+ last PATH;
+ };
+ Carp::croak "unsupported encoding: `$_'\n";
+ }
+
+ ### Close file:
+ close $DATA if defined( $self->{Path} );
}
-
+
else {
- Carp::croak "no data in this part\n";
+ Carp::croak "no data in this part\n";
}
1;
}
@@ -2252,23 +2338,24 @@ sub print_simple_body {
=item print_header [OUTHANDLE]
-I<Instance method.>
-Print the header of the message to the given output handle,
+I<Instance method.>
+Print the header of the message to the given output handle,
or to the currently-selected filehandle if none was given.
-All OUTHANDLE has to be is a filehandle (possibly a glob ref), or
+All OUTHANDLE has to be is a filehandle (possibly a glob ref), or
any object that responds to a print() message.
=cut
+
sub print_header {
- my ($self, $out) = @_;
+ my ( $self, $out ) = @_;
### Coerce into a printable output handle:
- $out = wrap MIME::Lite::IO_Handle $out;
+ $out = MIME::Lite::IO_Handle->wrap($out);
### Output the header:
- $out->print($self->header_as_string);
+ $out->print( $self->header_as_string );
1;
}
@@ -2276,17 +2363,18 @@ sub print_header {
=item as_string
-I<Instance method.>
+I<Instance method.>
Return the entire message as a string, with a header and an encoded body.
=cut
+
sub as_string {
my $self = shift;
- my $buf = [];
- my $io = (wrap MIME::Lite::IO_ScalarArray $buf);
+ my $buf = "";
+ my $io = ( wrap MIME::Lite::IO_Scalar \$buf);
$self->print($io);
- join '', @$buf;
+ return $buf;
}
*stringify = \&as_string; ### backwards compatibility
*stringify = \&as_string; ### ...twice to avoid warnings :)
@@ -2295,22 +2383,23 @@ sub as_string {
=item body_as_string
-I<Instance method.>
+I<Instance method.>
Return the encoded body as a string.
This is the portion after the header and the blank line.
I<Note:> actually prepares the body by "printing" to a scalar.
-Proof that you can hand the C<print*()> methods any blessed object
+Proof that you can hand the C<print*()> methods any blessed object
that responds to a C<print()> message.
=cut
+
sub body_as_string {
my $self = shift;
- my $buf = [];
- my $io = (wrap MIME::Lite::IO_ScalarArray $buf);
+ my $buf = "";
+ my $io = ( wrap MIME::Lite::IO_Scalar \$buf);
$self->print_body($io);
- join '', @$buf;
+ return $buf;
}
*stringify_body = \&body_as_string; ### backwards compatibility
*stringify_body = \&body_as_string; ### ...twice to avoid warnings :)
@@ -2323,30 +2412,31 @@ sub body_as_string {
# fields, where FIELDS is an arrayref like that returned by fields().
#
sub fields_as_string {
- my ($self, $fields) = @_;
- my @lines;
+ my ( $self, $fields ) = @_;
+ my $out = "";
foreach (@$fields) {
- my ($tag, $value) = @$_;
- next if ($value eq ''); ### skip empties
- $tag =~ s/\b([a-z])/uc($1)/ge; ### make pretty
- $tag =~ s/^mime-/MIME-/ig; ### even prettier
- push @lines, "$tag: $value\n";
+ my ( $tag, $value ) = @$_;
+ next if ( $value eq '' ); ### skip empties
+ $tag =~ s/\b([a-z])/uc($1)/ge; ### make pretty
+ $tag =~ s/^mime-/MIME-/i; ### even prettier
+ $out .= "$tag: $value\n";
}
- join '', @lines;
+ return $out;
}
#------------------------------
=item header_as_string
-I<Instance method.>
+I<Instance method.>
Return the header as a string.
=cut
+
sub header_as_string {
my $self = shift;
- $self->fields_as_string($self->fields);
+ $self->fields_as_string( $self->fields );
}
*stringify_header = \&header_as_string; ### backwards compatibility
*stringify_header = \&header_as_string; ### ...twice to avoid warnings :)
@@ -2356,7 +2446,6 @@ sub header_as_string {
=cut
-
#==============================
#==============================
@@ -2366,20 +2455,21 @@ sub header_as_string {
=cut
+
#------------------------------
=item send
=item send HOW, HOWARGS...
-I<Class/instance method.>
+I<Class/instance method.>
This is the principal method for sending mail, and for configuring
how mail will be sent.
-I<As a class method> with a HOW argument and optional HOWARGS, it sets
-the default sending mechanism that the no-argument instance method
-will use. The HOW is a facility name (B<see below>),
-and the HOWARGS is interpreted by the facilty.
+I<As a class method> with a HOW argument and optional HOWARGS, it sets
+the default sending mechanism that the no-argument instance method
+will use. The HOW is a facility name (B<see below>),
+and the HOWARGS is interpreted by the facilty.
The class method returns the previous HOW and HOWARGS as an array.
MIME::Lite->send('sendmail', "d:\\programs\\sendmail.exe");
@@ -2387,24 +2477,33 @@ The class method returns the previous HOW and HOWARGS as an array.
$msg = MIME::Lite->new(...);
$msg->send;
-I<As an instance method with arguments>
-(a HOW argument and optional HOWARGS), sends the message in the
+I<As an instance method with arguments>
+(a HOW argument and optional HOWARGS), sends the message in the
requested manner; e.g.:
$msg->send('sendmail', "d:\\programs\\sendmail.exe");
-I<As an instance method with no arguments,> sends the message by
-the default mechanism set up by the class method.
-Returns whatever the mail-handling routine returns: this should be true
-on success, false/exception on error:
+I<As an instance method with no arguments,> sends the
+message by the default mechanism set up by the class method.
+Returns whatever the mail-handling routine returns: this
+should be true on success, false/exception on error:
$msg = MIME::Lite->new(From=>...);
$msg->send || die "you DON'T have mail!";
-On Unix systems (at least), the default setting is equivalent to:
+On Unix systems (or rather non-Win32 systems), the default
+setting is equivalent to:
MIME::Lite->send("sendmail", "/usr/lib/sendmail -t -oi -oem");
+On Win32 systems the default setting is equivalent to:
+
+ MIME::Lite->send("smtp");
+
+The assumption is that on Win32 your site/lib/Net/libnet.cfg
+file will be preconfigured to use the appropriate SMTP
+server. See below for configuring for authentication.
+
There are three facilities:
=over 4
@@ -2415,10 +2514,21 @@ Send a message by piping it into the "sendmail" command.
Uses the L<send_by_sendmail()|/send_by_sendmail> method, giving it the ARGS.
This usage implements (and deprecates) the C<sendmail()> method.
-=item "smtp", [HOSTNAME]
+=item "smtp", [HOSTNAME, [NAMEDPARMS] ]
Send a message by SMTP, using optional HOSTNAME as SMTP-sending host.
-Uses the L<send_by_smtp()|/send_by_smtp> method.
+Uses the L<send_by_smtp()|/send_by_smtp> method. Any additional
+arguments passed in will also be passed through to send_by_smtp.
+This is useful for things like mail servers requiring authentication
+where you can say something like the following
+
+ MIME::List->send('smtp', $host, AuthUser=>$user, AuthPass=>$pass);
+
+which will configure things so future uses of
+
+ $msg->send();
+
+do the right thing.
=item "sub", \&SUBREF, ARGS...
@@ -2442,42 +2552,46 @@ That's it. Now, if you ever move your script to a Unix box, all you
need to do is change that line in the setup and you're done.
All of your $msg-E<gt>send invocations will work as expected.
+After sending, the method last_send_successful() can be used to determine
+if the send was succesful or not.
+
=cut
+
sub send {
my $self = shift;
-
- if (ref($self)) { ### instance method:
- my ($method, @args);
- if (@_) { ### args; use them just this once
- $method = 'send_by_' . shift;
- @args = @_;
- }
- else { ### no args; use defaults
- $method = "send_by_$Sender";
- @args = @{$SenderArgs{$Sender} || []};
- }
- $self->verify_data if $AUTO_VERIFY; ### prevents missing parts!
- return $self->$method(@args);
- }
- else { ### class method:
- if (@_) {
- my @old = ($Sender, @{$SenderArgs{$Sender}});
- $Sender = shift;
- $SenderArgs{$Sender} = [@_]; ### remaining args
- return @old;
- }
- else {
- Carp::croak "class method send must have HOW... arguments\n";
- }
+ my $meth = shift;
+
+ if ( ref($self) ) { ### instance method:
+ my ( $method, @args );
+ if (@_) { ### args; use them just this once
+ $method = 'send_by_' . $meth;
+ @args = @_;
+ } else { ### no args; use defaults
+ $method = "send_by_$Sender";
+ @args = @{ $SenderArgs{$Sender} || [] };
+ }
+ $self->verify_data if $AUTO_VERIFY; ### prevents missing parts!
+ Carp::croak "Unknown send method '$meth'" unless $self->can($method);
+ return $self->$method(@args);
+ } else { ### class method:
+ if (@_) {
+ my @old = ( $Sender, @{ $SenderArgs{$Sender} } );
+ $Sender = $meth;
+ $SenderArgs{$Sender} = [@_]; ### remaining args
+ return @old;
+ } else {
+ Carp::croak "class method send must have HOW... arguments\n";
+ }
}
}
+
#------------------------------
=item send_by_sendmail SENDMAILCMD
-=item send_by_sendmail PARAM=>VALUE, ...
+=item send_by_sendmail PARAM=>VALUE, ARRAY, HASH...
I<Instance method.>
Send message via an external "sendmail" program
@@ -2489,48 +2603,49 @@ You can specify the program and all its arguments by giving a single
string, SENDMAILCMD. Nothing fancy is done; the message is simply
piped in.
-However, if your needs are a little more advanced, you can specify
-zero or more of the following PARAM/VALUE pairs; a Unix-style,
-taint-safe "sendmail" command will be constructed for you:
+However, if your needs are a little more advanced, you can specify
+zero or more of the following PARAM/VALUE pairs (or a reference to hash
+or array of such arguments as well as any combination thereof); a
+Unix-style, taint-safe "sendmail" command will be constructed for you:
=over 4
=item Sendmail
-Full path to the program to use.
+Full path to the program to use.
Default is "/usr/lib/sendmail".
=item BaseArgs
-Ref to the basic array of arguments we start with.
+Ref to the basic array of arguments we start with.
Default is C<["-t", "-oi", "-oem"]>.
=item SetSender
Unless this is I<explicitly> given as false, we attempt to automatically
-set the C<-f> argument to the first address that can be extracted from
-the "From:" field of the message (if there is one).
+set the C<-f> argument to the first address that can be extracted from
+the "From:" field of the message (if there is one).
I<What is the -f, and why do we use it?>
-Suppose we did I<not> use C<-f>, and you gave an explicit "From:"
-field in your message: in this case, the sendmail "envelope" would
-indicate the I<real> user your process was running under, as a way
-of preventing mail forgery. Using the C<-f> switch causes the sender
+Suppose we did I<not> use C<-f>, and you gave an explicit "From:"
+field in your message: in this case, the sendmail "envelope" would
+indicate the I<real> user your process was running under, as a way
+of preventing mail forgery. Using the C<-f> switch causes the sender
to be set in the envelope as well.
I<So when would I NOT want to use it?>
If sendmail doesn't regard you as a "trusted" user, it will permit
the C<-f> but also add an "X-Authentication-Warning" header to the message
-to indicate a forged envelope. To avoid this, you can either
-(1) have SetSender be false, or
-(2) make yourself a trusted user by adding a C<T> configuration
- command to your I<sendmail.cf> file
+to indicate a forged envelope. To avoid this, you can either
+(1) have SetSender be false, or
+(2) make yourself a trusted user by adding a C<T> configuration
+ command to your I<sendmail.cf> file
(e.g.: C<Teryq> if the script is running as user "eryq").
=item FromSender
-If defined, this is identical to setting SetSender to true,
-except that instead of looking at the "From:" field we use
+If defined, this is identical to setting SetSender to true,
+except that instead of looking at the "From:" field we use
the address given by this option.
Thus:
@@ -2538,110 +2653,331 @@ Thus:
=back
+After sending, the method last_send_successful() can be used to determine
+if the send was succesful or not.
+
=cut
+sub _unfold_stupid_params {
+ my $self = shift;
+
+ my %p;
+ STUPID_PARAM: for (my $i = 0; $i < @_; $i++) { ## no critic Loop
+ my $item = $_[$i];
+ if (not ref $item) {
+ $p{ $item } = $_[ ++$i ];
+ } elsif (UNIVERSAL::isa($item, 'HASH')) {
+ $p{ $_ } = $item->{ $_ } for keys %$item;
+ } elsif (UNIVERSAL::isa($item, 'ARRAY')) {
+ for (my $j = 0; $j < @$item; $j += 2) {
+ $p{ $item->[ $j ] } = $item->[ $j + 1 ];
+ }
+ }
+ }
+
+ return %p;
+}
+
sub send_by_sendmail {
my $self = shift;
+ my $return;
+ if ( @_ == 1 and !ref $_[0] ) {
+ ### Use the given command...
+ my $sendmailcmd = shift @_;
+ Carp::croak "No sendmail command available" unless $sendmailcmd;
+
+ ### Do it:
+ local *SENDMAIL;
+ open SENDMAIL, "|$sendmailcmd" or Carp::croak "open |$sendmailcmd: $!\n";
+ $self->print( \*SENDMAIL );
+ close SENDMAIL;
+ $return = ( ( $? >> 8 ) ? undef: 1 );
+ } else { ### Build the command...
+ my %p = $self->_unfold_stupid_params(@_);
+
+ $p{Sendmail} = $SENDMAIL unless defined $p{Sendmail};
+
+ ### Start with the command and basic args:
+ my @cmd = ( $p{Sendmail}, @{ $p{BaseArgs} || [ '-t', '-oi', '-oem' ] } );
+
+ ### See if we are forcibly setting the sender:
+ $p{SetSender} ||= defined( $p{FromSender} );
+
+ ### Add the -f argument, unless we're explicitly told NOT to:
+ if ( $p{SetSender} ) {
+ my $from = $p{FromSender} || ( $self->get('From') )[0];
+ if ($from) {
+ my ($from_addr) = extract_full_addrs($from);
+ push @cmd, "-f$from_addr" if $from_addr;
+ }
+ }
- if (@_ == 1) { ### Use the given command...
- my $sendmailcmd = shift @_;
-
- ### Do it:
- open SENDMAIL, "|$sendmailcmd" or Carp::croak "open |$sendmailcmd: $!\n";
- $self->print(\*SENDMAIL);
- close SENDMAIL;
- return (($? >> 8) ? undef : 1);
- }
- else { ### Build the command...
- my %p = @_;
- $p{Sendmail} ||= "/usr/lib/sendmail";
-
- ### Start with the command and basic args:
- my @cmd = ($p{Sendmail}, @{$p{BaseArgs} || ['-t', '-oi', '-oem']});
-
- ### See if we are forcibly setting the sender:
- $p{SetSender} = 1 if defined($p{FromSender});
-
- ### Add the -f argument, unless we're explicitly told NOT to:
- unless (exists($p{SetSender}) and !$p{SetSender}) {
- my $from = $p{FromSender} || ($self->get('From'))[0];
- if ($from) {
- my ($from_addr) = extract_addrs($from);
- push @cmd, "-f$from_addr" if $from_addr;
- }
- }
-
- ### Open the command in a taint-safe fashion:
- my $pid = open SENDMAIL, "|-";
- defined($pid) or die "open of pipe failed: $!\n";
- if (!$pid) { ### child
- exec(@cmd) or die "can't exec $p{Sendmail}: $!\n";
- ### NOTREACHED
- }
- else { ### parent
- $self->print(\*SENDMAIL);
- close SENDMAIL || die "error closing $p{Sendmail}: $! (exit $?)\n";
- return 1;
- }
+ ### Open the command in a taint-safe fashion:
+ my $pid = open SENDMAIL, "|-";
+ defined($pid) or die "open of pipe failed: $!\n";
+ if ( !$pid ) { ### child
+ exec(@cmd) or die "can't exec $p{Sendmail}: $!\n";
+ ### NOTREACHED
+ } else { ### parent
+ $self->print( \*SENDMAIL );
+ close SENDMAIL || die "error closing $p{Sendmail}: $! (exit $?)\n";
+ $return = 1;
+ }
}
+ return $self->{last_send_successful} = $return;
}
#------------------------------
-=item send_by_smtp ARGS...
+=item send_by_smtp HOST, ARGS...
+
+=item send_by_smtp REF, HOST, ARGS
I<Instance method.>
-Send message via SMTP, using Net::SMTP.
-The optional ARGS are sent into Net::SMTP::new(): usually, these are
+Send message via SMTP, using Net::SMTP.
- MAILHOST, OPTION=>VALUE, ...
+HOST is the name of SMTP server to connect to, or undef to have
+L<Net::SMTP|Net::SMTP> use the defaults in Libnet.cfg.
-Note that the list of recipients is taken from the
-"To", "Cc" and "Bcc" fields.
+ARGS are a list of key value pairs which may be selected from the list
+below. Many of these are just passed through to specific
+L<Net::SMTP|Net::SMTP> commands and you should review that module for
+details.
-Returns true on success, false or exception on error.
+Please see L<Good-vs-bad email addresses with send_by_smtp()|/Good-vs-bad email addresses with send_by_smtp()>
+
+=over 4
+
+=item Hello
+
+=item LocalAddr
+
+=item LocalPort
+
+=item Timeout
+
+=item ExactAddresses
+
+=item Debug
+
+See L<Net::SMTP::new()|Net::SMTP/"mail"> for details.
+
+=item Size
+
+=item Return
+
+=item Bits
+
+=item Transaction
+
+=item Envelope
+
+See L<Net::SMTP::mail()|Net::SMTP/mail> for details.
+
+=item SkipBad
+
+If true doesnt throw an error when multiple email addresses are provided
+and some are not valid. See L<Net::SMTP::recipient()|Net::SMTP/recipient>
+for details.
+
+=item AuthUser
+
+Authenticate with L<Net::SMTP::auth()|Net::SMTP/auth> using this username.
+
+=item AuthPass
+
+Authenticate with L<Net::SMTP::auth()|Net::SMTP/auth> using this password.
+
+=item NoAuth
+
+Normally if AuthUser and AuthPass are defined MIME::Lite will attempt to
+use them with the L<Net::SMTP::auth()|Net::SMTP/auth> command to
+authenticate the connection, however if this value is true then no
+authentication occurs.
+
+=item To
+
+Sets the addresses to send to. Can be a string or a reference to an
+array of strings. Normally this is extracted from the To: (and Cc: and
+Bcc: fields if $AUTO_CC is true).
+
+This value overrides that.
+
+=item From
+
+Sets the email address to send from. Normally this value is extracted
+from the Return-Path: or From: field of the mail itself (in that order).
+
+This value overides that.
+
+=back
+
+I<Returns:>
+True on success, croaks with an error message on failure.
+
+After sending, the method last_send_successful() can be used to determine
+if the send was succesful or not.
+
+=cut
+
+
+# Derived from work by Andrew McRae. Version 0.2 anm 09Sep97
+# Copyright 1997 Optimation New Zealand Ltd.
+# May be modified/redistributed under the same terms as Perl.
+
+# external opts
+my @_mail_opts = qw( Size Return Bits Transaction Envelope );
+my @_recip_opts = qw( SkipBad );
+my @_net_smtp_opts = qw( Hello LocalAddr LocalPort Timeout
+ ExactAddresses Debug );
+# internal: qw( NoAuth AuthUser AuthPass To From Host);
+
+sub __opts {
+ my $args=shift;
+ return map { exists $args->{$_} ? ( $_ => $args->{$_} ) : () } @_;
+}
+
+sub send_by_smtp {
+ require Net::SMTP;
+ my ($self,$hostname,%args) = @_;
+ # We may need the "From:" and "To:" headers to pass to the
+ # SMTP mailer also.
+ $self->{last_send_successful}=0;
+
+ my @hdr_to = extract_only_addrs( scalar $self->get('To') );
+ if ($AUTO_CC) {
+ foreach my $field (qw(Cc Bcc)) {
+ push @hdr_to, extract_only_addrs($_) for $self->get($field);
+ }
+ }
+ Carp::croak "send_by_smtp: nobody to send to for host '$hostname'?!\n"
+ unless @hdr_to;
+
+ $args{To} ||= \@hdr_to;
+ $args{From} ||= extract_only_addrs( scalar $self->get('Return-Path') );
+ $args{From} ||= extract_only_addrs( scalar $self->get('From') ) ;
+
+ # Create SMTP client.
+ # MIME::Lite::SMTP is just a wrapper giving a print method
+ # to the SMTP object.
+
+ my %opts = __opts(\%args, @_net_smtp_opts);
+ my $smtp = MIME::Lite::SMTP->new( $hostname, %opts )
+ or Carp::croak "SMTP Failed to connect to mail server: $!\n";
+
+ # Possibly authenticate
+ if ( defined $args{AuthUser} and defined $args{AuthPass}
+ and !$args{NoAuth} )
+ {
+ if ($smtp->supports('AUTH',500,["Command unknown: 'AUTH'"])) {
+ $smtp->auth( $args{AuthUser}, $args{AuthPass} )
+ or die "SMTP auth() command failed: $!\n"
+ . $smtp->message . "\n";
+ } else {
+ die "SMTP auth() command not supported on $hostname\n";
+ }
+ }
+
+ # Send the mail command
+ %opts = __opts( \%args, @_mail_opts);
+ $smtp->mail( $args{From}, %opts ? \%opts : () )
+ or die "SMTP mail() command failed: $!\n"
+ . $smtp->message . "\n";
+
+ # Send the recipients command
+ %opts = __opts( \%args, @_recip_opts);
+ $smtp->recipient( @{ $args{To} }, %opts ? \%opts : () )
+ or die "SMTP recipient() command failed: $!\n"
+ . $smtp->message . "\n";
+
+ # Send the data
+ $smtp->data()
+ or die "SMTP data() command failed: $!\n"
+ . $smtp->message . "\n";
+ $self->print_for_smtp($smtp);
+
+ # Finish the mail
+ $smtp->dataend()
+ or Carp::croak "Net::CMD (Net::SMTP) DATAEND command failed.\n"
+ . "Last server message was:"
+ . $smtp->message
+ . "This probably represents a problem with newline encoding ";
+
+ # terminate the session
+ $smtp->quit;
+
+ return $self->{last_send_successful} = 1;
+}
+
+=item last_send_successful
+
+This method will return TRUE if the last send() or send_by_XXX() method call was
+successful. It will return defined but false if it was not successful, and undefined
+if the object had not been used to send yet.
=cut
+
+sub last_send_successful {
+ my $self = shift;
+ return $self->{last_send_successful};
+}
+
+
### Provided by Andrew McRae. Version 0.2 anm 09Sep97
### Copyright 1997 Optimation New Zealand Ltd.
### May be modified/redistributed under the same terms as Perl.
-#
-sub send_by_smtp {
- my ($self, @args) = @_;
-
+### Aditional changes by Yves.
+### Until 3.01_03 this was send_by_smtp()
+sub send_by_smtp_simple {
+ my ( $self, @args ) = @_;
+ $self->{last_send_successful} = 0;
### We need the "From:" and "To:" headers to pass to the SMTP mailer:
- my $hdr = $self->fields();
- my $from = $self->get('From');
- my $to = $self->get('To');
+ my $hdr = $self->fields();
+
+ my $from_header = $self->get('From');
+ my ($from) = extract_only_addrs($from_header);
+
+ warn "M::L>>> $from_header => $from" if $MIME::Lite::DEBUG;
+
+
+ my $to = $self->get('To');
### Sanity check:
- defined($to) or Carp::croak "send_by_smtp: missing 'To:' address\n";
-
+ defined($to)
+ or Carp::croak "send_by_smtp: missing 'To:' address\n";
+
### Get the destinations as a simple array of addresses:
- my @to_all = extract_addrs($to);
+ my @to_all = extract_only_addrs($to);
if ($AUTO_CC) {
- foreach my $field (qw(Cc Bcc)) {
- my $value = $self->get($field);
- push @to_all, extract_addrs($value) if defined($value);
- }
+ foreach my $field (qw(Cc Bcc)) {
+ my $value = $self->get($field);
+ push @to_all, extract_only_addrs($value)
+ if defined($value);
+ }
}
### Create SMTP client:
require Net::SMTP;
my $smtp = MIME::Lite::SMTP->new(@args)
- or Carp::croak("Failed to connect to mail server: $!\n");
+ or Carp::croak("Failed to connect to mail server: $!\n");
$smtp->mail($from)
- or Carp::croak("SMTP MAIL command failed: $!\n".$smtp->message."\n");
+ or Carp::croak( "SMTP MAIL command failed: $!\n" . $smtp->message . "\n" );
$smtp->to(@to_all)
- or Carp::croak("SMTP RCPT command failed: $!\n".$smtp->message."\n");
+ or Carp::croak( "SMTP RCPT command failed: $!\n" . $smtp->message . "\n" );
$smtp->data()
- or Carp::croak("SMTP DATA command failed: $!\n".$smtp->message."\n");
+ or Carp::croak( "SMTP DATA command failed: $!\n" . $smtp->message . "\n" );
### MIME::Lite can print() to anything with a print() method:
$self->print_for_smtp($smtp);
- $smtp->dataend();
+
+ $smtp->dataend()
+ or Carp::croak( "Net::CMD (Net::SMTP) DATAEND command failed.\n"
+ . "Last server message was:"
+ . $smtp->message
+ . "This probably represents a problem with newline encoding " );
$smtp->quit;
+ $self->{last_send_successful} = 1;
1;
}
@@ -2653,23 +2989,25 @@ sub send_by_smtp {
# Send the message via an anonymous subroutine.
#
sub send_by_sub {
- my ($self, $subref, @args) = @_;
- &$subref($self, @args);
+ my ( $self, $subref, @args ) = @_;
+ $self->{last_send_successful} = &$subref( $self, @args );
+
}
#------------------------------
=item sendmail COMMAND...
-I<Class method, DEPRECATED.>
+I<Class method, DEPRECATED.>
Declare the sender to be "sendmail", and set up the "sendmail" command.
I<You should use send() instead.>
=cut
+
sub sendmail {
my $self = shift;
- $self->send('sendmail', join(' ', @_));
+ $self->send( 'sendmail', join( ' ', @_ ) );
}
=back
@@ -2677,7 +3015,6 @@ sub sendmail {
=cut
-
#==============================
#==============================
@@ -2687,11 +3024,12 @@ sub sendmail {
=cut
+
#------------------------------
=item quiet ONOFF
-I<Class method.>
+I<Class method.>
Suppress/unsuppress all warnings coming from this module.
MIME::Lite->quiet(1); ### I know what I'm doing
@@ -2702,6 +3040,7 @@ you should reconsider the whole line. C<;-)>
=cut
+
sub quiet {
my $class = shift;
$QUIET = shift if @_;
@@ -2713,7 +3052,6 @@ sub quiet {
=cut
-
#============================================================
package MIME::Lite::SMTP;
@@ -2726,8 +3064,35 @@ use strict;
use vars qw( @ISA );
@ISA = qw(Net::SMTP);
-sub print { shift->datasend(@_) }
+# some of the below is borrowed from Data::Dumper
+my %esc = ( "\a" => "\\a",
+ "\b" => "\\b",
+ "\t" => "\\t",
+ "\n" => "\\n",
+ "\f" => "\\f",
+ "\r" => "\\r",
+ "\e" => "\\e",
+);
+sub _hexify {
+ local $_ = shift;
+ my @split = m/(.{1,16})/gs;
+ foreach my $split (@split) {
+ ( my $txt = $split ) =~ s/([\a\b\t\n\f\r\e])/$esc{$1}/sg;
+ $split =~ s/(.)/sprintf("%02X ",ord($1))/sge;
+ print STDERR "M::L >>> $split : $txt\n";
+ }
+}
+
+sub print {
+ my $smtp = shift;
+ $MIME::Lite::DEBUG and _hexify( join( "", @_ ) );
+ $smtp->datasend(@_)
+ or Carp::croak( "Net::CMD (Net::SMTP) DATASEND command failed.\n"
+ . "Last server message was:"
+ . $smtp->message
+ . "This probably represents a problem with newline encoding " );
+}
#============================================================
@@ -2739,18 +3104,18 @@ package MIME::Lite::IO_Handle;
### Wrap a non-object filehandle inside a blessed, printable interface:
### Does nothing if the given $fh is already a blessed object.
sub wrap {
- my ($class, $fh) = @_;
+ my ( $class, $fh ) = @_;
no strict 'refs';
### Get default, if necessary:
- $fh or $fh = select; ### no filehandle means selected one
- ref($fh) or $fh = \*$fh; ### scalar becomes a globref
-
+ $fh or $fh = select; ### no filehandle means selected one
+ ref($fh) or $fh = \*$fh; ### scalar becomes a globref
+
### Stop right away if already a printable object:
- return $fh if (ref($fh) and (ref($fh) ne 'GLOB'));
+ return $fh if ( ref($fh) and ( ref($fh) ne 'GLOB' ) );
### Get and return a printable interface:
- bless \$fh, $class; ### wrap it in a printable interface
+ bless \$fh, $class; ### wrap it in a printable interface
}
### Print:
@@ -2768,15 +3133,14 @@ package MIME::Lite::IO_Scalar;
### Wrap a scalar inside a blessed, printable interface:
sub wrap {
- my ($class, $scalarref) = @_;
+ my ( $class, $scalarref ) = @_;
defined($scalarref) or $scalarref = \"";
bless $scalarref, $class;
}
### Print:
sub print {
- my $self = shift;
- $$self .= join('', @_);
+ ${$_[0]} .= join( '', @_[1..$#_] );
1;
}
@@ -2789,7 +3153,7 @@ package MIME::Lite::IO_ScalarArray;
### Wrap an array inside a blessed, printable interface:
sub wrap {
- my ($class, $arrayref) = @_;
+ my ( $class, $arrayref ) = @_;
defined($arrayref) or $arrayref = [];
bless $arrayref, $class;
}
@@ -2807,6 +3171,7 @@ __END__
#============================================================
+
=head1 NOTES
@@ -2814,17 +3179,17 @@ __END__
Apparently, some people are using mail readers which display the MIME
headers like "Content-disposition", and they want MIME::Lite not
-to generate them "because they look ugly".
+to generate them "because they look ugly".
Sigh.
Y'know, kids, those headers aren't just there for cosmetic purposes.
-They help ensure that the message is I<understood> correctly by mail
-readers. But okay, you asked for it, you got it...
-here's how you can suppress the standard MIME headers.
+They help ensure that the message is I<understood> correctly by mail
+readers. But okay, you asked for it, you got it...
+here's how you can suppress the standard MIME headers.
Before you send the message, do this:
- $msg->scrub;
+ $msg->scrub;
You can scrub() any part of a multipart message independently;
just be aware that it works recursively. Before you scrub,
@@ -2834,26 +3199,26 @@ note the rules that I follow:
=item Content-type
-You can safely scrub the "content-type" attribute if, and only if,
-the part is of type "text/plain" with charset "us-ascii".
+You can safely scrub the "content-type" attribute if, and only if,
+the part is of type "text/plain" with charset "us-ascii".
=item Content-transfer-encoding
-You can safely scrub the "content-transfer-encoding" attribute
+You can safely scrub the "content-transfer-encoding" attribute
if, and only if, the part uses "7bit", "8bit", or "binary" encoding.
-You are far better off doing this if your lines are under 1000
+You are far better off doing this if your lines are under 1000
characters. Generally, that means you I<can> scrub it for plain
text, and you can I<not> scrub this for images, etc.
=item Content-disposition
-You can safely scrub the "content-disposition" attribute
+You can safely scrub the "content-disposition" attribute
if you trust the mail reader to do the right thing when it decides
whether to show an attachment inline or as a link. Be aware
that scrubbing both the content-disposition and the content-type
means that there is no way to "recommend" a filename for the attachment!
-B<Note:> there are reports of brain-dead MUAs out there that
+B<Note:> there are reports of brain-dead MUAs out there that
do the wrong thing if you I<provide> the content-disposition.
If your attachments keep showing up inline or vice-versa,
try scrubbing this attribute.
@@ -2864,20 +3229,16 @@ You can always scrub "content-length" safely.
=back
-
=head2 How do I give my attachment a [different] recommended filename?
By using the Filename option (which is different from Path!):
- $msg->attach(Type => "image/gif",
- Path => "/here/is/the/real/file.GIF",
- Filename => "logo.gif");
+ $msg->attach(Type => "image/gif",
+ Path => "/here/is/the/real/file.GIF",
+ Filename => "logo.gif");
You should I<not> put path information in the Filename.
-
-
-
=head2 Benign limitations
This is "lite", after all...
@@ -2890,8 +3251,8 @@ There's no parsing. Get MIME-tools if you need to parse MIME messages.
=item *
-MIME::Lite messages are currently I<not> interchangeable with
-either Mail::Internet or MIME::Entity objects. This is a completely
+MIME::Lite messages are currently I<not> interchangeable with
+either Mail::Internet or MIME::Entity objects. This is a completely
separate module.
=item *
@@ -2905,15 +3266,18 @@ it's not in the MIME RFCs, it's an HTTP thing), this seems pretty fair.
=item *
MIME::Lite alone cannot help you lose weight. You must supplement
-your use of MIME::Lite with a healthy diet and exercise.
+your use of MIME::Lite with a healthy diet and exercise.
=back
=head2 Cheap and easy mailing
-I thought putting in a default "sendmail" invocation wasn't too bad an
-idea, since a lot of Perlers are on UNIX systems.
+I thought putting in a default "sendmail" invocation wasn't too bad an
+idea, since a lot of Perlers are on UNIX systems. (As of version 3.02 this is
+default only on Non-Win32 boxen. On Win32 boxen the default is to use SMTP and the
+defaults specified in the site/lib/Net/libnet.cfg)
+
The out-of-the-box configuration is:
MIME::Lite->send('sendmail', "/usr/lib/sendmail -t -oi -oem");
@@ -2921,10 +3285,10 @@ The out-of-the-box configuration is:
By the way, these arguments to sendmail are:
-t Scan message for To:, Cc:, Bcc:, etc.
-
+
-oi Do NOT treat a single "." on a line as a message terminator.
As in, "-oi vey, it truncated my message... why?!"
-
+
-oem On error, mail back the message (I assume to the
appropriate address, given in the header).
When mail returns, circle is complete. Jai Guru Deva -oem.
@@ -2940,20 +3304,22 @@ diddling with the envelope by instead specifying:
MIME::Lite->send('sendmail', SetSender=>0);
And, if you're not on a Unix system, or if you'd just rather send mail
-some other way, there's always:
+some other way, there's always SMTP, which these days probably requires
+authentication so you probably need to say
- MIME::Lite->send('smtp', "smtp.myisp.net");
+ MIME::Lite->send('smtp', "smtp.myisp.net",
+ AuthUser=>"YourName",AuthPass=>"YourPass" );
Or you can set up your own subroutine to call.
-In any case, check out the L<send()|/send> method.
-
+In any case, check out the L<send()|/send> method.
=head1 WARNINGS
=head2 Good-vs-bad email addresses with send_by_smtp()
-If using L<send_by_smtp()|/send_by_smtp>, be aware that you are
+If using L<send_by_smtp()|/send_by_smtp>, be aware that unless you
+explicitly provide the email addresses to send to and from you will be
forcing MIME::Lite to extract email addresses out of a possible list
provided in the C<To:>, C<Cc:>, and C<Bcc:> fields. This is tricky
stuff, and as such only the following sorts of addresses will work
@@ -2963,17 +3329,20 @@ reliably:
full.name@some.host.com
"Name, Full" <full.name@some.host.com>
-This last form is discouraged because SMTP must be able to get
-at the I<name> or I<name@domain> portion.
-
B<Disclaimer:>
MIME::Lite was never intended to be a Mail User Agent, so please
don't expect a full implementation of RFC-822. Restrict yourself to
the common forms of Internet addresses described herein, and you should
be fine. If this is not feasible, then consider using MIME::Lite
-to I<prepare> your message only, and using Net::SMTP explicitly to
+to I<prepare> your message only, and using Net::SMTP explicitly to
I<send> your message.
+B<Note:>
+As of MIME::Lite v3.02 the mail name extraction routines have been
+beefed up considerably. Furthermore if Mail::Address if provided then
+name extraction is done using that. Accordingly the above advice is now
+less true than it once was. Funky email names I<should> work properly
+now. However the disclaimer remains. Patches welcome. :-)
=head2 Formatting of headers delayed until print()
@@ -2985,20 +3354,20 @@ to actually print the darn thing.
=head2 Encoding of data delayed until print()
-When you specify message bodies
-(in L<build()|/build> or L<attach()|/attach>) --
-whether by B<FH>, B<Data>, or B<Path> -- be warned that we don't
-attempt to open files, read filehandles, or encode the data until
-L<print()|/print> is invoked.
+When you specify message bodies
+(in L<build()|/build> or L<attach()|/attach>) --
+whether by B<FH>, B<Data>, or B<Path> -- be warned that we don't
+attempt to open files, read filehandles, or encode the data until
+L<print()|/print> is invoked.
In the past, this created some confusion for users of sendmail
-who gave the wrong path to an attachment body, since enough of
-the print() would succeed to get the initial part of the message out.
+who gave the wrong path to an attachment body, since enough of
+the print() would succeed to get the initial part of the message out.
Nowadays, $AUTO_VERIFY is used to spot-check the Paths given before
the mail facility is employed. A whisker slower, but tons safer.
-Note that if you give a message body via FH, and try to print()
-a message twice, the second print() will not do the right thing
+Note that if you give a message body via FH, and try to print()
+a message twice, the second print() will not do the right thing
unless you explicitly rewind the filehandle.
You can get past these difficulties by using the B<ReadNow> option,
@@ -3007,19 +3376,19 @@ provided that you have enough memory to handle your messages.
=head2 MIME attributes are separate from header fields!
-B<Important:> the MIME attributes are stored and manipulated separately
-from the message header fields; when it comes time to print the
+B<Important:> the MIME attributes are stored and manipulated separately
+from the message header fields; when it comes time to print the
header out, I<any explicitly-given header fields override the ones that
would be created from the MIME attributes.> That means that this:
### DANGER ### DANGER ### DANGER ### DANGER ### DANGER ###
$msg->add("Content-type", "text/html; charset=US-ASCII");
-will set the exact C<"Content-type"> field in the header I write,
+will set the exact C<"Content-type"> field in the header I write,
I<regardless of what the actual MIME attributes are.>
I<This feature is for experienced users only,> as an escape hatch in case
-the code that normally formats MIME header fields isn't doing what
+the code that normally formats MIME header fields isn't doing what
you need. And, like any escape hatch, it's got an alarm on it:
MIME::Lite will warn you if you attempt to C<set()> or C<replace()>
any MIME header field. Use C<attr()> instead.
@@ -3028,15 +3397,15 @@ any MIME header field. Use C<attr()> instead.
=head2 Beware of lines consisting of a single dot
Julian Haight noted that MIME::Lite allows you to compose messages
-with lines in the body consisting of a single ".".
-This is true: it should be completely harmless so long as "sendmail"
+with lines in the body consisting of a single ".".
+This is true: it should be completely harmless so long as "sendmail"
is used with the -oi option (see L<"Cheap and easy mailing">).
However, I don't know if using Net::SMTP to transfer such a message
is equally safe. Feedback is welcomed.
-My perspective: I don't want to magically diddle with a user's
-message unless absolutely positively necessary.
+My perspective: I don't want to magically diddle with a user's
+message unless absolutely positively necessary.
Some users may want to send files with "." alone on a line;
my well-meaning tinkering could seriously harm them.
@@ -3045,7 +3414,7 @@ my well-meaning tinkering could seriously harm them.
Stefan Sautter noticed a bug in 2.106 where a m//gc match was
failing due to tainted data, leading to an infinite loop inside
-MIME::Lite.
+MIME::Lite.
I am attempting to correct for this, but be advised that my fix will
silently untaint the data (given the context in which the problem
@@ -3062,15 +3431,12 @@ Global configuration variables are bad, and should go away.
Until they do, please follow the hints with each setting
on how I<not> to change it.
-
-
-
=head1 A MIME PRIMER
=head2 Content types
-The "Type" parameter of C<build()> is a I<content type>.
-This is the actual type of data you are sending.
+The "Type" parameter of C<build()> is a I<content type>.
+This is the actual type of data you are sending.
Generally this is a string of the form C<"majortype/minortype">.
Here are the major MIME types.
@@ -3080,8 +3446,8 @@ A more-comprehensive listing may be found in RFC-2046.
=item application
-Data which does not fit in any of the other categories, particularly
-data to be processed by some type of application program.
+Data which does not fit in any of the other categories, particularly
+data to be processed by some type of application program.
C<application/octet-stream>, C<application/gzip>, C<application/postscript>...
=item audio
@@ -3130,13 +3496,13 @@ A more-comprehensive listing may be found in RFC-2045.
=item 7bit
Basically, no I<real> encoding is done. However, this label guarantees that no
-8-bit characters are present, and that lines do not exceed 1000 characters
+8-bit characters are present, and that lines do not exceed 1000 characters
in length.
=item 8bit
-Basically, no I<real> encoding is done. The message might contain 8-bit
-characters, but this encoding guarantees that lines do not exceed 1000
+Basically, no I<real> encoding is done. The message might contain 8-bit
+characters, but this encoding guarantees that lines do not exceed 1000
characters in length.
=item binary
@@ -3144,384 +3510,137 @@ characters in length.
No encoding is done at all. Message might contain 8-bit characters,
and lines might be longer than 1000 characters long.
-The most liberal, and the least likely to get through mail gateways.
+The most liberal, and the least likely to get through mail gateways.
Use sparingly, or (better yet) not at all.
=item base64
Like "uuencode", but very well-defined. This is how you should send
-essentially binary information (tar files, GIFs, JPEGs, etc.).
+essentially binary information (tar files, GIFs, JPEGs, etc.).
=item quoted-printable
-Useful for encoding messages which are textual in nature, yet which contain
+Useful for encoding messages which are textual in nature, yet which contain
non-ASCII characters (e.g., Latin-1, Latin-2, or any other 8-bit alphabet).
=back
+=cut
-=head1 VERSION
-
-$Id$
-
-
-=head1 CHANGE LOG
-
-=over 4
-
-
-=item Version 2.117 (2001/08/20)
-
-The terms-of-use have been placed in the distribution file "COPYING".
-Also, small documentation tweaks were made.
-
-
-=item Version 2.116 (2001/08/17)
-
-Added long-overdue patch which makes the instance method form
-of send() do the right thing when given HOW... arguments.
-I<Thanks to Casey West for the patch.>
-
-=item Version 2.114 (2001/08/16)
-
-New special 'AUTO' content type in new()/build() tells MIME::Lite to
-try and guess the type from file extension. To make use of
-this, you'll want to install B<MIME::Types>.
-The "AUTO" setting can be made the default default (instead of "TEXT")
-if you set C<$AUTO_CONTENT_TYPE = 1, $PARANOID = 0>.
-I<Thanks to> Ville SkyttE<#228> I<for these patches.>
-
-File::Basename is used if it is available.
-I<Thanks to> Ville SkyttE<#228> I<for this patch.>
-
-SMTP failures (in send_by_smtp) now add the $smtp-E<gt>message to the
-croak'ed exception, so if things go wrong, you get a better
-idea of what and why.
-I<Thanks to Thomas R. Wyant III for the patch.>
-
-Made a subtle change to C<as_string> which supposedly fixes a
-failed MIME data.t test with Perl 5.004_04 on NT 4 sp6.
-The problem might only exist in this old perl, but as the patch
-author says, not everyone has climbed higher on the Perl ladder.
-I<Thanks to John Gotts for the patch.>
-
-Added C<contrib> directory, with F<MailTool.pm>.
-I<Thanks to Tom Wyant for this contribution.>
-
-Improved HTML documentation (notice the links to
-the individual methods in the top menu).
-
-Corrected some mis-docs.
-
-
-=item Version 2.111 (2001/04/03)
-
-Added long-overdue C<parts()> and C<parts_DFS()> methods.
-
- No instance method
- For accessing the subparts?
- That can't be right. D'OH!
-
-Added long-overdue auto-verify logic to C<print()> method.
-
-Added long-overdue C<preamble()> method for getting/setting
-the preamble text.
-I<Thanks to Jim Daigle for inspiring this.>
-
-
-=item Version 2.108 (2001/03/30)
-
-New C<field_order()> allows you to set the header order, both on a
-per-message basis, and package-wide.
-I<Thanks to Thomas Stromberg for suggesting this.>
-
-Added code to try and divine "sendmail" path more intelligently.
-I<Thanks to Slaven Rezic for the suggestion.>
-
-
-=item Version 2.107 (2001/03/27)
-
-Fixed serious bug where tainted data with quoted-printable encoding
-was causing infinite loops. The "fix" untaints the data in question,
-which is not optimal, but it's probably benign in this case.
-I<Thanks to Stefan Sautter for tracking this nasty little beast down.>
-I<Thanks to Larry Geralds for a related patch.>
-
- "Doctor, O doctor:
- it's painful when I do *this* --"
- "Simple: don't *do* that."
-
-Fixed bugs where a non-local C<$_> was being modified... again!
-Will I never learn?
-I<Thanks to Maarten Koskamp for reporting this.>
-
- Dollar-underscore
- can poison distant waters;
- 'local' must it be.
-
-Fixed buglet in C<add()> where all value references were being treated
-as arrayrefs, instead of as possibly-self-stringifying object refs.
-Now you can send in an object ref as the 2nd argument.
-I<Thanks to dLux for the bug report.>
-
- That ref is a string?
- Operator overload
- has ruined my day.
-
-Added "Approved" as an acceptable header field for C<new()>, as per RFC1036.
-I<Thanks to Thomax for the suggestion regarding MIME-tools.>
-
-Small improvements to docs to make different uses of attach()
-and various arguments clearer.
-I<Thanks to Sven Rassman and Roland Walter for the suggestions.>
-
-
-=item Version 2.106 (2000/11/21)
-
-Added Alpha version of scrub() to make it easy for people to suppress
-the printing of unwanted MIME attributes (like Content-length).
-I<Thanks to the many people who asked for this.>
-
-Headers with empty-strings for their values are no longer
-printed. This seems sensible, and helps us implement scrub().
-
-
-=item Version 2.105 (2000/10/14)
-
-The regression-test failure was identified, and it was my fault.
-Apparently some of the \-quoting in my "autoloaded" code was
-making Perl 5.6 unhappy. For this nesting-related idiocy,
-a nesting kaiku.
-I<Thanks to Scott Schwartz for identifying the problem.>
-
- In a pattern, my
- backslash-s dwells peacefully,
- unambiguous --
-
- but I embed it
- in a double-quoted string
- doubling the backslash --
-
- interpolating
- that same double-quoted string
- in other patterns --
-
- and, worlds within worlds,
- I single-quote the function
- to autoload it --
-
- changing the meaning
- of the backslash and the 's';
- and Five-Point-Six growls.
-
-
-=item Version 2.104 (2000/09/28)
-
-Now attempts to load and use Mail::Address for parsing email
-addresses I<before> falling back to our own method.
-I<Thanks to numerous people for suggesting this.>
-
- Parsing addresses
- is too damn hard. One last hope:
- Let Graham Barr do it!
-
-For the curious, the version of Mail::Address appears
-as the "A" number in the X-Mailer:
-
- X-Mailer: MIME::Lite 2.104 (A1.15; B2.09; Q2.03)
-
-Added B<FromSender> option to send_by_sendmail().
-I<Thanks to Bill Moseley for suggesting this feature.>
-
-
-=item Version 2.101 (2000/06/06)
-
-Major revision to print_body() and body_as_string() so that
-"body" really means "the part after the header", which is what most
-people would want in this context. This is B<not> how it was used
-1.x, where "body" only meant "the body of a simple singlepart".
-Hopefully, this change will solve many problems and create very few ones.
-
-Added support for attaching a part to a "message/rfc822", treating
-the "message" type as a multipart-like container.
-
-Now takes care not to include "Bcc:" in header when using send_by_smtp,
-as a safety precaution against qmail's behavior.
-I<Thanks to Tatsuhiko Miyagawa for identifying this problem.>
-
-Improved efficiency of many stringifying operations by using
-string-arrays which are joined, instead of doing multiple appends
-to a scalar.
-
-Cleaned up the "examples" directory.
-
-
-=item Version 1.147 (2000/06/02)
-
-Fixed buglet where lack of Cc:/Bcc: was causing extract_addrs
-to emit "undefined variable" warnings. Also, lack of a "To:" field
-now causes a croak.
-I<Thanks to David Mitchell for the bug report and suggested patch.>
-
-
-=item Version 1.146 (2000/05/18)
-
-Fixed bug in parsing of addresses; please read the WARNINGS section
-which describes recommended address formats for "To:", "Cc:", etc.
-Also added automatic inclusion of a UT "Date:" at top level unless
-explicitly told not to.
-I<Thanks to Andy Jacobs for the bug report and the suggestion.>
-
-=item Version 1.145 (2000/05/06)
-
-Fixed bug in encode_7bit(): a lingering C</e> modifier was removed.
-I<Thanks to Michael A. Chase for the patch.>
-
-
-=item Version 1.142 (2000/05/02)
-
-Added new, taint-safe invocation of "sendmail", one which also
-sets up the C<-f> option. Unfortunately, I couldn't make this automatic:
-the change could have broken a lot of code out there which used
-send_by_sendmail() with unusual "sendmail" variants.
-So you'll have to configure "send" to use the new mechanism:
-
- MIME::Lite->send('sendmail'); ### no args!
-
-I<Thanks to Jeremy Howard for suggesting these features.>
-
-
-=item Version 1.140 (2000/04/27)
-
-Fixed bug in support for "To", "Cc", and "Bcc" in send_by_smtp():
-multiple (comma-separated) addresses should now work fine.
-We try real hard to extract addresses from the flat text strings.
-I<Thanks to John Mason for motivating this change.>
-
-Added automatic verification that attached data files exist,
-done immediately before the "send" action is invoked.
-To turn this off, set $MIME::Lite::AUTO_VERIFY to false.
-
-=item Version 1.137 (2000/03/22)
-
-Added support for "Cc" and "Bcc" in send_by_smtp().
-To turn this off, set $MIME::Lite::AUTO_CC to false.
-I<Thanks to Lucas Maneos for the patch, and tons of others for
-the suggestion.>
-
-Chooses a better default content-transfer-encoding if the content-type
-is "image/*", "audio/*", etc.
-To turn this off, set $MIME::Lite::AUTO_ENCODE to false.
-I<Thanks to many folks for the suggestion.>
-
-Fixed bug in QP-encoding where a non-local C<$_> was being modified.
-I<Thanks to Jochen Stenzel for finding this very obscure bug!>
-
-Removed references to C<$`>, C<$'>, and C<$&> (bad variables
-which slow things down).
-
-Added an example of how to send HTML files with enclosed in-line
-images, per popular demand.
-
-
-=item Version 1.133 (1999/04/17)
-
-Fixed bug in "Data" handling: arrayrefs were not being handled
-properly.
-
-
-=item Version 1.130 (1998/12/14)
-
-Added much larger and more-flexible send() facility.
-I<Thanks to Andrew McRae (and Optimation New Zealand Ltd)
-for the Net::SMTP interface. Additional thanks to the many folks
-who requested this feature.>
-
-Added get() method for extracting basic attributes.
-
-New... "t" tests!
-
+=begin FOR_README_ONLY
-=item Version 1.124 (1998/11/13)
+=head1 INSTALLATION
-Folded in filehandle (FH) support in build/attach.
-I<Thanks to Miko O'Sullivan for the code.>
+Install using
+ perl makefile.pl
+ make test
+ make install
-=item Version 1.122 (1998/01/19)
+Adjust the make command as is appropriate for your OS.
+'nmake' is the usual name under Win32
-MIME::Base64 and MIME::QuotedPrint are used if available.
+In order to read the docmentation please use
-The 7bit encoding no longer does "escapes"; it merely strips 8-bit characters.
+ perldoc MIME::Lite
+from the command line or visit
-=item Version 1.121 (1997/04/08)
+ http://search.cpan.org/search?query=MIME%3A%3ALite&mode=all
-Filename attribute is now no longer ignored by build().
-I<Thanks to Ian Smith for finding and patching this bug.>
+for a list of all MIME::Lite related materials including the
+documentation in HTML of all of the released versions of
+MIME::Lite.
+=cut
-=item Version 1.120 (1997/03/29)
-Efficiency hack to speed up MIME::Lite::IO_Scalar.
-I<Thanks to David Aspinwall for the patch.>
+=end FOR_README_ONLY
+=cut
-=item Version 1.116 (1997/03/19)
-Small bug in our private copy of encode_base64() was patched.
-I<Thanks to Andreas Koenig for pointing this out.>
+=head1 HELPER MODULES
-New, prettier way of specifying mail message headers in C<build()>.
+MIME::Lite works nicely with other certain other modules if they are present.
+Good to have installed is the latest L<MIME::Types|MIME::Types>,
+L<Mail::Address|Mail::Address>, L<MIME::Base64|MIME::Base64>,
+L<MIME::QuotedPrint|MIME::QuotedPrint>.
-New quiet method to turn off warnings.
+If they aren't present then some functionality won't work, and other features
+wont be as efficient or up to date as they could be. Nevertheless they are optional
+extras.
-Changed "stringify" methods to more-standard "as_string" methods.
+=head1 BUNDLED GOODIES
+MIME::Lite comes with a number of extra files in the distribution bundle.
+This includes examples, and utility modules that you can use to get yourself
+started with the module.
-=item Version 1.112 (1997/03/06)
+The ./examples directory contains a number of snippets in prepared
+form, generally they are documented, but they should be easy to understand.
-Added C<read_now()>, and C<binmode()> method for our non-Unix-using brethren:
-file data is now read using binmode() if appropriate.
-I<Thanks to Xiangzhou Wang for pointing out this bug.>
+The ./contrib directory contains a companion/tool modules that come bundled
+with MIME::Lite, they dont get installed by default. Please review the POD they
+come with.
+=head1 BUGS
-=item Version 1.110 (1997/03/06)
+The whole reason that version 3.0 was released was to ensure that MIME::Lite
+is up to date and patched. If you find an issue please report it.
-Fixed bug in opening the data filehandle.
+As far as I know MIME::Lite doesnt currently have any serious bugs, but my usage
+is hardly comprehensive.
+Having said that there are a number of open issues for me, mostly caused by the progress
+in the community as whole since Eryq last released. The tests are based around an
+interesting but non standard test framework. I'd like to change it over to using
+Test::More.
-=item Version 1.102 (1997/03/01)
+Should tests fail please review the ./testout directory, and in any bug reports
+please include the output of the relevent file. This is the only redeeming feature
+of not using Test::More that I can see.
-Initial release.
+Bug fixes / Patches / Contribution are welcome, however I probably won't apply them
+unless they also have an associated test. This means that if I dont have the time to
+write the test the patch wont get applied, so please, include tests for any patches
+you provide.
+=head1 VERSION
-=item Version 1.101 (1997/03/01)
+Version: 3.01_06 (Dev Test Release)
-Baseline code.
-Originally created: 11 December 1996. Ho ho ho.
+=head1 CHANGE LOG
-=back
+Moved to ./changes.pod
+NOTE: Users of the "advanced features" of 3.01_0x smtp sending
+should take care: These features have been REMOVED as they never
+really fit the purpose of the module. Redundant SMTP delivery is
+a task that should be handled by another module.
=head1 TERMS AND CONDITIONS
-Copyright (c) 1997 by Eryq.
-Copyright (c) 1998 by ZeeGee Software Inc.
-All rights reserved. This program is free software; you can redistribute
-it and/or modify it under the same terms as Perl itself.
+ Copyright (c) 1997 by Eryq.
+ Copyright (c) 1998 by ZeeGee Software Inc.
+ Copyright (c) 2003,2005 Yves Orton. (demerphq)
+
+All rights reserved. This program is free software; you can
+redistribute it and/or modify it under the same terms as Perl
+itself.
This software comes with B<NO WARRANTY> of any kind.
See the COPYING file in the distribution for details.
-
=head1 NUTRITIONAL INFORMATION
For some reason, the US FDA says that this is now required by law
on any products that bear the name "Lite"...
- MIME::Lite |
+Version 3.0 is now new and improved! The distribution is now 30% smaller!
+
+ MIME::Lite |
------------------------------------------------------------
Serving size: | 1 module
Servings per container: | 1
@@ -3529,17 +3648,20 @@ on any products that bear the name "Lite"...
Fat: | 0g
Saturated Fat: | 0g
-Warning: for consumption by hardware only! May produce
+Warning: for consumption by hardware only! May produce
indigestion in humans if taken internally.
-
=head1 AUTHOR
Eryq (F<eryq@zeegee.com>).
President, ZeeGee Software Inc. (F<http://www.zeegee.com>).
-Go to F<http://www.zeegee.com> for the latest downloads
+Go to F<http://www.cpan.org> for the latest downloads
and on-line documentation for this module. Enjoy.
+Patches And Maintenance by Yves Orton and many others.
+Consult ./changes.pod
+
=cut
+

© 2014-2024 Faster IT GmbH | imprint | privacy policy