4 use vars qw ( @ISA @EXPORT_OK $DEBUG );
8 use IPC::Run qw( run timeout ); # for _pslatex
9 use IPC::Run3; # for do_print... should just use IPC::Run i guess
13 #do NOT depend on any FS:: modules here, causes weird (sometimes unreproducable
14 #until on client machine) dependancy loops. put them in FS::Misc::Something
17 @ISA = qw( Exporter );
18 @EXPORT_OK = qw( send_email generate_email send_fax
19 states_hash counties cities state_label
22 generate_ps generate_pdf do_print
31 FS::Misc - Miscellaneous subroutines
35 use FS::Misc qw(send_email);
41 Miscellaneous subroutines. This module contains miscellaneous subroutines
42 called from multiple other modules. These are not OO or necessarily related,
43 but are collected here to eliminate code duplication.
49 =item send_email OPTION => VALUE ...
61 (required) comma-separated scalar or arrayref of recipients
69 (optional) MIME type for the body
73 (required unless I<nobody> is true) arrayref of body text lines
77 (optional, but required if I<nobody> is true) arrayref of MIME::Entity->build PARAMHASH refs or MIME::Entity objects. These will be passed as arguments to MIME::Entity->attach().
81 (optional) when set true, send_email will ignore the I<body> option and simply construct a message with the given I<mimeparts>. In this case,
82 I<content-type>, if specified, overrides the default "multipart/mixed" for the outermost MIME container.
84 =item content-encoding
86 (optional) when using nobody, optional top-level MIME
87 encoding which, if specified, overrides the default "7bit".
91 (optional) type parameter for multipart/related messages
95 (optional) L<FS::cust_main> key; if passed, the message will be logged
96 (if logging is enabled) with this custnum.
100 (optional) L<FS::msg_template> key, for logging.
106 use vars qw( $conf );
109 use Email::Sender::Simple qw(sendmail);
110 use Email::Sender::Transport::SMTP;
111 use Email::Sender::Transport::SMTP::TLS 0.11;
114 FS::UID->install_callback( sub {
115 $conf = new FS::Conf;
121 my %doptions = %options;
122 $doptions{'body'} = '(full body not shown in debug)';
123 warn "FS::Misc::send_email called with options:\n ". Dumper(\%doptions);
124 # join("\n", map { " $_: ". $options{$_} } keys %options ). "\n"
127 my @to = ref($options{to}) ? @{ $options{to} } : ( $options{to} );
131 if ( $options{'nobody'} ) {
133 croak "'mimeparts' option required when 'nobody' option given\n"
134 unless $options{'mimeparts'};
136 @mimeparts = @{$options{'mimeparts'}};
139 'Type' => ( $options{'content-type'} || 'multipart/mixed' ),
140 'Encoding' => ( $options{'content-encoding'} || '7bit' ),
145 @mimeparts = @{$options{'mimeparts'}}
146 if ref($options{'mimeparts'}) eq 'ARRAY';
148 if (scalar(@mimeparts)) {
151 'Type' => 'multipart/mixed',
152 'Encoding' => '7bit',
155 unshift @mimeparts, {
156 'Type' => ( $options{'content-type'} || 'text/plain' ),
157 'Charset' => 'UTF-8',
158 'Data' => $options{'body'},
159 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
160 'Disposition' => 'inline',
166 'Type' => ( $options{'content-type'} || 'text/plain' ),
167 'Data' => $options{'body'},
168 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
169 'Charset' => 'UTF-8',
176 my $from = $options{from};
177 $from =~ s/^\s*//; $from =~ s/\s*$//;
178 if ( $from =~ /^(.*)\s*<(.*@.*)>$/ ) {
184 if ( $from =~ /\@([\w\.\-]+)/ ) {
187 warn 'no domain found in invoice from address '. $options{'from'}.
188 '; constructing Message-ID (and saying HELO) @example.com';
189 $domain = 'example.com';
191 my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
194 my $message = MIME::Entity->build(
195 'From' => $options{'from'},
196 'To' => join(', ', @to),
197 'Sender' => $options{'from'},
198 'Reply-To' => $options{'from'},
199 'Date' => time2str("%a, %d %b %Y %X %z", $time),
200 'Subject' => Encode::encode('MIME-Header', $options{'subject'}),
201 'Message-ID' => "<$message_id>",
205 if ( $options{'type'} ) {
206 #false laziness w/cust_bill::generate_email
207 $message->head->replace('Content-type',
209 '; boundary="'. $message->head->multipart_boundary. '"'.
210 '; type='. $options{'type'}
214 foreach my $part (@mimeparts) {
216 if ( UNIVERSAL::isa($part, 'MIME::Entity') ) {
218 warn "attaching MIME part from MIME::Entity object\n"
220 $message->add_part($part);
222 } elsif ( ref($part) eq 'HASH' ) {
224 warn "attaching MIME part from hashref:\n".
225 join("\n", map " $_: ".$part->{$_}, keys %$part ). "\n"
227 $message->attach(%$part);
230 croak "mimepart $part isn't a hashref or MIME::Entity object!";
237 my %smtp_opt = ( 'host' => $conf->config('smtpmachine'),
241 my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
242 $smtp_opt{'port'} = $port;
245 if ( defined($enc) && $enc eq 'starttls' ) {
246 $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password);
247 $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt );
249 if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
250 $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password);
252 $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls';
253 $transport = Email::Sender::Transport::SMTP->new( %smtp_opt );
256 push @to, $options{bcc} if defined($options{bcc});
257 local $@; # just in case
258 eval { sendmail($message, { transport => $transport,
263 if(ref($@) and $@->isa('Email::Sender::Failure')) {
264 $error = $@->code.' ' if $@->code;
265 $error .= $@->message;
272 if ( $conf->exists('log_sent_mail') ) {
273 my $cust_msg = FS::cust_msg->new({
274 'env_from' => $options{'from'},
275 'env_to' => join(', ', @to),
276 'header' => $message->header_as_string,
277 'body' => $message->body_as_string,
280 'custnum' => $options{'custnum'},
281 'msgnum' => $options{'msgnum'},
282 'status' => ($error ? 'failed' : 'sent'),
283 'msgtype' => $options{'msgtype'},
285 $cust_msg->insert; # ignore errors
291 =item generate_email OPTION => VALUE ...
299 Sender address, required
303 Recipient address, required
307 Blind copy address, optional
311 email subject, required
315 Email body (HTML alternative). Arrayref of lines, or scalar.
317 Will be placed inside an HTML <BODY> tag.
321 Email body (Text alternative). Arrayref of lines, or scalar.
323 =item custnum, msgnum (optional)
325 Customer and template numbers, passed through to send_email for logging.
329 Constructs a multipart message from text_body and html_body.
333 #false laziness w/FS::cust_bill::generate_email
341 my $me = '[FS::Misc::generate_email]';
343 my @fields = qw(from to bcc subject custnum msgnum msgtype);
345 @return{@fields} = @args{@fields};
347 warn "$me creating HTML/text multipart message"
350 $return{'nobody'} = 1;
352 my $alternative = build MIME::Entity
353 'Type' => 'multipart/alternative',
354 'Encoding' => '7bit',
355 'Disposition' => 'inline'
359 if ( ref($args{'text_body'}) eq 'ARRAY' ) {
360 $data = join("\n", @{ $args{'text_body'} });
362 $data = $args{'text_body'};
365 $alternative->attach(
366 'Type' => 'text/plain',
367 'Encoding' => 'quoted-printable',
368 'Charset' => 'UTF-8',
369 #'Encoding' => '7bit',
371 'Disposition' => 'inline',
375 if ( ref($args{'html_body'}) eq 'ARRAY' ) {
376 @html_data = @{ $args{'html_body'} };
378 @html_data = split(/\n/, $args{'html_body'});
381 $alternative->attach(
382 'Type' => 'text/html',
383 'Encoding' => 'quoted-printable',
384 'Data' => [ '<html>',
387 ' '. encode_entities($return{'subject'}),
390 ' <body bgcolor="#ffffff">',
395 'Disposition' => 'inline',
396 #'Filename' => 'invoice.pdf',
399 #no other attachment:
401 # multipart/alternative
405 $return{'content-type'} = 'multipart/related';
406 $return{'mimeparts'} = [ $alternative ];
407 $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
408 #$return{'disposition'} = 'inline';
414 =item process_send_email OPTION => VALUE ...
416 Takes arguments as per generate_email() and sends the message. This
417 will die on any error and can be used in the job queue.
421 sub process_send_email {
423 my $error = send_email(generate_email(%message));
424 die "$error\n" if $error;
428 =item process_send_generated_email OPTION => VALUE ...
430 Takes arguments as per send_email() and sends the message. This
431 will die on any error and can be used in the job queue.
435 sub process_send_generated_email {
437 my $error = send_email(%args);
438 die "$error\n" if $error;
442 =item send_fax OPTION => VALUE ...
446 I<dialstring> - (required) 10-digit phone number w/ area code
448 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
452 I<docfile> - (required) Filename of PostScript TIFF Class F document
454 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
463 die 'HylaFAX support has not been configured.'
464 unless $conf->exists('hylafax');
467 require Fax::Hylafax::Client;
471 if ($@ =~ /^Can't locate Fax.*/) {
472 die "You must have Fax::Hylafax::Client installed to use invoice faxing."
478 my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
480 die 'Called send_fax without a \'dialstring\'.'
481 unless exists($options{'dialstring'});
483 if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
484 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
485 my $fh = new File::Temp(
486 TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
489 ) or die "can't open temp file: $!\n";
491 $options{docfile} = $fh->filename;
493 print $fh @{$options{'docdata'}};
496 delete $options{'docdata'};
499 die 'Called send_fax without a \'docfile\' or \'docdata\'.'
500 unless exists($options{'docfile'});
502 #FIXME: Need to send canonical dialstring to HylaFAX, but this only
505 $options{'dialstring'} =~ s/[^\d\+]//g;
506 if ($options{'dialstring'} =~ /^\d{10}$/) {
507 $options{dialstring} = '+1' . $options{'dialstring'};
509 return 'Invalid dialstring ' . $options{'dialstring'} . '.';
512 my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
514 if ($faxjob->success) {
515 warn "Successfully queued fax to '$options{dialstring}' with jobid " .
520 return 'Error while sending FAX: ' . $faxjob->trace;
525 =item states_hash COUNTRY
527 Returns a list of key/value pairs containing state (or other sub-country
528 division) abbriviations and names.
532 use FS::Record qw(qsearch);
533 use Locale::SubCountry;
540 map { s/[\n\r]//g; $_; }
544 'table' => 'cust_main_county',
545 'hashref' => { 'country' => $country },
546 'extra_sql' => 'GROUP BY state',
549 #it could throw a fatal "Invalid country code" error (for example "AX")
550 my $subcountry = eval { new Locale::SubCountry($country) }
551 or return ( '', '(n/a)' );
553 #"i see your schwartz is as big as mine!"
554 map { ( $_->[0] => $_->[1] ) }
555 sort { $a->[1] cmp $b->[1] }
556 map { [ $_ => state_label($_, $subcountry) ] }
560 =item counties STATE COUNTRY
562 Returns a list of counties for this state and country.
567 my( $state, $country ) = @_;
569 map { $_ } #return num_counties($state, $country) unless wantarray;
570 sort map { s/[\n\r]//g; $_; }
573 'select' => 'DISTINCT county',
574 'table' => 'cust_main_county',
575 'hashref' => { 'state' => $state,
576 'country' => $country,
581 =item cities COUNTY STATE COUNTRY
583 Returns a list of cities for this county, state and country.
588 my( $county, $state, $country ) = @_;
590 map { $_ } #return num_cities($county, $state, $country) unless wantarray;
591 sort map { s/[\n\r]//g; $_; }
594 'select' => 'DISTINCT city',
595 'table' => 'cust_main_county',
596 'hashref' => { 'county' => $county,
598 'country' => $country,
603 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
608 my( $state, $country ) = @_;
610 unless ( ref($country) ) {
611 $country = eval { new Locale::SubCountry($country) }
616 # US kludge to avoid changing existing behaviour
617 # also we actually *use* the abbriviations...
618 my $full_name = $country->country_code eq 'US'
620 : $country->full_name($state);
622 $full_name = '' if $full_name eq 'unknown';
623 $full_name =~ s/\(see also.*\)\s*$//;
624 $full_name .= " ($state)" if $full_name;
626 $full_name || $state || '(n/a)';
632 Returns a hash reference of the accepted credit card types. Keys are shorter
633 identifiers and values are the longer strings used by the system (see
634 L<Business::CreditCard>).
641 my $conf = new FS::Conf;
644 #displayname #value (Business::CreditCard)
645 "VISA" => "VISA card",
646 "MasterCard" => "MasterCard",
647 "Discover" => "Discover card",
648 "American Express" => "American Express card",
649 "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
650 "enRoute" => "enRoute",
652 "BankCard" => "BankCard",
653 "Switch" => "Switch",
656 my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
657 if ( @conf_card_types ) {
658 #perhaps the hash is backwards for this, but this way works better for
659 #usage in selfservice
660 %card_types = map { $_ => $card_types{$_} }
663 grep { $card_types{$d} eq $_ } @conf_card_types
673 Returns a hash reference of allowed package billing frequencies.
678 tie my %freq, 'Tie::IxHash', (
679 '0' => '(no recurring fee)',
682 '2d' => 'every two days',
683 '3d' => 'every three days',
685 '2w' => 'biweekly (every 2 weeks)',
687 '45d' => 'every 45 days',
688 '2' => 'bimonthly (every 2 months)',
689 '3' => 'quarterly (every 3 months)',
690 '4' => 'every 4 months',
691 '137d' => 'every 4 1/2 months (137 days)',
692 '6' => 'semiannually (every 6 months)',
694 '13' => 'every 13 months (annually +1 month)',
695 '24' => 'biannually (every 2 years)',
696 '36' => 'triannually (every 3 years)',
697 '48' => '(every 4 years)',
698 '60' => '(every 5 years)',
699 '120' => '(every 10 years)',
704 =item generate_ps FILENAME
706 Returns an postscript rendition of the LaTex file, as a scalar.
707 FILENAME does not contain the .tex suffix and is unlinked by this function.
711 use String::ShellQuote;
716 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
721 system('dvips', '-q', '-t', 'letter', "$file.dvi", '-o', "$file.ps" ) == 0
722 or die "dvips failed";
724 open(POSTSCRIPT, "<$file.ps")
725 or die "can't open $file.ps: $! (error in LaTeX template?)\n";
727 unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex")
728 unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
732 if ( $conf->exists('lpr-postscript_prefix') ) {
733 my $prefix = $conf->config('lpr-postscript_prefix');
734 $ps .= eval qq("$prefix");
737 while (<POSTSCRIPT>) {
743 if ( $conf->exists('lpr-postscript_suffix') ) {
744 my $suffix = $conf->config('lpr-postscript_suffix');
745 $ps .= eval qq("$suffix");
752 =item generate_pdf FILENAME
754 Returns an PDF rendition of the LaTex file, as a scalar. FILENAME does not
755 contain the .tex suffix and is unlinked by this function.
759 use String::ShellQuote;
764 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
767 #system('pdflatex', "$file.tex");
768 #system('pdflatex', "$file.tex");
769 #! LaTeX Error: Unknown graphics extension: .eps.
773 my $sfile = shell_quote $file;
775 #system('dvipdf', "$file.dvi", "$file.pdf" );
777 "dvips -q -t letter -f $sfile.dvi ".
778 "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
781 or die "dvips | gs failed: $!";
783 open(PDF, "<$file.pdf")
784 or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
786 unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex")
787 unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
803 #my $sfile = shell_quote $file;
807 '-interaction=batchmode',
808 '\AtBeginDocument{\RequirePackage{pslatex}}',
809 '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
810 '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
815 my $timeout = 30; #? should be more than enough
819 local($SIG{CHLD}) = sub {};
820 run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
821 or warn "bad exit status from pslatex pass $_\n";
825 return if -e "$file.dvi" && -s "$file.dvi";
826 die "pslatex $file.tex failed; see $file.log for details?\n";
830 =item do_print ARRAYREF [, OPTION => VALUE ... ]
832 Sends the lines in ARRAYREF to the printer.
834 Options available are:
840 Uses this agent's 'lpr' configuration setting override instead of the global
845 Uses this command instead of the configured lpr command (overrides both the
846 global value and agentnum).
851 my( $data, %opt ) = @_;
853 my $lpr = ( exists($opt{'lpr'}) && $opt{'lpr'} )
855 : $conf->config('lpr', $opt{'agentnum'} );
858 run3 $lpr, $data, \$outerr, \$outerr;
860 $outerr = ": $outerr" if length($outerr);
861 die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
866 =item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ]
868 Converts the filehandle referenced by FILEREF from fixed length record
869 lines to a CSV file according to the lengths specified in LENGTH_LISTREF.
870 The CALLBACKS_LISTREF refers to a correpsonding list of coderefs. Each
871 should return the value to be substituted in place of its single argument.
873 Returns false on success or an error if one occurs.
878 my( $fhref, $countref, $lengths, $callbacks) = @_;
880 eval { require Text::CSV_XS; };
884 my $unpacker = new Text::CSV_XS;
886 my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths;
888 my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc";
889 my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX",
892 ) or return "can't open temp file: $!\n"
895 while ( defined(my $line=<$ofh>) ) {
901 return "unexpected input at line $$countref: $line".
902 " -- expected $total but received ". length($line)
903 unless length($line) == $total;
905 $unpacker->combine( map { my $i = $column++;
906 defined( $callbacks->[$i] )
907 ? &{ $callbacks->[$i] }( $_ )
909 } unpack( $template, $line )
911 or return "invalid data for CSV: ". $unpacker->error_input;
913 print $fh $unpacker->string(), "\n"
914 or return "can't write temp file: $!\n";
918 if ( $template ) { close $$fhref; $$fhref = $fh }
924 =item ocr_image IMAGE_SCALAR
926 Runs OCR on the provided image data and returns a list of text lines.
931 my $logo_data = shift;
933 #XXX use conf dir location from Makefile
934 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
935 my $fh = new File::Temp(
936 TEMPLATE => 'bizcard.XXXXXXXX',
937 SUFFIX => '.png', #XXX assuming, but should handle jpg, gif, etc. too
940 ) or die "can't open temp file: $!\n";
942 my $filename = $fh->filename;
944 print $fh $logo_data;
947 run( [qw(ocroscript recognize), $filename], '>'=>"$filename.hocr" )
948 or die "ocroscript recognize failed\n";
950 run( [qw(ocroscript hocr-to-text), "$filename.hocr"], '>pipe'=>\*OUT )
951 or die "ocroscript hocr-to-text failed\n";
953 my @lines = split(/\n/, <OUT> );
955 foreach (@lines) { s/\.c0m\s*$/.com/; }
968 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
970 L<Fax::Hylafax::Client>