Line # Revision Author
1 740 ahitrov package Contenido::Mail;
2
3 743 ahitrov use strict;
4 use warnings;
5
6 740 ahitrov use Net::SMTP;
7 use MIME::Lite;
8 use MIME::Base64;
9 use Data::Dumper;
10 743 ahitrov
11 use parent 'Contenido::Accessor';
12 __PACKAGE__->mk_accessors(qw(enable mailer from login password server hello timeout ssl port));
13
14 740 ahitrov use Contenido::Globals;
15 743 ahitrov use Contenido::Email;
16 740 ahitrov
17 sub new {
18 743 ahitrov my ($proto, $args) = @_;
19 740 ahitrov my $class = ref($proto) || $proto;
20 743 ahitrov $args //= {};
21 740 ahitrov my $self = {};
22 743 ahitrov bless $self, $class;
23 740 ahitrov
24 743 ahitrov $self->enable( $state->{email_enable} );
25 if ( $self->enable ) {
26 $self->mailer( $state->{email_mailer} );
27 $self->from( $state->{email_from} );
28 $self->login( delete $args->{login} || $state->{email_auth_login} );
29 $self->password( delete $args->{password} || $state->{email_auth_password} );
30 if ( $self->mailer eq 'smtp' ) {
31 $self->server( $state->{email_smtp_server} );
32 $self->hello( $state->{email_smtp_hello} );
33 $self->timeout( $state->{email_smtp_timeout} );
34 $self->ssl( $state->{email_smtp_ssl} );
35 $self->port( $state->{email_smtp_port} );
36 740 ahitrov }
37 }
38
39 750 ahitrov warn Dumper $self if $DEBUG;
40 740 ahitrov return $self;
41 }
42
43 sub send {
44 return unless @_;
45 my $self;
46 if ( ref $_[0] eq 'Contenido::Mail' ) {
47 $self = shift;
48 743 ahitrov } elsif ( !ref $_[0] && $_[0] eq 'Contenido::Mail' ) {
49 my $class = shift;
50 $self = $class->new;
51 740 ahitrov } else {
52 $self = Contenido::Mail->new;
53 }
54
55 my $opts = shift // {};
56 755 ahitrov my $debug = $state->development || $DEBUG || $opts->{debug} ? 1 : 0;
57 740 ahitrov
58 my $email = delete $opts->{email} // return undef;
59 755 ahitrov warn Dumper $email if $debug;
60 740 ahitrov return unless ref $email && exists $email->{to} && $email->{subject} && $email->{body};
61
62 my $etype = delete $opts->{etype} // 'mixed';
63
64 my $subject = $email->{subject};
65 $subject = MIME::Base64::encode($subject);
66 $subject =~ s/\s//sgi;
67 $subject = '=?utf-8?B?'.$subject.'?=';
68
69 743 ahitrov my $error;
70 740 ahitrov my $emailfrom;
71 if ( $email->{from} ) {
72 my ($from, $efrom) = $email->{from} =~ /^(.*?)<(.*?)>/ ? ($1, $2) : $email->{from} =~ /<(.*?)>/ ? ('',$1) : ('',$email->{from});
73 if ( $from ) {
74 $from = MIME::Base64::encode($from);
75 $from =~ s/\s+$//si;
76 $from = '=?utf-8?B?'.$from.'?=';
77 $emailfrom = $from.' <'.$efrom.'>';
78 } else {
79 $emailfrom = $efrom;
80 }
81 766 ahitrov } elsif ( $self->from ) {
82 $emailfrom = $self->from;
83 740 ahitrov }
84
85 my ($emailto, @to);
86 if ( ref $email->{to} eq 'ARRAY' ) {
87 foreach my $tostr ( @{$email->{to}} ) {
88 my ($to, $eto) = $tostr =~ /^(.*?)<(.*?)>/ ? ($1, $2) : $tostr =~ /<(.*?)>/ ? ('',$1) : ('',$tostr);
89 if ( $to ) {
90 $to = MIME::Base64::encode($to);
91 $to =~ s/\s+$//si;
92 $to = '=?utf-8?B?'.$to.'?=';
93 push @to, $to.' <'.$eto.'>';
94 } else {
95 758 ahitrov push @to, '<'.$eto.'>';
96 740 ahitrov }
97 }
98 758 ahitrov $emailto = join ', ', @to;
99 740 ahitrov } else {
100 my ($to, $eto) = $email->{to} =~ /^(.*?)<(.*?)>/ ? ($1, $2) : $email->{to} =~ /<(.*?)>/ ? ('',$1) : ('',$email->{to});
101 if ( $to ) {
102 $to = MIME::Base64::encode($to);
103 $to =~ s/\s+$//si;
104 $to = '=?utf-8?B?'.$to.'?=';
105 $emailto = $to.' <'.$eto.'>';
106 } else {
107 $emailto = $eto;
108 }
109 758 ahitrov @to = ($emailto);
110 740 ahitrov }
111
112 my $ccmail;
113 if ( exists $email->{cc} && ref $email->{cc} eq 'ARRAY' ) {
114 foreach my $cc ( @{ $email->{cc}} ) {
115 my ($cce, $ecce) = $cc =~ /^(.*?)<(.*?)>/ ? ($1, $2) : $cc =~ /<(.*?)>/ ? ('',$1) : ('',$cc);
116 759 ahitrov $email->{cc} = ($cce ? $cce.' ' : '').'<'.$ecce.'>';
117 push @to, $ecce;
118 740 ahitrov }
119 759 ahitrov $ccmail = join ', ', @{$email->{cc}};
120 740 ahitrov } elsif ( exists $email->{cc} && $email->{cc} ) {
121 my ($cce, $ecce) = $email->{cc} =~ /^(.*?)<(.*?)>/ ? ($1, $2) : $email->{cc} =~ /<(.*?)>/ ? ('',$1) : ('',$email->{cc});
122 759 ahitrov $ccmail = ($cce ? $cce.' ' : '').'<'.$ecce.'>';
123 push @to, $ecce;
124 740 ahitrov }
125
126 my $body = $email->{body};
127 warn Dumper($email) if $debug;
128 my $dt = Contenido::DateTime->new;
129 $dt->set_locale('en_EN');
130 my $pdate = $dt->strftime("%a, %d %b %Y %H:%M:%S %z");
131 my $msg = MIME::Lite->new(
132 To => $emailto,
133 From => $emailfrom,
134 $ccmail ? ( Cc => $ccmail ) : (),
135 Subject => $subject,
136 # Encoding=> 'binary',
137 Date => $pdate,
138 Type => ($etype eq 'mixed' ? 'multipart/mixed' : $etype eq 'related' ? 'multipart/related;type="multipart/alternative";charset="utf-8"' : $etype),
139 );
140 $msg->attach(
141 'Type' => 'text/html;charset="utf-8"',
142 'Data' => $body,
143 'Disposition' => '',
144 );
145
146 my $email_body = $msg->as_string;
147 if ( $self->mailer eq 'smtp' ) {
148 my $mailer = Net::SMTP->new( $self->{server},
149 $self->{hello} ? (Hello => $self->{hello}) : (),
150 Port => $self->{port},
151 Timeout => $self->{timeout},
152 SSL => $self->{ssl},
153 Debug => $debug,
154 );
155 warn Dumper $mailer if $debug;
156 if ( ref $mailer ) {
157 if ( $self->{login} && $self->{password} ) {
158 $mailer->auth( $self->{login}, $self->{password} );
159 747 ahitrov unless ( $mailer->ok ) {
160 $error = $mailer->message;
161 }
162 740 ahitrov }
163 747 ahitrov unless ( $error ) {
164 $mailer->mail( $emailfrom );
165 unless ( $mailer->ok ) {
166 $error = $mailer->message;
167 }
168 }
169 unless ( $error ) {
170 758 ahitrov $mailer->to( @to );
171 747 ahitrov unless ( $mailer->ok ) {
172 $error = $mailer->message;
173 }
174 }
175 unless ( $error ) {
176 $mailer->data;
177 $mailer->datasend( $email_body );
178 $mailer->dataend;
179 }
180 740 ahitrov $mailer->quit;
181 } else {
182 747 ahitrov $error = "MAIL ERROR! Can't create SMTP object";
183 743 ahitrov warn "$error\n";
184 740 ahitrov }
185 }
186 743 ahitrov return $error;
187 740 ahitrov }
188
189
190 743 ahitrov sub add {
191 return unless @_;
192 my $self;
193 if ( ref $_[0] eq 'Contenido::Mail' ) {
194 $self = shift;
195 } elsif ( !ref $_[0] && $_[0] eq 'Contenido::Mail' ) {
196 my $class = shift;
197 $self = $class->new;
198 } else {
199 $self = Contenido::Mail->new;
200 }
201
202 my $opts = shift // {};
203 755 ahitrov my $debug = $state->development || $DEBUG || $opts->{debug} ? 1 : 0;
204 743 ahitrov
205 my $email = delete $opts->{email} // return undef;
206 755 ahitrov warn Dumper $email if $debug;
207 743 ahitrov return unless ref $email && exists $email->{to} && $email->{subject} && $email->{body};
208
209 my $que = Contenido::Email->new( $keeper );
210 $que->status( 0 );
211 757 ahitrov if ( ref $email->{to} eq 'ARRAY' ) {
212 758 ahitrov my @to = grep { $_ } @{$email->{to}};
213 return unless @to;
214 $que->name( join ',', @to );
215 757 ahitrov } else {
216 758 ahitrov return unless $email->{to};
217 757 ahitrov $que->name( $email->{to} );
218 }
219 758 ahitrov if ( exists $email->{cc} && ref $email->{cc} eq 'ARRAY' ) {
220 $que->cc( join("\n", @{$email->{cc}}) );
221 } elsif ( exists $email->{cc} && $email->{cc} ) {
222 $que->cc( $email->{cc} );
223 }
224 766 ahitrov if ( exists $email->{from} && $email->{from} ) {
225 $que->from( $email->{from} );
226 }
227 743 ahitrov $que->subject( $email->{subject} );
228 $que->body_html( $email->{body} );
229 if ( exists $email->{text} ) {
230 $que->body_text( $email->{text} );
231 }
232 if ( exists $email->{date} && ref $email->{date} eq 'DateTime' ) {
233 $que->dtime( $email->{date}->ymd('-').' '.$email->{date}->hms );
234 } elsif ( exists $email->{date} && $email->{date} ) {
235 my $dt;
236 eval{ $dt = Contenido::DateTime->new( postgres => $email->{date} ) };
237 if ( ref $dt ) {
238 $que->dtime( $dt->ymd('-').' '.$dt->hms );
239 }
240 } else {
241 my $now = Contenido::DateTime->new;
242 $que->dtime( $now->ymd('-').' '.$now->hms );
243 }
244 if ( $que->store ) {
245 return $que;
246 }
247 756 ahitrov warn "Store failed!!!!\n" if $debug;
248 743 ahitrov return undef;
249 }
250
251 740 ahitrov 1;