File Coverage

blib/lib/Mail/Transport/Mailx.pm
Criterion Covered Total %
statement 12 44 27.2
branch 0 20 0.0
condition 0 6 0.0
subroutine 4 7 57.1
pod 1 2 50.0
total 17 79 21.5


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::Mailx;{
13             our $VERSION = '4.01';
14             }
15              
16 1     1   1391 use parent 'Mail::Transport::Send';
  1         2  
  1         21  
17              
18 1     1   64 use strict;
  1         1  
  1         15  
19 1     1   3 use warnings;
  1         1  
  1         52  
20              
21 1     1   4 use Log::Report 'mail-transport', import => [ qw/__x fault error/ ];
  1         2  
  1         7  
22              
23             #--------------------
24              
25             sub init($)
26 0     0 0   { my ($self, $args) = @_;
27 0           $args->{via} = 'mailx';
28              
29 0 0         $self->SUPER::init($args) or return;
30              
31 0 0 0       $self->{MTM_program} = $args->{proxy} || $self->findBinary('mailx') || $self->findBinary('Mail') || $self->findBinary('mail')
32             or error __x"cannot find binary of mailx.";
33              
34 0 0 0       $self->{MTM_style} = $args->{style} // ( $^O =~ m/linux|freebsd|bsdos|netbsd|openbsd/ ? 'BSD' : 'RFC822' );
35 0           $self;
36             }
37              
38              
39             sub _try_send_bsdish($$)
40 0     0     { my ($self, $message, $args) = @_;
41              
42 0           my @options = ('-s' => $message->subject);
43              
44 0           { local $" = ',';
  0            
45 0           my @cc = map $_->format, $message->cc;
46 0 0         push @options, ('-c' => "@cc") if @cc;
47              
48 0           my @bcc = map $_->format, $message->bcc;
49 0 0         push @options, ('-b' => "@bcc") if @bcc;
50             }
51              
52 0           my @to = map $_->format, $message->to;
53 0           my $program = $self->{MTM_program};
54              
55 0           my $mailer;
56 0 0         if((open $mailer, '|-')==0)
57 0           { close STDOUT;
58 0           { exec $program, @options, @to }
  0            
59 0           fault __x"cannot open pipe to {program}", program => $program;
60             }
61              
62 0           $self->putContent($message, $mailer, body_only => 1);
63              
64 0 0         $mailer->close
65             or fault __x"errors when closing Mailx mailer {program}", program => $program;
66              
67 0           1;
68             }
69              
70             sub trySend($@)
71 0     0 1   { my ($self, $message, %args) = @_;
72              
73             return $self->_try_send_bsdish($message, \%args)
74 0 0         if $self->{MTM_style} eq 'BSD';
75              
76 0           my $program = $self->{MTM_program};
77 0 0         open my $mailer, '|-', $program, '-t'
78             or fault __x"cannot open pipe to {program}", program => $program;
79              
80 0           $self->putContent($message, $mailer);
81              
82 0 0         $mailer->close
83             or fault __x"errors when closing Mailx mailer {program}", program => $program;
84              
85 0           1;
86             }
87              
88             1;