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