File Coverage

blib/lib/Test/Smoke/Mailer/MIME_Lite.pm
Criterion Covered Total %
statement 9 31 29.0
branch 0 26 0.0
condition 0 5 0.0
subroutine 3 4 75.0
pod 1 1 100.0
total 13 67 19.4


line stmt bran cond sub pod time code
1             package Test::Smoke::Mailer::MIME_Lite;
2 3     3   19 use warnings;
  3         7  
  3         96  
3 3     3   16 use strict;
  3         6  
  3         116  
4              
5             our $VERSION = '0.016';
6              
7 3     3   22 use base 'Test::Smoke::Mailer::Base';
  3         17  
  3         1395  
8              
9             =head1 Test::Smoke::Mailer::MIME_Lite
10              
11             This handles sending the message using the B module.
12              
13             =head1 DESCRIPTION
14              
15             =head2 Test::Smoke::Mailer::MIME_Lite->new( %args )
16              
17             Keys for C<%args>:
18              
19             * ddir
20             * mserver
21             * msport
22             * msuser
23             * mspass
24             * to
25             * from
26             * cc
27             * v
28              
29             =cut
30              
31             =head2 $mailer->mail( )
32              
33             C sets up the message to be send by B.
34              
35             =cut
36              
37             sub mail {
38 0     0 1   my $self = shift;
39              
40 0           eval { require MIME::Lite; };
  0            
41              
42 0 0         $self->{error} = $@ and return undef;
43              
44 0           my $subject = $self->fetch_report();
45 0           my $cc = $self->_get_cc( $subject );
46              
47             my %message = (
48             To => $self->{to},
49             Subject => $subject,
50             Type => "TEXT",
51             Data => $self->{body},
52 0           );
53 0 0         $message{Cc} = $cc if $cc;
54 0 0         $message{Bcc} = $self->{bcc} if $self->{bcc};
55 0 0         $message{From} = $self->{from} if $self->{from};
56              
57 0 0         if ($self->{mserver}) {
58 0           my %authinfo = ();
59 0 0         $authinfo{AuthUser} = $self->{msuser} if $self->{msuser};
60 0 0         $authinfo{AuthPass} = $self->{mspass} if defined $self->{mspass};
61             MIME::Lite->send(
62             smtp => $self->{mserver},
63             Port => ($self->{msport} || 25),
64             FromSender => $self->{from},
65 0   0       Debug => ($self->{v} > 1),
66             %authinfo,
67             );
68             }
69              
70 0           my $ml_msg = MIME::Lite->new( %message );
71             $ml_msg->attr( 'content-type.charset' => 'UTF8' )
72 0 0 0       if exists $ENV{LANG} && $ENV{LANG} =~ /utf-?8$/i;
73              
74 0 0         $self->{v} > 1 and print "[MIME::Lite]\n";
75 0 0         $self->{v} and print "Sending report to $self->{to} ";
76              
77 0 0         $ml_msg->send or $self->{error} = "Problem sending mail";
78              
79 0 0         $self->{v} and print $self->{error} ? "not OK\n" : "OK\n";
    0          
80              
81 0           return ! $self->{error};
82             }
83              
84             1;
85              
86             =head1 COPYRIGHT
87              
88             (c) 2002-2013, All rights reserved.
89              
90             * Abe Timmerman
91              
92             This library is free software; you can redistribute it and/or modify
93             it under the same terms as Perl itself.
94              
95             See:
96              
97             * ,
98             *
99              
100             This program is distributed in the hope that it will be useful,
101             but WITHOUT ANY WARRANTY; without even the implied warranty of
102             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
103              
104             =cut