X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FMailer.pm;h=2857e1c755b7882b730ef2d20aa3ef0f94f44584;hb=420cc628dce84d55be98be5f9987b13879c2010e;hp=76eac68e344d981db97c0d56de816445e9f50acd;hpb=ee072e4f077213bf6f8792ca8f0a1afebbb6282f;p=kivitendo-erp.git diff --git a/SL/Mailer.pm b/SL/Mailer.pm index 76eac68e3..2857e1c75 100644 --- a/SL/Mailer.pm +++ b/SL/Mailer.pm @@ -5,14 +5,6 @@ # Web http://www.lx-office.org # #===================================================================== -# SQL-Ledger Accounting -# Copyright (C) 2001 -# -# Author: Dieter Simader -# Email: dsimader@sql-ledger.org -# Web: http://www.sql-ledger.org -# -# Contributors: # # 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 @@ -30,153 +22,189 @@ package Mailer; -sub new { - $main::lxdebug->enter_sub(); +use Email::Address; +use Email::MIME::Creator; +use File::Slurp; - my ($type) = @_; - my $self = {}; +use SL::Common; +use SL::MIME; +use SL::Template; - $main::lxdebug->leave_sub(); +use strict; + +my $num_sent = 0; + +sub new { + my ($type, %params) = @_; + my $self = { %params }; bless $self, $type; } -sub send { - $main::lxdebug->enter_sub(); - - my ($self, $out) = @_; +sub _create_driver { + my ($self) = @_; - my $boundary = time; - $boundary = "SL-$self->{version}-$boundary"; - my $domain = $self->{from}; - $domain =~ s/(.*?\@|>)//g; - my $msgid = "$boundary\@$domain"; + my %params = ( + mailer => $self, + form => $::form, + myconfig => \%::myconfig, + ); - $self->{charset} = "ISO-8859-1" unless $self->{charset}; + my $module = ($::lx_office_conf{mail_delivery}->{method} || 'smtp') ne 'smtp' ? 'SL::Mailer::Sendmail' : 'SL::Mailer::SMTP'; + eval "require $module" or return undef; - if ($out) { - if (!open(OUT, $out)) { - $main::lxdebug->leave_sub(); - return "$out : $!"; - } - } else { - if (!open(OUT, ">-")) { - $main::lxdebug->leave_sub(); - return "STDOUT : $!"; - } - } - - $self->{contenttype} = "text/plain" unless $self->{contenttype}; + return $module->new(%params); +} - my ($cc, $bcc); - $cc = "Cc: $self->{cc}\n" if $self->{cc}; - $bcc = "Bcc: $self->{bcc}\n" if $self->{bcc}; +sub _cleanup_addresses { + my ($self) = @_; foreach my $item (qw(to cc bcc)) { + next unless $self->{$item}; + $self->{$item} =~ s/\</{$item} =~ s/\$<\$/{$item} =~ s/\>/>/g; $self->{$item} =~ s/\$>\$/>/g; } +} - print OUT qq|From: $self->{from} -To: $self->{to} -${cc}${bcc}Subject: $self->{subject} -Message-ID: <$msgid> -X-Mailer: SQL-Ledger $self->{version} -MIME-Version: 1.0 -|; +sub _create_message_id { + my ($self) = @_; - if ($self->{attachments}) { - print OUT qq|Content-Type: multipart/mixed; boundary="$boundary" + $num_sent += 1; + my $domain = $self->{from}; + $domain =~ s/.*\@//; + $domain =~ s/>.*//; -|; - if ($self->{message}) { - print OUT qq|--${boundary} -Content-Type: $self->{contenttype}; charset="$self->{charset}" + return "kivitendo-$self->{version}-" . time() . "-${$}-${num_sent}\@$domain"; +} -$self->{message} +sub _create_address_headers { + my ($self) = @_; -|; - } + $self->{addresses} = {}; - foreach my $attachment (@{ $self->{attachments} }) { + foreach my $item (qw(from to cc bcc)) { + $self->{addresses}->{$item} = []; + next if !$self->{$item} || $self->{driver}->keep_from_header($item); - my $application = - ($attachment =~ /(^\w+$)|\.(html|text|txt|sql)$/) - ? "text" - : "application"; + my @header_addresses; - open(IN, $attachment); - if ($?) { - close(OUT); - $main::lxdebug->leave_sub(); - return "$attachment : $!"; + foreach my $addr_obj (Email::Address->parse($self->{$item})) { + push @{ $self->{addresses}->{$item} }, $addr_obj->address; + my $phrase = $addr_obj->phrase(); + if ($phrase) { + $phrase =~ s/^\"//; + $phrase =~ s/\"$//; + $addr_obj->phrase($phrase); } - my $filename = $attachment; + push @header_addresses, $addr_obj->format; + } - # strip path - $filename =~ s/(.*\/|$self->{fileid})//g; + push @{ $self->{headers} }, ( ucfirst($item) => join(', ', @header_addresses) ) if @header_addresses; + } +} - print OUT qq|--${boundary} -Content-Type: $application/$self->{format}; name="$filename"; charset="$self->{charset}" -Content-Transfer-Encoding: BASE64 -Content-Disposition: attachment; filename="$filename"\n\n|; +sub _create_attachment_part { + my ($self, $attachment) = @_; - my $msg = ""; - while () { - ; - $msg .= $_; - } - print OUT &encode_base64($msg); + my $source_file_name; - close(IN); + my %attributes = ( + disposition => 'attachment', + encoding => 'base64', + ); - } - print OUT qq|--${boundary}--\n|; + if (ref($attachment) eq "HASH") { + $attributes{filename} = $attachment->{name}; + $source_file_name = $attachment->{filename}; } else { - print OUT qq|Content-Type: $self->{contenttype}; charset="$self->{charset}" - -$self->{message} -|; + # strip path + $attributes{filename} = $attachment; + $attributes{filename} =~ s:.*\Q$self->{fileid}\E:: if $self->{fileid}; + $attributes{filename} =~ s:.*/::g; + $source_file_name = $attachment; } - close(OUT); + my $attachment_content = eval { read_file($source_file_name) }; + return undef if !defined $attachment_content; - $main::lxdebug->leave_sub(); + my $application = ($attachment =~ /(^\w+$)|\.(html|text|txt|sql)$/) ? 'text' : 'application'; + $attributes{content_type} = SL::MIME->mime_type_from_ext($attributes{filename}); + $attributes{content_type} ||= "${application}/$self->{format}" if $self->{format}; + $attributes{content_type} ||= 'application/octet-stream'; + $attributes{charset} = $self->{charset} if lc $application eq 'text' && $self->{charset}; - return ""; + return Email::MIME->create( + attributes => \%attributes, + body => $attachment_content, + ); } -sub encode_base64 ($;$) { - $main::lxdebug->enter_sub(); +sub _create_message { + my ($self) = @_; - # this code is from the MIME-Base64-2.12 package - # Copyright 1995-1999,2001 Gisle Aas + my @parts; - my $res = ""; - my $eol = $_[1]; - $eol = "\n" unless defined $eol; - pos($_[0]) = 0; # ensure start at the beginning + if ($self->{message}) { + push @parts, Email::MIME->create( + attributes => { + content_type => $self->{contenttype}, + charset => $self->{charset}, + encoding => 'quoted-printable', + }, + body_str => $self->{message}, + ); - $res = join '', map(pack('u', $_) =~ /^.(\S*)/, ($_[0] =~ /(.{1,45})/gs)); + push @{ $self->{headers} }, ( + 'Content-Type' => qq|$self->{contenttype}; charset="$self->{charset}"|, + ); + } - $res =~ tr|` -_|AA-Za-z0-9+/|; # `# help emacs - # fix padding at the end - my $padding = (3 - length($_[0]) % 3) % 3; - $res =~ s/.{$padding}$/'=' x $padding/e if $padding; + push @parts, grep { $_ } map { $self->_create_attachment_part($_) } @{ $self->{attachments} || [] }; - # break encoded string into lines of no more than 60 characters each - if (length $eol) { - $res =~ s/(.{1,60})/$1$eol/g; + return Email::MIME->create( + header_str => $self->{headers}, + parts => \@parts, + ); +} + +sub send { + my ($self) = @_; + + # Create driver for delivery method (sendmail/SMTP) + $self->{driver} = eval { $self->_create_driver }; + if (!$self->{driver}) { + $::lxdebug->leave_sub(); + return "send email : $@"; } - $main::lxdebug->leave_sub(); + # Set defaults & headers + $self->{charset} ||= Common::DEFAULT_CHARSET; + $self->{contenttype} ||= "text/plain"; + $self->{headers} = [ + Subject => $self->{subject}, + 'Message-ID' => $self->_create_message_id, + 'X-Mailer' => "kivitendo $self->{version}", + ]; + + # Clean up To/Cc/Bcc address fields + $self->_cleanup_addresses; + $self->_create_address_headers; - return $res; + my $email = $self->_create_message; + + # $::lxdebug->message(0, "message: " . $email->as_string); + # return "boom"; + + $self->{driver}->start_mail(from => $self->{from}, to => [ map { @{ $self->{addresses}->{$_} } } qw(to cc bcc) ]); + $self->{driver}->print($email->as_string); + $self->{driver}->send; + + return ''; } 1; -