File Coverage

blib/lib/Test/Smoke/Mailer.pm
Criterion Covered Total %
statement 24 61 39.3
branch 0 24 0.0
condition 0 3 0.0
subroutine 8 10 80.0
pod 2 2 100.0
total 34 100 34.0


line stmt bran cond sub pod time code
1             package Test::Smoke::Mailer;
2 3     3   767 use warnings;
  3         13  
  3         108  
3 3     3   15 use strict;
  3         6  
  3         59  
4 3     3   13 use Carp;
  3         6  
  3         206  
5              
6             our $VERSION = '0.016';
7              
8 3     3   1342 use Test::Smoke::Mailer::Sendmail;
  3         8  
  3         92  
9 3     3   1334 use Test::Smoke::Mailer::Mail_X;
  3         7  
  3         114  
10 3     3   1288 use Test::Smoke::Mailer::SendEmail;
  3         8  
  3         92  
11 3     3   1324 use Test::Smoke::Mailer::Mail_Sendmail;
  3         9  
  3         104  
12 3     3   1296 use Test::Smoke::Mailer::MIME_Lite;
  3         8  
  3         2202  
13              
14             =head1 NAME
15              
16             Test::Smoke::Mailer - Factory for objects to send the report.
17              
18             =head1 SYNOPSIS
19              
20             use Test::Smoke::Mailer;
21              
22             my %args = ( mhowto => 'smtp', mserver => 'smtp.your.domain' );
23             my $mailer = Test::Smoke::Mailer->new( $ddir, %args );
24              
25             $mailer->mail or die "Problem in mailing: " . $mailer->error;
26              
27             =head1 DESCRIPTION
28              
29             This little wrapper still allows you to use the B, B,
30             B or B programs, but prefers to use the B
31             module (which comes with this distribution) to send the reports.
32              
33             =head1 METHODS
34              
35             =head2 Test::Smoke::Mailer->new( $mailer[, %args] )
36              
37             Can we provide sensible defaults for the mail stuff?
38              
39             mhowto => [Module::Name|sendmail|mail|mailx|sendemail]
40             mserver => an SMTP server || localhost
41             mbin => the full path to the mail binary
42             mto => list of addresses (comma separated!)
43             mfrom => single address
44             mcc => list of addresses (coma separated!)
45              
46             =cut
47              
48             our $P5P = 'perl5-porters@perl.org';
49             our $NOCC_RE = ' (?:PASS\b|FAIL\(X\))';
50             my %CONFIG = (
51             df_mailer => 'Mail::Sendmail',
52             df_ddir => undef,
53             df_v => 0,
54             df_rptfile => 'mktest.rpt',
55             df_to => 'daily-build-reports@perl.org',
56             df_from => '',
57             df_cc => '',
58             df_swcc => '-c',
59             df_swbcc => '-b',
60             df_bcc => '',
61             df_ccp5p_onfail => 0,
62             df_mserver => 'localhost',
63             df_msuser => undef,
64             df_mspass => undef,
65              
66             df_mailbin => 'mail',
67             mail => [qw( bcc cc mailbin )],
68              
69             df_mailxbin => 'mailx',
70             mailx => [qw( bcc cc mailxbin swcc swbcc )],
71              
72             df_sendemailbin => 'sendemail',
73             sendemail => [qw( from bcc cc sendemailbin mserver msuser mspass )],
74              
75             df_sendmailbin => 'sendmail',
76             sendmail => [qw( from bcc cc sendmailbin )],
77             'Mail::Sendmail' => [qw( from bcc cc mserver )],
78             'MIME::Lite' => [qw( from bcc cc mserver msuser mspass )],
79              
80             valid_mailer => {
81             sendmail => 1,
82             mail => 1,
83             mailx => 1,
84             sendemail => 1,
85             'Mail::Sendmail' => 1,
86             'MIME::Lite' => 1,
87             },
88             );
89              
90             sub new {
91 0     0 1   my $class = shift;
92              
93 0   0       my $mailer = shift || $CONFIG{df_mailer};
94              
95 0 0         if (! exists $CONFIG{valid_mailer}->{ $mailer } ) {
96 0           croak( "Invalid mailer '$mailer'" );
97             };
98              
99 0 0         my %args_raw = @_ ? UNIVERSAL::isa( $_[0], 'HASH' ) ? %{ $_[0] } : @_ : ();
  0 0          
100              
101             my %args = map {
102 0           ( my $key = $_ ) =~ s/^-?(.+)$/lc $1/e;
  0            
  0            
103 0           ( $key => $args_raw{ $_ } );
104             } keys %args_raw;
105              
106             my %fields = map {
107 0 0         my $value = exists $args{$_} ? $args{ $_ } : $CONFIG{ "df_$_" };
108 0           ( $_ => $value )
109 0           } ( rptfile => v => ddir => to => ccp5p_onfail => @{ $CONFIG{ $mailer } } );
  0            
110 0           $fields{ddir} = File::Spec->rel2abs( $fields{ddir} );
111              
112             DO_NEW: {
113 0           local $_ = $mailer;
  0            
114              
115 0 0         /^sendmail$/ && do {
116 0           return Test::Smoke::Mailer::Sendmail->new(%fields);
117             };
118 0 0         /^mailx?$/ && do {
119 0           return Test::Smoke::Mailer::Mail_X->new(%fields);
120             };
121 0 0         /^sendemail?$/ && do {
122 0           return Test::Smoke::Mailer::SendEmail->new(%fields);
123             };
124 0 0         /^Mail::Sendmail$/ && do {
125 0           return Test::Smoke::Mailer::Mail_Sendmail->new(%fields);
126             };
127 0 0         /^MIME::Lite$/ && do {
128 0           return Test::Smoke::Mailer::MIME_Lite->new(%fields);
129             };
130             }
131              
132             }
133              
134             =head2 Test::Smoke::Mailer->config( $key[, $value] )
135              
136             C is an interface to the package lexical C<%CONFIG>,
137             which holds all the default values for the C arguments.
138              
139             With the special key B this returns a reference
140             to a hash holding all the default values.
141              
142             =cut
143              
144             sub config {
145 0     0 1   my $dummy = shift;
146              
147 0           my $key = lc shift;
148              
149 0 0         if ( $key eq 'all_defaults' ) {
150             my %default = map {
151 0           my( $pass_key ) = $_ =~ /^df_(.+)/;
  0            
152 0           ( $pass_key => $CONFIG{ $_ } );
153             } grep /^df_/ => keys %CONFIG;
154 0           return \%default;
155             }
156              
157 0 0         return undef unless exists $CONFIG{ "df_$key" };
158              
159 0 0         $CONFIG{ "df_$key" } = shift if @_;
160              
161 0           return $CONFIG{ "df_$key" };
162             }
163              
164             =head1 COPYRIGHT
165              
166             (c) 2002-2013, All rights reserved.
167              
168             * Abe Timmerman
169              
170             This library is free software; you can redistribute it and/or modify
171             it under the same terms as Perl itself.
172              
173             See:
174              
175             * ,
176             *
177              
178             This program is distributed in the hope that it will be useful,
179             but WITHOUT ANY WARRANTY; without even the implied warranty of
180             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
181              
182             =cut