kivitendo/SL/Mailer.pm @ 7b1da9c3
| d319704a | Moritz Bunkus | #=====================================================================
|
||
# LX-Office ERP
|
||||
# Copyright (C) 2004
|
||||
# Based on SQL-Ledger Version 2.1.9
|
||||
# Web http://www.lx-office.org
|
||||
#
|
||||
#=====================================================================
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
| f7b15d43 | Christian Wittmer | # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
|
||
# MA 02110-1335, USA.
|
||||
| d319704a | Moritz Bunkus | #======================================================================
|
||
package Mailer;
|
||||
| 6cac7ef5 | Tamino Steinert | use IO::Socket::INET;
|
||
use IO::Socket::SSL;
|
||||
| 8f3ecba9 | Moritz Bunkus | use Email::Address;
|
||
| e3b0f613 | Martin Helmling | use Email::MIME::Creator;
|
||
| bbb2383f | Moritz Bunkus | use Encode;
|
||
| a40f0c2f | Martin Helmling | use File::MimeInfo::Magic;
|
||
| e8c2a3b8 | Moritz Bunkus | use File::Slurp;
|
||
| 24ab7ec0 | Moritz Bunkus | use List::UtilsBy qw(bundle_by);
|
||
| 2bceb436 | Sven Schöling | use List::Util qw(sum);
|
||
| 8f3ecba9 | Moritz Bunkus | |||
| faef45c2 | Moritz Bunkus | use SL::Common;
|
||
| 24ab7ec0 | Moritz Bunkus | use SL::DB::EmailJournal;
|
||
use SL::DB::EmailJournalAttachment;
|
||||
use SL::DB::Employee;
|
||||
| 2bceb436 | Sven Schöling | use SL::Locale::String qw(t8);
|
||
| 920fd369 | Moritz Bunkus | use SL::Template;
|
||
| d90b14b1 | Sven Schöling | use SL::Version;
|
||
| 0572a0b8 | Tamino Steinert | use SL::IMAPClient;
|
||
| faef45c2 | Moritz Bunkus | |||
| c510d88b | Sven Schöling | use strict;
|
||
| ba36bef4 | Moritz Bunkus | my $num_sent = 0;
|
||
| adbc100a | Sven Schöling | my %mail_delivery_modules = (
|
||
sendmail => 'SL::Mailer::Sendmail',
|
||||
smtp => 'SL::Mailer::SMTP',
|
||||
);
|
||||
| d63305ba | Jan Büren | 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',
|
||||
| a031b820 | Bernd Bleßmann | dunning => 'dunning',
|
||
| d63305ba | Jan Büren | );
|
||
| 9ef26511 | Jan Büren | my %type_to_email = (
|
||
sales_quotation => sub { $::instance_conf->get_email_sender_sales_quotation },
|
||||
request_quotation => sub { $::instance_conf->get_email_sender_request_quotation },
|
||||
sales_order => sub { $::instance_conf->get_email_sender_sales_order },
|
||||
purchase_order => sub { $::instance_conf->get_email_sender_purchase_order },
|
||||
invoice => sub { $::instance_conf->get_email_sender_invoice },
|
||||
credit_note => sub { $::instance_conf->get_email_sender_invoice },
|
||||
purchase_invoice => sub { $::instance_conf->get_email_sender_purchase_invoice },
|
||||
letter => sub { $::instance_conf->get_email_sender_letter },
|
||||
purchase_delivery_order => sub { $::instance_conf->get_email_sender_purchase_delivery_order },
|
||||
sales_delivery_order => sub { $::instance_conf->get_email_sender_sales_delivery_order },
|
||||
dunning => sub { $::instance_conf->get_email_sender_dunning },
|
||||
);
|
||||
| d63305ba | Jan Büren | |||
| d319704a | Moritz Bunkus | sub new {
|
||
| 45c9cdd8 | Sven Schöling | my ($type, %params) = @_;
|
||
my $self = { %params };
|
||||
| d319704a | Moritz Bunkus | |||
bless $self, $type;
|
||||
}
|
||||
| 5896d8bf | Moritz Bunkus | sub _create_driver {
|
||
my ($self) = @_;
|
||||
my %params = (
|
||||
mailer => $self,
|
||||
form => $::form,
|
||||
myconfig => \%::myconfig,
|
||||
);
|
||||
| adbc100a | Sven Schöling | my $module = $mail_delivery_modules{ $::lx_office_conf{mail_delivery}->{method} };
|
||
| 16cc4053 | Moritz Bunkus | eval "require $module" or return undef;
|
||
| 7734bb7c | Moritz Bunkus | |||
| 16cc4053 | Moritz Bunkus | return $module->new(%params);
|
||
}
|
||||
| 7734bb7c | Moritz Bunkus | |||
| 16cc4053 | Moritz Bunkus | sub _cleanup_addresses {
|
||
my ($self) = @_;
|
||||
| 7734bb7c | Moritz Bunkus | |||
| 16cc4053 | Moritz Bunkus | foreach my $item (qw(to cc bcc)) {
|
||
next unless $self->{$item};
|
||||
| 7734bb7c | Moritz Bunkus | |||
| 16cc4053 | Moritz Bunkus | $self->{$item} =~ s/\</</g;
|
||
$self->{$item} =~ s/\$<\$/</g;
|
||||
$self->{$item} =~ s/\>/>/g;
|
||||
$self->{$item} =~ s/\$>\$/>/g;
|
||||
| 7734bb7c | Moritz Bunkus | }
|
||
}
|
||||
| 16cc4053 | Moritz Bunkus | sub _create_message_id {
|
||
| 974b5d86 | Moritz Bunkus | my ($self) = @_;
|
||
| 16cc4053 | Moritz Bunkus | $num_sent += 1;
|
||
my $domain = $self->{from};
|
||||
$domain =~ s/.*\@//;
|
||||
$domain =~ s/>.*//;
|
||||
| 920fd369 | Moritz Bunkus | |||
| d90b14b1 | Sven Schöling | return "kivitendo-" . SL::Version->get_version . "-" . time() . "-${$}-${num_sent}\@$domain";
|
||
| 16cc4053 | Moritz Bunkus | }
|
||
| d319704a | Moritz Bunkus | |||
| 16cc4053 | Moritz Bunkus | sub _create_address_headers {
|
||
my ($self) = @_;
|
||||
| d319704a | Moritz Bunkus | |||
| f8361ca6 | Moritz Bunkus | # $self->{addresses} collects the recipients for use in e.g. the
|
||
# SMTP 'RCPT TO:' envelope command. $self->{headers} collects the
|
||||
# headers that make up the actual email. 'BCC' should not be
|
||||
# included there for certain transportation methods (SMTP).
|
||||
| 16cc4053 | Moritz Bunkus | $self->{addresses} = {};
|
||
| d319704a | Moritz Bunkus | |||
| 38c19bfd | Sven Schöling | foreach my $item (qw(from to cc bcc)) {
|
||
| 16cc4053 | Moritz Bunkus | $self->{addresses}->{$item} = [];
|
||
| f8361ca6 | Moritz Bunkus | next if !$self->{$item};
|
||
| 5896d8bf | Moritz Bunkus | |||
| 16cc4053 | Moritz Bunkus | my @header_addresses;
|
||
| 2bceb436 | Sven Schöling | 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,
|
||||
);
|
||||
}
|
||||
| 8f3ecba9 | Moritz Bunkus | |||
| 2bceb436 | Sven Schöling | foreach my $addr_obj (@addresses) {
|
||
| 16cc4053 | Moritz Bunkus | push @{ $self->{addresses}->{$item} }, $addr_obj->address;
|
||
| f8361ca6 | Moritz Bunkus | next if $self->{driver}->keep_from_header($item);
|
||
| 77733865 | Moritz Bunkus | my $phrase = $addr_obj->phrase();
|
||
if ($phrase) {
|
||||
$phrase =~ s/^\"//;
|
||||
$phrase =~ s/\"$//;
|
||||
| 16cc4053 | Moritz Bunkus | $addr_obj->phrase($phrase);
|
||
| 77733865 | Moritz Bunkus | }
|
||
| 8f3ecba9 | Moritz Bunkus | |||
| ae20c836 | Moritz Bunkus | push @header_addresses, $addr_obj->format;
|
||
| 8f3ecba9 | Moritz Bunkus | }
|
||
| 5896d8bf | Moritz Bunkus | |||
| 16cc4053 | Moritz Bunkus | push @{ $self->{headers} }, ( ucfirst($item) => join(', ', @header_addresses) ) if @header_addresses;
|
||
}
|
||||
}
|
||||
| d319704a | Moritz Bunkus | |||
| 16cc4053 | Moritz Bunkus | sub _create_attachment_part {
|
||
my ($self, $attachment) = @_;
|
||||
| d319704a | Moritz Bunkus | |||
| 16cc4053 | Moritz Bunkus | my %attributes = (
|
||
| e3b0f613 | Martin Helmling | disposition => 'attachment',
|
||
encoding => 'base64',
|
||||
| 16cc4053 | Moritz Bunkus | );
|
||
| 3d779763 | Moritz Bunkus | |||
| 8fec2dc1 | Moritz Bunkus | my $attachment_content;
|
||
| 63dc98ee | Moritz Bunkus | my $file_id = 0;
|
||
| a40f0c2f | Martin Helmling | my $email_journal = $::instance_conf->get_email_journal;
|
||
| 8fec2dc1 | Moritz Bunkus | |||
| 16cc4053 | Moritz Bunkus | if (ref($attachment) eq "HASH") {
|
||
| e3b0f613 | Martin Helmling | $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;
|
||||
| 3d779763 | Moritz Bunkus | |||
| 16cc4053 | Moritz Bunkus | } else {
|
||
| e3b0f613 | Martin Helmling | $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) };
|
||||
| 16cc4053 | Moritz Bunkus | }
|
||
| d319704a | Moritz Bunkus | |||
| a40f0c2f | Martin Helmling | return undef if $email_journal > 1 && !defined $attachment_content;
|
||
| 48399a5a | Sven Schöling | |||
| 63dc98ee | Moritz Bunkus | $attachment_content ||= ' ';
|
||
| 36857857 | Moritz Bunkus | $attributes{charset} = $self->{charset} if $self->{charset} && ($attributes{content_type} =~ m{^text/});
|
||
| d319704a | Moritz Bunkus | |||
| a40f0c2f | Martin Helmling | my $ent;
|
||
| e3b0f613 | Martin Helmling | if ( $attributes{content_type} eq 'message/rfc822' ) {
|
||
$ent = Email::MIME->new($attachment_content);
|
||||
| a40f0c2f | Martin Helmling | } else {
|
||
| e3b0f613 | Martin Helmling | $ent = Email::MIME->create(
|
||
attributes => \%attributes,
|
||||
body => $attachment_content,
|
||||
);
|
||||
| a40f0c2f | Martin Helmling | }
|
||
| 63dc98ee | Moritz Bunkus | |||
| bbb2383f | Moritz Bunkus | # 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}) . '"');
|
||||
| a40f0c2f | Martin Helmling | push @{ $self->{mail_attachments}} , SL::DB::EmailJournalAttachment->new(
|
||
| e3b0f613 | Martin Helmling | name => $attributes{filename},
|
||
mime_type => $attributes{content_type},
|
||||
| a40f0c2f | Martin Helmling | content => ( $email_journal > 1 ? $attachment_content : ' '),
|
||
file_id => $file_id,
|
||||
| 16cc4053 | Moritz Bunkus | );
|
||
| 63dc98ee | Moritz Bunkus | |||
| a40f0c2f | Martin Helmling | return $ent;
|
||
| 16cc4053 | Moritz Bunkus | }
|
||
| d319704a | Moritz Bunkus | |||
| 16cc4053 | Moritz Bunkus | sub _create_message {
|
||
my ($self) = @_;
|
||||
| d319704a | Moritz Bunkus | |||
| e3b0f613 | Martin Helmling | my @parts;
|
||
| 63dc98ee | Moritz Bunkus | |||
| 16cc4053 | Moritz Bunkus | if ($self->{message}) {
|
||
| e3b0f613 | Martin Helmling | push @parts, Email::MIME->create(
|
||
attributes => {
|
||||
| b161d667 | Bernd Bleßmann | content_type => $self->{content_type},
|
||
| e3b0f613 | Martin Helmling | charset => $self->{charset},
|
||
encoding => 'quoted-printable',
|
||||
},
|
||||
body_str => $self->{message},
|
||||
);
|
||||
push @{ $self->{headers} }, (
|
||||
| b161d667 | Bernd Bleßmann | 'Content-Type' => qq|$self->{content_type}; charset="$self->{charset}"|,
|
||
| 63dc98ee | Moritz Bunkus | );
|
||
| d319704a | Moritz Bunkus | }
|
||
| e3b0f613 | Martin Helmling | push @parts, grep { $_ } map { $self->_create_attachment_part($_) } @{ $self->{attachments} || [] };
|
||
| 63dc98ee | Moritz Bunkus | |||
| e3b0f613 | Martin Helmling | return Email::MIME->create(
|
||
header_str => $self->{headers},
|
||||
parts => \@parts,
|
||||
);
|
||||
| d319704a | Moritz Bunkus | }
|
||
| 16cc4053 | Moritz Bunkus | sub send {
|
||
my ($self) = @_;
|
||||
| d319704a | Moritz Bunkus | |||
| 16cc4053 | Moritz Bunkus | # Create driver for delivery method (sendmail/SMTP)
|
||
$self->{driver} = eval { $self->_create_driver };
|
||||
if (!$self->{driver}) {
|
||||
| 117332fc | Moritz Bunkus | my $error = $@;
|
||
| 54de916a | Tamino Steinert | $self->_store_in_journal('send_failed', 'driver could not be created; check your configuration & log files');
|
||
| 117332fc | Moritz Bunkus | $::lxdebug->message(LXDebug::WARN(), "Mailer error during 'send': $error");
|
||
| 56ed2f3a | Moritz Bunkus | return $error;
|
||
| 16cc4053 | Moritz Bunkus | }
|
||
| 9ef26511 | Jan Büren | $self->_default_from; # set from for records if configured in client config
|
||
| 16cc4053 | Moritz Bunkus | # Set defaults & headers
|
||
| b161d667 | Bernd Bleßmann | $self->{charset} = 'UTF-8';
|
||
$self->{content_type} ||= "text/plain";
|
||||
| d3217777 | Moritz Bunkus | $self->{headers} ||= [];
|
||
push @{ $self->{headers} }, (
|
||||
| b161d667 | Bernd Bleßmann | Subject => $self->{subject},
|
||
'Message-ID' => '<' . $self->_create_message_id . '>',
|
||||
'X-Mailer' => "kivitendo " . SL::Version->get_version,
|
||||
| d3217777 | Moritz Bunkus | );
|
||
| a40f0c2f | Martin Helmling | $self->{mail_attachments} = [];
|
||
| d319704a | Moritz Bunkus | |||
| 313e7ce3 | Tamino Steinert | my $email_as_string;
|
||
| 24ab7ec0 | Moritz Bunkus | my $error;
|
||
my $ok = eval {
|
||||
# Clean up To/Cc/Bcc address fields
|
||||
$self->_cleanup_addresses;
|
||||
$self->_create_address_headers;
|
||||
| d319704a | Moritz Bunkus | |||
| 24ab7ec0 | Moritz Bunkus | my $email = $self->_create_message;
|
||
| d319704a | Moritz Bunkus | |||
| 895ccd7f | Moritz Bunkus | my $from_obj = (Email::Address->parse($self->{from}))[0];
|
||
$self->{driver}->start_mail(from => $from_obj->address, to => [ $self->_all_recipients ]);
|
||||
| 24ab7ec0 | Moritz Bunkus | $self->{driver}->print($email->as_string);
|
||
$self->{driver}->send;
|
||||
| d319704a | Moritz Bunkus | |||
| 313e7ce3 | Tamino Steinert | $email_as_string = $email->as_string;
|
||
| 24ab7ec0 | Moritz Bunkus | 1;
|
||
};
|
||||
$error = $@ if !$ok;
|
||||
| 514d95ca | Tamino Steinert | # TODO: Error is not for sending emial
|
||
# in SL::Form->send_email error is treated as error for sending email
|
||||
if ($ok) {
|
||||
| 667dbd3d | Bernd Bleßmann | eval {$self->_store_in_imap_sent_folder($email_as_string); 1} or do {
|
||
| 514d95ca | Tamino Steinert | $ok = 0;
|
||
$error = $@;
|
||||
};
|
||||
}
|
||||
| 6cac7ef5 | Tamino Steinert | |||
| d63305ba | Jan Büren | # create journal and link to record
|
||
| a40f0c2f | Martin Helmling | $self->{journalentry} = $self->_store_in_journal;
|
||
| d63305ba | Jan Büren | $self->_create_record_link if $self->{journalentry};
|
||
| 24ab7ec0 | Moritz Bunkus | |||
| 56ed2f3a | Moritz Bunkus | return $ok ? '' : ($error || "undefined error");
|
||
| 24ab7ec0 | Moritz Bunkus | }
|
||
sub _all_recipients {
|
||||
my ($self) = @_;
|
||||
$self->{addresses} ||= {};
|
||||
return map { @{ $self->{addresses}->{$_} || [] } } qw(to cc bcc);
|
||||
}
|
||||
| 6cac7ef5 | Tamino Steinert | sub _get_header_string {
|
||
my ($self) = @_;
|
||||
my $header_string =
|
||||
join "\r\n",
|
||||
(bundle_by { join(': ', @_) } 2, @{ $self->{headers} || [] });
|
||||
return $header_string;
|
||||
}
|
||||
sub _store_in_imap_sent_folder {
|
||||
| 313e7ce3 | Tamino Steinert | my ($self, $email_as_string) = @_;
|
||
| 11067e9a | Tamino Steinert | |||
| 81e922c2 | Tamino Steinert | my $from_email = $self->{from};
|
||
my $user_email = $::myconfig{email};
|
||||
| 9ea083c2 | Tamino Steinert | my $imap_config =
|
||
| 81e922c2 | Tamino Steinert | $::lx_office_conf{"sent_emails_in_imap/email/$from_email"}
|
||
|| $::lx_office_conf{"sent_emails_in_imap/email/$user_email"}
|
||||
| 11067e9a | Tamino Steinert | || $::lx_office_conf{sent_emails_in_imap}
|
||
|| {};
|
||||
| 9ea083c2 | Tamino Steinert | return unless ($imap_config->{enabled});
|
||
| 6cac7ef5 | Tamino Steinert | |||
| 9ea083c2 | Tamino Steinert | my $folder = delete $imap_config->{folder};
|
||
my $imap_client = SL::IMAPClient->new(%$imap_config);
|
||||
| 0572a0b8 | Tamino Steinert | $imap_client->store_email_in_email_folder(
|
||
| 9ea083c2 | Tamino Steinert | email_as_string => $email_as_string,
|
||
folder => $folder ||'Sent/Kivitendo',
|
||||
| 0572a0b8 | Tamino Steinert | );
|
||
| 6cac7ef5 | Tamino Steinert | |||
return 1;
|
||||
}
|
||||
| 24ab7ec0 | Moritz Bunkus | sub _store_in_journal {
|
||
my ($self, $status, $extended_status) = @_;
|
||||
| 687f2d96 | Martin Helmling | my $journal_enable = $::instance_conf->get_email_journal;
|
||
return if $journal_enable == 0;
|
||||
| 24ab7ec0 | Moritz Bunkus | $status //= $self->{driver}->status if $self->{driver};
|
||
| 54de916a | Tamino Steinert | $status //= 'send_failed';
|
||
| 24ab7ec0 | Moritz Bunkus | $extended_status //= $self->{driver}->extended_status if $self->{driver};
|
||
$extended_status //= 'unknown error';
|
||||
| 6cac7ef5 | Tamino Steinert | my $headers = $self->_get_header_string;
|
||
| 24ab7ec0 | Moritz Bunkus | |||
| a40f0c2f | Martin Helmling | my $jentry = SL::DB::EmailJournal->new(
|
||
| 24ab7ec0 | Moritz Bunkus | sender => SL::DB::Manager::Employee->current,
|
||
from => $self->{from} // '',
|
||||
recipients => join(', ', $self->_all_recipients),
|
||||
subject => $self->{subject} // '',
|
||||
headers => $headers,
|
||||
body => $self->{message} // '',
|
||||
sent_on => DateTime->now_local,
|
||||
| a40f0c2f | Martin Helmling | attachments => \@{ $self->{mail_attachments} },
|
||
| 24ab7ec0 | Moritz Bunkus | status => $status,
|
||
extended_status => $extended_status,
|
||||
)->save;
|
||||
| a40f0c2f | Martin Helmling | return $jentry->id;
|
||
| d319704a | Moritz Bunkus | }
|
||
| d63305ba | Jan Büren | |||
sub _create_record_link {
|
||||
my ($self) = @_;
|
||||
# check for custom/overloaded types and ids (form != controller)
|
||||
| b2d84264 | Bernd Bleßmann | my $record_type = $self->{record_type} || $::form->{type} || '';
|
||
| d63305ba | Jan Büren | 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},
|
||||
);
|
||||
}
|
||||
}
|
||||
| 9ef26511 | Jan Büren | |||
sub _default_from {
|
||||
my ($self) = @_;
|
||||
| b2d84264 | Bernd Bleßmann | my $record_type = $self->{record_type} || $::form->{type} || $self->{driver}{form}{formname} || '';
|
||
| 9ef26511 | Jan Büren | my $record_email = exists $type_to_email{$record_type} ? $type_to_email{$record_type}->() : undef;
|
||
$self->{from} = $record_email if $record_email;
|
||||
}
|
||||
| d319704a | Moritz Bunkus | 1;
|
||
| d63305ba | Jan Büren | |||
__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
|
||||
| 48412a8f | Geoffrey Richardson | Mail can be sent from kivitendo via the sendmail command or the smtp protocol.
|
||
| d63305ba | Jan Büren | |||
=head1 INTERNAL DATA TYPES
|
||||
=over 2
|
||||
=item C<%mail_delivery_modules>
|
||||
| 48412a8f | Geoffrey Richardson | Currently two modules are supported: smtp or sendmail.
|
||
| d63305ba | Jan Büren | |||
=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<new>
|
||||
=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<send>
|
||||
| 48412a8f | Geoffrey Richardson | If a mail was sent successfully the internal function _store_in_journal
|
||
| d63305ba | Jan Büren | 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
|
||||
| 48412a8f | Geoffrey Richardson | this order) exist a record link from record to email journal is created.
|
||
| a031b820 | Bernd Bleßmann | 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.
|
||||
| d63305ba | Jan Büren | Will fail silently if record_link creation wasn't successful (same behaviour as
|
||
_store_in_journal).
|
||||
=item C<validate>
|
||||
=back
|
||||
=head1 BUGS
|
||||
Nothing here yet.
|
||||
=head1 AUTHOR
|
||||
=cut
|