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 'Data' => $options{'body'},
158 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
159 'Disposition' => 'inline',
165 'Type' => ( $options{'content-type'} || 'text/plain' ),
166 'Data' => $options{'body'},
167 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
174 my $from = $options{from};
175 $from =~ s/^\s*//; $from =~ s/\s*$//;
176 if ( $from =~ /^(.*)\s*<(.*@.*)>$/ ) {
182 if ( $from =~ /\@([\w\.\-]+)/ ) {
185 warn 'no domain found in invoice from address '. $options{'from'}.
186 '; constructing Message-ID (and saying HELO) @example.com';
187 $domain = 'example.com';
189 my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
192 my $message = MIME::Entity->build(
193 'From' => $options{'from'},
194 'To' => join(', ', @to),
195 'Sender' => $options{'from'},
196 'Reply-To' => $options{'from'},
197 'Date' => time2str("%a, %d %b %Y %X %z", $time),
198 'Subject' => Encode::encode('MIME-Header', $options{'subject'}),
199 'Message-ID' => "<$message_id>",
203 if ( $options{'type'} ) {
204 #false laziness w/cust_bill::generate_email
205 $message->head->replace('Content-type',
207 '; boundary="'. $message->head->multipart_boundary. '"'.
208 '; type='. $options{'type'}
212 foreach my $part (@mimeparts) {
214 if ( UNIVERSAL::isa($part, 'MIME::Entity') ) {
216 warn "attaching MIME part from MIME::Entity object\n"
218 $message->add_part($part);
220 } elsif ( ref($part) eq 'HASH' ) {
222 warn "attaching MIME part from hashref:\n".
223 join("\n", map " $_: ".$part->{$_}, keys %$part ). "\n"
225 $message->attach(%$part);
228 croak "mimepart $part isn't a hashref or MIME::Entity object!";
235 my %smtp_opt = ( 'host' => $conf->config('smtpmachine'),
239 my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
240 $smtp_opt{'port'} = $port;
243 if ( defined($enc) && $enc eq 'starttls' ) {
244 $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password);
245 $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt );
247 if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
248 $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password);
250 $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls';
251 $transport = Email::Sender::Transport::SMTP->new( %smtp_opt );
254 push @to, $options{bcc} if defined($options{bcc});
255 local $@; # just in case
256 eval { sendmail($message, { transport => $transport,
261 if(ref($@) and $@->isa('Email::Sender::Failure')) {
262 $error = $@->code.' ' if $@->code;
263 $error .= $@->message;
270 if ( $conf->exists('log_sent_mail') and $options{'custnum'} ) {
271 my $cust_msg = FS::cust_msg->new({
272 'env_from' => $options{'from'},
273 'env_to' => join(', ', @to),
274 'header' => $message->header_as_string,
275 'body' => $message->body_as_string,
278 'custnum' => $options{'custnum'},
279 'msgnum' => $options{'msgnum'},
280 'status' => ($error ? 'failed' : 'sent'),
282 $cust_msg->insert; # ignore errors
288 =item generate_email OPTION => VALUE ...
296 Sender address, required
300 Recipient address, required
304 Blind copy address, optional
308 email subject, required
312 Email body (HTML alternative). Arrayref of lines, or scalar.
314 Will be placed inside an HTML <BODY> tag.
318 Email body (Text alternative). Arrayref of lines, or scalar.
320 =item custnum, msgnum (optional)
322 Customer and template numbers, passed through to send_email for logging.
326 Constructs a multipart message from text_body and html_body.
330 #false laziness w/FS::cust_bill::generate_email
338 my $me = '[FS::Misc::generate_email]';
340 my @fields = qw(from to bcc subject custnum msgnum);
342 @return{@fields} = @args{@fields};
344 warn "$me creating HTML/text multipart message"
347 $return{'nobody'} = 1;
349 my $alternative = build MIME::Entity
350 'Type' => 'multipart/alternative',
351 'Encoding' => '7bit',
352 'Disposition' => 'inline'
356 if ( ref($args{'text_body'}) eq 'ARRAY' ) {
357 $data = join("\n", @{ $args{'text_body'} });
359 $data = $args{'text_body'};
362 $alternative->attach(
363 'Type' => 'text/plain',
364 'Encoding' => 'quoted-printable',
365 #'Encoding' => '7bit',
367 'Disposition' => 'inline',
371 if ( ref($args{'html_body'}) eq 'ARRAY' ) {
372 @html_data = @{ $args{'html_body'} };
374 @html_data = split(/\n/, $args{'html_body'});
377 $alternative->attach(
378 'Type' => 'text/html',
379 'Encoding' => 'quoted-printable',
380 'Data' => [ '<html>',
383 ' '. encode_entities($return{'subject'}),
386 ' <body bgcolor="#ffffff">',
391 'Disposition' => 'inline',
392 #'Filename' => 'invoice.pdf',
395 #no other attachment:
397 # multipart/alternative
401 $return{'content-type'} = 'multipart/related';
402 $return{'mimeparts'} = [ $alternative ];
403 $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
404 #$return{'disposition'} = 'inline';
410 =item process_send_email OPTION => VALUE ...
412 Takes arguments as per generate_email() and sends the message. This
413 will die on any error and can be used in the job queue.
417 sub process_send_email {
419 my $error = send_email(generate_email(%message));
420 die "$error\n" if $error;
424 =item process_send_generated_email OPTION => VALUE ...
426 Takes arguments as per send_email() and sends the message. This
427 will die on any error and can be used in the job queue.
431 sub process_send_generated_email {
433 my $error = send_email(%args);
434 die "$error\n" if $error;
438 =item send_fax OPTION => VALUE ...
442 I<dialstring> - (required) 10-digit phone number w/ area code
444 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
448 I<docfile> - (required) Filename of PostScript TIFF Class F document
450 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
459 die 'HylaFAX support has not been configured.'
460 unless $conf->exists('hylafax');
463 require Fax::Hylafax::Client;
467 if ($@ =~ /^Can't locate Fax.*/) {
468 die "You must have Fax::Hylafax::Client installed to use invoice faxing."
474 my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
476 die 'Called send_fax without a \'dialstring\'.'
477 unless exists($options{'dialstring'});
479 if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
480 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
481 my $fh = new File::Temp(
482 TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
485 ) or die "can't open temp file: $!\n";
487 $options{docfile} = $fh->filename;
489 print $fh @{$options{'docdata'}};
492 delete $options{'docdata'};
495 die 'Called send_fax without a \'docfile\' or \'docdata\'.'
496 unless exists($options{'docfile'});
498 #FIXME: Need to send canonical dialstring to HylaFAX, but this only
501 $options{'dialstring'} =~ s/[^\d\+]//g;
502 if ($options{'dialstring'} =~ /^\d{10}$/) {
503 $options{dialstring} = '+1' . $options{'dialstring'};
505 return 'Invalid dialstring ' . $options{'dialstring'} . '.';
508 my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
510 if ($faxjob->success) {
511 warn "Successfully queued fax to '$options{dialstring}' with jobid " .
516 return 'Error while sending FAX: ' . $faxjob->trace;
521 =item states_hash COUNTRY
523 Returns a list of key/value pairs containing state (or other sub-country
524 division) abbriviations and names.
528 use FS::Record qw(qsearch);
529 use Locale::SubCountry;
536 map { s/[\n\r]//g; $_; }
540 'table' => 'cust_main_county',
541 'hashref' => { 'country' => $country },
542 'extra_sql' => 'GROUP BY state',
545 #it could throw a fatal "Invalid country code" error (for example "AX")
546 my $subcountry = eval { new Locale::SubCountry($country) }
547 or return ( '', '(n/a)' );
549 #"i see your schwartz is as big as mine!"
550 map { ( $_->[0] => $_->[1] ) }
551 sort { $a->[1] cmp $b->[1] }
552 map { [ $_ => state_label($_, $subcountry) ] }
556 =item counties STATE COUNTRY
558 Returns a list of counties for this state and country.
563 my( $state, $country ) = @_;
565 map { $_ } #return num_counties($state, $country) unless wantarray;
566 sort map { s/[\n\r]//g; $_; }
569 'select' => 'DISTINCT county',
570 'table' => 'cust_main_county',
571 'hashref' => { 'state' => $state,
572 'country' => $country,
577 =item cities COUNTY STATE COUNTRY
579 Returns a list of cities for this county, state and country.
584 my( $county, $state, $country ) = @_;
586 map { $_ } #return num_cities($county, $state, $country) unless wantarray;
587 sort map { s/[\n\r]//g; $_; }
590 'select' => 'DISTINCT city',
591 'table' => 'cust_main_county',
592 'hashref' => { 'county' => $county,
594 'country' => $country,
599 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
604 my( $state, $country ) = @_;
606 unless ( ref($country) ) {
607 $country = eval { new Locale::SubCountry($country) }
612 # US kludge to avoid changing existing behaviour
613 # also we actually *use* the abbriviations...
614 my $full_name = $country->country_code eq 'US'
616 : $country->full_name($state);
618 $full_name = '' if $full_name eq 'unknown';
619 $full_name =~ s/\(see also.*\)\s*$//;
620 $full_name .= " ($state)" if $full_name;
622 $full_name || $state || '(n/a)';
628 Returns a hash reference of the accepted credit card types. Keys are shorter
629 identifiers and values are the longer strings used by the system (see
630 L<Business::CreditCard>).
637 my $conf = new FS::Conf;
640 #displayname #value (Business::CreditCard)
641 "VISA" => "VISA card",
642 "MasterCard" => "MasterCard",
643 "Discover" => "Discover card",
644 "American Express" => "American Express card",
645 "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
646 "enRoute" => "enRoute",
648 "BankCard" => "BankCard",
649 "Switch" => "Switch",
652 my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
653 if ( @conf_card_types ) {
654 #perhaps the hash is backwards for this, but this way works better for
655 #usage in selfservice
656 %card_types = map { $_ => $card_types{$_} }
659 grep { $card_types{$d} eq $_ } @conf_card_types
669 Returns a hash reference of allowed package billing frequencies.
674 tie my %freq, 'Tie::IxHash', (
675 '0' => '(no recurring fee)',
678 '2d' => 'every two days',
679 '3d' => 'every three days',
681 '2w' => 'biweekly (every 2 weeks)',
683 '45d' => 'every 45 days',
684 '2' => 'bimonthly (every 2 months)',
685 '3' => 'quarterly (every 3 months)',
686 '4' => 'every 4 months',
687 '137d' => 'every 4 1/2 months (137 days)',
688 '6' => 'semiannually (every 6 months)',
690 '13' => 'every 13 months (annually +1 month)',
691 '24' => 'biannually (every 2 years)',
692 '36' => 'triannually (every 3 years)',
693 '48' => '(every 4 years)',
694 '60' => '(every 5 years)',
695 '120' => '(every 10 years)',
700 =item generate_ps FILENAME
702 Returns an postscript rendition of the LaTex file, as a scalar.
703 FILENAME does not contain the .tex suffix and is unlinked by this function.
707 use String::ShellQuote;
712 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
717 system('dvips', '-q', '-t', 'letter', "$file.dvi", '-o', "$file.ps" ) == 0
718 or die "dvips failed";
720 open(POSTSCRIPT, "<$file.ps")
721 or die "can't open $file.ps: $! (error in LaTeX template?)\n";
723 unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex")
724 unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
728 if ( $conf->exists('lpr-postscript_prefix') ) {
729 my $prefix = $conf->config('lpr-postscript_prefix');
730 $ps .= eval qq("$prefix");
733 while (<POSTSCRIPT>) {
739 if ( $conf->exists('lpr-postscript_suffix') ) {
740 my $suffix = $conf->config('lpr-postscript_suffix');
741 $ps .= eval qq("$suffix");
748 =item generate_pdf FILENAME
750 Returns an PDF rendition of the LaTex file, as a scalar. FILENAME does not
751 contain the .tex suffix and is unlinked by this function.
755 use String::ShellQuote;
760 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
763 #system('pdflatex', "$file.tex");
764 #system('pdflatex', "$file.tex");
765 #! LaTeX Error: Unknown graphics extension: .eps.
769 my $sfile = shell_quote $file;
771 #system('dvipdf', "$file.dvi", "$file.pdf" );
773 "dvips -q -t letter -f $sfile.dvi ".
774 "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
777 or die "dvips | gs failed: $!";
779 open(PDF, "<$file.pdf")
780 or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
782 unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex")
783 unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
799 #my $sfile = shell_quote $file;
803 '-interaction=batchmode',
804 '\AtBeginDocument{\RequirePackage{pslatex}}',
805 '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
806 '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
811 my $timeout = 30; #? should be more than enough
815 local($SIG{CHLD}) = sub {};
816 run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
817 or warn "bad exit status from pslatex pass $_\n";
821 return if -e "$file.dvi" && -s "$file.dvi";
822 die "pslatex $file.tex failed; see $file.log for details?\n";
826 =item do_print ARRAYREF [, OPTION => VALUE ... ]
828 Sends the lines in ARRAYREF to the printer.
830 Options available are:
836 Uses this agent's 'lpr' configuration setting override instead of the global
841 Uses this command instead of the configured lpr command (overrides both the
842 global value and agentnum).
847 my( $data, %opt ) = @_;
849 my $lpr = ( exists($opt{'lpr'}) && $opt{'lpr'} )
851 : $conf->config('lpr', $opt{'agentnum'} );
854 run3 $lpr, $data, \$outerr, \$outerr;
856 $outerr = ": $outerr" if length($outerr);
857 die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
862 =item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ]
864 Converts the filehandle referenced by FILEREF from fixed length record
865 lines to a CSV file according to the lengths specified in LENGTH_LISTREF.
866 The CALLBACKS_LISTREF refers to a correpsonding list of coderefs. Each
867 should return the value to be substituted in place of its single argument.
869 Returns false on success or an error if one occurs.
874 my( $fhref, $countref, $lengths, $callbacks) = @_;
876 eval { require Text::CSV_XS; };
880 my $unpacker = new Text::CSV_XS;
882 my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths;
884 my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc";
885 my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX",
888 ) or return "can't open temp file: $!\n"
891 while ( defined(my $line=<$ofh>) ) {
897 return "unexpected input at line $$countref: $line".
898 " -- expected $total but received ". length($line)
899 unless length($line) == $total;
901 $unpacker->combine( map { my $i = $column++;
902 defined( $callbacks->[$i] )
903 ? &{ $callbacks->[$i] }( $_ )
905 } unpack( $template, $line )
907 or return "invalid data for CSV: ". $unpacker->error_input;
909 print $fh $unpacker->string(), "\n"
910 or return "can't write temp file: $!\n";
914 if ( $template ) { close $$fhref; $$fhref = $fh }
920 =item ocr_image IMAGE_SCALAR
922 Runs OCR on the provided image data and returns a list of text lines.
927 my $logo_data = shift;
929 #XXX use conf dir location from Makefile
930 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
931 my $fh = new File::Temp(
932 TEMPLATE => 'bizcard.XXXXXXXX',
933 SUFFIX => '.png', #XXX assuming, but should handle jpg, gif, etc. too
936 ) or die "can't open temp file: $!\n";
938 my $filename = $fh->filename;
940 print $fh $logo_data;
943 run( [qw(ocroscript recognize), $filename], '>'=>"$filename.hocr" )
944 or die "ocroscript recognize failed\n";
946 run( [qw(ocroscript hocr-to-text), "$filename.hocr"], '>pipe'=>\*OUT )
947 or die "ocroscript hocr-to-text failed\n";
949 my @lines = split(/\n/, <OUT> );
951 foreach (@lines) { s/\.c0m\s*$/.com/; }
964 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
966 L<Fax::Hylafax::Client>