File Coverage

lib/Haineko/SMTPD/Relay/File.pm
Criterion Covered Total %
statement 75 88 85.2
branch 7 12 58.3
condition 5 9 55.5
subroutine 12 13 92.3
pod 2 2 100.0
total 101 124 81.4


line stmt bran cond sub pod time code
1             package Haineko::SMTPD::Relay::File;
2 1     1   6602 use parent 'Haineko::SMTPD::Relay';
  1         367  
  1         5  
3 1     1   45 use strict;
  1         3  
  1         33  
4 1     1   5 use warnings;
  1         2  
  1         27  
5 1     1   656 use Haineko::SMTPD::Response;
  1         2  
  1         34  
6 1     1   1297 use Email::MIME;
  1         88214  
  1         53  
7 1     1   1151 use Time::Piece;
  1         13723  
  1         6  
8 1     1   906 use Try::Tiny;
  1         1802  
  1         66  
9 1     1   980 use IO::File;
  1         11655  
  1         170  
10 1     1   10 use Encode;
  1         2  
  1         913  
11              
12             sub new {
13 3     3 1 707 my $class = shift;
14 3         12 my $argvs = { @_ };
15              
16 3   50     22 $argvs->{'host'} ||= '/tmp';
17 3   66     26 $argvs->{'port'} = undef,
18             $argvs->{'time'} ||= Time::Piece->new;
19 3         440 $argvs->{'sleep'} = 0;
20 3         8 $argvs->{'retry'} = 0;
21 3         6 $argvs->{'timeout'} = 0;
22 3         8 $argvs->{'startls'} = 0;
23 3         13 return bless $argvs, __PACKAGE__;
24             }
25              
26             sub sendmail {
27 1     1 1 3970 my $self = shift;
28              
29 1         3 my $headerlist = [];
30 1   50     10 my $emencoding = uc( $self->{'attr'}->{'charset'} || 'UTF-8' );
31 1         8 my $methodargv = {
32 1         2 'body' => Encode::encode( $emencoding, ${ $self->{'body'} } ),
33             'attributes' => $self->{'attr'},
34             };
35 1 50       199 utf8::decode $methodargv->{'body'} unless utf8::is_utf8 $methodargv->{'body'} ;
36              
37 1         2 for my $e ( @{ $self->{'head'}->{'Received'} } ) {
  1         7  
38             # Convert email headers
39 0         0 push @$headerlist, 'Received' => $e;
40             }
41 1         4 push @$headerlist, 'To' => $self->{'rcpt'};
42              
43 1         2 for my $e ( keys %{ $self->{'head'} } ) {
  1         6  
44             # Make email headers except ``Received'' and ``MIME-Version''
45 5 100       15 next if $e eq 'Received';
46 4 50       10 next if $e eq 'MIME-Version';
47              
48 4 50       11 if( ref $self->{'head'}->{ $e } eq 'ARRAY' ) {
49              
50 0         0 for my $f ( @{ $self->{'head'}->{ $e } } ) {
  0         0  
51 0         0 push @$headerlist, $e => $f;
52             }
53             }
54             else {
55 4         11 push @$headerlist, $e => $self->{'head'}->{ $e };
56             }
57             }
58 1         4 $methodargv->{'header'} = $headerlist;
59              
60 1         13 my $mimeobject = Email::MIME->create( %$methodargv );
61 1         3384 my $mailstring = $mimeobject->as_string;
62 1         94 my $mailfolder = $self->{'host'};
63 1         4 my $messageid0 = undef;
64              
65 1 50       6 if( exists $self->{'head'}->{'Message-Id'} ) {
66             # Use the local part of the Message-Id header as a file name.
67 1         7 $messageid0 = [ split( '@', $self->{'head'}->{'Message-Id'} ) ]->[0];
68              
69             } else {
70             # Message-Id header is not defined or does not exist
71 0         0 require Haineko::SMTPD::Session;
72 0         0 $messageid0 = sprintf( "%s.%d.%d.%03d",
73             Haineko::SMTPD::Session->make_queueid, $$,
74             $self->time->epoch, int(rand(100)) );
75             }
76              
77 1         6 my $timestring = sprintf( "%s-%s", $self->time->ymd('-'), $self->time->hms );
78 1         47 my $outputfile = sprintf( "%s/haineko.%s.%s.eml", $mailfolder, $timestring, $messageid0 );
79 1         2 my $filehandle = undef;
80 1         2 my $smtpparams = undef;
81 1         2 my $smtpstatus = 0;
82              
83             try {
84 1     1   46 $outputfile =~ y{/}{}s;
85 1         12 $smtpparams = {
86             'dsn' => undef,
87             'code' => 200,
88             'host' => undef,
89             'port' => undef,
90             'rcpt' => $self->{'rcpt'},
91             'error' => 0,
92             'mailer' => 'File',
93             'message' => [ $outputfile ],
94             'command' => 'DATA',
95             };
96 1   50     10 $filehandle = IO::File->new( $outputfile, 'w' ) || die $!;
97 1 50       291 utf8::encode $mailstring if utf8::is_utf8 $mailstring;
98              
99 1         11 $filehandle->print( $mailstring );
100 1         151 $filehandle->close;
101 1         230 push @{ $smtpparams->{'message'} }, 'Successfully saved';
  1         4  
102 1         5 $smtpstatus = 1;
103              
104             } catch {
105 0     0   0 require Haineko::E;
106 0         0 my $E = Haineko::E->new( $_ );
107 0         0 $smtpparams->{'code'} = 400;
108 0         0 $smtpparams->{'error'} = 1;
109 0         0 push @{ $smtpparams->{'message'} }, 'Failed to save: '.join( ' ', @{ $E->mesg } );
  0         0  
  0         0  
110 1         23 };
111              
112 1         42 $self->response( Haineko::SMTPD::Response->new( %$smtpparams ) );
113 1         39 return $smtpstatus;
114             }
115              
116             1;
117             __END__