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-2019 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 the bundle MailTools. Meta-POD processed with
6             # OODoc into POD and HTML manual-pages. See README.md for Copyright.
7             # Licensed under the same terms as Perl itself.
8              
9             package Mail::Mailer::testfile;
10 1     1   7 use vars '$VERSION';
  1         2  
  1         68  
11             $VERSION = '2.21';
12              
13 1     1   5 use base 'Mail::Mailer::rfc822';
  1         6  
  1         468  
14              
15 1     1   6 use strict;
  1         2  
  1         25  
16              
17 1     1   449 use Mail::Util qw/mailaddress/;
  1         3  
  1         251  
18              
19             my $num = 0;
20             sub can_cc() { 0 }
21              
22             sub exec($$$)
23 0     0 0   { my ($self, $exe, $args, $to) = @_;
24              
25 0   0       my $outfn = $Mail::Mailer::testfile::config{outfile} || 'mailer.testfile';
26 0 0         open F, '>>', $outfn
27             or die "Cannot append message to testfile $outfn: $!";
28              
29             print F "\n===\ntest ", ++$num, " ", (scalar localtime),
30             "\nfrom: " . mailaddress(),
31 0           "\nto: " . join(' ',@{$to}), "\n\n";
  0            
32 0           close F;
33              
34 0 0         untie *$self if tied *$self;
35 0           tie *$self, 'Mail::Mailer::testfile::pipe', $self;
36 0           $self;
37             }
38              
39 1     1 0   sub close { 1 }
40              
41             package Mail::Mailer::testfile::pipe;
42 1     1   7 use vars '$VERSION';
  1         2  
  1         164  
43             $VERSION = '2.21';
44              
45              
46             sub TIEHANDLE
47 0     0     { my ($class, $self) = @_;
48 0           bless \$self, $class;
49             }
50              
51             sub PRINT
52 0     0     { my $self = shift;
53 0   0       open F, '>>', $Mail::Mailer::testfile::config{outfile} || 'mailer.testfile';
54 0           print F @_;
55 0           close F;
56             }
57              
58             1;