Layout package names refactored

[mfinanz.git] / SL / Mailer.pm

diff --git a/SL/Mailer.pm b/SL/Mailer.pm
index 7b011d4b0ddb1076454bf36bb949ee57b3a6df95..b04af08ddf5943ee4d7df2753080048571881c9d 100644 (file)
--- a/SL/Mailer.pm
+++ b/SL/Mailer.pm
@@ -30,19 +30,47 @@
 
 package Mailer;
 
 
 package Mailer;
 

+use Email::Address;
+use Encode;
+

 use SL::Common;
 use SL::Common;

+use SL::MIME;
+use SL::Template;
+
+use strict;
+
+my $num_sent = 0;

 
 sub new {
   $main::lxdebug->enter_sub();
 
 
 sub new {
   $main::lxdebug->enter_sub();
 

-  my ($type) = @_;
-  my $self = {};
+  my ($type, %params) = @_;
+  my $self = { %params };

 
   $main::lxdebug->leave_sub();
 
   bless $self, $type;
 }
 
 
   $main::lxdebug->leave_sub();
 
   bless $self, $type;
 }
 

+sub _create_driver {
+  my ($self) = @_;
+
+  my %params = (
+    mailer   => $self,
+    form     => $::form,
+    myconfig => \%::myconfig,
+  );
+
+  my $cfg = $::lx_office_conf{mail_delivery};
+  if (($cfg->{method} || 'smtp') ne 'smtp') {
+    require SL::Mailer::Sendmail;
+    return SL::Mailer::Sendmail->new(%params);
+  } else {
+    require SL::Mailer::SMTP;
+    return SL::Mailer::SMTP->new(%params);
+  }
+}
+

 sub mime_quote_text {
   $main::lxdebug->enter_sub();
 
 sub mime_quote_text {
   $main::lxdebug->enter_sub();
 


@@ -52,30 +80,29 @@ sub mime_quote_text {
   my $l_start = length($q_start);
 
   my $new_text = "$q_start";
   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));
 
 
   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);
         $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(' '));
 
     } 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);
         $new_text .= "?=\n $q_start";
         $chars_left = 75 - $l_start;
       }
 
       $new_text .= chr($char);

-      $chars_left--;
+      $chars_left-- if (defined $chars_left);

     }
   }
 
     }
   }
 


@@ -91,55 +118,78 @@ sub send {
 
   my ($self) = @_;
 
 
   my ($self) = @_;
 

-  local (*IN, *OUT);
+  local (*IN);

 
 

-  my $boundary = time;
-  $boundary = "LxOffice-$self->{version}-$boundary";
-  my $domain = $self->{from};
-  $domain =~ s/(.*?\@|>)//g;
-  my $msgid = "$boundary\@$domain";
+  $num_sent++;
+  my $boundary    = time() . "-$$-${num_sent}";
+  $boundary       =  "LxOffice-$self->{version}-$boundary";
+  my $domain      =  $self->recode($self->{from});
+  $domain         =~ s/(.*?\@|>)//g;
+  my $msgid       =  "$boundary\@$domain";

 
 

-  $self->{charset} = Common::DEFAULT_CHARSET unless $self->{charset};
+  my $form        =  $main::form;
+  my $myconfig    =  \%main::myconfig;

 
 

-  if (!open(OUT, $main::sendmail)) {
+  my $driver = eval { $self->_create_driver };
+  if (!$driver) {

     $main::lxdebug->leave_sub();
     $main::lxdebug->leave_sub();

-    return "$main::sendmail : $!";
+    return "send email : $@";

   }
 
   }
 

-  $self->{contenttype} = "text/plain" unless $self->{contenttype};
-
-  my ($cc, $bcc);
-  $cc  = "Cc: $self->{cc}\n"   if $self->{cc};
-  $bcc = "Bcc: $self->{bcc}\n" if $self->{bcc};
+  $self->{charset}     ||= Common::DEFAULT_CHARSET;
+  $self->{contenttype} ||= "text/plain";

 
   foreach my $item (qw(to cc bcc)) {
 
   foreach my $item (qw(to cc bcc)) {

+    next unless ($self->{$item});
+    $self->{$item} =  $self->recode($self->{$item});

     $self->{$item} =~ s/\&lt;/</g;
     $self->{$item} =~ s/\$<\$/</g;
     $self->{$item} =~ s/\&gt;/>/g;
     $self->{$item} =~ s/\$>\$/>/g;
   }
 
     $self->{$item} =~ s/\&lt;/</g;
     $self->{$item} =~ s/\$<\$/</g;
     $self->{$item} =~ s/\&gt;/>/g;
     $self->{$item} =~ s/\$>\$/>/g;
   }
 

-  my $subject = $self->mime_quote_text($self->{subject}, 60);
+  $self->{from} = $self->recode($self->{from});

 
 

-  print OUT qq|From: $self->{from}
-To: $self->{to}
-${cc}${bcc}Subject: $subject
-Message-ID: <$msgid>
+  my %addresses;
+  my $headers = '';
+  foreach my $item (qw(from to cc bcc)) {
+    $addresses{$item} = [];
+    next unless ($self->{$item});
+
+    my (@addr_objects) = Email::Address->parse($self->{$item});
+    next unless (scalar @addr_objects);
+
+    foreach my $addr_obj (@addr_objects) {
+      push @{ $addresses{$item} }, $addr_obj->address;
+      my $phrase = $addr_obj->phrase();
+      if ($phrase) {
+        $phrase =~ s/^\"//;
+        $phrase =~ s/\"$//;
+        $addr_obj->phrase($self->mime_quote_text($phrase));
+      }
+
+      $headers .= sprintf("%s: %s\n", ucfirst($item), $addr_obj->format()) unless $driver->keep_from_header($item);
+    }
+  }
+
+  $headers .= sprintf("Subject: %s\n", $self->mime_quote_text($self->recode($self->{subject}), 60));
+
+  $driver->start_mail(from => $self->{from}, to => [ map { @{ $addresses{$_} } } qw(to cc bcc) ]);
+
+  $driver->print(qq|${headers}Message-ID: <$msgid>

 X-Mailer: Lx-Office $self->{version}
 MIME-Version: 1.0
 X-Mailer: Lx-Office $self->{version}
 MIME-Version: 1.0

-|;
+|);

 
   if ($self->{attachments}) {
 
   if ($self->{attachments}) {

-    print OUT qq|Content-Type: multipart/mixed; boundary="$boundary"
-
-|;
+    $driver->print(qq|Content-Type: multipart/mixed; boundary="$boundary"\n\n|);

     if ($self->{message}) {
     if ($self->{message}) {

-      print OUT qq|--${boundary}
+      $driver->print(qq|--${boundary}

 Content-Type: $self->{contenttype}; charset="$self->{charset}"
 
 Content-Type: $self->{contenttype}; charset="$self->{charset}"
 

-$self->{message}
+| . $self->recode($self->{message}) . qq|

 
 

-|;
+|);

     }
 
     foreach my $attachment (@{ $self->{attachments} }) {
     }
 
     foreach my $attachment (@{ $self->{attachments} }) {


@@ -152,46 +202,52 @@ $self->{message}
       } else {
         $filename = $attachment;
         # strip path
       } 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 ($?) {
 
       open(IN, $attachment);
       if ($?) {

-        close(OUT);

         $main::lxdebug->leave_sub();
         return "$attachment : $!";
       }
 
         $main::lxdebug->leave_sub();
         return "$attachment : $!";
       }
 

-      print OUT qq|--${boundary}
-Content-Type: $application/$self->{format}; name="$filename"; charset="$self->{charset}"
+      # 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}" |;
+      }
+
+      $driver->print(qq|--${boundary}
+Content-Type: ${content_type}; name="$filename"$attachment_charset

 Content-Transfer-Encoding: BASE64
 Content-Transfer-Encoding: BASE64

-Content-Disposition: attachment; filename="$filename"\n\n|;
+Content-Disposition: attachment; filename="$filename"\n\n|);

 
       my $msg = "";
       while (<IN>) {
         ;
         $msg .= $_;
       }
 
       my $msg = "";
       while (<IN>) {
         ;
         $msg .= $_;
       }

-      print OUT &encode_base64($msg);
+      $driver->print(encode_base64($msg));

 
       close(IN);
 
     }
 
       close(IN);
 
     }

-    print OUT qq|--${boundary}--\n|;
+    $driver->print(qq|--${boundary}--\n|);

 
   } else {
 
   } else {

-    print OUT qq|Content-Type: $self->{contenttype}; charset="$self->{charset}"
+    $driver->print(qq|Content-Type: $self->{contenttype}; charset="$self->{charset}"

 
 

-$self->{message}
-|;
+| . $self->recode($self->{message}) . qq|
+|);

   }
 
   }
 

-  close(OUT);
+  $driver->send;

 
   $main::lxdebug->leave_sub();
 
 
   $main::lxdebug->leave_sub();
 


@@ -226,5 +282,11 @@ sub encode_base64 ($;$) {
   return $res;
 }
 
   return $res;
 }
 

-1;
+sub recode {
+  my $self = shift;
+  my $text = shift;

 
 

+  return $::locale->is_utf8 ? Encode::encode('utf-8-strict', $text) : $text;
+}
+
+1;