File Coverage

blib/lib/Log/Dispatch/Email/Siffra.pm
Criterion Covered Total %
statement 46 65 70.7
branch 0 2 0.0
condition 0 3 0.0
subroutine 14 16 87.5
pod 2 2 100.0
total 62 88 70.4


line stmt bran cond sub pod time code
1             package Log::Dispatch::Email::Siffra;
2              
3 1     1   159811 use 5.014;
  1         4  
4 1     1   5 use strict;
  1         2  
  1         20  
5 1     1   4 use warnings;
  1         2  
  1         23  
6 1     1   4 use Carp;
  1         2  
  1         52  
7 1     1   5 use utf8;
  1         2  
  1         6  
8 1     1   598 use Data::Dumper;
  1         6052  
  1         411  
9 1     1   460 use DDP;
  1         40329  
  1         14  
10 1     1   67 use Encode qw(decode encode);
  1         3  
  1         64  
11 1     1   513 use Log::Any qw($log);
  1         8209  
  1         12  
12             $Carp::Verbose = 1;
13              
14             $| = 1; #autoflush
15              
16             BEGIN
17             {
18 1     1   27 binmode( STDOUT, ":encoding(UTF-8)" );
  1     1   9  
  1         3  
  1         9  
19 1         1141 binmode( STDERR, ":encoding(UTF-8)" );
20 1         554 require Log::Dispatch::Email;
21 1     1   2171 use Exporter ();
  1         2  
  1         23  
22 1     1   9 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  1         2  
  1         143  
23 1         283610 $VERSION = '0.03';
24 1         26 @ISA = qw(Log::Dispatch::Email Exporter);
25              
26             #Give a hoot don't pollute, do not export more than needed by default
27 1         6 @EXPORT = qw();
28 1         4 @EXPORT_OK = qw();
29 1         60 %EXPORT_TAGS = ();
30             } ## end BEGIN
31              
32             =head3 C<send_email()>
33             =cut
34              
35             sub send_email
36             {
37 0     0 1   my ( $self, %parameters ) = @_;
38              
39             # Send email somehow. Message is in $parameters{message}
40 1     1   878 use MIME::Lite;
  1         30793  
  1         306  
41              
42 0           my $to = ( join ',', @{ $self->{ to } } );
  0            
43 0           my $from = $self->{ from };
44 0           my $subject = encode( 'utf8', 'Test Email encode : não / ü / ção...' );
45 0           my $message = "<h4>$parameters{ message }</h4>";
46 0           $message = encode( 'utf8', $message );
47              
48 0           my $msg = MIME::Lite->new(
49             From => $from,
50             To => $to,
51             Subject => $subject,
52             Data => $message,
53             Type => 'text/html; charset=UTF-8',
54             );
55              
56 0           $msg->attr( 'content-type' => 'text/html' );
57 0           $msg->attr( 'content-type.charset' => 'UTF-8' );
58 0           $msg->send( 'smtp', 'mail', 'port', 2525 );
59 0           $log->info( "Email Sent Successfully\n" );
60             } ## end sub send_email
61              
62             =head3 C<flush()>
63             =cut
64              
65             sub flush
66             {
67 0     0 1   my ( $self, %parameters ) = @_;
68              
69 0 0 0       if ( $self->{ buffered } && @{ $self->{ buffer } } )
  0            
70             {
71 0           my $message = join "<br>", @{ $self->{ buffer } };
  0            
72              
73 0           $self->send_email( message => $message );
74 0           $self->{ buffer } = [];
75             } ## end if ( $self->{ buffered...})
76             } ## end sub flush
77              
78             #################### main pod documentation begin ###################
79             ## Below is the stub of documentation for your module.
80             ## You better edit it!
81              
82             =encoding UTF-8
83              
84              
85             =head1 NAME
86              
87             Log::Dispatch::Email::Siffra - Module abstract (<= 44 characters) goes here
88              
89             =head1 SYNOPSIS
90              
91             use Log::Dispatch::Email::Siffra;
92             blah blah blah
93              
94              
95             =head1 DESCRIPTION
96              
97             Stub documentation for this module was created by ExtUtils::ModuleMaker.
98             It looks like the author of the extension was negligent enough
99             to leave the stub unedited.
100              
101             Blah blah blah.
102              
103              
104             =head1 USAGE
105              
106              
107              
108             =head1 BUGS
109              
110              
111              
112             =head1 SUPPORT
113              
114              
115              
116             =head1 AUTHOR
117              
118             Luiz Benevenuto
119             CPAN ID: LUIZBENE
120             Siffra TI
121             luiz@siffra.com.br
122             https://siffra.com.br
123              
124             =head1 COPYRIGHT
125              
126             This program is free software; you can redistribute
127             it and/or modify it under the same terms as Perl itself.
128              
129             The full text of the license can be found in the
130             LICENSE file included with this module.
131              
132              
133             =head1 SEE ALSO
134              
135             perl(1).
136              
137             =cut
138              
139             #################### main pod documentation end ###################
140              
141             1;
142              
143             # The preceding line will help the module return a true value
144