Email::Sender::Transport::SMTP::TLS no longer needed

[freeside.git] / FS / FS / Misc.pm

diff --git a/FS/FS/Misc.pm b/FS/FS/Misc.pm
index a55f4a9..5eba874 100644 (file)
--- a/FS/FS/Misc.pm
+++ b/FS/FS/Misc.pm
@@ -1,7 +1,7 @@
 package FS::Misc;
 
 use strict;
 package FS::Misc;
 
 use strict;

-use vars qw ( @ISA @EXPORT_OK $DEBUG );
+use vars qw ( @ISA @EXPORT_OK $DEBUG $DISABLE_ALL_NOTICES );

 use Exporter;
 use Carp;
 use Data::Dumper;
 use Exporter;
 use Carp;
 use Data::Dumper;


@@ -9,6 +9,7 @@ use IPC::Run qw( run timeout );   # for _pslatex
 use IPC::Run3; # for do_print... should just use IPC::Run i guess
 use File::Temp;
 use Tie::IxHash;
 use IPC::Run3; # for do_print... should just use IPC::Run i guess
 use File::Temp;
 use Tie::IxHash;

+use Encode;

 #do NOT depend on any FS:: modules here, causes weird (sometimes unreproducable
 #until on client machine) dependancy loops.  put them in FS::Misc::Something
 #instead
 #do NOT depend on any FS:: modules here, causes weird (sometimes unreproducable
 #until on client machine) dependancy loops.  put them in FS::Misc::Something
 #instead


@@ -21,6 +22,7 @@ use Tie::IxHash;
                  generate_ps generate_pdf do_print
                  csv_from_fixed
                  ocr_image
                  generate_ps generate_pdf do_print
                  csv_from_fixed
                  ocr_image

+                 money_pretty

                );
 
 $DEBUG = 0;
                );
 
 $DEBUG = 0;


@@ -41,6 +43,32 @@ Miscellaneous subroutines.  This module contains miscellaneous subroutines
 called from multiple other modules.  These are not OO or necessarily related,
 but are collected here to eliminate code duplication.
 
 called from multiple other modules.  These are not OO or necessarily related,
 but are collected here to eliminate code duplication.
 

+=head1 DISABLE ALL NOTICES
+
+Set $FS::Misc::DISABLE_ALL_NOTICES to suppress:
+
+=over 4
+
+=item FS::cust_bill::send_csv
+
+=item FS::cust_bill::spool_csv
+
+=item FS::msg_template::email::send_prepared
+
+=item FS::Misc::send_email
+
+=item FS::Misc::do_print
+
+=item FS::Misc::send_fax
+
+=item FS::Template_Mixin::postal_mail_fsinc
+
+=back
+
+=cut
+
+$DISABLE_ALL_NOTICES = 0;
+

 =head1 SUBROUTINES
 
 =over 4
 =head1 SUBROUTINES
 
 =over 4


@@ -89,6 +117,15 @@ encoding which, if specified, overrides the default "7bit".
 
 (optional) type parameter for multipart/related messages
 
 
 (optional) type parameter for multipart/related messages
 

+=item custnum
+
+(optional) L<FS::cust_main> key; if passed, the message will be logged
+(if logging is enabled) with this custnum.
+
+=item msgnum
+
+(optional) L<FS::msg_template> key, for logging.
+

 =back
 
 =cut
 =back
 
 =cut


@@ -98,7 +135,6 @@ use Date::Format;
 use MIME::Entity;
 use Email::Sender::Simple qw(sendmail);
 use Email::Sender::Transport::SMTP;
 use MIME::Entity;
 use Email::Sender::Simple qw(sendmail);
 use Email::Sender::Transport::SMTP;

-use Email::Sender::Transport::SMTP::TLS;

 use FS::UID;
 
 FS::UID->install_callback( sub {
 use FS::UID;
 
 FS::UID->install_callback( sub {


@@ -107,6 +143,12 @@ FS::UID->install_callback( sub {
 
 sub send_email {
   my(%options) = @_;
 
 sub send_email {
   my(%options) = @_;

+
+  if ( $DISABLE_ALL_NOTICES ) {
+    warn 'send_email() disabled by $FS::Misc::DISABLE_ALL_NOTICES' if $DEBUG;
+    return;
+  }
+

   if ( $DEBUG ) {
     my %doptions = %options;
     $doptions{'body'} = '(full body not shown in debug)';
   if ( $DEBUG ) {
     my %doptions = %options;
     $doptions{'body'} = '(full body not shown in debug)';


@@ -144,7 +186,11 @@ sub send_email {
   
       unshift @mimeparts, { 
         'Type'        => ( $options{'content-type'} || 'text/plain' ),
   
       unshift @mimeparts, { 
         'Type'        => ( $options{'content-type'} || 'text/plain' ),

-        'Data'        => $options{'body'},
+        'Charset'     => 'UTF-8',
+        'Data'        => ( $options{'content-type'} =~ /^text\//
+                             ? Encode::encode_utf8( $options{'body'} )
+                             : $options{'body'}
+                         ),

         'Encoding'    => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
         'Disposition' => 'inline',
       };
         'Encoding'    => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
         'Disposition' => 'inline',
       };


@@ -153,16 +199,27 @@ sub send_email {
     
       @mimeargs = (
         'Type'     => ( $options{'content-type'} || 'text/plain' ),
     
       @mimeargs = (
         'Type'     => ( $options{'content-type'} || 'text/plain' ),

-        'Data'     => $options{'body'},
+        'Data'     => ( $options{'content-type'} =~ /^text\//
+                          ? Encode::encode_utf8( $options{'body'} )
+                          : $options{'body'}
+                      ),

         'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
         'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),

+        'Charset'  => 'UTF-8',

       );
 
     }
 
   }
 
       );
 
     }
 
   }
 

+  my $from = $options{from};
+  $from =~ s/^\s*//; $from =~ s/\s*$//;
+  if ( $from =~ /^(.*)\s*<(.*@.*)>$/ ) {
+    # a common idiom
+    $from = $2;
+  }
+

   my $domain;
   my $domain;

-  if ( $options{'from'} =~ /\@([\w\.\-]+)/ ) {
+  if ( $from =~ /\@([\w\.\-]+)/ ) {

     $domain = $1;
   } else {
     warn 'no domain found in invoice from address '. $options{'from'}.
     $domain = $1;
   } else {
     warn 'no domain found in invoice from address '. $options{'from'}.


@@ -171,13 +228,14 @@ sub send_email {
   }
   my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
 
   }
   my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
 

+  my $time = time;

   my $message = MIME::Entity->build(
     'From'       => $options{'from'},
     'To'         => join(', ', @to),
     'Sender'     => $options{'from'},
     'Reply-To'   => $options{'from'},
   my $message = MIME::Entity->build(
     'From'       => $options{'from'},
     'To'         => join(', ', @to),
     'Sender'     => $options{'from'},
     'Reply-To'   => $options{'from'},

-    'Date'       => time2str("%a, %d %b %Y %X %z", time),
-    'Subject'    => $options{'subject'},
+    'Date'       => time2str("%a, %d %b %Y %X %z", $time),
+    'Subject'    => Encode::encode('MIME-Header', $options{'subject'}),

     'Message-ID' => "<$message_id>",
     @mimeargs,
   );
     'Message-ID' => "<$message_id>",
     @mimeargs,
   );


@@ -221,30 +279,66 @@ sub send_email {
   my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
   $smtp_opt{'port'} = $port;
 
   my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
   $smtp_opt{'port'} = $port;
 

-  my $transport;
-  if ( defined($enc) && $enc eq 'starttls' ) {
-    $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password);
-    $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt );
-  } else {
-    if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
-      $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password);
-    }
-    $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls';
-    $transport = Email::Sender::Transport::SMTP->new( %smtp_opt );
+  my $error = '';
+  if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
+    $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password);
+  } elsif ( defined($enc) && $enc eq 'starttls') {
+    $error = "SMTP settings misconfiguration: STARTTLS enabled in ".
+            "smtp-encryption but smtp-username or smtp-password missing";
+  }
+
+  if ( defined($enc) ) {
+    $smtp_opt{'ssl'} = 'starttls' if $enc eq 'starttls';
+    $smtp_opt{'ssl'} = 1          if $enc eq 'tls';

   }
   }

+
+  my $transport = Email::Sender::Transport::SMTP->new( %smtp_opt );

   
   push @to, $options{bcc} if defined($options{bcc});
   
   push @to, $options{bcc} if defined($options{bcc});

-  local $@; # just in case
-  eval { sendmail($message, { transport => $transport,
-                              from      => $options{from},
-                              to        => \@to }) };
- 
-  if(ref($@) and $@->isa('Email::Sender::Failure')) {
-    return ($@->code ? $@->code.' ' : '').$@->message
+  # fully unpack all addresses found in @to (including Bcc) to make the
+  # envelope list
+  my @env_to;
+  foreach my $dest (@to) {
+    push @env_to, map { $_->address } Email::Address->parse($dest);

   }
   }

-  else {
-    return $@;
+
+  unless ( length($error) ) {
+
+    local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
+    local $@; # just in case
+    eval { sendmail($message, { transport => $transport,
+                                from      => $from,
+                                to        => \@env_to }) };
+
+    if (ref($@) and $@->isa('Email::Sender::Failure')) {
+      $error = $@->code.' ' if $@->code;
+      $error .= $@->message;
+    } else {
+      $error = $@;
+    }
+
+  }
+
+  # Logging
+  if ( $conf->exists('log_sent_mail') ) {
+    my $cust_msg = FS::cust_msg->new({
+        'env_from'  => $options{'from'},
+        'env_to'    => join(', ', @env_to),
+        'header'    => $message->header_as_string,
+        'body'      => $message->body_as_string,
+        '_date'     => $time,
+        'error'     => $error,
+        'custnum'   => $options{'custnum'},
+        'msgnum'    => $options{'msgnum'},
+        'status'    => ($error ? 'failed' : 'sent'),
+        'msgtype'   => $options{'msgtype'},
+    });
+    my $log_error = $cust_msg->insert;
+    warn "Error logging message: $log_error\n" if $log_error; # at least warn

   }
   }

+
+  $error;
+   

 }
 
 =item generate_email OPTION => VALUE ...
 }
 
 =item generate_email OPTION => VALUE ...


@@ -279,6 +373,10 @@ Will be placed inside an HTML <BODY> tag.
 
 Email body (Text alternative).  Arrayref of lines, or scalar.
 
 
 Email body (Text alternative).  Arrayref of lines, or scalar.
 

+=item custnum, msgnum (optional)
+
+Customer and template numbers, passed through to send_email for logging.
+

 =back
 
 Constructs a multipart message from text_body and html_body.
 =back
 
 Constructs a multipart message from text_body and html_body.


@@ -295,20 +393,9 @@ sub generate_email {
 
   my $me = '[FS::Misc::generate_email]';
 
 
   my $me = '[FS::Misc::generate_email]';
 

-  my %return = (
-    'from'    => $args{'from'},
-    'to'      => $args{'to'},
-    'bcc'     => $args{'bcc'},
-    'subject' => $args{'subject'},
-  );
-
-  #if (ref($args{'to'}) eq 'ARRAY') {
-  #  $return{'to'} = $args{'to'};
-  #} else {
-  #  $return{'to'} = [ grep { $_ !~ /^(POST|FAX)$/ }
-  #                         $self->cust_main->invoicing_list
-  #                  ];
-  #}
+  my @fields = qw(from to bcc subject custnum msgnum msgtype);
+  my %return;
+  @return{@fields} = @args{@fields};

 
   warn "$me creating HTML/text multipart message"
     if $DEBUG;
 
   warn "$me creating HTML/text multipart message"
     if $DEBUG;


@@ -330,9 +417,10 @@ sub generate_email {
 
   $alternative->attach(
     'Type'        => 'text/plain',
 
   $alternative->attach(
     'Type'        => 'text/plain',

-    #'Encoding'    => 'quoted-printable',
-    'Encoding'    => '7bit',
-    'Data'        => $data,
+    'Encoding'    => 'quoted-printable',
+    'Charset'     => 'UTF-8',
+    #'Encoding'    => '7bit',
+    'Data'        => Encode::encode_utf8($data),

     'Disposition' => 'inline',
   );
 
     'Disposition' => 'inline',
   );
 


@@ -352,8 +440,8 @@ sub generate_email {
                        '      '. encode_entities($return{'subject'}), 
                        '    </title>',
                        '  </head>',
                        '      '. encode_entities($return{'subject'}), 
                        '    </title>',
                        '  </head>',

-                       '  <body bgcolor="#e8e8e8">',
-                       @html_data,
+                       '  <body bgcolor="#ffffff">',
+                       ( map Encode::encode_utf8($_), @html_data ),

                        '  </body>',
                        '</html>',
                      ],
                        '  </body>',
                        '</html>',
                      ],


@@ -376,20 +464,6 @@ sub generate_email {
 
 }
 
 
 }
 

-=item process_send_email OPTION => VALUE ...
-
-Takes arguments as per generate_email() and sends the message.  This 
-will die on any error and can be used in the job queue.
-
-=cut
-
-sub process_send_email {
-  my %message = @_;
-  my $error = send_email(generate_email(%message));
-  die "$error\n" if $error;
-  '';
-}
-

 =item send_fax OPTION => VALUE ...
 
 Options:
 =item send_fax OPTION => VALUE ...
 
 Options:


@@ -414,6 +488,11 @@ sub send_fax {
   die 'HylaFAX support has not been configured.'
     unless $conf->exists('hylafax');
 
   die 'HylaFAX support has not been configured.'
     unless $conf->exists('hylafax');
 

+  if ( $DISABLE_ALL_NOTICES ) {
+    warn 'send_fax() disabled by $FS::Misc::DISABLE_ALL_NOTICES' if $DEBUG;
+    return;
+  }
+

   eval {
     require Fax::Hylafax::Client;
   };
   eval {
     require Fax::Hylafax::Client;
   };


@@ -486,6 +565,9 @@ use Locale::SubCountry;
 sub states_hash {
   my($country) = @_;
 
 sub states_hash {
   my($country) = @_;
 

+  #a hash?  not expecting an explosion of business from unrecognized countries..
+  return states_hash_nosubcountry($country) if $country eq 'XC';
+

   my @states = 
 #     sort
      map { s/[\n\r]//g; $_; }
   my @states = 
 #     sort
      map { s/[\n\r]//g; $_; }


@@ -499,7 +581,7 @@ sub states_hash {
 
   #it could throw a fatal "Invalid country code" error (for example "AX")
   my $subcountry = eval { new Locale::SubCountry($country) }
 
   #it could throw a fatal "Invalid country code" error (for example "AX")
   my $subcountry = eval { new Locale::SubCountry($country) }

-    or return ( '', '(n/a)' );
+    or return (); # ( '', '(n/a)' );

 
   #"i see your schwartz is as big as mine!"
   map  { ( $_->[0] => $_->[1] ) }
 
   #"i see your schwartz is as big as mine!"
   map  { ( $_->[0] => $_->[1] ) }


@@ -508,6 +590,27 @@ sub states_hash {
        @states;
 }
 
        @states;
 }
 

+sub states_hash_nosubcountry {
+  my($country) = @_;
+
+  my @states = 
+#     sort
+     map { s/[\n\r]//g; $_; }
+     map { $_->state; }
+         qsearch({ 
+                   'select'    => 'state',
+                   'table'     => 'cust_main_county',
+                   'hashref'   => { 'country' => $country },
+                   'extra_sql' => 'GROUP BY state',
+                });
+
+  #"i see your schwartz is as big as mine!"
+  map  { ( $_->[0] => $_->[1] ) }
+  sort { $a->[1] cmp $b->[1] }
+  map  { [ $_ => $_ ] }
+       @states;
+}
+

 =item counties STATE COUNTRY
 
 Returns a list of counties for this state and country.
 =item counties STATE COUNTRY
 
 Returns a list of counties for this state and country.


@@ -669,13 +772,18 @@ sub generate_ps {
 
   _pslatex($file);
 
 
   _pslatex($file);
 

-  system('dvips', '-q', '-t', 'letter', "$file.dvi", '-o', "$file.ps" ) == 0
+  my $papersize = $conf->config('papersize') || 'letter';
+
+  local($SIG{CHLD}) = sub {};
+
+  system('dvips', '-q', '-t', $papersize, "$file.dvi", '-o', "$file.ps" ) == 0

     or die "dvips failed";
 
   open(POSTSCRIPT, "<$file.ps")
     or die "can't open $file.ps: $! (error in LaTeX template?)\n";
 
     or die "dvips failed";
 
   open(POSTSCRIPT, "<$file.ps")
     or die "can't open $file.ps: $! (error in LaTeX template?)\n";
 

-  unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex");
+  unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex")
+    unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');

 
   my $ps = '';
 
 
   my $ps = '';
 


@@ -723,8 +831,12 @@ sub generate_pdf {
   my $sfile = shell_quote $file;
 
   #system('dvipdf', "$file.dvi", "$file.pdf" );
   my $sfile = shell_quote $file;
 
   #system('dvipdf', "$file.dvi", "$file.pdf" );

+  my $papersize = $conf->config('papersize') || 'letter';
+
+  local($SIG{CHLD}) = sub {};
+

   system(
   system(

-    "dvips -q -t letter -f $sfile.dvi ".
+    "dvips -q -f $sfile.dvi -t $papersize ".

     "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
     "     -c save pop -"
   ) == 0
     "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
     "     -c save pop -"
   ) == 0


@@ -733,7 +845,8 @@ sub generate_pdf {
   open(PDF, "<$file.pdf")
     or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
 
   open(PDF, "<$file.pdf")
     or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
 

-  unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex");
+  unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex")
+    unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');

 
   my $pdf = '';
   while (<PDF>) {
 
   my $pdf = '';
   while (<PDF>) {


@@ -772,22 +885,44 @@ sub _pslatex {
   }
 
   return if -e "$file.dvi" && -s "$file.dvi";
   }
 
   return if -e "$file.dvi" && -s "$file.dvi";

-  die "pslatex $file.tex failed; see $file.log for details?\n";
+  die "pslatex $file.tex failed, see $file.log for details?\n";

 
 }
 
 
 }
 

-=item print ARRAYREF
+=item do_print ARRAYREF [, OPTION => VALUE ... ]

 
 Sends the lines in ARRAYREF to the printer.
 
 
 Sends the lines in ARRAYREF to the printer.
 

+Options available are:
+
+=over 4
+
+=item agentnum
+
+Uses this agent's 'lpr' configuration setting override instead of the global
+value.
+
+=item lpr
+
+Uses this command instead of the configured lpr command (overrides both the
+global value and agentnum).
+

 =cut
 
 sub do_print {
 =cut
 
 sub do_print {

-  my $data = shift;
+  my( $data, %opt ) = @_;

 
 

-  my $lpr = $conf->config('lpr');
+  if ( $DISABLE_ALL_NOTICES ) {
+    warn 'do_print() disabled by $FS::Misc::DISABLE_ALL_NOTICES' if $DEBUG;
+    return;
+  }
+
+  my $lpr = ( exists($opt{'lpr'}) && $opt{'lpr'} )
+              ? $opt{'lpr'}
+              : $conf->config('lpr', $opt{'agentnum'} );

 
   my $outerr = '';
 
   my $outerr = '';

+  local($SIG{CHLD}) = sub {};

   run3 $lpr, $data, \$outerr, \$outerr;
   if ( $? ) {
     $outerr = ": $outerr" if length($outerr);
   run3 $lpr, $data, \$outerr, \$outerr;
   if ( $? ) {
     $outerr = ": $outerr" if length($outerr);


@@ -877,6 +1012,8 @@ sub ocr_image {
   print $fh $logo_data;
   close $fh;
 
   print $fh $logo_data;
   close $fh;
 

+  local($SIG{CHLD}) = sub {};
+

   run( [qw(ocroscript recognize), $filename], '>'=>"$filename.hocr" )
     or die "ocroscript recognize failed\n";
 
   run( [qw(ocroscript recognize), $filename], '>'=>"$filename.hocr" )
     or die "ocroscript recognize failed\n";
 


@@ -890,6 +1027,45 @@ sub ocr_image {
   @lines;
 }
 
   @lines;
 }
 

+=item bytes_substr STRING, OFFSET[, LENGTH[, REPLACEMENT] ]
+
+DEPRECATED
+  Use Unicode::Truncate truncate_egc instead
+
+A replacement for "substr" that counts raw bytes rather than logical 
+characters. Unlike "bytes::substr", will suppress fragmented UTF-8 characters
+rather than output them. Unlike real "substr", is not an lvalue.
+
+=cut
+
+# sub bytes_substr {
+#   my ($string, $offset, $length, $repl) = @_;
+#   my $bytes = substr(
+#     Encode::encode('utf8', $string),
+#     $offset,
+#     $length,
+#     Encode::encode('utf8', $repl)
+#   );
+#   my $chk = $DEBUG ? Encode::FB_WARN : Encode::FB_QUIET;
+#   return Encode::decode('utf8', $bytes, $chk);
+# }
+
+=item money_pretty
+
+Accepts a postive or negative numerical value.
+Returns amount formatted for display,
+including money character.
+
+=cut
+
+sub money_pretty {
+  my $amount = shift;
+  my $money_char = $conf->{'money_char'} || '$';
+  $amount = sprintf("%0.2f",$amount);
+  $amount =~ s/^(-?)/$1$money_char/;
+  return $amount;
+}
+

 =back
 
 =head1 BUGS
 =back
 
 =head1 BUGS