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
12 #do NOT depend on any FS:: modules here, causes weird (sometimes unreproducable
13 #until on client machine) dependancy loops. put them in FS::Misc::Something
16 @ISA = qw( Exporter );
17 @EXPORT_OK = qw( send_email generate_email send_fax
18 states_hash counties cities state_label
21 generate_ps generate_pdf do_print
30 FS::Misc - Miscellaneous subroutines
34 use FS::Misc qw(send_email);
40 Miscellaneous subroutines. This module contains miscellaneous subroutines
41 called from multiple other modules. These are not OO or necessarily related,
42 but are collected here to eliminate code duplication.
48 =item send_email OPTION => VALUE ...
60 (required) comma-separated scalar or arrayref of recipients
68 (optional) MIME type for the body
72 (required unless I<nobody> is true) arrayref of body text lines
76 (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().
80 (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,
81 I<content-type>, if specified, overrides the default "multipart/mixed" for the outermost MIME container.
83 =item content-encoding
85 (optional) when using nobody, optional top-level MIME
86 encoding which, if specified, overrides the default "7bit".
90 (optional) type parameter for multipart/related messages
94 (optional) L<FS::cust_msg> object. If provided, it will be updated
95 with the message envelope information, contents, and server response.
101 use vars qw( $conf );
104 use Email::Sender::Simple qw(sendmail);
105 use Email::Sender::Transport::SMTP;
106 use Email::Sender::Transport::SMTP::TLS;
109 FS::UID->install_callback( sub {
110 $conf = new FS::Conf;
116 my %doptions = %options;
117 $doptions{'body'} = '(full body not shown in debug)';
118 warn "FS::Misc::send_email called with options:\n ". Dumper(\%doptions);
119 # join("\n", map { " $_: ". $options{$_} } keys %options ). "\n"
122 my @to = ref($options{to}) ? @{ $options{to} } : ( $options{to} );
126 if ( $options{'nobody'} ) {
128 croak "'mimeparts' option required when 'nobody' option given\n"
129 unless $options{'mimeparts'};
131 @mimeparts = @{$options{'mimeparts'}};
134 'Type' => ( $options{'content-type'} || 'multipart/mixed' ),
135 'Encoding' => ( $options{'content-encoding'} || '7bit' ),
140 @mimeparts = @{$options{'mimeparts'}}
141 if ref($options{'mimeparts'}) eq 'ARRAY';
143 if (scalar(@mimeparts)) {
146 'Type' => 'multipart/mixed',
147 'Encoding' => '7bit',
150 unshift @mimeparts, {
151 'Type' => ( $options{'content-type'} || 'text/plain' ),
152 'Data' => $options{'body'},
153 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
154 'Disposition' => 'inline',
160 'Type' => ( $options{'content-type'} || 'text/plain' ),
161 'Data' => $options{'body'},
162 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
170 if ( $options{'from'} =~ /\@([\w\.\-]+)/ ) {
173 warn 'no domain found in invoice from address '. $options{'from'}.
174 '; constructing Message-ID (and saying HELO) @example.com';
175 $domain = 'example.com';
177 my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
180 my $message = MIME::Entity->build(
181 'From' => $options{'from'},
182 'To' => join(', ', @to),
183 'Sender' => $options{'from'},
184 'Reply-To' => $options{'from'},
185 'Date' => time2str("%a, %d %b %Y %X %z", $time),
186 'Subject' => $options{'subject'},
187 'Message-ID' => "<$message_id>",
191 if ( $options{'type'} ) {
192 #false laziness w/cust_bill::generate_email
193 $message->head->replace('Content-type',
195 '; boundary="'. $message->head->multipart_boundary. '"'.
196 '; type='. $options{'type'}
200 foreach my $part (@mimeparts) {
202 if ( UNIVERSAL::isa($part, 'MIME::Entity') ) {
204 warn "attaching MIME part from MIME::Entity object\n"
206 $message->add_part($part);
208 } elsif ( ref($part) eq 'HASH' ) {
210 warn "attaching MIME part from hashref:\n".
211 join("\n", map " $_: ".$part->{$_}, keys %$part ). "\n"
213 $message->attach(%$part);
216 croak "mimepart $part isn't a hashref or MIME::Entity object!";
223 my %smtp_opt = ( 'host' => $conf->config('smtpmachine'),
227 my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
228 $smtp_opt{'port'} = $port;
231 if ( defined($enc) && $enc eq 'starttls' ) {
232 $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password);
233 $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt );
235 if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
236 $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password);
238 $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls';
239 $transport = Email::Sender::Transport::SMTP->new( %smtp_opt );
242 push @to, $options{bcc} if defined($options{bcc});
243 local $@; # just in case
244 eval { sendmail($message, { transport => $transport,
245 from => $options{from},
249 if(ref($@) and $@->isa('Email::Sender::Failure')) {
250 $error = $@->code.' ' if $@->code;
251 $error .= $@->message;
258 my $cust_msg = $options{'cust_msg'};
260 $cust_msg->env_from($options{from});
261 $cust_msg->env_to(join(",", @to));
262 $cust_msg->header($message->header_as_string);
263 $cust_msg->body($message->body_as_string);
264 $cust_msg->_date($time);
265 $cust_msg->error($error);
266 $cust_msg->status( $error ? 'failed' : 'sent' );
273 =item generate_email OPTION => VALUE ...
281 Sender address, required
285 Recipient address, required
289 Blind copy address, optional
293 email subject, required
297 Email body (HTML alternative). Arrayref of lines, or scalar.
299 Will be placed inside an HTML <BODY> tag.
303 Email body (Text alternative). Arrayref of lines, or scalar.
305 =item cust_msg (optional)
307 An L<FS::cust_msg> object. Will be passed through to send_email.
311 Constructs a multipart message from text_body and html_body.
315 #false laziness w/FS::cust_bill::generate_email
323 my $me = '[FS::Misc::generate_email]';
326 'from' => $args{'from'},
328 'bcc' => $args{'bcc'},
329 'subject' => $args{'subject'},
330 'cust_msg'=> $args{'cust_msg'},
333 #if (ref($args{'to'}) eq 'ARRAY') {
334 # $return{'to'} = $args{'to'};
336 # $return{'to'} = [ grep { $_ !~ /^(POST|FAX)$/ }
337 # $self->cust_main->invoicing_list
341 warn "$me creating HTML/text multipart message"
344 $return{'nobody'} = 1;
346 my $alternative = build MIME::Entity
347 'Type' => 'multipart/alternative',
348 'Encoding' => '7bit',
349 'Disposition' => 'inline'
353 if ( ref($args{'text_body'}) eq 'ARRAY' ) {
354 $data = join("\n", @{ $args{'text_body'} });
356 $data = $args{'text_body'};
359 $alternative->attach(
360 'Type' => 'text/plain',
361 #'Encoding' => 'quoted-printable',
362 'Encoding' => '7bit',
364 'Disposition' => 'inline',
368 if ( ref($args{'html_body'}) eq 'ARRAY' ) {
369 @html_data = @{ $args{'html_body'} };
371 @html_data = split(/\n/, $args{'html_body'});
374 $alternative->attach(
375 'Type' => 'text/html',
376 'Encoding' => 'quoted-printable',
377 'Data' => [ '<html>',
380 ' '. encode_entities($return{'subject'}),
383 ' <body bgcolor="#e8e8e8">',
388 'Disposition' => 'inline',
389 #'Filename' => 'invoice.pdf',
392 #no other attachment:
394 # multipart/alternative
398 $return{'content-type'} = 'multipart/related';
399 $return{'mimeparts'} = [ $alternative ];
400 $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
401 #$return{'disposition'} = 'inline';
407 =item process_send_email OPTION => VALUE ...
409 Takes arguments as per generate_email() and sends the message. This
410 will die on any error and can be used in the job queue.
414 sub process_send_email {
416 my $error = send_email(generate_email(%message));
417 die "$error\n" if $error;
421 =item send_fax OPTION => VALUE ...
425 I<dialstring> - (required) 10-digit phone number w/ area code
427 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
431 I<docfile> - (required) Filename of PostScript TIFF Class F document
433 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
442 die 'HylaFAX support has not been configured.'
443 unless $conf->exists('hylafax');
446 require Fax::Hylafax::Client;
450 if ($@ =~ /^Can't locate Fax.*/) {
451 die "You must have Fax::Hylafax::Client installed to use invoice faxing."
457 my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
459 die 'Called send_fax without a \'dialstring\'.'
460 unless exists($options{'dialstring'});
462 if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
463 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
464 my $fh = new File::Temp(
465 TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
468 ) or die "can't open temp file: $!\n";
470 $options{docfile} = $fh->filename;
472 print $fh @{$options{'docdata'}};
475 delete $options{'docdata'};
478 die 'Called send_fax without a \'docfile\' or \'docdata\'.'
479 unless exists($options{'docfile'});
481 #FIXME: Need to send canonical dialstring to HylaFAX, but this only
484 $options{'dialstring'} =~ s/[^\d\+]//g;
485 if ($options{'dialstring'} =~ /^\d{10}$/) {
486 $options{dialstring} = '+1' . $options{'dialstring'};
488 return 'Invalid dialstring ' . $options{'dialstring'} . '.';
491 my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
493 if ($faxjob->success) {
494 warn "Successfully queued fax to '$options{dialstring}' with jobid " .
499 return 'Error while sending FAX: ' . $faxjob->trace;
504 =item states_hash COUNTRY
506 Returns a list of key/value pairs containing state (or other sub-country
507 division) abbriviations and names.
511 use FS::Record qw(qsearch);
512 use Locale::SubCountry;
519 map { s/[\n\r]//g; $_; }
523 'table' => 'cust_main_county',
524 'hashref' => { 'country' => $country },
525 'extra_sql' => 'GROUP BY state',
528 #it could throw a fatal "Invalid country code" error (for example "AX")
529 my $subcountry = eval { new Locale::SubCountry($country) }
530 or return ( '', '(n/a)' );
532 #"i see your schwartz is as big as mine!"
533 map { ( $_->[0] => $_->[1] ) }
534 sort { $a->[1] cmp $b->[1] }
535 map { [ $_ => state_label($_, $subcountry) ] }
539 =item counties STATE COUNTRY
541 Returns a list of counties for this state and country.
546 my( $state, $country ) = @_;
548 map { $_ } #return num_counties($state, $country) unless wantarray;
549 sort map { s/[\n\r]//g; $_; }
552 'select' => 'DISTINCT county',
553 'table' => 'cust_main_county',
554 'hashref' => { 'state' => $state,
555 'country' => $country,
560 =item cities COUNTY STATE COUNTRY
562 Returns a list of cities for this county, state and country.
567 my( $county, $state, $country ) = @_;
569 map { $_ } #return num_cities($county, $state, $country) unless wantarray;
570 sort map { s/[\n\r]//g; $_; }
573 'select' => 'DISTINCT city',
574 'table' => 'cust_main_county',
575 'hashref' => { 'county' => $county,
577 'country' => $country,
582 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
587 my( $state, $country ) = @_;
589 unless ( ref($country) ) {
590 $country = eval { new Locale::SubCountry($country) }
595 # US kludge to avoid changing existing behaviour
596 # also we actually *use* the abbriviations...
597 my $full_name = $country->country_code eq 'US'
599 : $country->full_name($state);
601 $full_name = '' if $full_name eq 'unknown';
602 $full_name =~ s/\(see also.*\)\s*$//;
603 $full_name .= " ($state)" if $full_name;
605 $full_name || $state || '(n/a)';
611 Returns a hash reference of the accepted credit card types. Keys are shorter
612 identifiers and values are the longer strings used by the system (see
613 L<Business::CreditCard>).
620 my $conf = new FS::Conf;
623 #displayname #value (Business::CreditCard)
624 "VISA" => "VISA card",
625 "MasterCard" => "MasterCard",
626 "Discover" => "Discover card",
627 "American Express" => "American Express card",
628 "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
629 "enRoute" => "enRoute",
631 "BankCard" => "BankCard",
632 "Switch" => "Switch",
635 my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
636 if ( @conf_card_types ) {
637 #perhaps the hash is backwards for this, but this way works better for
638 #usage in selfservice
639 %card_types = map { $_ => $card_types{$_} }
642 grep { $card_types{$d} eq $_ } @conf_card_types
652 Returns a hash reference of allowed package billing frequencies.
657 tie my %freq, 'Tie::IxHash', (
658 '0' => '(no recurring fee)',
661 '2d' => 'every two days',
662 '3d' => 'every three days',
664 '2w' => 'biweekly (every 2 weeks)',
666 '45d' => 'every 45 days',
667 '2' => 'bimonthly (every 2 months)',
668 '3' => 'quarterly (every 3 months)',
669 '4' => 'every 4 months',
670 '137d' => 'every 4 1/2 months (137 days)',
671 '6' => 'semiannually (every 6 months)',
673 '13' => 'every 13 months (annually +1 month)',
674 '24' => 'biannually (every 2 years)',
675 '36' => 'triannually (every 3 years)',
676 '48' => '(every 4 years)',
677 '60' => '(every 5 years)',
678 '120' => '(every 10 years)',
683 =item generate_ps FILENAME
685 Returns an postscript rendition of the LaTex file, as a scalar.
686 FILENAME does not contain the .tex suffix and is unlinked by this function.
690 use String::ShellQuote;
695 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
700 system('dvips', '-q', '-t', 'letter', "$file.dvi", '-o', "$file.ps" ) == 0
701 or die "dvips failed";
703 open(POSTSCRIPT, "<$file.ps")
704 or die "can't open $file.ps: $! (error in LaTeX template?)\n";
706 unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex");
710 if ( $conf->exists('lpr-postscript_prefix') ) {
711 my $prefix = $conf->config('lpr-postscript_prefix');
712 $ps .= eval qq("$prefix");
715 while (<POSTSCRIPT>) {
721 if ( $conf->exists('lpr-postscript_suffix') ) {
722 my $suffix = $conf->config('lpr-postscript_suffix');
723 $ps .= eval qq("$suffix");
730 =item generate_pdf FILENAME
732 Returns an PDF rendition of the LaTex file, as a scalar. FILENAME does not
733 contain the .tex suffix and is unlinked by this function.
737 use String::ShellQuote;
742 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
745 #system('pdflatex', "$file.tex");
746 #system('pdflatex', "$file.tex");
747 #! LaTeX Error: Unknown graphics extension: .eps.
751 my $sfile = shell_quote $file;
753 #system('dvipdf', "$file.dvi", "$file.pdf" );
755 "dvips -q -t letter -f $sfile.dvi ".
756 "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
759 or die "dvips | gs failed: $!";
761 open(PDF, "<$file.pdf")
762 or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
764 unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex");
780 #my $sfile = shell_quote $file;
784 '-interaction=batchmode',
785 '\AtBeginDocument{\RequirePackage{pslatex}}',
786 '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
787 '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
792 my $timeout = 30; #? should be more than enough
796 local($SIG{CHLD}) = sub {};
797 run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
798 or warn "bad exit status from pslatex pass $_\n";
802 return if -e "$file.dvi" && -s "$file.dvi";
803 die "pslatex $file.tex failed; see $file.log for details?\n";
809 Sends the lines in ARRAYREF to the printer.
816 my $lpr = $conf->config('lpr');
819 run3 $lpr, $data, \$outerr, \$outerr;
821 $outerr = ": $outerr" if length($outerr);
822 die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
827 =item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ]
829 Converts the filehandle referenced by FILEREF from fixed length record
830 lines to a CSV file according to the lengths specified in LENGTH_LISTREF.
831 The CALLBACKS_LISTREF refers to a correpsonding list of coderefs. Each
832 should return the value to be substituted in place of its single argument.
834 Returns false on success or an error if one occurs.
839 my( $fhref, $countref, $lengths, $callbacks) = @_;
841 eval { require Text::CSV_XS; };
845 my $unpacker = new Text::CSV_XS;
847 my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths;
849 my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc";
850 my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX",
853 ) or return "can't open temp file: $!\n"
856 while ( defined(my $line=<$ofh>) ) {
862 return "unexpected input at line $$countref: $line".
863 " -- expected $total but received ". length($line)
864 unless length($line) == $total;
866 $unpacker->combine( map { my $i = $column++;
867 defined( $callbacks->[$i] )
868 ? &{ $callbacks->[$i] }( $_ )
870 } unpack( $template, $line )
872 or return "invalid data for CSV: ". $unpacker->error_input;
874 print $fh $unpacker->string(), "\n"
875 or return "can't write temp file: $!\n";
879 if ( $template ) { close $$fhref; $$fhref = $fh }
885 =item ocr_image IMAGE_SCALAR
887 Runs OCR on the provided image data and returns a list of text lines.
892 my $logo_data = shift;
894 #XXX use conf dir location from Makefile
895 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
896 my $fh = new File::Temp(
897 TEMPLATE => 'bizcard.XXXXXXXX',
898 SUFFIX => '.png', #XXX assuming, but should handle jpg, gif, etc. too
901 ) or die "can't open temp file: $!\n";
903 my $filename = $fh->filename;
905 print $fh $logo_data;
908 run( [qw(ocroscript recognize), $filename], '>'=>"$filename.hocr" )
909 or die "ocroscript recognize failed\n";
911 run( [qw(ocroscript hocr-to-text), "$filename.hocr"], '>pipe'=>\*OUT )
912 or die "ocroscript hocr-to-text failed\n";
914 my @lines = split(/\n/, <OUT> );
916 foreach (@lines) { s/\.c0m\s*$/.com/; }
929 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
931 L<Fax::Hylafax::Client>