1# Copyrights 1995-2019 by [Mark Overmeer <markov@cpan.org>]. 2# For other contributors see ChangeLog. 3# See the manual pages for details on the licensing terms. 4# Pod stripped from pm file by OODoc 2.02. 5# This code is part of the bundle MailTools. Meta-POD processed with 6# OODoc into POD and HTML manual-pages. See README.md for Copyright. 7# Licensed under the same terms as Perl itself. 8 9package Mail::Mailer::smtp; 10use vars '$VERSION'; 11$VERSION = '2.21'; 12 13use base 'Mail::Mailer::rfc822'; 14 15use strict; 16 17use Net::SMTP; 18use Mail::Util qw(mailaddress); 19use Carp; 20 21sub can_cc { 0 } 22 23sub exec { 24 my ($self, $exe, $args, $to) = @_; 25 my %opt = @$args; 26 my $host = $opt{Server} || undef; 27 $opt{Debug} ||= 0; 28 29 my $smtp = Net::SMTP->new($host, %opt) 30 or return undef; 31 32 if($opt{StartTLS}) 33 { $Net::SMTP::VERSION >= 1.28 34 or die "StartTLS requires Net::SMTP 1.28"; 35 36 $smtp->starttls 37 or return undef; 38 } 39 40 if($opt{Auth}) 41 { $smtp->auth(@{$opt{Auth}}) 42 or return undef; 43 } 44 45 ${*$self}{sock} = $smtp; 46 47 $smtp->mail($opt{From} || mailaddress()); 48 $smtp->to($_) for @$to; 49 $smtp->data; 50 51 untie *$self if tied *$self; 52 tie *$self, 'Mail::Mailer::smtp::pipe', $self; 53 $self; 54} 55 56sub set_headers($) 57{ my ($self, $hdrs) = @_; 58 $self->SUPER::set_headers 59 ( { From => "<" . mailaddress() . ">" 60 , %$hdrs 61 , 'X-Mailer' => "Mail::Mailer[v$Mail::Mailer::VERSION] Net::SMTP[v$Net::SMTP::VERSION]" 62 } 63 ); 64} 65 66sub epilogue() 67{ my $self = shift; 68 my $sock = ${*$self}{sock}; 69 70 my $ok = $sock->dataend; 71 $sock->quit; 72 73 delete ${*$self}{sock}; 74 untie *$self; 75 $ok; 76} 77 78sub close(@) 79{ my ($self, @to) = @_; 80 my $sock = ${*$self}{sock}; 81 82 $sock && fileno $sock 83 or return 1; 84 85 my $ok = $self->epilogue; 86 87 # Epilogue should destroy the SMTP filehandle, 88 # but just to be on the safe side. 89 $sock && fileno $sock 90 or return $ok; 91 92 close $sock 93 or croak 'Cannot destroy socket filehandle'; 94 95 $ok; 96} 97 98package Mail::Mailer::smtp::pipe; 99use vars '$VERSION'; 100$VERSION = '2.21'; 101 102 103sub TIEHANDLE 104{ my ($class, $self) = @_; 105 my $sock = ${*$self}{sock}; 106 bless \$sock, $class; 107} 108 109sub PRINT 110{ my $self = shift; 111 my $sock = $$self; 112 $sock->datasend( @_ ); 113} 114 1151; 116