X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FMisc.pm;h=380f8959d234dfc7b1d512aea5a46cbc90ad385f;hb=c2f7d8ba623194ad1fae37b231b2e29b33d05674;hp=19ac35c8fd6ceada44824e06c305e081e9297987;hpb=5164aa211f893adf641a3b78293d7b0585eb0af0;p=freeside.git diff --git a/FS/FS/Misc.pm b/FS/FS/Misc.pm index 19ac35c8f..380f8959d 100644 --- a/FS/FS/Misc.pm +++ b/FS/FS/Misc.pm @@ -8,6 +8,8 @@ use Data::Dumper; 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 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 @@ -16,8 +18,10 @@ use File::Temp; @EXPORT_OK = qw( send_email generate_email send_fax states_hash counties cities state_label card_types + pkg_freqs generate_ps generate_pdf do_print csv_from_fixed + ocr_image ); $DEBUG = 0; @@ -86,6 +90,15 @@ encoding which, if specified, overrides the default "7bit". (optional) type parameter for multipart/related messages +=item custnum + +(optional) L key; if passed, the message will be logged +(if logging is enabled) with this custnum. + +=item msgnum + +(optional) L key, for logging. + =back =cut @@ -95,7 +108,7 @@ use Date::Format; use MIME::Entity; use Email::Sender::Simple qw(sendmail); use Email::Sender::Transport::SMTP; -use Email::Sender::Transport::SMTP::TLS; +use Email::Sender::Transport::SMTP::TLS 0.11; use FS::UID; FS::UID->install_callback( sub { @@ -111,7 +124,7 @@ sub send_email { # join("\n", map { " $_: ". $options{$_} } keys %options ). "\n" } - my $to = ref($options{to}) ? join(', ', @{ $options{to} } ) : $options{to}; + my @to = ref($options{to}) ? @{ $options{to} } : ( $options{to} ); my @mimeargs = (); my @mimeparts = (); @@ -141,6 +154,7 @@ sub send_email { unshift @mimeparts, { 'Type' => ( $options{'content-type'} || 'text/plain' ), + 'Charset' => 'UTF-8', 'Data' => $options{'body'}, 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ), 'Disposition' => 'inline', @@ -152,14 +166,22 @@ sub send_email { 'Type' => ( $options{'content-type'} || 'text/plain' ), 'Data' => $options{'body'}, '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; - if ( $options{'from'} =~ /\@([\w\.\-]+)/ ) { + if ( $from =~ /\@([\w\.\-]+)/ ) { $domain = $1; } else { warn 'no domain found in invoice from address '. $options{'from'}. @@ -168,13 +190,14 @@ sub send_email { } my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain"; + my $time = time; my $message = MIME::Entity->build( 'From' => $options{'from'}, - 'To' => $to, + '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, ); @@ -230,15 +253,39 @@ sub send_email { $transport = Email::Sender::Transport::SMTP->new( %smtp_opt ); } + push @to, $options{bcc} if defined($options{bcc}); local $@; # just in case - eval { sendmail($message, { transport => $transport }) }; - + eval { sendmail($message, { transport => $transport, + from => $from, + to => \@to }) }; + + my $error = ''; if(ref($@) and $@->isa('Email::Sender::Failure')) { - return ($@->code ? $@->code.' ' : '').$@->message + $error = $@->code.' ' if $@->code; + $error .= $@->message; } else { - return $@; + $error = $@; } + + # Logging + if ( $conf->exists('log_sent_mail') ) { + my $cust_msg = FS::cust_msg->new({ + 'env_from' => $options{'from'}, + 'env_to' => join(', ', @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'}, + }); + $cust_msg->insert; # ignore errors + } + $error; + } =item generate_email OPTION => VALUE ... @@ -255,6 +302,10 @@ Sender address, required Recipient address, required +=item bcc + +Blind copy address, optional + =item subject email subject, required @@ -269,6 +320,10 @@ Will be placed inside an HTML tag. 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. @@ -285,19 +340,9 @@ sub generate_email { my $me = '[FS::Misc::generate_email]'; - my %return = ( - 'from' => $args{'from'}, - 'to' => $args{'to'}, - '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; @@ -312,15 +357,16 @@ sub generate_email { my $data; if ( ref($args{'text_body'}) eq 'ARRAY' ) { - $data = $args{'text_body'}; + $data = join("\n", @{ $args{'text_body'} }); } else { - $data = [ split(/\n/, $args{'text_body'}) ]; + $data = $args{'text_body'}; } $alternative->attach( 'Type' => 'text/plain', - #'Encoding' => 'quoted-printable', - 'Encoding' => '7bit', + 'Encoding' => 'quoted-printable', + 'Charset' => 'UTF-8', + #'Encoding' => '7bit', 'Data' => $data, 'Disposition' => 'inline', ); @@ -341,7 +387,7 @@ sub generate_email { ' '. encode_entities($return{'subject'}), ' ', ' ', - ' ', + ' ', @html_data, ' ', '', @@ -379,6 +425,20 @@ sub process_send_email { ''; } +=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: @@ -608,6 +668,39 @@ sub card_types { \%card_types; } +=item pkg_freqs + +Returns a hash reference of allowed package billing frequencies. + +=cut + +sub pkg_freqs { + tie my %freq, 'Tie::IxHash', ( + '0' => '(no recurring fee)', + '1h' => 'hourly', + '1d' => 'daily', + '2d' => 'every two days', + '3d' => 'every three days', + '1w' => 'weekly', + '2w' => 'biweekly (every 2 weeks)', + '1' => 'monthly', + '45d' => 'every 45 days', + '2' => 'bimonthly (every 2 months)', + '3' => 'quarterly (every 3 months)', + '4' => 'every 4 months', + '137d' => 'every 4 1/2 months (137 days)', + '6' => 'semiannually (every 6 months)', + '12' => 'annually', + '13' => 'every 13 months (annually +1 month)', + '24' => 'biannually (every 2 years)', + '36' => 'triannually (every 3 years)', + '48' => '(every 4 years)', + '60' => '(every 5 years)', + '120' => '(every 10 years)', + ) ; + \%freq; +} + =item generate_ps FILENAME Returns an postscript rendition of the LaTex file, as a scalar. @@ -625,13 +718,16 @@ sub generate_ps { _pslatex($file); - system('dvips', '-q', '-t', 'letter', "$file.dvi", '-o', "$file.ps" ) == 0 + my $papersize = $conf->config('papersize') || 'letter'; + + 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"; - 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 = ''; @@ -679,8 +775,10 @@ sub generate_pdf { my $sfile = shell_quote $file; #system('dvipdf', "$file.dvi", "$file.pdf" ); + my $papersize = $conf->config('papersize') || 'letter'; + 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 @@ -689,7 +787,8 @@ sub generate_pdf { 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 () { @@ -723,22 +822,41 @@ sub _pslatex { local($SIG{CHLD}) = sub {}; run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) ) - or die "pslatex $file.tex failed; see $file.log for details?\n"; + or warn "bad exit status from pslatex pass $_\n"; } + return if -e "$file.dvi" && -s "$file.dvi"; + 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. +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 { - my $data = shift; + my( $data, %opt ) = @_; - my $lpr = $conf->config('lpr'); + my $lpr = ( exists($opt{'lpr'}) && $opt{'lpr'} ) + ? $opt{'lpr'} + : $conf->config('lpr', $opt{'agentnum'} ); my $outerr = ''; run3 $lpr, $data, \$outerr, \$outerr; @@ -807,6 +925,41 @@ sub csv_from_fixed { ''; } +=item ocr_image IMAGE_SCALAR + +Runs OCR on the provided image data and returns a list of text lines. + +=cut + +sub ocr_image { + my $logo_data = shift; + + #XXX use conf dir location from Makefile + my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc; + my $fh = new File::Temp( + TEMPLATE => 'bizcard.XXXXXXXX', + SUFFIX => '.png', #XXX assuming, but should handle jpg, gif, etc. too + DIR => $dir, + UNLINK => 0, + ) or die "can't open temp file: $!\n"; + + my $filename = $fh->filename; + + print $fh $logo_data; + close $fh; + + run( [qw(ocroscript recognize), $filename], '>'=>"$filename.hocr" ) + or die "ocroscript recognize failed\n"; + + run( [qw(ocroscript hocr-to-text), "$filename.hocr"], '>pipe'=>\*OUT ) + or die "ocroscript hocr-to-text failed\n"; + + my @lines = split(/\n/, ); + + foreach (@lines) { s/\.c0m\s*$/.com/; } + + @lines; +} =back