1package Email::Sender::Transport::Sendmail;
2# ABSTRACT: send mail via sendmail(1)
3$Email::Sender::Transport::Sendmail::VERSION = '1.300031';
4use Moo;
5with 'Email::Sender::Transport';
6
7use MooX::Types::MooseLike::Base qw(Str);
8
9#pod =head2 DESCRIPTION
10#pod
11#pod This transport sends mail by piping it to the F<sendmail> command.  If the
12#pod location of the F<sendmail> command is not provided in the constructor (see
13#pod below) then the library will look for an executable file called F<sendmail> in
14#pod the path.
15#pod
16#pod To specify the location of sendmail:
17#pod
18#pod   my $sender = Email::Sender::Transport::Sendmail->new({ sendmail => $path });
19#pod
20#pod =cut
21
22use File::Spec ();
23
24has 'sendmail' => (
25  is  => 'ro',
26  isa => Str,
27  required => 1,
28  lazy     => 1,
29  default  => sub {
30    # This should not have to be lazy, but Moose has a bug(?) that prevents the
31    # instance or partial-instance from being passed in to the default sub.
32    # Laziness doesn't hurt much, though, because (ugh) of the BUILD below.
33    # -- rjbs, 2008-12-04
34
35    # return $ENV{PERL_SENDMAIL_PATH} if $ENV{PERL_SENDMAIL_PATH}; # ???
36    return $_[0]->_find_sendmail('sendmail');
37  },
38);
39
40sub BUILD {
41  $_[0]->sendmail; # force population -- rjbs, 2009-06-08
42}
43
44sub _find_sendmail {
45  my ($self, $program_name) = @_;
46  $program_name ||= 'sendmail';
47
48  my @path = File::Spec->path;
49
50  if ($program_name eq 'sendmail') {
51    # for 'real' sendmail we will look in common locations -- rjbs, 2009-07-12
52    push @path, (
53      File::Spec->catfile('', qw(usr sbin)),
54      File::Spec->catfile('', qw(usr lib)),
55    );
56  }
57
58  for my $dir (@path) {
59    my $sendmail = File::Spec->catfile($dir, $program_name);
60    return $sendmail if ($^O eq 'MSWin32') ? -f $sendmail : -x $sendmail;
61  }
62
63  Carp::confess("couldn't find a sendmail executable");
64}
65
66sub _sendmail_pipe {
67  my ($self, $envelope) = @_;
68
69  my $prog = $self->sendmail;
70
71  my ($first, @args) = $^O eq 'MSWin32'
72           ? qq(| "$prog" -i -f $envelope->{from} @{$envelope->{to}})
73           : (q{|-}, $prog, '-i', '-f', $envelope->{from}, '--', @{$envelope->{to}});
74
75  no warnings 'exec'; ## no critic
76  my $pipe;
77  Email::Sender::Failure->throw("couldn't open pipe to sendmail ($prog): $!")
78    unless open($pipe, $first, @args);
79
80  return $pipe;
81}
82
83sub send_email {
84  my ($self, $email, $envelope) = @_;
85
86  my $pipe = $self->_sendmail_pipe($envelope);
87
88  my $string = $email->as_string;
89  $string =~ s/\x0D\x0A/\x0A/g unless $^O eq 'MSWin32';
90
91  print $pipe $string
92    or Email::Sender::Failure->throw("couldn't send message to sendmail: $!");
93
94  close $pipe
95    or Email::Sender::Failure->throw("error when closing pipe to sendmail: $!");
96
97  return $self->success;
98}
99
100no Moo;
1011;
102
103__END__
104
105=pod
106
107=encoding UTF-8
108
109=head1 NAME
110
111Email::Sender::Transport::Sendmail - send mail via sendmail(1)
112
113=head1 VERSION
114
115version 1.300031
116
117=head2 DESCRIPTION
118
119This transport sends mail by piping it to the F<sendmail> command.  If the
120location of the F<sendmail> command is not provided in the constructor (see
121below) then the library will look for an executable file called F<sendmail> in
122the path.
123
124To specify the location of sendmail:
125
126  my $sender = Email::Sender::Transport::Sendmail->new({ sendmail => $path });
127
128=head1 AUTHOR
129
130Ricardo Signes <rjbs@cpan.org>
131
132=head1 COPYRIGHT AND LICENSE
133
134This software is copyright (c) 2017 by Ricardo Signes.
135
136This is free software; you can redistribute it and/or modify it under
137the same terms as the Perl 5 programming language system itself.
138
139=cut
140