File Coverage

blib/lib/Dancer2/Plugin/Email.pm
Criterion Covered Total %
statement 53 72 73.6
branch 6 24 25.0
condition 7 24 29.1
subroutine 10 10 100.0
pod 1 1 100.0
total 77 131 58.7


line stmt bran cond sub pod time code
1             package Dancer2::Plugin::Email;
2              
3             our $VERSION = '0.0201'; # VERSION
4              
5 1     1   423428 use strict;
  1         2  
  1         40  
6 1     1   4 use warnings;
  1         2  
  1         39  
7              
8 1     1   3 use Dancer2::Core::Types qw/HashRef/;
  1         2  
  1         46  
9 1     1   528 use Dancer2::Plugin;
  1         13033  
  1         5  
10 1     1   3091 use Email::Sender::Simple 'sendmail';
  1         130694  
  1         7  
11 1     1   782 use Email::Date::Format 'email_date';
  1         490  
  1         79  
12 1     1   551 use File::Type;
  1         7214  
  1         73  
13 1     1   14 use MIME::Entity;
  1         2  
  1         61  
14 1     1   6 use Module::Runtime 'use_module';
  1         2  
  1         13  
15              
16             has headers => (
17             is => 'ro',
18             isa => HashRef,
19             from_config => sub { +{} },
20             );
21              
22             has transport => (
23             is => 'ro',
24             isa => HashRef,
25             from_config => sub { +{} },
26             );
27              
28             plugin_keywords 'email';
29              
30             sub email {
31 1     1 1 86203 my ($plugin, $params) = @_;
32 1   50     5 $params ||= {};
33 1         4 my $multipart = delete $params->{multipart};
34 1   50     8 my $extra_headers = delete($params->{headers}) || {};
35 1         2 my %headers = ( %{ $plugin->headers }, %$params, %$extra_headers );
  1         5  
36 1         49 my $attach = $headers{attach};
37 1         3 my $sender = delete $headers{sender};
38 1 50       8 if (my $type = $headers{type}) {
39 0 0       0 $headers{Type} = $type eq 'html' ? 'text/html' : 'text/plain';
40             }
41 1   50     9 $headers{Type} ||= 'text/plain';
42 1 50 50     8 $headers{Format} ||= 'flowed' if $headers{Type} eq 'text/plain';
43 1   33     1928 $headers{Date} ||= email_date();
44 1         160 delete $headers{$_} for qw(body message attach type);
45              
46             my $email = MIME::Entity->build(
47             Charset => 'utf-8',
48             Encoding => 'quoted-printable',
49             %headers, # %headers may overwrite type, charset, and encoding
50             Data => $params->{body} || $params->{message},
51 1   33     17 );
52 1 50       1677 if ($attach) {
53 0 0       0 if ($multipart) {
54             # by default, when you add an attachment,
55             # C will be called by MIME::Entity, but
56             # defaults to 'mixed'. Thunderbird doesn't like this for
57             # embedded images, so we have a chance to set it to
58             # 'related' or anything that the user wants
59 0         0 $email->make_multipart($multipart);
60             }
61 0 0       0 my @attachments = ref($attach) eq 'ARRAY' ? @$attach : $attach;
62 0         0 for my $attachment (@attachments) {
63 0         0 my %mime;
64 0 0       0 if (ref($attachment) eq 'HASH') {
65 0         0 %mime = %$attachment;
66 0 0 0     0 unless ($mime{Path} || $mime{Data}) {
67 0         0 $plugin->app->log('warning', "No Path or Data provided for this attachment!");
68 0         0 next;
69             };
70 0 0       0 if ( $mime{Path} ) {
71 0   0     0 $mime{Encoding} ||= 'base64';
72 0   0     0 $mime{Type} ||= File::Type->mime_type( $mime{Path} ),;
73             }
74             } else {
75 0         0 %mime = (
76             Path => $attachment,
77             Type => File::Type->mime_type($attachment),
78             Encoding => 'base64',
79             );
80             }
81 0         0 $email->attach(%mime);
82             }
83             }
84              
85 1         1 my $transport;
86 1 50       2 if (my ($transport_name) = keys %{ $plugin->transport }) {
  1         5  
87 1   50     629 my $transport_params = $plugin->transport->{$transport_name} || {};
88 1         10 my $transport_class = "Email::Sender::Transport::$transport_name";
89 1         2 my $transport_redirect = $transport_params->{redirect_address};
90 1         5 $transport = use_module($transport_class)->new($transport_params);
91              
92 1 50       7632 if ($transport_redirect) {
93 0         0 $transport_class = 'Email::Sender::Transport::Redirect';
94 0         0 $plugin->app->log('debug', "Redirecting email to $transport_redirect.");
95 0         0 $transport = use_module($transport_class)->new(
96             transport => $transport,
97             redirect_address => $transport_redirect
98             );
99             }
100             }
101 1         5 my %sendmail_arg = ( transport => $transport );
102 1 50       4 $sendmail_arg{from} = $sender if defined $sender;
103 1         7 return sendmail $email, \%sendmail_arg;
104             };
105              
106             # ABSTRACT: Simple email sending for Dancer2 applications
107              
108              
109             1;
110              
111             __END__