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 852 ahitrov push @to, $emailto;
110 740 ahitrov }
111
112 my $ccmail;
113 if ( exists $email->{cc} && ref $email->{cc} eq 'ARRAY' ) {
114 852 ahitrov my @cc;
115 740 ahitrov foreach my $cc ( @{ $email->{cc}} ) {
116 my ($cce, $ecce) = $cc =~ /^(.*?)<(.*?)>/ ? ($1, $2) : $cc =~ /<(.*?)>/ ? ('',$1) : ('',$cc);
117 852 ahitrov if ( $cce ) {
118 $cce = MIME::Base64::encode($cce);
119 $cce =~ s/\s+$//si;
120 $cce = '=?utf-8?B?'.$cce.'?=';
121 push @to, $cce.' <'.$ecce.'>';
122 push @cc, $cce.' <'.$ecce.'>';
123 } else {
124 push @to, '<'.$ecce.'>';
125 push @cc, '<'.$ecce.'>';
126 }
127 740 ahitrov }
128 852 ahitrov $ccmail = join ', ', @cc;
129 740 ahitrov } elsif ( exists $email->{cc} && $email->{cc} ) {
130 my ($cce, $ecce) = $email->{cc} =~ /^(.*?)<(.*?)>/ ? ($1, $2) : $email->{cc} =~ /<(.*?)>/ ? ('',$1) : ('',$email->{cc});
131 852 ahitrov if ( $cce ) {
132 $cce = MIME::Base64::encode($cce);
133 $cce =~ s/\s+$//si;
134 $cce = '=?utf-8?B?'.$cce.'?=';
135 $ccmail = $cce.' <'.$ecce.'>';
136 } else {
137 $ccmail = $ecce;
138 }
139 push @to, $ccmail;
140 740 ahitrov }
141
142 my $body = $email->{body};
143 warn Dumper($email) if $debug;
144 my $dt = Contenido::DateTime->new;
145 $dt->set_locale('en_EN');
146 my $pdate = $dt->strftime("%a, %d %b %Y %H:%M:%S %z");
147 my $msg = MIME::Lite->new(
148 To => $emailto,
149 From => $emailfrom,
150 $ccmail ? ( Cc => $ccmail ) : (),
151 Subject => $subject,
152 # Encoding=> 'binary',
153 Date => $pdate,
154 Type => ($etype eq 'mixed' ? 'multipart/mixed' : $etype eq 'related' ? 'multipart/related;type="multipart/alternative";charset="utf-8"' : $etype),
155 );
156 $msg->attach(
157 'Type' => 'text/html;charset="utf-8"',
158 'Data' => $body,
159 'Disposition' => '',
160 );
161
162 my $email_body = $msg->as_string;
163 if ( $self->mailer eq 'smtp' ) {
164 my $mailer = Net::SMTP->new( $self->{server},
165 $self->{hello} ? (Hello => $self->{hello}) : (),
166 Port => $self->{port},
167 Timeout => $self->{timeout},
168 SSL => $self->{ssl},
169 Debug => $debug,
170 );
171 warn Dumper $mailer if $debug;
172 if ( ref $mailer ) {
173 if ( $self->{login} && $self->{password} ) {
174 $mailer->auth( $self->{login}, $self->{password} );
175 747 ahitrov unless ( $mailer->ok ) {
176 $error = $mailer->message;
177 }
178 740 ahitrov }
179 747 ahitrov unless ( $error ) {
180 $mailer->mail( $emailfrom );
181 unless ( $mailer->ok ) {
182 $error = $mailer->message;
183 }
184 }
185 unless ( $error ) {
186 758 ahitrov $mailer->to( @to );
187 747 ahitrov unless ( $mailer->ok ) {
188 $error = $mailer->message;
189 }
190 }
191 unless ( $error ) {
192 $mailer->data;
193 $mailer->datasend( $email_body );
194 $mailer->dataend;
195 }
196 740 ahitrov $mailer->quit;
197 } else {
198 747 ahitrov $error = "MAIL ERROR! Can't create SMTP object";
199 743 ahitrov warn "$error\n";
200 740 ahitrov }
201 }
202 743 ahitrov return $error;
203 740 ahitrov }
204
205
206 743 ahitrov sub add {
207 return unless @_;
208 my $self;
209 if ( ref $_[0] eq 'Contenido::Mail' ) {
210 $self = shift;
211 } elsif ( !ref $_[0] && $_[0] eq 'Contenido::Mail' ) {
212 my $class = shift;
213 $self = $class->new;
214 } else {
215 $self = Contenido::Mail->new;
216 }
217
218 my $opts = shift // {};
219 755 ahitrov my $debug = $state->development || $DEBUG || $opts->{debug} ? 1 : 0;
220 743 ahitrov
221 my $email = delete $opts->{email} // return undef;
222 755 ahitrov warn Dumper $email if $debug;
223 743 ahitrov return unless ref $email && exists $email->{to} && $email->{subject} && $email->{body};
224
225 my $que = Contenido::Email->new( $keeper );
226 $que->status( 0 );
227 757 ahitrov if ( ref $email->{to} eq 'ARRAY' ) {
228 758 ahitrov my @to = grep { $_ } @{$email->{to}};
229 return unless @to;
230 $que->name( join ',', @to );
231 757 ahitrov } else {
232 758 ahitrov return unless $email->{to};
233 757 ahitrov $que->name( $email->{to} );
234 }
235 758 ahitrov if ( exists $email->{cc} && ref $email->{cc} eq 'ARRAY' ) {
236 $que->cc( join("\n", @{$email->{cc}}) );
237 } elsif ( exists $email->{cc} && $email->{cc} ) {
238 $que->cc( $email->{cc} );
239 }
240 766 ahitrov if ( exists $email->{from} && $email->{from} ) {
241 $que->from( $email->{from} );
242 }
243 743 ahitrov $que->subject( $email->{subject} );
244 $que->body_html( $email->{body} );
245 if ( exists $email->{text} ) {
246 $que->body_text( $email->{text} );
247 }
248 if ( exists $email->{date} && ref $email->{date} eq 'DateTime' ) {
249 $que->dtime( $email->{date}->ymd('-').' '.$email->{date}->hms );
250 } elsif ( exists $email->{date} && $email->{date} ) {
251 my $dt;
252 eval{ $dt = Contenido::DateTime->new( postgres => $email->{date} ) };
253 if ( ref $dt ) {
254 $que->dtime( $dt->ymd('-').' '.$dt->hms );
255 }
256 } else {
257 my $now = Contenido::DateTime->new;
258 $que->dtime( $now->ymd('-').' '.$now->hms );
259 }
260 if ( $que->store ) {
261 return $que;
262 }
263 756 ahitrov warn "Store failed!!!!\n" if $debug;
264 743 ahitrov return undef;
265 }
266
267 740 ahitrov 1;