File Coverage

blib/lib/Net/Peep/Mail.pm
Criterion Covered Total %
statement 18 74 24.3
branch 0 30 0.0
condition 0 19 0.0
subroutine 6 14 42.8
pod 2 8 25.0
total 26 145 17.9


line stmt bran cond sub pod time code
1             package Net::Peep::Mail;
2              
3             require 5.005;
4 3     3   15 use strict;
  3         6  
  3         93  
5 3     3   14 use Carp;
  3         6  
  3         154  
6 3     3   15 use Data::Dumper;
  3         6  
  3         112  
7 3     3   16150 use Net::SMTP;
  3         108771  
  3         184  
8 3     3   34 use Net::Peep::Log;
  3         43  
  3         139  
9              
10             require Exporter;
11              
12 3     3   15 use vars qw{ @ISA %EXPORT_TAGS @EXPORT_OK @EXPORT $VERSION $LOGGER };
  3         6  
  3         2873  
13              
14             @ISA = qw(Exporter);
15             %EXPORT_TAGS = ( );
16             @EXPORT_OK = ( );
17             @EXPORT = qw( );
18             $VERSION = do { my @r = (q$Revision: 1.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
19              
20             $LOGGER = Net::Peep::Log->new();
21              
22             sub new {
23              
24 0     0 0   my $self = shift;
25 0   0       my $class = ref($self) || $self;
26 0           my $this = {};
27 0           bless $this, $class;
28              
29             } # end sub new
30              
31             sub to {
32              
33 0     0 1   my $self = shift;
34 0 0         $self->{'_TO'} = [] unless exists $self->{'_TO'};
35 0 0         if (@_) { my @to = @_; $self->{'_TO'} = \@to; }
  0            
  0            
36 0 0         return wantarray ? @{$self->{'_TO'}} : $self->{'_TO'};
  0            
37              
38             } # end sub to
39              
40             sub from {
41              
42 0     0 1   my $self = shift;
43 0 0         if (@_) { $self->{'_FROM'} = shift; }
  0            
44 0           return $self->{'_FROM'};
45              
46             } # end from
47              
48             sub smtp_server {
49              
50 0     0 0   my $self = shift;
51 0 0         $self->{'_SMTP_SERVER'} = [] unless exists $self->{'_SMTP_SERVER'};
52 0 0         if (@_) { my @smtp_server = @_; $self->{'_SMTP_SERVER'} = \@smtp_server; }
  0            
  0            
53 0 0         return wantarray ? @{$self->{'_SMTP_SERVER'}} : $self->{'_SMTP_SERVER'};
  0            
54              
55             } # end sub smtp_server
56              
57             sub timeout {
58              
59 0     0 0   my $self = shift;
60 0 0         if (@_) { $self->{'_TIMEOUT'} = shift; }
  0            
61 0           return $self->{'_TIMEOUT'};
62              
63             } # end timeout
64              
65             sub subject {
66              
67 0     0 0   my $self = shift;
68 0 0         if (@_) { $self->{'_SUBJECT'} = shift; }
  0            
69 0           return $self->{'_SUBJECT'};
70              
71             } # end subject
72              
73             sub body {
74              
75 0     0 0   my $self = shift;
76 0 0         if (@_) { $self->{'_BODY'} = shift; }
  0            
77 0           return $self->{'_BODY'};
78              
79             } # end body
80              
81             sub send {
82              
83 0     0 0   my $self = shift;
84              
85 0           my $from = $self->from();
86 0           my $to = join ', ', $self->to();
87 0           my $subject = $self->subject();
88 0           my $body = $self->body();
89              
90 0           my $data = <<"eop";
91             To: $to
92             From: $from
93             Subject: $subject
94              
95             $body
96             eop
97             ;
98              
99 0           my $delivered = 0;
100              
101 0           $LOGGER->debug(7,"Sending e-mail:");
102 0           $LOGGER->debug(7,$data);
103 0           $LOGGER->debug(7,"Trying SMTP servers [".(join ', ', $self->smtp_server())."] ...");
104              
105 0           for my $smtp_server ($self->smtp_server()) {
106              
107 0 0         my @smtp_args = $self->timeout()
108             ? ( $smtp_server, Timeout => $self->timeout() )
109             : ( $smtp_server );
110              
111 0           my $smtp = Net::SMTP->new(@smtp_args);
112              
113 0           $LOGGER->debug(7,"Sending e-mail to [$smtp_server] ...");
114              
115 0 0 0       $LOGGER->log("Error instantiating Net::SMTP object. ".
116             "The SMTP server [$smtp_server] may not be accepting mail relay requests.")
117             and next unless defined $smtp;
118              
119 0 0 0       if ($smtp->mail($from) &&
      0        
      0        
      0        
120             $smtp->to($self->to()) &&
121             $smtp->data() &&
122             $smtp->datasend($data) &&
123             $smtp->dataend()) {
124 0           $delivered++;
125             }
126              
127 0           $smtp->quit();
128              
129 0 0 0       $LOGGER->debug(7,"E-mail successfully sent.") and last if $delivered;
130              
131             }
132              
133 0 0         unless ($delivered) {
134 0           $LOGGER->log("Error delivering mail to server(s) [".join(',',$self->smtp_server())."].");
135             }
136              
137 0           return $delivered;
138              
139             } # end sub send
140              
141             1;
142              
143             __END__