don't include stack backtrace with email errors, RT#83078, RT#83088
[freeside.git] / FS / FS / Misc.pm
index 93445ab..a9d24c2 100644 (file)
@@ -1,7 +1,7 @@
 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;
@@ -22,6 +22,7 @@ use Encode;
                  generate_ps generate_pdf do_print
                  csv_from_fixed
                  ocr_image
+                 money_pretty
                );
 
 $DEBUG = 0;
@@ -42,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.
 
+=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
@@ -117,6 +144,12 @@ FS::UID->install_callback( sub {
 
 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)';
@@ -155,7 +188,10 @@ sub send_email {
       unshift @mimeparts, { 
         'Type'        => ( $options{'content-type'} || 'text/plain' ),
         'Charset'     => 'UTF-8',
-        'Data'        => $options{'body'},
+        'Data'        => ( $options{'content-type'} =~ /^text\//
+                             ? Encode::encode_utf8( $options{'body'} )
+                             : $options{'body'}
+                         ),
         'Encoding'    => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
         'Disposition' => 'inline',
       };
@@ -164,7 +200,10 @@ sub send_email {
     
       @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' ),
         'Charset'  => 'UTF-8',
       );
@@ -254,10 +293,18 @@ sub send_email {
   }
   
   push @to, $options{bcc} if defined($options{bcc});
+  # 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);
+  }
+
+  local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
   local $@; # just in case
   eval { sendmail($message, { transport => $transport,
                               from      => $from,
-                              to        => \@to }) };
+                              to        => \@env_to }) };
 
   my $error = '';
   if(ref($@) and $@->isa('Email::Sender::Failure')) {
@@ -272,7 +319,7 @@ sub send_email {
   if ( $conf->exists('log_sent_mail') ) {
     my $cust_msg = FS::cust_msg->new({
         'env_from'  => $options{'from'},
-        'env_to'    => join(', ', @to),
+        'env_to'    => join(', ', @env_to),
         'header'    => $message->header_as_string,
         'body'      => $message->body_as_string,
         '_date'     => $time,
@@ -282,7 +329,8 @@ sub send_email {
         'status'    => ($error ? 'failed' : 'sent'),
         'msgtype'   => $options{'msgtype'},
     });
-    $cust_msg->insert; # ignore errors
+    my $log_error = $cust_msg->insert;
+    warn "Error logging message: $log_error\n" if $log_error; # at least warn
   }
   $error;
    
@@ -367,7 +415,7 @@ sub generate_email {
     'Encoding'    => 'quoted-printable',
     'Charset'     => 'UTF-8',
     #'Encoding'    => '7bit',
-    'Data'        => $data,
+    'Data'        => Encode::encode_utf8($data),
     'Disposition' => 'inline',
   );
 
@@ -388,7 +436,7 @@ sub generate_email {
                        '    </title>',
                        '  </head>',
                        '  <body bgcolor="#ffffff">',
-                       @html_data,
+                       ( map Encode::encode_utf8($_), @html_data ),
                        '  </body>',
                        '</html>',
                      ],
@@ -411,34 +459,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 process_send_generated_email OPTION => VALUE ...
-
-Takes arguments as per send_email() and sends the message.  This 
-will die on any error and can be used in the job queue.
-
-=cut
-
-sub process_send_generated_email {
-  my %args = @_;
-  my $error = send_email(%args);
-  die "$error\n" if $error;
-  '';
-}
-
 =item send_fax OPTION => VALUE ...
 
 Options:
@@ -463,6 +483,11 @@ sub send_fax {
   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;
   };
@@ -535,6 +560,9 @@ use Locale::SubCountry;
 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; $_; }
@@ -548,7 +576,7 @@ sub states_hash {
 
   #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] ) }
@@ -557,6 +585,27 @@ sub states_hash {
        @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.
@@ -718,7 +767,11 @@ sub generate_ps {
 
   _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")
@@ -773,8 +826,12 @@ sub generate_pdf {
   my $sfile = shell_quote $file;
 
   #system('dvipdf', "$file.dvi", "$file.pdf" );
+  my $papersize = $conf->config('papersize') || 'letter';
+
+  local($SIG{CHLD}) = sub {};
+
   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
@@ -823,7 +880,7 @@ sub _pslatex {
   }
 
   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";
 
 }
 
@@ -850,11 +907,17 @@ global value and agentnum).
 sub do_print {
   my( $data, %opt ) = @_;
 
+  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 = '';
+  local($SIG{CHLD}) = sub {};
   run3 $lpr, $data, \$outerr, \$outerr;
   if ( $? ) {
     $outerr = ": $outerr" if length($outerr);
@@ -944,6 +1007,8 @@ sub ocr_image {
   print $fh $logo_data;
   close $fh;
 
+  local($SIG{CHLD}) = sub {};
+
   run( [qw(ocroscript recognize), $filename], '>'=>"$filename.hocr" )
     or die "ocroscript recognize failed\n";
 
@@ -957,6 +1022,45 @@ sub ocr_image {
   @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