summaryrefslogtreecommitdiff
path: root/cpan
diff options
context:
space:
mode:
Diffstat (limited to 'cpan')
-rw-r--r--cpan/lib/Mail/Address.pm32
-rw-r--r--cpan/lib/Mail/Cap.pm84
-rw-r--r--cpan/lib/Mail/Field.pm12
-rw-r--r--cpan/lib/Mail/Field/AddrList.pm3
-rw-r--r--cpan/lib/Mail/Field/Date.pm2
-rw-r--r--cpan/lib/Mail/Filter.pm12
-rw-r--r--cpan/lib/Mail/Header.pm47
-rw-r--r--cpan/lib/Mail/Internet.pm30
-rw-r--r--cpan/lib/Mail/Mailer.pm77
-rw-r--r--cpan/lib/Mail/Mailer/qmail.pm9
-rw-r--r--cpan/lib/Mail/Mailer/rfc822.pm7
-rw-r--r--cpan/lib/Mail/Mailer/smtp.pm17
-rw-r--r--cpan/lib/Mail/Send.pm12
-rw-r--r--cpan/lib/Mail/Util.pm55
14 files changed, 246 insertions, 153 deletions
diff --git a/cpan/lib/Mail/Address.pm b/cpan/lib/Mail/Address.pm
index 74a6b580..6fa1f1c9 100644
--- a/cpan/lib/Mail/Address.pm
+++ b/cpan/lib/Mail/Address.pm
@@ -1,6 +1,6 @@
# Mail::Address.pm
#
-# Copyright (c) 1995-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# Copyright (c) 1995-2001 Graham Barr <gbarr@pobox.com>. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
@@ -11,7 +11,7 @@ use Carp;
use vars qw($VERSION);
use locale;
-$VERSION = "1.17";
+$VERSION = "1.52";
sub Version { $VERSION }
#
@@ -154,6 +154,8 @@ sub new {
sub parse {
my $pkg = shift;
+ my @line = grep { defined $_} @_;
+ my $line = join '', @line;
local $_;
@@ -162,10 +164,10 @@ sub parse {
my @address = ();
my @objs = ();
my $depth = 0;
- my $idx = 0;
- my $tokens = _tokenise(grep { defined $_} @_);
- my $len = scalar(@{$tokens});
- my $next = _find_next($idx,$tokens,$len);
+ my $idx = 0;
+ my $tokens = _tokenise(@line);
+ my $len = @$tokens;
+ my $next = _find_next($idx,$tokens,$len);
for( ; $idx < $len ; $idx++) {
$_ = $tokens->[$idx];
@@ -177,16 +179,10 @@ sub parse {
$depth++;
}
elsif($_ eq '>') {
- $depth-- if($depth);
- unless($depth) {
- my $o = _complete($pkg,\@phrase, \@address, \@comment);
- push(@objs, $o) if(defined $o);
- $depth = 0;
- $next = _find_next($idx,$tokens,$len);
- }
+ $depth-- if $depth;
}
elsif($_ eq ',') {
- warn "Unmatched '<>'" if($depth);
+ warn "Unmatched '<>' in $line" if($depth);
my $o = _complete($pkg,\@phrase, \@address, \@comment);
push(@objs, $o) if(defined $o);
$depth = 0;
@@ -198,11 +194,11 @@ sub parse {
elsif($next eq "<") {
push(@phrase,$_);
}
- elsif($_ =~ /\A[\Q.\@:;\E]\Z/ || !scalar(@address) || $address[$#address] =~ /\A[\Q.\@:;\E]\Z/) {
+ elsif( /\A[\Q.\@:;\E]\Z/ || !@address || $address[-1] =~ /\A[\Q.\@:;\E]\Z/) {
push(@address,$_);
}
else {
- warn "Unmatched '<>'" if($depth);
+ warn "Unmatched '<>' in $line" if($depth);
my $o = _complete($pkg,\@phrase, \@address, \@comment);
push(@objs, $o) if(defined $o);
$depth = 0;
@@ -412,11 +408,11 @@ Unimplemented yet but should return the UUCP canon for the message
=head1 AUTHOR
-Graham Barr <gbarr@pobox.com>
+Graham Barr. Maintained by Mark Overmeer <mailtools@overmeer.net>
=head1 COPYRIGHT
-Copyright (c) 1995-8 Graham Barr. All rights reserved. This program is free
+Copyright (c) 1995-2001 Graham Barr. All rights reserved. This program is free
software; you can redistribute it and/or modify it under the same terms
as Perl itself.
diff --git a/cpan/lib/Mail/Cap.pm b/cpan/lib/Mail/Cap.pm
index 3edac654..c9dbae45 100644
--- a/cpan/lib/Mail/Cap.pm
+++ b/cpan/lib/Mail/Cap.pm
@@ -1,11 +1,10 @@
-#
package Mail::Cap;
use strict;
use vars qw($VERSION $useCache);
-$VERSION = "1.07";
+$VERSION = "1.52";
sub Version { $VERSION; }
=head1 NAME
@@ -54,34 +53,84 @@ if($^O eq "MacOS") {
=head1 METHODS
-=head2 new()
+=head2 new(OPTIONS)
$mcap = new Mail::Cap;
$mcap = new Mail::Cap "/mydir/mailcap";
+ $mcap = new Mail::Cap filename => "/mydir/mailcap";
+ $mcap = new Mail::Cap take => 'ALL';
+ $mcap = Mail::Cap->new(take => 'ALL');
Create and initialize a new Mail::Cap object. If you give it an
argument it will try to parse the specified file. Without any
arguments it will search for the mailcap file using the standard
mailcap path, or the MAILCAPS environment variable if it is defined.
+There is currently two OPTION implemented:
+
+=over 4
+
+=item * take =E<gt> 'ALL'|'FIRST'
+
+Include all mailcap files you can find. By default, only the first
+file is parsed, however the RFC tells us to include ALL. To maintain
+backwards compatibility, the default only takes the FIRST.
+
+=item * filename =E<gt> FILENAME
+
+Add the specified file to the list to standard locations. This file
+is tried first.
+
+=back
+
=cut
sub new
{
- my($class, $file) = @_;
- unless (defined $file) {
- for (@path) {
- if (-r $_) {
- $file = $_;
- last;
+ my $class = shift;
+
+ if(@_ % 2 == 1) {unshift @_, 'filename'}
+ my %args = @_;
+
+ my $take_all = $args{take} && uc $args{take} eq 'ALL';
+
+ my $self = bless {}, $class;
+ $self->{_count} = 0;
+
+ if (defined($args{filename}) && -r $args{filename}) {
+ $self->_process_file($args{filename});
+ }
+
+ if ( !defined($args{filename}) || $take_all)
+ { my $fname;
+ foreach $fname (@path) {
+ if (-r $fname) {
+ $self->_process_file($fname);
+ last unless $take_all;
}
}
}
- my $self = bless {}, $class;
+
+ unless ($self->{_count}) {
+ # Set up default mailcap
+ $self->{'audio/*'} = [{'view' => "showaudio %s"}];
+ $self->{'image/*'} = [{'view' => "xv %s"}];
+ $self->{'message/rfc822'} = [{'view' => "xterm -e metamail %s"}];
+ }
+
+ $self;
+}
+
+sub _process_file
+{
+ my $self = shift;
+ my $file = shift;
+ unless($file) { return;}
+
local *MAILCAP;
- if (defined $file && open(MAILCAP, $file)) {
+ if(open(MAILCAP, $file)) {
$self->{'_file'} = $file;
- local($_);
+ local($_);
while (<MAILCAP>) {
next if /^\s*#/; # comment
next if /^\s*$/; # blank line
@@ -117,17 +166,12 @@ sub new
# record this entry
unless (exists $self->{$type}) {
$self->{$type} = [];
+ $self->{_count}++;
}
push(@{$self->{$type}}, \%field);
}
close(MAILCAP);
- } else {
- # Set up default mailcap
- $self->{'audio/*'} = [{'view' => "showaudio %s"}];
- $self->{'image/*'} = [{'view' => "xv %s"}];
- $self->{'message/rfc822'} = [{'view' => "xterm -e metamail %s"}];
}
- $self;
}
=head2 view($type, $file)
@@ -330,7 +374,9 @@ modify it under the same terms as Perl itself.
Gisle Aas <aas@oslonett.no>
-Maintained by Graham Barr <gbarr@pobox.com>
+Modified by Graham Barr <gbarr@pobox.com>
+
+Maintained by Mark Overmeer <mailtools@overmeer.net>
=cut
diff --git a/cpan/lib/Mail/Field.pm b/cpan/lib/Mail/Field.pm
index eea94c00..50ba5ad6 100644
--- a/cpan/lib/Mail/Field.pm
+++ b/cpan/lib/Mail/Field.pm
@@ -1,6 +1,6 @@
# Mail::Field.pm
#
-# Copyright (c) 1995-2000 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# Copyright (c) 1995-2001 Graham Barr. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
@@ -12,7 +12,7 @@ use Carp;
use strict;
use vars qw($AUTOLOAD $VERSION);
-$VERSION = "1.08";
+$VERSION = "1.52";
unless(defined &UNIVERSAL::can) {
*UNIVERSAL::can = sub {
@@ -485,7 +485,9 @@ C<_header_pkg_name> subroutine in C<Mail::Field>
=head1 AUTHOR
-Graham Barr <gbarr@pobox.com>
+Graham Barr.
+
+Maintained by Mark Overmeer <mailtools@overmeer.net>
=head1 SEE ALSO
@@ -494,11 +496,11 @@ L<MIME::*>s
=head1 CREDITS
Eryq <eryq@rhine.gsfc.nasa.gov> - for all the help in defining this package
-so that Mail::* and MIME::* can be integrated together.
+so that C<Mail::*> and C<MIME::*> can be integrated together.
=head1 COPYRIGHT
-Copyright (c) 1995-2000 Graham Barr. All rights reserved. This program is free
+Copyright (c) 1995-2001 Graham Barr. All rights reserved. This program is free
software; you can redistribute it and/or modify it under the same terms
as Perl itself.
diff --git a/cpan/lib/Mail/Field/AddrList.pm b/cpan/lib/Mail/Field/AddrList.pm
index fa6a0d5c..950385c4 100644
--- a/cpan/lib/Mail/Field/AddrList.pm
+++ b/cpan/lib/Mail/Field/AddrList.pm
@@ -38,6 +38,7 @@ To, From, Cc, Reply-To and Sender.
Peter Orbaek <poe@cit.dk> 26-Feb-97
Modified by Graham Barr <gbarr@pobox.com>
+Maintained by Mark Overmeer <mailtools@overmeer.net>
=cut
@@ -48,7 +49,7 @@ use Carp;
use Mail::Address;
@ISA = qw(Mail::Field);
-$VERSION = '1.0';
+$VERSION = '1.52';
# install header interpretation, see Mail::Field
INIT: {
diff --git a/cpan/lib/Mail/Field/Date.pm b/cpan/lib/Mail/Field/Date.pm
index a90d431a..49db8a17 100644
--- a/cpan/lib/Mail/Field/Date.pm
+++ b/cpan/lib/Mail/Field/Date.pm
@@ -15,7 +15,7 @@ use Date::Format qw(time2str);
use Date::Parse qw(str2time);
@ISA = qw(Mail::Field);
-$VERSION = do { my @r=(q$Revision$=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
+$VERSION = '1.52';
bless([])->register('Date');
diff --git a/cpan/lib/Mail/Filter.pm b/cpan/lib/Mail/Filter.pm
index 1101084a..b0f3aba5 100644
--- a/cpan/lib/Mail/Filter.pm
+++ b/cpan/lib/Mail/Filter.pm
@@ -1,7 +1,7 @@
# Mail::Filter.pm
#
-# Copyright (c) 1997 Graham Barr <gbarr@pobox.com>. All rights
-# reserved. This program is free software; you can redistribute it and/or
+# Copyright (c) 1997-2001 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
package Mail::Filter;
@@ -10,7 +10,7 @@ use Carp;
use strict;
use vars qw($VERSION);
-$VERSION = "1.01";
+$VERSION = "1.52";
sub new {
my $self = shift;
@@ -169,11 +169,13 @@ L<Mail::Folder>
=head1 AUTHOR
-Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
+Graham Barr.
+
+Maintained by Mark Overmeer <mailtools@overmeer.net>
=head1 COPYRIGHT
-Copyright (c) 1997 Graham Barr. All rights reserved. This program is free
+Copyright (c) 1997-2001 Graham Barr. All rights reserved. This program is free
software; you can redistribute it and/or modify it under the same terms
as Perl itself.
diff --git a/cpan/lib/Mail/Header.pm b/cpan/lib/Mail/Header.pm
index e4fd8af6..ca864212 100644
--- a/cpan/lib/Mail/Header.pm
+++ b/cpan/lib/Mail/Header.pm
@@ -1,6 +1,6 @@
# Mail::Header.pm
#
-# Copyright (c) 1995-7 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# Copyright (c) 1995-2001 Graham Barr <gbarr@pobox.com>. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
@@ -19,7 +19,7 @@ use strict;
use Carp;
use vars qw($VERSION $FIELD_NAME);
-$VERSION = "1.19";
+$VERSION = "1.52";
my $MAIL_FROM = 'KEEP';
my %HDR_LENGTHS = ();
@@ -86,7 +86,7 @@ my %STRUCTURE;
Resent-Date Resent-From Resent-Sender Resent-To Return-Path
list-help list-post list-unsubscribe Mailing-List
Received References Message-ID In-Reply-To
- Content-Length Content-Type
+ Content-Length Content-Type Content-Disposition
Delivered-To
Lines
MIME-Version
@@ -112,7 +112,7 @@ sub _fold_line
if(length($_[0]) > $ml)
{
- if ($_[0] =~ /^([-\w]+)/ and exists $STRUCTURE{ lc $1 } )
+ if ($_[0] =~ /^([-\w]+)/ && exists $STRUCTURE{ lc $1 } )
{
#Split the line up
# first bias towards splitting at a , or a ; >4/5 along the line
@@ -135,14 +135,8 @@ sub _fold_line
}
else
{
- my $dif = $max-$min;
-
- $_[0] =~ s/(?:^|\G)
- (?:
- (.{$min,$max})\s+
- |(.{$min,$max})
- )
- /$+\n /xg;
+ $_[0] =~ s/(.{$min,$max})\s+/$+\n /g;
+ $_[0] =~ s/\s*$/\n/s;
}
}
@@ -160,10 +154,10 @@ sub _tag_case
$tag =~ s/:\Z//o;
- # Change the case of the tag
- # eq Message-Id
- $tag =~ s/\b([a-z]+)/\L\u$1/gio;
- $tag =~ s/\b([b-df-hj-np-tv-z]+|MIME)\b/\U$1/gio
+ # Change the casing of the tag, eg "Message-Id"
+ # Bug in unicode \U, perl 5.8.0 requires an extra \u
+ $tag =~ s/\b([a-z]+)/\L\u\u$1/gio;
+ $tag =~ s/\b([b-df-hj-np-tv-z]+|MIME)\b/\U\u$1/gio
if $tag =~ /-/;
$tag;
@@ -242,24 +236,24 @@ sub _insert
if($where < 0)
{
- $where = scalar(@{$me->{'mail_hdr_list'}}) + $where + 1;
+ $where = @{$me->{'mail_hdr_list'}} + $where + 1;
$where = 0
if($where < 0);
}
- elsif($where >= scalar(@{$me->{'mail_hdr_list'}}))
+ elsif($where >= @{$me->{'mail_hdr_list'}})
{
- $where = scalar(@{$me->{'mail_hdr_list'}});
+ $where = @{$me->{'mail_hdr_list'}};
}
- my $atend = $where == scalar(@{$me->{'mail_hdr_list'}});
+ my $atend = $where == @{$me->{'mail_hdr_list'}};
splice(@{$me->{'mail_hdr_list'}},$where,0,$line);
$me->{'mail_hdr_hash'}{$tag} ||= [];
my $ref = \${$me->{'mail_hdr_list'}}[$where];
- if(scalar($me->{'mail_hdr_hash'}{$tag}) && $where)
+ if($me->{'mail_hdr_hash'}{$tag} && $where)
{
if($atend)
{
@@ -267,9 +261,8 @@ sub _insert
}
else
{
- my($ln,$i,$ref);
- $i = 0;
- foreach $ln (@{$me->{'mail_hdr_list'}})
+ my $i = 0;
+ foreach my $ln (@{$me->{'mail_hdr_list'}})
{
my $r = \$ln;
last if($r == $ref);
@@ -750,7 +743,7 @@ sub fold_length
if(defined $len)
{
$me->{'mail_hdr_foldlen'} = $len > 20 ? $len : 20;
- $me->fold;
+ $me->fold if $me->{'mail_hdr_modify'};
}
}
@@ -1011,11 +1004,11 @@ multiple lines. IF C<TAG> is not given then all lines are unfolded.
=head1 AUTHOR
-Graham Barr <gbarr@pobox.com>
+Graham Barr. Maintained by Mark Overmeer <mailtools@overmeer.net>
=head1 COPYRIGHT
-Copyright (c) 1995-7 Graham Barr. All rights reserved. This program is free
+Copyright (c) 1995-2001 Graham Barr. All rights reserved. This program is free
software; you can redistribute it and/or modify it under the same terms
as Perl itself.
diff --git a/cpan/lib/Mail/Internet.pm b/cpan/lib/Mail/Internet.pm
index 57c0e962..6b1157ba 100644
--- a/cpan/lib/Mail/Internet.pm
+++ b/cpan/lib/Mail/Internet.pm
@@ -1,7 +1,7 @@
# Mail::Internet.pm
#
-# Copyright (c) 1995-8 Graham Barr <gbarr@pobox.com>. All rights
-# reserved. This program is free software; you can redistribute it and/or
+# Copyright (c) 1995-2001 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
@@ -16,7 +16,7 @@ use Mail::Header;
use vars qw($VERSION);
BEGIN {
- $VERSION = "1.33";
+ $VERSION = "1.52";
*AUTOLOAD = \&AutoLoader::AUTOLOAD;
unless(defined &UNIVERSAL::isa) {
@@ -109,7 +109,7 @@ sub body
if(@_)
{
my $new = shift;
- $me->{'mail_inet_body'} = ref($new) eq 'ARRAY' ? $new : [ $new ];
+ $me->{'mail_inet_body'} = ref($new) eq 'ARRAY' ? $new : [ $new, @_ ];
}
return $body;
@@ -533,9 +533,10 @@ sub _prephdr {
$hdr->delete('Received');
- $hdr->replace('X-Mailer', "Perl5 Mail::Internet v" . $Mail::Internet::VERSION);
+ $hdr->replace('X-Mailer', "Perl5 Mail::Internet v".$Mail::Internet::VERSION)
+ unless $hdr->count('X-Mailer');
- my $name = eval { local $SIG{__DIE__}; (getpwuid($>))[6] } || $ENV{NAME} || "";
+ my $name = eval {local $SIG{__DIE__}; (getpwuid($>))[6]} || $ENV{NAME} ||"";
while($name =~ s/\([^\(\)]*\)//) { 1; }
@@ -549,7 +550,7 @@ sub _prephdr {
my $tag;
- foreach $tag (qw(From Sender)) {
+ foreach $tag (qw(From Sender)) { # Sender is deprecated
$hdr->add($tag,$from)
unless($hdr->get($tag));
}
@@ -745,6 +746,10 @@ Mail::Internet - manipulate Internet format (RFC 822) mail messages
This package provides a class object which can be used for reading, creating,
manipulating and writing a message with RFC822 compliant headers.
+If you start writing a new application, you may want to use the
+L<Mail::Box> set of packages (requires perl 5.6.1), which has more
+features. See http://perl.overmeer.net/mailbox.
+
=head1 CONSTRUCTOR
=over 4
@@ -785,11 +790,16 @@ also be given.
=over 4
-=item body ()
+=item body ( [ BODY ] )
Returns the body of the message. This is a reference to an array.
Each entry in the array represents a single line in the message.
+If I<BODY> is given, it can be a referenc to an aray or an array, then
+the body will be replaced. If a reference is passed, it is used directly
+and not copied, so any sunsequent changes to the array will change the
+contents of the body.
+
=item print_header ( [ FILEHANDLE ] )
=item print_body ( [ FILEHANDLE ] )
@@ -940,11 +950,11 @@ L<Mail::Address>
=head1 AUTHOR
-Graham Barr <gbarr@pobox.com>
+Graham Barr. Maintained by Mark Overmeer <mailtools@overmeer.net>
=head1 COPYRIGHT
-Copyright (c) 1995-7 Graham Barr. All rights reserved. This program is free
+Copyright (c) 1995-2001 Graham Barr. All rights reserved. This program is free
software; you can redistribute it and/or modify it under the same terms
as Perl itself.
diff --git a/cpan/lib/Mail/Mailer.pm b/cpan/lib/Mail/Mailer.pm
index e5a42ff0..bda244e2 100644
--- a/cpan/lib/Mail/Mailer.pm
+++ b/cpan/lib/Mail/Mailer.pm
@@ -29,12 +29,6 @@ behaviour of a method by passing C<$command> to the C<new> method.
=over 4
-=item C<mail>
-
-Use the Unix system C<mail> program to deliver the mail. C<$command>
-is the path to C<mail>. Mail::Mailer will search for C<mailx>, C<Mail>
-and C<mail> (in this order).
-
=item C<sendmail>
Use the C<sendmail> program to deliver the mail. C<$command> is the
@@ -47,10 +41,18 @@ to use can be specified in C<@args> with
$mailer = new Mail::Mailer 'smtp', Server => $server;
+The smtp mailer does not handle C<Cc> and C<Bcc> lines, neither their
+C<Resent-*> fellows. The C<Debug> options enables debugging output
+from C<Net::SMTP>.
+
+=item C<qmail>
+
+Use qmail's qmail-inject program to deliver the mail.
+
=item C<test>
-Used for debugging, this calls C</bin/echo> to display the data. No
-mail is ever sent. C<$command> is ignored.
+Used for debugging, this displays the data on STDOUT. No mail is ever
+sent. C<$command> is ignored.
=back
@@ -95,6 +97,12 @@ of mailx, one could set C<PERL_MAILERS> to:
"mail:/does/not/exists:sendmail:$HOME/test/bin/sendmail"
+On systems which may include C<:> in file names, use C<|> as separator
+between type-groups.
+
+ "mail:c:/does/not/exists|sendmail:$HOME/test/bin/sendmail"
+
+
=back
=head1 SEE ALSO
@@ -103,16 +111,13 @@ Mail::Send
=head1 AUTHORS
-Maintained by Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
+Maintained by Mark Overmeer <mailtools@overmeer.net>
Original code written by Tim Bunce E<lt>F<Tim.Bunce@ig.co.uk>E<gt>,
with a kick start from Graham Barr E<lt>F<gbarr@pobox.com>E<gt>. With
contributions by Gerard Hickey E<lt>F<hickey@ctron.com>E<gt> Small fix
and documentation by Nathan Torkington E<lt>F<gnat@frii.com>E<gt>.
-For support please contact comp.lang.perl.misc or Graham Barr
-E<lt>F<gbarr@pobox.com>E<gt>
-
=cut
use Carp;
@@ -121,7 +126,7 @@ use vars qw(@ISA $VERSION $MailerBinary $MailerType %Mailers @Mailers);
use Config;
use strict;
-$VERSION = "1.21"; # $Id$
+$VERSION = "1.52";
sub Version { $VERSION }
@@ -130,40 +135,31 @@ sub Version { $VERSION }
# Suggested binaries for types? Should this be handled in the object class?
@Mailers = (
- # Body on stdin with tilde escapes
- 'mail' => 'mail',
-
# Headers-blank-Body all on stdin
- 'sendmail' => '/usr/lib/sendmail;/usr/sbin/sendmail;/usr/ucblib/sendmail',
+ 'sendmail' => '/usr/lib/sendmail;/usr/sbin/sendmail;/usr/ucblib/sendmail',
- 'smtp' => undef,
- 'test' => 'test'
+ 'smtp' => undef,
+ 'qmail' => '/usr/sbin/qmail-inject;/var/qmail/bin/qmail-inject',
+ 'test' => undef
);
-# There are several flavours of mail, which do we have ????
-
-{
- my $cmd = is_exe('mailx;Mail;mail');
- my $osname = $Config{'osname'};
-
- if($osname =~ /(?:dgux)|(?:solaris)/io) {
- $cmd .= " -~";
- }
- elsif($osname =~ /(?:linux)|(?:bsdos)|(?:freebsd)/io) {
- $cmd .= " -I";
- }
- push @Mailers, 'mail', $cmd;
+if($ENV{PERL_MAILERS})
+{ push @Mailers
+ , map { split /\:/, $_, 2}
+ split /$Config{path_sep}/, $ENV{PERL_MAILERS};
}
-push(@Mailers, split(/:/,$ENV{PERL_MAILERS})) if $ENV{PERL_MAILERS};
-
%Mailers = @Mailers;
$MailerBinary = undef;
# does this really need to be done? or should a default mailer be specfied?
-if($^O eq 'MacOS' || $^O eq 'VMS' || $^O eq 'MSWin32') {
+if($^O eq 'os2') {
+ $Mailers{sendmail} = 'sendmail' unless is_exe($Mailers{sendmail});
+}
+
+if($^O eq 'MacOS' || $^O eq 'VMS' || $^O eq 'MSWin32' || $^O eq 'os2') {
$MailerType = 'smtp';
$MailerBinary = $Mailers{$MailerType};
}
@@ -204,10 +200,10 @@ sub to_array {
}
sub is_exe {
- my $exe = shift;
+ my $exe = shift || '';
my $cmd;
- foreach $cmd (split /;/, $exe) {
+ foreach $cmd (split /\;/, $exe) {
$cmd =~ s/^\s+//;
# remove any options
@@ -215,11 +211,11 @@ sub is_exe {
# check for absolute or relative path
return ($cmd)
- if (-x $name and ! -d $name and $name =~ m:/:);
+ if (-x $name and ! -d $name and $name =~ m:[\\/]:);
if (defined $ENV{PATH}) {
my $dir;
- foreach $dir (split(/:/, $ENV{PATH})) {
+ foreach $dir (split(/$Config{path_sep}/, $ENV{PATH})) {
return "$dir/$cmd"
if (-x "$dir/$name" && ! -d "$dir/$name");
}
@@ -284,7 +280,8 @@ sub _cleanup_hdrs {
my $h;
foreach $h (values %$hdrs) {
foreach (ref($h) ? @{$h} : $h) {
- s/\n//;
+ s/\n\s*/ /g;
+ s/\s+$//;
}
}
}
diff --git a/cpan/lib/Mail/Mailer/qmail.pm b/cpan/lib/Mail/Mailer/qmail.pm
new file mode 100644
index 00000000..ea312606
--- /dev/null
+++ b/cpan/lib/Mail/Mailer/qmail.pm
@@ -0,0 +1,9 @@
+package Mail::Mailer::qmail;
+use vars qw(@ISA);
+require Mail::Mailer::rfc822;
+@ISA = qw(Mail::Mailer::rfc822);
+
+sub exec {
+ my($self, $exe, $args, $to) = @_;
+ exec(( $exe ));
+}
diff --git a/cpan/lib/Mail/Mailer/rfc822.pm b/cpan/lib/Mail/Mailer/rfc822.pm
index dcb0dbca..fa59d0fe 100644
--- a/cpan/lib/Mail/Mailer/rfc822.pm
+++ b/cpan/lib/Mail/Mailer/rfc822.pm
@@ -8,7 +8,12 @@ sub set_headers {
local($\)="";
foreach(keys %$hdrs) {
next unless m/^[A-Z]/;
- print $self "$_: ", join(",", $self->to_array($hdrs->{$_})), "\n";
+
+ my ($h);
+ foreach $h ($self->to_array($hdrs->{$_}))
+ { $h =~ s/\n+\Z//;
+ print $self "$_: ", $h, "\n";
+ }
}
print $self "\n"; # terminate headers
}
diff --git a/cpan/lib/Mail/Mailer/smtp.pm b/cpan/lib/Mail/Mailer/smtp.pm
index 6db78fa4..42eac5e4 100644
--- a/cpan/lib/Mail/Mailer/smtp.pm
+++ b/cpan/lib/Mail/Mailer/smtp.pm
@@ -2,6 +2,7 @@ package Mail::Mailer::smtp;
use vars qw(@ISA);
use Net::SMTP;
use Mail::Util qw(mailaddress);
+use Carp;
require Mail::Mailer::rfc822;
@ISA = qw(Mail::Mailer::rfc822);
@@ -10,10 +11,12 @@ sub can_cc { 0 }
sub exec {
my($self, $exe, $args, $to) = @_;
- my %opt = @$args;
- my $host = $opt{'Server'} || undef;
+ my %opt = @$args;
+ my $host = $opt{Server} || undef;
+ $opt{Debug} ||= 0;
+
# for Net::SMTP we do not really exec
- my $smtp = Net::SMTP->new($host, Debug => 0)
+ my $smtp = Net::SMTP->new($host, %opt)
or return undef;
${*$self}{'sock'} = $smtp;
@@ -52,8 +55,14 @@ sub close {
my $sock = ${*$self}{'sock'};
if ($sock && fileno($sock)) {
$self->epilogue;
- close($sock);
+ # Epilogue should destroy the SMTP filehandle,
+ # but just to be on the safe side.
+ if ($sock && fileno($sock)) {
+ close $sock
+ or croak 'Cannot destroy socket filehandle';
+ }
}
+ 1;
}
package Mail::Mailer::smtp::pipe;
diff --git a/cpan/lib/Mail/Send.pm b/cpan/lib/Mail/Send.pm
index 346a2002..7af92296 100644
--- a/cpan/lib/Mail/Send.pm
+++ b/cpan/lib/Mail/Send.pm
@@ -8,7 +8,7 @@ use Carp;
use vars qw($VERSION);
require Mail::Mailer;
-$VERSION = "1.09";
+$VERSION = "1.52";
sub Version { $VERSION }
@@ -79,8 +79,11 @@ Mail::Send - Simple electronic mail interface
# Launch mailer and set headers. The filehandle returned
# by open() is an instance of the Mail::Mailer class.
+ # Arguments to the open() method are passed to the Mail::Mailer
+ # constructor.
- $fh = $msg->open;
+ $fh = $msg->open; # some default mailer
+ # $fh = $msg->open('sendmail'); # explicit
print $fh "Body of message";
@@ -96,15 +99,12 @@ Mail::Mailer
=head1 AUTHORS
-Maintained by Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
+Maintained by Mark Overmeer <mailtools@overmeer.net>
Original code written by Tim Bunce E<lt>F<Tim.Bunce@ig.co.uk>E<gt>,
with a kick start from Graham Barr E<lt>F<gbarr@pobox.com>E<gt>. With
contributions by Gerard Hickey E<lt>F<hickey@ctron.com>E<gt>
-For support please contact comp.lang.perl.misc or Graham Barr
-E<lt>F<gbarr@pobox.com>E<gt>
-
=cut
diff --git a/cpan/lib/Mail/Util.pm b/cpan/lib/Mail/Util.pm
index e0c2a344..a1d5be98 100644
--- a/cpan/lib/Mail/Util.pm
+++ b/cpan/lib/Mail/Util.pm
@@ -1,6 +1,6 @@
# Mail::Util.pm
#
-# Copyright (c) 1995-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# Copyright (c) 1995-2001 Graham Barr <gbarr@pobox.com>. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
@@ -14,7 +14,7 @@ use Exporter ();
BEGIN {
require 5.000;
- $VERSION = "1.16";
+ $VERSION = "1.52";
*AUTOLOAD = \&AutoLoader::AUTOLOAD;
@ISA = qw(Exporter);
@@ -50,23 +50,34 @@ Each reference is a reference to an array containg one message.
Attempt to determine the current uers mail domain string via the following
methods
- Look for a sendmail.cf file and extract DH parameter
- Look for a smail config file and usr the first host defined in hostname(s)
- Try an SMTP connect (if Net::SMTP exists) first to mailhost then localhost
- Use value from Net::Domain::domainname (if Net::Domain exists)
+=over 4
+
+=item * Look for the MAILDOMAIN enviroment variable, which can be set from outside the program.
+
+=item * Look for a sendmail.cf file and extract DH parameter
+
+=item * Look for a smail config file and usr the first host defined in hostname(s)
+
+=item * Try an SMTP connect (if Net::SMTP exists) first to mailhost then localhost
+
+=item * Use value from Net::Domain::domainname (if Net::Domain exists)
+
+=back
=head2 mailaddress()
Return a guess at the current users mail address. The user can force
-the return value by setting C<$ENV{MAILADDRESS}>
+the return value by setting the MAILADDRESS environment variable.
=head1 AUTHOR
-Graham Barr <gbarr@pobox.com>
+Graham Barr.
+
+Maintained by Mark Overmeer <mailtools@overmeer.net>
=head1 COPYRIGHT
-Copyright (c) 1995-8 Graham Barr. All rights reserved. This program is free
+Copyright (c) 1995-2001 Graham Barr. All rights reserved. This program is free
software; you can redistribute it and/or modify it under the same terms
as Perl itself.
@@ -118,6 +129,15 @@ sub maildomain {
if(defined $domain);
##
+ ## Get mail domain from environment
+ ##
+
+ $domain = $ENV{MAILDOMAIN};
+
+ return $domain
+ if(defined $domain);
+
+ ##
## Try sendmail config file if exists
##
@@ -135,15 +155,18 @@ sub maildomain {
if(defined $config && open(CF,$config)) {
my %var;
while(<CF>) {
- if(/\AD([a-zA-Z])([\w.]+)/) {
- my($v,$arg) = ($1,$2);
- $arg =~ s/\$([a-zA-Z])/exists $var{$1} ? $var{$1} : '$' . $1/eg;
+ if(my ($v, $arg) = /^D([a-zA-Z])([\w.\$\-]+)/) {
+ $arg =~ s/\$([a-zA-Z])/exists $var{$1} ? $var{$1} : '$'.$1/eg;
$var{$v} = $arg;
}
}
close(CF);
- $domain = $var{'j'} if defined $var{'j'};
- $domain = $var{'M'} if defined $var{'M'};
+ $domain = $var{j} if defined $var{j};
+ $domain = $var{M} if defined $var{M};
+
+ $domain = $1
+ if($domain && $domain =~ m/([A-Za-z0-9](?:[\.\-A-Za-z0-9]+))/ );
+
return $domain
if(defined $domain);
}
@@ -222,9 +245,9 @@ sub mailaddress {
$mailaddress = $InternetConfig{kICEmail()};
}
- $mailaddress ||= $ENV{USER} ||
+ $mailaddress ||= $ENV{USER} ||
$ENV{LOGNAME} ||
- eval { (getpwuid($>))[6] } ||
+ eval {getpwuid($>)} ||
"postmaster";
##
generated by cgit v1.2.1 (git 2.18.0) at 2026-09-02 05:06:39 +0000