X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FMailer.pm;h=9ef0b085b1e943d5d740e339b8a543df13f5d12d;hb=f9676efea9ccfa01df2a57dca9c45cc8fde0d09e;hp=37d98b7a7d00bf12d705eab256f8c144bcec5082;hpb=3d7797630e04ddb308b11a58cd9732d502029125;p=kivitendo-erp.git diff --git a/SL/Mailer.pm b/SL/Mailer.pm index 37d98b7a7..9ef0b085b 100644 --- a/SL/Mailer.pm +++ b/SL/Mailer.pm @@ -30,6 +30,16 @@ package Mailer; +use Email::Address; + +use SL::Common; +use SL::MIME; +use SL::Template; + +use strict; + +my $num_sent = 0; + sub new { $main::lxdebug->enter_sub(); @@ -50,30 +60,29 @@ sub mime_quote_text { my $l_start = length($q_start); my $new_text = "$q_start"; - $chars_left -= $l_start; + $chars_left -= $l_start if (defined $chars_left); for (my $i = 0; $i < length($text); $i++) { my $char = ord(substr($text, $i, 1)); - if (($char < 32) || ($char > 127) || - ($char == ord('?')) || ($char == ord('_'))) { - if ($chars_left < 5) { + if (($char < 32) || ($char > 127) || ($char == ord('?')) || ($char == ord('_'))) { + if ((defined $chars_left) && ($chars_left < 5)) { $new_text .= "?=\n $q_start"; $chars_left = 75 - $l_start; } $new_text .= sprintf("=%02X", $char); - $chars_left -= 3; + $chars_left -= 3 if (defined $chars_left); } else { $char = ord('_') if ($char == ord(' ')); - if ($chars_left < 5) { + if ((defined $chars_left) && ($chars_left < 5)) { $new_text .= "?=\n $q_start"; $chars_left = 75 - $l_start; } $new_text .= chr($char); - $chars_left--; + $chars_left-- if (defined $chars_left); } } @@ -87,47 +96,64 @@ sub mime_quote_text { sub send { $main::lxdebug->enter_sub(); - my ($self, $out) = @_; + my ($self) = @_; - my $boundary = time; - $boundary = "LxOffice-$self->{version}-$boundary"; - my $domain = $self->{from}; - $domain =~ s/(.*?\@|>)//g; - my $msgid = "$boundary\@$domain"; + local (*IN, *OUT); - $self->{charset} = "ISO-8859-15" unless $self->{charset}; + $num_sent++; + my $boundary = time() . "-$$-${num_sent}"; + $boundary = "LxOffice-$self->{version}-$boundary"; + my $domain = $self->{from}; + $domain =~ s/(.*?\@|>)//g; + my $msgid = "$boundary\@$domain"; - if ($out) { - if (!open(OUT, $out)) { - $main::lxdebug->leave_sub(); - return "$out : $!"; - } - } else { - if (!open(OUT, ">-")) { - $main::lxdebug->leave_sub(); - return "STDOUT : $!"; - } - } + my $form = $main::form; + my $myconfig = \%main::myconfig; + + my $email = $myconfig->{email}; + $email =~ s/[^\w\.\-\+=@]//ig; - $self->{contenttype} = "text/plain" unless $self->{contenttype}; + my %temp_form = ( %{ $form }, 'myconfig_email' => $email ); + my $template = SL::Template::create(type => 'PlainText', form => \%temp_form); + my $sendmail = $template->parse_block($main::sendmail); - my ($cc, $bcc); - $cc = "Cc: $self->{cc}\n" if $self->{cc}; - $bcc = "Bcc: $self->{bcc}\n" if $self->{bcc}; + if (!open(OUT, $sendmail)) { + $main::lxdebug->leave_sub(); + return "$sendmail : $!"; + } + + $self->{charset} ||= Common::DEFAULT_CHARSET; + $self->{contenttype} ||= "text/plain"; foreach my $item (qw(to cc bcc)) { + next unless ($self->{$item}); $self->{$item} =~ s/\</{$item} =~ s/\$<\$/{$item} =~ s/\>/>/g; $self->{$item} =~ s/\$>\$/>/g; } - my $subject = $self->mime_quote_text($self->{subject}, 60); + my $headers = ''; + foreach my $item (qw(from to cc bcc)) { + next unless ($self->{$item}); + my (@addr_objects) = Email::Address->parse($self->{$item}); + next unless (scalar @addr_objects); + + foreach my $addr_obj (@addr_objects) { + my $phrase = $addr_obj->phrase(); + if ($phrase) { + $phrase =~ s/^\"//; + $phrase =~ s/\"$//; + $addr_obj->phrase($self->mime_quote_text($phrase)); + } - print OUT qq|From: $self->{from} -To: $self->{to} -${cc}${bcc}Subject: $subject -Message-ID: <$msgid> + $headers .= sprintf("%s: %s\n", ucfirst($item), $addr_obj->format()); + } + } + + $headers .= sprintf("Subject: %s\n", $self->mime_quote_text($self->{subject}, 60)); + + print OUT qq|${headers}Message-ID: <$msgid> X-Mailer: Lx-Office $self->{version} MIME-Version: 1.0 |; @@ -155,13 +181,13 @@ $self->{message} } else { $filename = $attachment; # strip path - $filename =~ s/(.*\/|$self->{fileid})//g; + $filename =~ s/(.*\/|\Q$self->{fileid}\E)//g; } - my $application = - ($attachment =~ /(^\w+$)|\.(html|text|txt|sql)$/) - ? "text" - : "application"; + my $application = ($attachment =~ /(^\w+$)|\.(html|text|txt|sql)$/) ? "text" : "application"; + my $content_type = SL::MIME->mime_type_from_ext($filename); + $content_type = "${application}/$self->{format}" if (!$content_type && $self->{format}); + $content_type ||= 'application/octet-stream'; open(IN, $attachment); if ($?) { @@ -170,8 +196,15 @@ $self->{message} return "$attachment : $!"; } + # only set charset for attachements of type text. every other type should not have this field + # refer to bug 883 for detailed information + my $attachment_charset; + if (lc $application eq 'text' && $self->{charset}) { + $attachment_charset = qq|; charset="$self->{charset}" |; + } + print OUT qq|--${boundary} -Content-Type: $application/$self->{format}; name="$filename"; charset="$self->{charset}" +Content-Type: ${content_type}; name="$filename"$attachment_charset Content-Transfer-Encoding: BASE64 Content-Disposition: attachment; filename="$filename"\n\n|;