SL::Mailer: content_type statt contenttype, so wie im POD beschrieben
[kivitendo-erp.git] / SL / Mailer.pm
1 #=====================================================================
2 # LX-Office ERP
3 # Copyright (C) 2004
4 # Based on SQL-Ledger Version 2.1.9
5 # Web http://www.lx-office.org
6 #
7 #=====================================================================
8 #
9 # This program is free software; you can redistribute it and/or modify
10 # it under the terms of the GNU General Public License as published by
11 # the Free Software Foundation; either version 2 of the License, or
12 # (at your option) any later version.
13 #
14 # This program is distributed in the hope that it will be useful,
15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with this program; if not, write to the Free Software
20 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
21 # MA 02110-1335, USA.
22 #======================================================================
23
24 package Mailer;
25
26 use Email::Address;
27 use Email::MIME::Creator;
28 use File::MimeInfo::Magic;
29 use File::Slurp;
30 use List::UtilsBy qw(bundle_by);
31
32 use SL::Common;
33 use SL::DB::EmailJournal;
34 use SL::DB::EmailJournalAttachment;
35 use SL::DB::Employee;
36 use SL::Template;
37 use SL::Version;
38
39 use strict;
40
41 my $num_sent = 0;
42
43 my %mail_delivery_modules = (
44   sendmail => 'SL::Mailer::Sendmail',
45   smtp     => 'SL::Mailer::SMTP',
46 );
47
48 my %type_to_table = (
49   sales_quotation         => 'oe',
50   request_quotation       => 'oe',
51   sales_order             => 'oe',
52   purchase_order          => 'oe',
53   invoice                 => 'ar',
54   credit_note             => 'ar',
55   purchase_invoice        => 'ap',
56   letter                  => 'letter',
57   purchase_delivery_order => 'delivery_orders',
58   sales_delivery_order    => 'delivery_orders',
59 );
60
61 sub new {
62   my ($type, %params) = @_;
63   my $self = { %params };
64
65   bless $self, $type;
66 }
67
68 sub _create_driver {
69   my ($self) = @_;
70
71   my %params = (
72     mailer   => $self,
73     form     => $::form,
74     myconfig => \%::myconfig,
75   );
76
77   my $module = $mail_delivery_modules{ $::lx_office_conf{mail_delivery}->{method} };
78   eval "require $module" or return undef;
79
80   return $module->new(%params);
81 }
82
83 sub _cleanup_addresses {
84   my ($self) = @_;
85
86   foreach my $item (qw(to cc bcc)) {
87     next unless $self->{$item};
88
89     $self->{$item} =~ s/\&lt;/</g;
90     $self->{$item} =~ s/\$<\$/</g;
91     $self->{$item} =~ s/\&gt;/>/g;
92     $self->{$item} =~ s/\$>\$/>/g;
93   }
94 }
95
96 sub _create_message_id {
97   my ($self) = @_;
98
99   $num_sent  +=  1;
100   my $domain  =  $self->{from};
101   $domain     =~ s/.*\@//;
102   $domain     =~ s/>.*//;
103
104   return  "kivitendo-" . SL::Version->get_version . "-" . time() . "-${$}-${num_sent}\@$domain";
105 }
106
107 sub _create_address_headers {
108   my ($self) = @_;
109
110   # $self->{addresses} collects the recipients for use in e.g. the
111   # SMTP 'RCPT TO:' envelope command. $self->{headers} collects the
112   # headers that make up the actual email. 'BCC' should not be
113   # included there for certain transportation methods (SMTP).
114
115   $self->{addresses} = {};
116
117   foreach my $item (qw(from to cc bcc)) {
118     $self->{addresses}->{$item} = [];
119     next if !$self->{$item};
120
121     my @header_addresses;
122
123     foreach my $addr_obj (Email::Address->parse($self->{$item})) {
124       push @{ $self->{addresses}->{$item} }, $addr_obj->address;
125       next if $self->{driver}->keep_from_header($item);
126
127       my $phrase = $addr_obj->phrase();
128       if ($phrase) {
129         $phrase =~ s/^\"//;
130         $phrase =~ s/\"$//;
131         $addr_obj->phrase($phrase);
132       }
133
134       push @header_addresses, $addr_obj->format;
135     }
136
137     push @{ $self->{headers} }, ( ucfirst($item) => join(', ', @header_addresses) ) if @header_addresses;
138   }
139 }
140
141 sub _create_attachment_part {
142   my ($self, $attachment) = @_;
143
144   my %attributes = (
145     disposition  => 'attachment',
146     encoding     => 'base64',
147   );
148
149   my $attachment_content;
150   my $file_id       = 0;
151   my $email_journal = $::instance_conf->get_email_journal;
152
153   $::lxdebug->message(LXDebug->DEBUG2(), "mail5 att=" . $attachment . " email_journal=" . $email_journal . " id=" . $attachment->{id});
154
155   if (ref($attachment) eq "HASH") {
156     $attributes{filename}     = $attachment->{name};
157     $file_id                  = $attachment->{id}   || '0';
158     $attributes{content_type} = $attachment->{type} || 'application/pdf';
159     $attachment_content       = $attachment->{content};
160     $attachment_content       = eval { read_file($attachment->{path}) } if !$attachment_content;
161
162   } else {
163     $attributes{filename} =  $attachment;
164     $attributes{filename} =~ s:.*\Q$self->{fileid}\E:: if $self->{fileid};
165     $attributes{filename} =~ s:.*/::g;
166
167     my $application             = ($attachment =~ /(^\w+$)|\.(html|text|txt|sql)$/) ? 'text' : 'application';
168     $attributes{content_type}   = File::MimeInfo::Magic::magic($attachment);
169     $attributes{content_type} ||= "${application}/$self->{format}" if $self->{format};
170     $attributes{content_type} ||= 'application/octet-stream';
171     $attachment_content         = eval { read_file($attachment) };
172   }
173
174   return undef if $email_journal > 1 && !defined $attachment_content;
175
176   $attachment_content ||= ' ';
177   $attributes{charset}  = $self->{charset} if $self->{charset} && ($attributes{content_type} =~ m{^text/});
178
179   $::lxdebug->message(LXDebug->DEBUG2(), "mail6 mtype=" . $attributes{content_type} . " filename=" . $attributes{filename});
180
181   my $ent;
182   if ( $attributes{content_type} eq 'message/rfc822' ) {
183     $ent = Email::MIME->new($attachment_content);
184     $ent->header_str_set('Content-disposition' => 'attachment; filename='.$attributes{filename});
185   } else {
186     $ent = Email::MIME->create(
187       attributes => \%attributes,
188       body       => $attachment_content,
189     );
190   }
191
192   push @{ $self->{mail_attachments}} , SL::DB::EmailJournalAttachment->new(
193     name      => $attributes{filename},
194     mime_type => $attributes{content_type},
195     content   => ( $email_journal > 1 ? $attachment_content : ' '),
196     file_id   => $file_id,
197   );
198
199   return $ent;
200 }
201
202 sub _create_message {
203   my ($self) = @_;
204
205   my @parts;
206
207   push @{ $self->{headers} }, (Type => "multipart/mixed");
208
209   if ($self->{message}) {
210     push @parts, Email::MIME->create(
211       attributes => {
212         content_type => $self->{content_type},
213         charset      => $self->{charset},
214         encoding     => 'quoted-printable',
215       },
216       body_str => $self->{message},
217     );
218
219     push @{ $self->{headers} }, (
220       'Content-Type' => qq|$self->{content_type}; charset="$self->{charset}"|,
221     );
222   }
223
224   push @parts, grep { $_ } map { $self->_create_attachment_part($_) } @{ $self->{attachments} || [] };
225
226   return Email::MIME->create(
227       header_str => $self->{headers},
228       parts      => \@parts,
229   );
230 }
231
232 sub send {
233   my ($self) = @_;
234
235   # Create driver for delivery method (sendmail/SMTP)
236   $self->{driver} = eval { $self->_create_driver };
237   if (!$self->{driver}) {
238     my $error = $@;
239     $self->_store_in_journal('failed', 'driver could not be created; check your configuration & log files');
240     $::lxdebug->message(LXDebug::WARN(), "Mailer error during 'send': $error");
241
242     return $error;
243   }
244
245   # Set defaults & headers
246   $self->{charset}        =  'UTF-8';
247   $self->{content_type} ||=  "text/plain";
248   $self->{headers}        =  [
249     Subject               => $self->{subject},
250     'Message-ID'          => '<' . $self->_create_message_id . '>',
251     'X-Mailer'            => "kivitendo " . SL::Version->get_version,
252   ];
253   $self->{mail_attachments} = [];
254   $self->{content_by_name}  = $::instance_conf->get_email_journal == 1 && $::instance_conf->get_doc_files;
255
256   my $error;
257   my $ok = eval {
258     # Clean up To/Cc/Bcc address fields
259     $self->_cleanup_addresses;
260     $self->_create_address_headers;
261
262     my $email = $self->_create_message;
263
264     #$::lxdebug->message(0, "message: " . $email->as_string);
265     # return "boom";
266
267     $::lxdebug->message(LXDebug->DEBUG2(), "mail1 from=".$self->{from}." to=".$self->{to});
268     my $from_obj = (Email::Address->parse($self->{from}))[0];
269
270     $self->{driver}->start_mail(from => $from_obj->address, to => [ $self->_all_recipients ]);
271     $self->{driver}->print($email->as_string);
272     $self->{driver}->send;
273
274     1;
275   };
276
277   $error = $@ if !$ok;
278
279   # create journal and link to record
280   $self->{journalentry} = $self->_store_in_journal;
281   $self->_create_record_link if $self->{journalentry};
282
283   return $ok ? '' : ($error || "undefined error");
284 }
285
286 sub _all_recipients {
287   my ($self) = @_;
288   $self->{addresses} ||= {};
289   return map { @{ $self->{addresses}->{$_} || [] } } qw(to cc bcc);
290 }
291
292 sub _store_in_journal {
293   my ($self, $status, $extended_status) = @_;
294
295   my $journal_enable = $::instance_conf->get_email_journal;
296
297   return if $journal_enable == 0;
298
299   $status          //= $self->{driver}->status if $self->{driver};
300   $status          //= 'failed';
301   $extended_status //= $self->{driver}->extended_status if $self->{driver};
302   $extended_status //= 'unknown error';
303
304   my $headers = join "\r\n", (bundle_by { join(': ', @_) } 2, @{ $self->{headers} || [] });
305
306   my $jentry = SL::DB::EmailJournal->new(
307     sender          => SL::DB::Manager::Employee->current,
308     from            => $self->{from}    // '',
309     recipients      => join(', ', $self->_all_recipients),
310     subject         => $self->{subject} // '',
311     headers         => $headers,
312     body            => $self->{message} // '',
313     sent_on         => DateTime->now_local,
314     attachments     => \@{ $self->{mail_attachments} },
315     status          => $status,
316     extended_status => $extended_status,
317   )->save;
318   return $jentry->id;
319 }
320
321
322 sub _create_record_link {
323   my ($self) = @_;
324
325   # check for custom/overloaded types and ids (form != controller)
326   my $record_type = $self->{record_type} || $::form->{type};
327   my $record_id   = $self->{record_id}   || $::form->{id};
328
329   # you may send mails for unsaved objects (no record_id => unlinkable case)
330   if ($self->{journalentry} && $record_id && exists($type_to_table{$record_type})) {
331     RecordLinks->create_links(
332       mode       => 'ids',
333       from_table => $type_to_table{$record_type},
334       from_ids   => $record_id,
335       to_table   => 'email_journal',
336       to_id      => $self->{journalentry},
337     );
338   }
339 }
340
341 1;
342
343
344 __END__
345
346 =pod
347
348 =encoding utf8
349
350 =head1 NAME
351
352 SL::Mailer - Base class for sending mails from kivitendo
353
354 =head1 SYNOPSIS
355
356   package SL::BackgroundJob::CreatePeriodicInvoices;
357
358   use SL::Mailer;
359
360   my $mail              = Mailer->new;
361   $mail->{from}         = $config{periodic_invoices}->{email_from};
362   $mail->{to}           = $email;
363   $mail->{subject}      = $config{periodic_invoices}->{email_subject};
364   $mail->{content_type} = $filename =~ m/.html$/ ? 'text/html' : 'text/plain';
365   $mail->{message}      = $output;
366
367   $mail->send;
368
369 =head1 OVERVIEW
370
371 Mail can be send from kivitendo via the sendmail command or the smtp protocol.
372
373
374 =head1 INTERNAL DATA TYPES
375
376
377 =over 2
378
379 =item C<%mail_delivery_modules>
380
381   Currently two modules are supported either smtp or sendmail.
382
383 =item C<%type_to_table>
384
385   Due to the lack of a single global mapping for $form->{type},
386   type is mapped to the corresponding database table. All types which
387   implement a mail action are currently mapped and should be mapped.
388   Type is either the value of the old form or the newer controller
389   based object type.
390
391 =back
392
393 =head1 FUNCTIONS
394
395 =over 4
396
397 =item C<new>
398
399 =item C<_create_driver>
400
401 =item C<_cleanup_addresses>
402
403 =item C<_create_address_headers>
404
405 =item C<_create_message_id>
406
407 =item C<_create_attachment_part>
408
409 =item C<_create_message>
410
411 =item C<send>
412
413   If a mail was send successfully the internal functions _store_in_journal
414   is called if email journaling is enabled. If _store_in_journal was executed
415   successfully and the calling form is already persistent (database id) a
416   record_link will be created.
417
418 =item C<_all_recipients>
419
420 =item C<_store_in_journal>
421
422 =item C<_create_record_link $self->{journalentry}, $::form->{id}, $self->{record_id}>
423
424
425   If $self->{journalentry} and either $self->{record_id} or $::form->{id} (checked in
426   this order) exists a record link from record to email journal is created.
427   Will fail silently if record_link creation wasn't successful (same behaviour as
428   _store_in_journal).
429
430 =item C<validate>
431
432 =back
433
434 =head1 BUGS
435
436 Nothing here yet.
437
438 =head1 AUTHOR
439
440 =cut