File Coverage

blib/lib/Mail/Transport/Send.pm
Criterion Covered Total %
statement 21 60 35.0
branch 0 34 0.0
condition 0 3 0.0
subroutine 7 12 58.3
pod 5 5 100.0
total 33 114 28.9


line stmt bran cond sub pod time code
1             # Copyrights 2001-2020 by [Mark Overmeer].
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 distribution Mail-Transport. Meta-POD processed with
6             # OODoc into POD and HTML manual-pages. See README.md
7             # Copyright Mark Overmeer. Licensed under the same terms as Perl itself.
8              
9             package Mail::Transport::Send;
10 1     1   9 use vars '$VERSION';
  1         3  
  1         50  
11             $VERSION = '3.005';
12              
13 1     1   5 use base 'Mail::Transport';
  1         2  
  1         90  
14              
15 1     1   12 use strict;
  1         3  
  1         21  
16 1     1   4 use warnings;
  1         3  
  1         22  
17              
18 1     1   4 use Carp;
  1         2  
  1         66  
19 1     1   17 use File::Spec;
  1         2  
  1         34  
20 1     1   14 use Errno 'EAGAIN';
  1         2  
  1         774  
21              
22              
23             sub new(@)
24 0     0 1   { my $class = shift;
25 0 0         return $class->SUPER::new(@_)
26             if $class ne __PACKAGE__;
27              
28 0           require Mail::Transport::Sendmail;
29 0           Mail::Transport::Sendmail->new(@_);
30             }
31              
32             #------------------------------------------
33              
34              
35             sub send($@)
36 0     0 1   { my ($self, $message, %args) = @_;
37              
38 0 0         unless($message->isa('Mail::Message')) # avoid rebless.
39 0           { $message = Mail::Message->coerce($message);
40 0 0         confess "Unable to coerce object into Mail::Message."
41             unless defined $message;
42             }
43              
44 0 0         return 1 if $self->trySend($message, %args);
45 0 0         return 0 unless $?==EAGAIN;
46              
47 0           my ($interval, $retry) = $self->retry;
48 0 0         $interval = $args{interval} if exists $args{interval};
49 0 0         $retry = $args{retry} if exists $args{retry};
50              
51 0           while($retry!=0)
52 0           { sleep $interval;
53 0 0         return 1 if $self->trySend($message, %args);
54 0 0         return 0 unless $?==EAGAIN;
55 0           $retry--;
56             }
57              
58 0           0;
59             }
60              
61             #------------------------------------------
62              
63              
64             sub trySend($@)
65 0     0 1   { my $self = shift;
66 0           $self->log(ERROR => "Transporters of type ".ref($self). " cannot send.");
67             }
68              
69             #------------------------------------------
70              
71              
72             sub putContent($$@)
73 0     0 1   { my ($self, $message, $fh, %args) = @_;
74              
75 0 0         if($args{body_only}) { $message->body->print($fh) }
  0 0          
76 0           elsif($args{undisclosed}) { $message->Mail::Message::print($fh) }
77             else
78 0           { $message->head->printUndisclosed($fh);
79 0           $message->body->print($fh);
80             }
81              
82 0           $self;
83             }
84              
85             #------------------------------------------
86              
87              
88             sub destinations($;$)
89 0     0 1   { my ($self, $message, $overrule) = @_;
90 0           my @to;
91              
92 0 0         if(defined $overrule) # Destinations overruled by user.
    0          
93 0 0         { my @addr = ref $overrule eq 'ARRAY' ? @$overrule : ($overrule);
94 0 0 0       @to = map { ref $_ && $_->isa('Mail::Address') ? ($_)
  0            
95             : Mail::Address->parse($_) } @addr;
96             }
97             elsif(my @rgs = $message->head->resentGroups)
98 0           { @to = $rgs[0]->destinations;
99 0 0         $self->log(WARNING => "Resent group does not specify a destination"), return ()
100             unless @to;
101             }
102             else
103 0           { @to = $message->destinations;
104 0 0         $self->log(WARNING => "Message has no destination"), return ()
105             unless @to;
106             }
107              
108 0           @to;
109             }
110              
111             #------------------------------------------
112              
113              
114             1;