File Coverage

blib/lib/Mail/Transport/Sendmail.pm
Criterion Covered Total %
statement 12 31 38.7
branch 0 6 0.0
condition 0 7 0.0
subroutine 4 6 66.6
pod 1 2 50.0
total 17 52 32.6


line stmt bran cond sub pod time code
1             # This code is part of Perl distribution Mail-Transport version 4.01.
2             # The POD got stripped from this file by OODoc version 3.05.
3             # For contributors see file ChangeLog.
4              
5             # This software is copyright (c) 2001-2025 by Mark Overmeer.
6              
7             # This is free software; you can redistribute it and/or modify it under
8             # the same terms as the Perl 5 programming language system itself.
9             # SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later
10              
11              
12             package Mail::Transport::Sendmail;{
13             our $VERSION = '4.01';
14             }
15              
16 1     1   1433 use parent 'Mail::Transport::Send';
  1         2  
  1         8  
17              
18 1     1   84 use strict;
  1         3  
  1         71  
19 1     1   7 use warnings;
  1         2  
  1         68  
20              
21 1     1   7 use Log::Report 'mail-transport', import => [ qw/__x error fault warning/ ];
  1         1  
  1         10  
22              
23             #--------------------
24              
25             sub init($)
26 0     0 0   { my ($self, $args) = @_;
27 0           $args->{via} = 'sendmail';
28 0           $self->SUPER::init($args);
29              
30 0 0 0       $self->{MTS_program} = $args->{proxy} || $self->findBinary('sendmail') or return;
31 0   0       $self->{MTS_opts} = $args->{sendmail_options} || [];
32 0           $self;
33             }
34              
35             #--------------------
36              
37             sub trySend($@)
38 0     0 1   { my ($self, $message, %args) = @_;
39              
40 0           my $program = $self->{MTS_program};
41 0           my $mailer;
42 0 0         if(open($mailer, '|-')==0)
43             { # Child process is sendmail binary
44 0   0       my $options = $args{sendmail_options} || [];
45 0           my @to = map $_->address, $self->destinations($message, $args{to});
46              
47             # {} to avoid warning about code after exec
48 0           { exec $program, '-i', @{$self->{MTS_opts}}, @$options, @to; }
  0            
  0            
49 0           fault __x"cannot open pipe to {program}", program => $program;
50             }
51              
52             # Parent process is the main program, still
53 0           $self->putContent($message, $mailer, undisclosed => 1);
54              
55 0 0         $mailer->close
56             or fault __x"errors when closing sendmail mailer {program}", program => $program;
57              
58 0           1;
59             }
60              
61             1;