File Coverage

blib/lib/Mail/Mailer/testfile.pm
Criterion Covered Total %
statement 16 31 51.6
branch 0 4 0.0
condition 0 4 0.0
subroutine 6 9 66.6
pod 0 2 0.0
total 22 50 44.0


line stmt bran cond sub pod time code
1             # Copyrights 1995-2017 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 1     1   8 use strict;
  1         4  
  1         50  
6              
7             package Mail::Mailer::testfile;
8 1     1   7 use vars '$VERSION';
  1         3  
  1         75  
9             $VERSION = '2.19';
10              
11 1     1   9 use base 'Mail::Mailer::rfc822';
  1         3  
  1         390  
12              
13 1     1   344 use Mail::Util qw/mailaddress/;
  1         4  
  1         338  
14              
15             my $num = 0;
16             sub can_cc() { 0 }
17              
18             sub exec($$$)
19 0     0 0   { my ($self, $exe, $args, $to) = @_;
20              
21 0   0       my $outfn = $Mail::Mailer::testfile::config{outfile} || 'mailer.testfile';
22 0 0         open F, '>>', $outfn
23             or die "Cannot append message to testfile $outfn: $!";
24              
25             print F "\n===\ntest ", ++$num, " ", (scalar localtime),
26             "\nfrom: " . mailaddress(),
27 0           "\nto: " . join(' ',@{$to}), "\n\n";
  0            
28 0           close F;
29              
30 0 0         untie *$self if tied *$self;
31 0           tie *$self, 'Mail::Mailer::testfile::pipe', $self;
32 0           $self;
33             }
34              
35 1     1 0   sub close { 1 }
36              
37             package Mail::Mailer::testfile::pipe;
38 1     1   10 use vars '$VERSION';
  1         3  
  1         170  
39             $VERSION = '2.19';
40              
41              
42             sub TIEHANDLE
43 0     0     { my ($class, $self) = @_;
44 0           bless \$self, $class;
45             }
46              
47             sub PRINT
48 0     0     { my $self = shift;
49 0   0       open F, '>>', $Mail::Mailer::testfile::config{outfile} || 'mailer.testfile';
50 0           print F @_;
51 0           close F;
52             }
53              
54             1;