X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2FMisc.pm;h=1c100eacd0418537515ae00b4dca284dfdbaa0b2;hp=a2d1b3ed5b82cb747ce642277b98b10793e3dfe3;hb=3adb46fccf9f631e188ea5383bd147b340477639;hpb=c74a93a8460dc0e867e93a5ded0c63a1585b86c9 diff --git a/FS/FS/Misc.pm b/FS/FS/Misc.pm index a2d1b3ed5..1c100eacd 100644 --- a/FS/FS/Misc.pm +++ b/FS/FS/Misc.pm @@ -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; @@ -16,13 +16,13 @@ use Encode; @ISA = qw( Exporter ); @EXPORT_OK = qw( send_email generate_email send_fax + email_sender_transport_or_error states_hash counties cities state_label card_types pkg_freqs generate_ps generate_pdf do_print csv_from_fixed ocr_image - bytes_substr money_pretty ); @@ -44,6 +44,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 @@ -110,7 +136,6 @@ use Date::Format; use MIME::Entity; use Email::Sender::Simple qw(sendmail); use Email::Sender::Transport::SMTP; -use Email::Sender::Transport::SMTP::TLS 0.11; use FS::UID; FS::UID->install_callback( sub { @@ -119,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)'; @@ -157,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', }; @@ -166,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', ); @@ -236,25 +273,6 @@ sub send_email { #send the email - my %smtp_opt = ( 'host' => $conf->config('smtpmachine'), - 'helo' => $domain, - ); - - 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 ); - } - push @to, $options{bcc} if defined($options{bcc}); # fully unpack all addresses found in @to (including Bcc) to make the # envelope list @@ -263,18 +281,26 @@ sub send_email { push @env_to, map { $_->address } Email::Address->parse($dest); } - local $@; # just in case - eval { sendmail($message, { transport => $transport, - from => $from, - to => \@env_to }) }; + my $transport = email_sender_transport_or_error($domain); my $error = ''; - if(ref($@) and $@->isa('Email::Sender::Failure')) { - $error = $@->code.' ' if $@->code; - $error .= $@->message; - } - else { - $error = $@; + if ( ref($transport) ) { + + 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 = $@; + } + + } else { + $error = $transport; } # Logging @@ -294,10 +320,37 @@ sub send_email { my $log_error = $cust_msg->insert; warn "Error logging message: $log_error\n" if $log_error; # at least warn } + $error; } +sub email_sender_transport_or_error { + my $domain = shift; + + my %smtp_opt = ( 'host' => $conf->config('smtpmachine'), + 'helo' => $domain, + ); + + my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') ); + $smtp_opt{'port'} = $port; + + 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') { + return "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'; + } + + Email::Sender::Transport::SMTP->new( %smtp_opt ); + +} + =item generate_email OPTION => VALUE ... Options: @@ -377,7 +430,7 @@ sub generate_email { 'Encoding' => 'quoted-printable', 'Charset' => 'UTF-8', #'Encoding' => '7bit', - 'Data' => $data, + 'Data' => Encode::encode_utf8($data), 'Disposition' => 'inline', ); @@ -398,7 +451,7 @@ sub generate_email { ' ', ' ', ' ', - @html_data, + ( map Encode::encode_utf8($_), @html_data ), ' ', '', ], @@ -445,6 +498,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; }; @@ -726,6 +784,8 @@ sub generate_ps { 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"; @@ -783,6 +843,8 @@ sub generate_pdf { #system('dvipdf', "$file.dvi", "$file.pdf" ); my $papersize = $conf->config('papersize') || 'letter'; + local($SIG{CHLD}) = sub {}; + system( "dvips -q -f $sfile.dvi -t $papersize ". "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ". @@ -860,11 +922,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); @@ -954,6 +1022,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"; @@ -969,23 +1039,26 @@ sub ocr_image { =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); -} +# 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