SL/Mailer.pm

   1 #=====================================================================
   2 # LX-Office ERP
   3 # Copyright (C) 2004
   4 # Based on SQL-Ledger Version 2.1.9
   5 # Web http://www.lx-office.org
   6 #
   7 #=====================================================================
   8 # SQL-Ledger Accounting
   9 # Copyright (C) 2001
  10 #
  11 #  Author: Dieter Simader
  12 #   Email: dsimader@sql-ledger.org
  13 #     Web: http://www.sql-ledger.org
  14 #
  15 # Contributors:
  16 #
  17 # This program is free software; you can redistribute it and/or modify
  18 # it under the terms of the GNU General Public License as published by
  19 # the Free Software Foundation; either version 2 of the License, or
  20 # (at your option) any later version.
  21 #
  22 # This program is distributed in the hope that it will be useful,
  23 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  24 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  25 # GNU General Public License for more details.
  26 # You should have received a copy of the GNU General Public License
  27 # along with this program; if not, write to the Free Software
  28 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  29 #======================================================================
  30
  31 package Mailer;
  32
  33 use SL::Common;
  34 use SL::Template;
  35
  36 my $num_sent = 0;
  37
  38 sub new {
  39   $main::lxdebug->enter_sub();
  40
  41   my ($type) = @_;
  42   my $self = {};
  43
  44   $main::lxdebug->leave_sub();
  45
  46   bless $self, $type;
  47 }
  48
  49 sub mime_quote_text {
  50   $main::lxdebug->enter_sub();
  51
  52   my ($self, $text, $chars_left) = @_;
  53
  54   my $q_start = "=?$self->{charset}?Q?";
  55   my $l_start = length($q_start);
  56
  57   my $new_text = "$q_start";
  58   $chars_left -= $l_start;
  59
  60   for (my $i = 0; $i < length($text); $i++) {
  61     my $char = ord(substr($text, $i, 1));
  62
  63     if (($char < 32) || ($char > 127) ||
  64         ($char == ord('?')) || ($char == ord('_'))) {
  65       if ($chars_left < 5) {
  66         $new_text .= "?=\n $q_start";
  67         $chars_left = 75 - $l_start;
  68       }
  69
  70       $new_text .= sprintf("=%02X", $char);
  71       $chars_left -= 3;
  72
  73     } else {
  74       $char = ord('_') if ($char == ord(' '));
  75       if ($chars_left < 5) {
  76         $new_text .= "?=\n $q_start";
  77         $chars_left = 75 - $l_start;
  78       }
  79
  80       $new_text .= chr($char);
  81       $chars_left--;
  82     }
  83   }
  84
  85   $new_text .= "?=";
  86
  87   $main::lxdebug->leave_sub();
  88
  89   return $new_text;
  90 }
  91
  92 sub send {
  93   $main::lxdebug->enter_sub();
  94
  95   my ($self) = @_;
  96
  97   local (*IN, *OUT);
  98
  99   $num_sent++;
 100   my $boundary = time() . "-$$-${num_sent}";
 101   $boundary    =  "LxOffice-$self->{version}-$boundary";
 102   my $domain   =  $self->{from};
 103   $domain      =~ s/(.*?\@|>)//g;
 104   my $msgid    =  "$boundary\@$domain";
 105
 106   my $form     =  $main::form;
 107   my $myconfig =  \%main::myconfig;
 108
 109   my $email    =  $myconfig->{email};
 110   $email       =~ s/[^\w\.\-\+=@]//ig;
 111
 112   $form->{myconfig_email} = $email;
 113
 114   my $template =  PlainTextTemplate->new(undef, $form, $myconfig);
 115   my $sendmail =  $template->parse_block($main::sendmail);
 116
 117   $self->{charset} = Common::DEFAULT_CHARSET unless $self->{charset};
 118
 119   if (!open(OUT, $sendmail)) {
 120     $main::lxdebug->leave_sub();
 121     return "$sendmail : $!";
 122   }
 123
 124   $self->{contenttype} = "text/plain" unless $self->{contenttype};
 125
 126   my ($cc, $bcc);
 127   $cc  = "Cc: $self->{cc}\n"   if $self->{cc};
 128   $bcc = "Bcc: $self->{bcc}\n" if $self->{bcc};
 129
 130   foreach my $item (qw(to cc bcc)) {
 131     $self->{$item} =~ s/\&lt;/</g;
 132     $self->{$item} =~ s/\$<\$/</g;
 133     $self->{$item} =~ s/\&gt;/>/g;
 134     $self->{$item} =~ s/\$>\$/>/g;
 135   }
 136
 137   my $subject = $self->mime_quote_text($self->{subject}, 60);
 138
 139   print OUT qq|From: $self->{from}
 140 To: $self->{to}
 141 ${cc}${bcc}Subject: $subject
 142 Message-ID: <$msgid>
 143 X-Mailer: Lx-Office $self->{version}
 144 MIME-Version: 1.0
 145 |;
 146
 147   if ($self->{attachments}) {
 148     print OUT qq|Content-Type: multipart/mixed; boundary="$boundary"
 149
 150 |;
 151     if ($self->{message}) {
 152       print OUT qq|--${boundary}
 153 Content-Type: $self->{contenttype}; charset="$self->{charset}"
 154
 155 $self->{message}
 156
 157 |;
 158     }
 159
 160     foreach my $attachment (@{ $self->{attachments} }) {
 161
 162       my $filename;
 163
 164       if (ref($attachment) eq "HASH") {
 165         $filename = $attachment->{"name"};
 166         $attachment = $attachment->{"filename"};
 167       } else {
 168         $filename = $attachment;
 169         # strip path
 170         $filename =~ s/(.*\/|\Q$self->{fileid}\E)//g;
 171       }
 172
 173       my $application =
 174         ($attachment =~ /(^\w+$)|\.(html|text|txt|sql)$/)
 175         ? "text"
 176         : "application";
 177
 178       open(IN, $attachment);
 179       if ($?) {
 180         close(OUT);
 181         $main::lxdebug->leave_sub();
 182         return "$attachment : $!";
 183       }
 184
 185       print OUT qq|--${boundary}
 186 Content-Type: $application/$self->{format}; name="$filename"; charset="$self->{charset}"
 187 Content-Transfer-Encoding: BASE64
 188 Content-Disposition: attachment; filename="$filename"\n\n|;
 189
 190       my $msg = "";
 191       while (<IN>) {
 192         ;
 193         $msg .= $_;
 194       }
 195       print OUT &encode_base64($msg);
 196
 197       close(IN);
 198
 199     }
 200     print OUT qq|--${boundary}--\n|;
 201
 202   } else {
 203     print OUT qq|Content-Type: $self->{contenttype}; charset="$self->{charset}"
 204
 205 $self->{message}
 206 |;
 207   }
 208
 209   close(OUT);
 210
 211   $main::lxdebug->leave_sub();
 212
 213   return "";
 214 }
 215
 216 sub encode_base64 ($;$) {
 217   $main::lxdebug->enter_sub();
 218
 219   # this code is from the MIME-Base64-2.12 package
 220   # Copyright 1995-1999,2001 Gisle Aas <gisle@ActiveState.com>
 221
 222   my $res = "";
 223   my $eol = $_[1];
 224   $eol = "\n" unless defined $eol;
 225   pos($_[0]) = 0;    # ensure start at the beginning
 226
 227   $res = join '', map(pack('u', $_) =~ /^.(\S*)/, ($_[0] =~ /(.{1,45})/gs));
 228
 229   $res =~ tr|` -_|AA-Za-z0-9+/|;    # `# help emacs
 230                                     # fix padding at the end
 231   my $padding = (3 - length($_[0]) % 3) % 3;
 232   $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
 233
 234   # break encoded string into lines of no more than 60 characters each
 235   if (length $eol) {
 236     $res =~ s/(.{1,60})/$1$eol/g;
 237   }
 238
 239   $main::lxdebug->leave_sub();
 240
 241   return $res;
 242 }
 243
 244 1;
 245