X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FMailer.pm;h=f242120a964c89ec1593303556a7b49431ff46c4;hb=2a0cbd885790174fa0f212e6661b30362650a42c;hp=b8b8b1775f123ce7905cc483b4926431e58d54c5;hpb=63dc98ee1d7bc23baa2567f2da7ad188f38d70d1;p=kivitendo-erp.git diff --git a/SL/Mailer.pm b/SL/Mailer.pm index b8b8b1775..f242120a9 100644 --- a/SL/Mailer.pm +++ b/SL/Mailer.pm @@ -24,34 +24,47 @@ package Mailer; use Email::Address; -use MIME::Entity; -use MIME::Parser; +use Email::MIME::Creator; +use Encode; use File::MimeInfo::Magic; use File::Slurp; use List::UtilsBy qw(bundle_by); +use List::Util qw(sum); use SL::Common; use SL::DB::EmailJournal; use SL::DB::EmailJournalAttachment; use SL::DB::Employee; +use SL::Locale::String qw(t8); use SL::Template; +use SL::Version; use strict; -use Encode; my $num_sent = 0; -my $parser; my %mail_delivery_modules = ( sendmail => 'SL::Mailer::Sendmail', smtp => 'SL::Mailer::SMTP', ); +my %type_to_table = ( + sales_quotation => 'oe', + request_quotation => 'oe', + sales_order => 'oe', + purchase_order => 'oe', + invoice => 'ar', + credit_note => 'ar', + purchase_invoice => 'ap', + letter => 'letter', + purchase_delivery_order => 'delivery_orders', + sales_delivery_order => 'delivery_orders', + dunning => 'dunning', +); + sub new { my ($type, %params) = @_; my $self = { %params }; - $parser = new MIME::Parser; - $parser->output_under("users"); bless $self, $type; } @@ -92,7 +105,7 @@ sub _create_message_id { $domain =~ s/.*\@//; $domain =~ s/>.*//; - return "kivitendo-$self->{version}-" . time() . "-${$}-${num_sent}\@$domain"; + return "kivitendo-" . SL::Version->get_version . "-" . time() . "-${$}-${num_sent}\@$domain"; } sub _create_address_headers { @@ -110,8 +123,21 @@ sub _create_address_headers { next if !$self->{$item}; my @header_addresses; + my @addresses = Email::Address->parse($self->{$item}); + + # if either no address was parsed or + # there are more than 3 characters per parsed email extra, assume the the user has entered bunk + if (!@addresses) { + die t8('"#1" seems to be a faulty list of email addresses. No addresses could be extracted.', + $self->{$item}, + ); + } elsif ((length($self->{$item}) - sum map { length $_->original } @addresses) / @addresses > 3) { + die t8('"#1" seems to be a faulty list of email addresses. After extracing addresses (#2) too many characters are left.', + $self->{$item}, join ', ', map { $_->original } @addresses, + ); + } - foreach my $addr_obj (Email::Address->parse($self->{$item})) { + foreach my $addr_obj (@addresses) { push @{ $self->{addresses}->{$item} }, $addr_obj->address; next if $self->{driver}->keep_from_header($item); @@ -122,7 +148,7 @@ sub _create_address_headers { $addr_obj->phrase($phrase); } - push @header_addresses, encode('MIME-Header',$addr_obj->format); + push @header_addresses, $addr_obj->format; } push @{ $self->{headers} }, ( ucfirst($item) => join(', ', @header_addresses) ) if @header_addresses; @@ -133,58 +159,58 @@ sub _create_attachment_part { my ($self, $attachment) = @_; my %attributes = ( - Disposition => 'attachment', - Encoding => 'base64', + disposition => 'attachment', + encoding => 'base64', ); my $attachment_content; my $file_id = 0; my $email_journal = $::instance_conf->get_email_journal; - $::lxdebug->message(LXDebug->DEBUG2(), "mail5 att=" . $attachment . " email_journal=" . $email_journal . " id=" . $attachment->{id}); - if (ref($attachment) eq "HASH") { - $attributes{Path} = $attachment->{path} || $attachment->{filename}; - $attributes{Filename} = $attachment->{name}; - $file_id = $attachment->{id} || '0'; - $attributes{Type} = $attachment->{type} || 'application/pdf'; - $attachment_content = eval { read_file($attachment->{path}) } if $email_journal > 1; + $attributes{filename} = $attachment->{name}; + $file_id = $attachment->{id} || '0'; + $attributes{content_type} = $attachment->{type} || 'application/pdf'; + $attachment_content = $attachment->{content}; + $attachment_content = eval { read_file($attachment->{path}) } if !$attachment_content; } else { - # strip path - $attributes{Path} = $attachment; - $attributes{Filename} = $attachment; - $attributes{Filename} =~ s:.*\Q$self->{fileid}\E:: if $self->{fileid}; - $attributes{Filename} =~ s:.*/::g; - - my $application = ($attachment =~ /(^\w+$)|\.(html|text|txt|sql)$/) ? 'text' : 'application'; - $attributes{Type} = File::MimeInfo::Magic::magic($attachment); - $attributes{Type} ||= "${application}/$self->{format}" if $self->{format}; - $attributes{Type} ||= 'application/octet-stream'; - $attachment_content = eval { read_file($attachment) } if $email_journal > 1; + $attributes{filename} = $attachment; + $attributes{filename} =~ s:.*\Q$self->{fileid}\E:: if $self->{fileid}; + $attributes{filename} =~ s:.*/::g; + + my $application = ($attachment =~ /(^\w+$)|\.(html|text|txt|sql)$/) ? 'text' : 'application'; + $attributes{content_type} = File::MimeInfo::Magic::magic($attachment); + $attributes{content_type} ||= "${application}/$self->{format}" if $self->{format}; + $attributes{content_type} ||= 'application/octet-stream'; + $attachment_content = eval { read_file($attachment) }; } return undef if $email_journal > 1 && !defined $attachment_content; $attachment_content ||= ' '; - $attributes{Charset} = $self->{charset} if $self->{charset}; - - $::lxdebug->message(LXDebug->DEBUG2(), "mail6 mtype=" . $attributes{Type} . " path=" . $attributes{Path} . " filename=" . $attributes{Filename}); + $attributes{charset} = $self->{charset} if $self->{charset} && ($attributes{content_type} =~ m{^text/}); my $ent; - if ( $attributes{Type} eq 'message/rfc822' ) { - my $fh = IO::File->new($attributes{Path}, "r") or return undef; - $ent = $parser->parse($fh); - - $ent->head->replace('Content-disposition','attachment; filename='.$attributes{Filename}); - + if ( $attributes{content_type} eq 'message/rfc822' ) { + $ent = Email::MIME->new($attachment_content); } else { - $ent = MIME::Entity->build(%attributes); + $ent = Email::MIME->create( + attributes => \%attributes, + body => $attachment_content, + ); } + # Due to a bug in Email::MIME it's not enough to hand over the encoded file name in the "attributes" hash in the + # "create" call. Email::MIME iterates over the keys in the hash, and depending on which key it has already seen during + # the iteration it might revert the encoding. As Perl's hash key order is randomized for each Perl run, this means + # that the file name stays unencoded sometimes. + # Setting the header manually after the "create" call circumvents this problem. + $ent->header_set('Content-disposition' => 'attachment; filename="' . encode('MIME-Q', $attributes{filename}) . '"'); + push @{ $self->{mail_attachments}} , SL::DB::EmailJournalAttachment->new( - name => $attributes{Filename}, - mime_type => $attributes{Type}, + name => $attributes{filename}, + mime_type => $attributes{content_type}, content => ( $email_journal > 1 ? $attachment_content : ' '), file_id => $file_id, ); @@ -195,22 +221,29 @@ sub _create_attachment_part { sub _create_message { my ($self) = @_; - push @{ $self->{headers} }, (Type => "multipart/mixed"); - - my $top = MIME::Entity->build(@{$self->{headers}}); + my @parts; if ($self->{message}) { - $top->attach( - Data => encode($self->{charset},$self->{message}), - Charset => $self->{charset}, - Type => $self->{contenttype}, - Encoding => 'quoted-printable', + push @parts, Email::MIME->create( + attributes => { + content_type => $self->{content_type}, + charset => $self->{charset}, + encoding => 'quoted-printable', + }, + body_str => $self->{message}, + ); + + push @{ $self->{headers} }, ( + 'Content-Type' => qq|$self->{content_type}; charset="$self->{charset}"|, ); } - $top->add_part($self->_create_attachment_part($_)) for @{ $self->{attachments} || [] }; + push @parts, grep { $_ } map { $self->_create_attachment_part($_) } @{ $self->{attachments} || [] }; - return $top; + return Email::MIME->create( + header_str => $self->{headers}, + parts => \@parts, + ); } sub send { @@ -219,20 +252,23 @@ sub send { # Create driver for delivery method (sendmail/SMTP) $self->{driver} = eval { $self->_create_driver }; if (!$self->{driver}) { - $self->_store_in_journal('failed', 'driver could not be created; check your configuration'); - return "send email : $@"; + my $error = $@; + $self->_store_in_journal('failed', 'driver could not be created; check your configuration & log files'); + $::lxdebug->message(LXDebug::WARN(), "Mailer error during 'send': $error"); + + return $error; } # Set defaults & headers - $self->{charset} = 'UTF-8'; - $self->{contenttype} ||= "text/plain"; - $self->{headers} = [ - Subject => encode('MIME-Header',$self->{subject}), - 'Message-ID' => '<' . $self->_create_message_id . '>', - 'X-Mailer' => "kivitendo $self->{version}", - ]; + $self->{charset} = 'UTF-8'; + $self->{content_type} ||= "text/plain"; + $self->{headers} ||= []; + push @{ $self->{headers} }, ( + Subject => $self->{subject}, + 'Message-ID' => '<' . $self->_create_message_id . '>', + 'X-Mailer' => "kivitendo " . SL::Version->get_version, + ); $self->{mail_attachments} = []; - $self->{content_by_name} = $::instance_conf->get_email_journal == 1 && $::instance_conf->get_doc_files; my $error; my $ok = eval { @@ -242,10 +278,9 @@ sub send { my $email = $self->_create_message; - #$::lxdebug->message(0, "message: " . $email->as_string); - # return "boom"; + my $from_obj = (Email::Address->parse($self->{from}))[0]; - $self->{driver}->start_mail(from => encode('MIME-Header',$self->{from}), to => [ $self->_all_recipients ]); + $self->{driver}->start_mail(from => $from_obj->address, to => [ $self->_all_recipients ]); $self->{driver}->print($email->as_string); $self->{driver}->send; @@ -254,10 +289,11 @@ sub send { $error = $@ if !$ok; + # create journal and link to record $self->{journalentry} = $self->_store_in_journal; - $parser->filer->purge; + $self->_create_record_link if $self->{journalentry}; - return $ok ? '' : "send email: $error"; + return $ok ? '' : ($error || "undefined error"); } sub _all_recipients { @@ -295,4 +331,126 @@ sub _store_in_journal { return $jentry->id; } + +sub _create_record_link { + my ($self) = @_; + + # check for custom/overloaded types and ids (form != controller) + my $record_type = $self->{record_type} || $::form->{type}; + my $record_id = $self->{record_id} || $::form->{id}; + + # you may send mails for unsaved objects (no record_id => unlinkable case) + if ($self->{journalentry} && $record_id && exists($type_to_table{$record_type})) { + RecordLinks->create_links( + mode => 'ids', + from_table => $type_to_table{$record_type}, + from_ids => $record_id, + to_table => 'email_journal', + to_id => $self->{journalentry}, + ); + } +} + 1; + + +__END__ + +=pod + +=encoding utf8 + +=head1 NAME + +SL::Mailer - Base class for sending mails from kivitendo + +=head1 SYNOPSIS + + package SL::BackgroundJob::CreatePeriodicInvoices; + + use SL::Mailer; + + my $mail = Mailer->new; + $mail->{from} = $config{periodic_invoices}->{email_from}; + $mail->{to} = $email; + $mail->{subject} = $config{periodic_invoices}->{email_subject}; + $mail->{content_type} = $filename =~ m/.html$/ ? 'text/html' : 'text/plain'; + $mail->{message} = $output; + + $mail->send; + +=head1 OVERVIEW + +Mail can be sent from kivitendo via the sendmail command or the smtp protocol. + + +=head1 INTERNAL DATA TYPES + + +=over 2 + +=item C<%mail_delivery_modules> + + Currently two modules are supported: smtp or sendmail. + +=item C<%type_to_table> + + Due to the lack of a single global mapping for $form->{type}, + type is mapped to the corresponding database table. All types which + implement a mail action are currently mapped and should be mapped. + Type is either the value of the old form or the newer controller + based object type. + +=back + +=head1 FUNCTIONS + +=over 4 + +=item C + +=item C<_create_driver> + +=item C<_cleanup_addresses> + +=item C<_create_address_headers> + +=item C<_create_message_id> + +=item C<_create_attachment_part> + +=item C<_create_message> + +=item C + + If a mail was sent successfully the internal function _store_in_journal + is called if email journaling is enabled. If _store_in_journal was executed + successfully and the calling form is already persistent (database id) a + record_link will be created. + +=item C<_all_recipients> + +=item C<_store_in_journal> + +=item C<_create_record_link $self->{journalentry}, $::form->{id}, $self->{record_id}> + + + If $self->{journalentry} and either $self->{record_id} or $::form->{id} (checked in + this order) exist a record link from record to email journal is created. + It is possible to provide an array reference with more than one id in + $self->{record_id} or $::form->{id}. In this case all records are linked to + the mail. + Will fail silently if record_link creation wasn't successful (same behaviour as + _store_in_journal). + +=item C + +=back + +=head1 BUGS + +Nothing here yet. + +=head1 AUTHOR + +=cut