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
32 FS::Misc - Miscellaneous subroutines
36 use FS::Misc qw(send_email);
42 Miscellaneous subroutines. This module contains miscellaneous subroutines
43 called from multiple other modules. These are not OO or necessarily related,
44 but are collected here to eliminate code duplication.
50 =item send_email OPTION => VALUE ...
62 (required) comma-separated scalar or arrayref of recipients
70 (optional) MIME type for the body
74 (required unless I<nobody> is true) arrayref of body text lines
78 (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().
82 (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,
83 I<content-type>, if specified, overrides the default "multipart/mixed" for the outermost MIME container.
85 =item content-encoding
87 (optional) when using nobody, optional top-level MIME
88 encoding which, if specified, overrides the default "7bit".
92 (optional) type parameter for multipart/related messages
96 (optional) L<FS::cust_main> key; if passed, the message will be logged
97 (if logging is enabled) with this custnum.
101 (optional) L<FS::msg_template> key, for logging.
107 use vars qw( $conf );
110 use Email::Sender::Simple qw(sendmail);
111 use Email::Sender::Transport::SMTP;
112 use Email::Sender::Transport::SMTP::TLS 0.11;
115 FS::UID->install_callback( sub {
116 $conf = new FS::Conf;
122 my %doptions = %options;
123 $doptions{'body'} = '(full body not shown in debug)';
124 warn "FS::Misc::send_email called with options:\n ". Dumper(\%doptions);
125 # join("\n", map { " $_: ". $options{$_} } keys %options ). "\n"
128 my @to = ref($options{to}) ? @{ $options{to} } : ( $options{to} );
132 if ( $options{'nobody'} ) {
134 croak "'mimeparts' option required when 'nobody' option given\n"
135 unless $options{'mimeparts'};
137 @mimeparts = @{$options{'mimeparts'}};
140 'Type' => ( $options{'content-type'} || 'multipart/mixed' ),
141 'Encoding' => ( $options{'content-encoding'} || '7bit' ),
146 @mimeparts = @{$options{'mimeparts'}}
147 if ref($options{'mimeparts'}) eq 'ARRAY';
149 if (scalar(@mimeparts)) {
152 'Type' => 'multipart/mixed',
153 'Encoding' => '7bit',
156 unshift @mimeparts, {
157 'Type' => ( $options{'content-type'} || 'text/plain' ),
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' ),
175 my $from = $options{from};
176 $from =~ s/^\s*//; $from =~ s/\s*$//;
177 if ( $from =~ /^(.*)\s*<(.*@.*)>$/ ) {
183 if ( $from =~ /\@([\w\.\-]+)/ ) {
186 warn 'no domain found in invoice from address '. $options{'from'}.
187 '; constructing Message-ID (and saying HELO) @example.com';
188 $domain = 'example.com';
190 my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
193 my $message = MIME::Entity->build(
194 'From' => $options{'from'},
195 'To' => join(', ', @to),
196 'Sender' => $options{'from'},
197 'Reply-To' => $options{'from'},
198 'Date' => time2str("%a, %d %b %Y %X %z", $time),
199 'Subject' => Encode::encode('MIME-Header', $options{'subject'}),
200 'Message-ID' => "<$message_id>",
204 if ( $options{'type'} ) {
205 #false laziness w/cust_bill::generate_email
206 $message->head->replace('Content-type',
208 '; boundary="'. $message->head->multipart_boundary. '"'.
209 '; type='. $options{'type'}
213 foreach my $part (@mimeparts) {
215 if ( UNIVERSAL::isa($part, 'MIME::Entity') ) {
217 warn "attaching MIME part from MIME::Entity object\n"
219 $message->add_part($part);
221 } elsif ( ref($part) eq 'HASH' ) {
223 warn "attaching MIME part from hashref:\n".
224 join("\n", map " $_: ".$part->{$_}, keys %$part ). "\n"
226 $message->attach(%$part);
229 croak "mimepart $part isn't a hashref or MIME::Entity object!";
236 my %smtp_opt = ( 'host' => $conf->config('smtpmachine'),
240 my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
241 $smtp_opt{'port'} = $port;
244 if ( defined($enc) && $enc eq 'starttls' ) {
245 $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password);
246 $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt );
248 if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
249 $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password);
251 $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls';
252 $transport = Email::Sender::Transport::SMTP->new( %smtp_opt );
255 push @to, $options{bcc} if defined($options{bcc});
256 local $@; # just in case
257 eval { sendmail($message, { transport => $transport,
262 if(ref($@) and $@->isa('Email::Sender::Failure')) {
263 $error = $@->code.' ' if $@->code;
264 $error .= $@->message;
271 if ( $conf->exists('log_sent_mail') ) {
272 my $cust_msg = FS::cust_msg->new({
273 'env_from' => $options{'from'},
274 'env_to' => join(', ', @to),
275 'header' => $message->header_as_string,
276 'body' => $message->body_as_string,
279 'custnum' => $options{'custnum'},
280 'msgnum' => $options{'msgnum'},
281 'status' => ($error ? 'failed' : 'sent'),
282 'msgtype' => $options{'msgtype'},
284 $cust_msg->insert; # ignore errors
290 =item generate_email OPTION => VALUE ...
298 Sender address, required
302 Recipient address, required
306 Blind copy address, optional
310 email subject, required
314 Email body (HTML alternative). Arrayref of lines, or scalar.
316 Will be placed inside an HTML <BODY> tag.
320 Email body (Text alternative). Arrayref of lines, or scalar.
322 =item custnum, msgnum (optional)
324 Customer and template numbers, passed through to send_email for logging.
328 Constructs a multipart message from text_body and html_body.
332 #false laziness w/FS::cust_bill::generate_email
340 my $me = '[FS::Misc::generate_email]';
342 my @fields = qw(from to bcc subject custnum msgnum msgtype);
344 @return{@fields} = @args{@fields};
346 warn "$me creating HTML/text multipart message"
349 $return{'nobody'} = 1;
351 my $alternative = build MIME::Entity
352 'Type' => 'multipart/alternative',
353 'Encoding' => '7bit',
354 'Disposition' => 'inline'
358 if ( ref($args{'text_body'}) eq 'ARRAY' ) {
359 $data = join("\n", @{ $args{'text_body'} });
361 $data = $args{'text_body'};
364 $alternative->attach(
365 'Type' => 'text/plain',
366 'Encoding' => 'quoted-printable',
367 #'Encoding' => '7bit',
369 'Disposition' => 'inline',
373 if ( ref($args{'html_body'}) eq 'ARRAY' ) {
374 @html_data = @{ $args{'html_body'} };
376 @html_data = split(/\n/, $args{'html_body'});
379 $alternative->attach(
380 'Type' => 'text/html',
381 'Encoding' => 'quoted-printable',
382 'Data' => [ '<html>',
385 ' '. encode_entities($return{'subject'}),
388 ' <body bgcolor="#ffffff">',
393 'Disposition' => 'inline',
394 #'Filename' => 'invoice.pdf',
397 #no other attachment:
399 # multipart/alternative
403 $return{'content-type'} = 'multipart/related';
404 $return{'mimeparts'} = [ $alternative ];
405 $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
406 #$return{'disposition'} = 'inline';
412 =item process_send_email OPTION => VALUE ...
414 Takes arguments as per generate_email() and sends the message. This
415 will die on any error and can be used in the job queue.
419 sub process_send_email {
421 my $error = send_email(generate_email(%message));
422 die "$error\n" if $error;
426 =item process_send_generated_email OPTION => VALUE ...
428 Takes arguments as per send_email() and sends the message. This
429 will die on any error and can be used in the job queue.
433 sub process_send_generated_email {
435 my $error = send_email(%args);
436 die "$error\n" if $error;
440 =item send_fax OPTION => VALUE ...
444 I<dialstring> - (required) 10-digit phone number w/ area code
446 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
450 I<docfile> - (required) Filename of PostScript TIFF Class F document
452 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
461 die 'HylaFAX support has not been configured.'
462 unless $conf->exists('hylafax');
465 require Fax::Hylafax::Client;
469 if ($@ =~ /^Can't locate Fax.*/) {
470 die "You must have Fax::Hylafax::Client installed to use invoice faxing."
476 my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
478 die 'Called send_fax without a \'dialstring\'.'
479 unless exists($options{'dialstring'});
481 if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
482 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
483 my $fh = new File::Temp(
484 TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
487 ) or die "can't open temp file: $!\n";
489 $options{docfile} = $fh->filename;
491 print $fh @{$options{'docdata'}};
494 delete $options{'docdata'};
497 die 'Called send_fax without a \'docfile\' or \'docdata\'.'
498 unless exists($options{'docfile'});
500 #FIXME: Need to send canonical dialstring to HylaFAX, but this only
503 $options{'dialstring'} =~ s/[^\d\+]//g;
504 if ($options{'dialstring'} =~ /^\d{10}$/) {
505 $options{dialstring} = '+1' . $options{'dialstring'};
507 return 'Invalid dialstring ' . $options{'dialstring'} . '.';
510 my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
512 if ($faxjob->success) {
513 warn "Successfully queued fax to '$options{dialstring}' with jobid " .
518 return 'Error while sending FAX: ' . $faxjob->trace;
523 =item states_hash COUNTRY
525 Returns a list of key/value pairs containing state (or other sub-country
526 division) abbriviations and names.
530 use FS::Record qw(qsearch);
531 use Locale::SubCountry;
538 map { s/[\n\r]//g; $_; }
542 'table' => 'cust_main_county',
543 'hashref' => { 'country' => $country },
544 'extra_sql' => 'GROUP BY state',
547 #it could throw a fatal "Invalid country code" error (for example "AX")
548 my $subcountry = eval { new Locale::SubCountry($country) }
549 or return (); # ( '', '(n/a)' );
551 #"i see your schwartz is as big as mine!"
552 map { ( $_->[0] => $_->[1] ) }
553 sort { $a->[1] cmp $b->[1] }
554 map { [ $_ => state_label($_, $subcountry) ] }
558 =item counties STATE COUNTRY
560 Returns a list of counties for this state and country.
565 my( $state, $country ) = @_;
567 map { $_ } #return num_counties($state, $country) unless wantarray;
568 sort map { s/[\n\r]//g; $_; }
571 'select' => 'DISTINCT county',
572 'table' => 'cust_main_county',
573 'hashref' => { 'state' => $state,
574 'country' => $country,
579 =item cities COUNTY STATE COUNTRY
581 Returns a list of cities for this county, state and country.
586 my( $county, $state, $country ) = @_;
588 map { $_ } #return num_cities($county, $state, $country) unless wantarray;
589 sort map { s/[\n\r]//g; $_; }
592 'select' => 'DISTINCT city',
593 'table' => 'cust_main_county',
594 'hashref' => { 'county' => $county,
596 'country' => $country,
601 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
606 my( $state, $country ) = @_;
608 unless ( ref($country) ) {
609 $country = eval { new Locale::SubCountry($country) }
614 # US kludge to avoid changing existing behaviour
615 # also we actually *use* the abbriviations...
616 my $full_name = $country->country_code eq 'US'
618 : $country->full_name($state);
620 $full_name = '' if $full_name eq 'unknown';
621 $full_name =~ s/\(see also.*\)\s*$//;
622 $full_name .= " ($state)" if $full_name;
624 $full_name || $state || '(n/a)';
630 Returns a hash reference of the accepted credit card types. Keys are shorter
631 identifiers and values are the longer strings used by the system (see
632 L<Business::CreditCard>).
639 my $conf = new FS::Conf;
642 #displayname #value (Business::CreditCard)
643 "VISA" => "VISA card",
644 "MasterCard" => "MasterCard",
645 "Discover" => "Discover card",
646 "American Express" => "American Express card",
647 "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
648 "enRoute" => "enRoute",
650 "BankCard" => "BankCard",
651 "Switch" => "Switch",
654 my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
655 if ( @conf_card_types ) {
656 #perhaps the hash is backwards for this, but this way works better for
657 #usage in selfservice
658 %card_types = map { $_ => $card_types{$_} }
661 grep { $card_types{$d} eq $_ } @conf_card_types
671 Returns a hash reference of allowed package billing frequencies.
676 tie my %freq, 'Tie::IxHash', (
677 '0' => '(no recurring fee)',
680 '2d' => 'every two days',
681 '3d' => 'every three days',
683 '2w' => 'biweekly (every 2 weeks)',
685 '45d' => 'every 45 days',
686 '2' => 'bimonthly (every 2 months)',
687 '3' => 'quarterly (every 3 months)',
688 '4' => 'every 4 months',
689 '137d' => 'every 4 1/2 months (137 days)',
690 '6' => 'semiannually (every 6 months)',
692 '13' => 'every 13 months (annually +1 month)',
693 '24' => 'biannually (every 2 years)',
694 '36' => 'triannually (every 3 years)',
695 '48' => '(every 4 years)',
696 '60' => '(every 5 years)',
697 '120' => '(every 10 years)',
702 =item generate_ps FILENAME
704 Returns an postscript rendition of the LaTex file, as a scalar.
705 FILENAME does not contain the .tex suffix and is unlinked by this function.
709 use String::ShellQuote;
714 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
719 my $papersize = $conf->config('papersize') || 'letter';
721 system('dvips', '-q', '-t', $papersize, "$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" );
776 my $papersize = $conf->config('papersize') || 'letter';
779 "dvips -q -f $sfile.dvi -t $papersize ".
780 "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
783 or die "dvips | gs failed: $!";
785 open(PDF, "<$file.pdf")
786 or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
788 unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex")
789 unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
805 #my $sfile = shell_quote $file;
809 '-interaction=batchmode',
810 '\AtBeginDocument{\RequirePackage{pslatex}}',
811 '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
812 '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
817 my $timeout = 30; #? should be more than enough
821 local($SIG{CHLD}) = sub {};
822 run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
823 or warn "bad exit status from pslatex pass $_\n";
827 return if -e "$file.dvi" && -s "$file.dvi";
828 die "pslatex $file.tex failed; see $file.log for details?\n";
832 =item do_print ARRAYREF [, OPTION => VALUE ... ]
834 Sends the lines in ARRAYREF to the printer.
836 Options available are:
842 Uses this agent's 'lpr' configuration setting override instead of the global
847 Uses this command instead of the configured lpr command (overrides both the
848 global value and agentnum).
853 my( $data, %opt ) = @_;
855 my $lpr = ( exists($opt{'lpr'}) && $opt{'lpr'} )
857 : $conf->config('lpr', $opt{'agentnum'} );
860 run3 $lpr, $data, \$outerr, \$outerr;
862 $outerr = ": $outerr" if length($outerr);
863 die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
868 =item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ]
870 Converts the filehandle referenced by FILEREF from fixed length record
871 lines to a CSV file according to the lengths specified in LENGTH_LISTREF.
872 The CALLBACKS_LISTREF refers to a correpsonding list of coderefs. Each
873 should return the value to be substituted in place of its single argument.
875 Returns false on success or an error if one occurs.
880 my( $fhref, $countref, $lengths, $callbacks) = @_;
882 eval { require Text::CSV_XS; };
886 my $unpacker = new Text::CSV_XS;
888 my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths;
890 my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc";
891 my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX",
894 ) or return "can't open temp file: $!\n"
897 while ( defined(my $line=<$ofh>) ) {
903 return "unexpected input at line $$countref: $line".
904 " -- expected $total but received ". length($line)
905 unless length($line) == $total;
907 $unpacker->combine( map { my $i = $column++;
908 defined( $callbacks->[$i] )
909 ? &{ $callbacks->[$i] }( $_ )
911 } unpack( $template, $line )
913 or return "invalid data for CSV: ". $unpacker->error_input;
915 print $fh $unpacker->string(), "\n"
916 or return "can't write temp file: $!\n";
920 if ( $template ) { close $$fhref; $$fhref = $fh }
926 =item ocr_image IMAGE_SCALAR
928 Runs OCR on the provided image data and returns a list of text lines.
933 my $logo_data = shift;
935 #XXX use conf dir location from Makefile
936 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
937 my $fh = new File::Temp(
938 TEMPLATE => 'bizcard.XXXXXXXX',
939 SUFFIX => '.png', #XXX assuming, but should handle jpg, gif, etc. too
942 ) or die "can't open temp file: $!\n";
944 my $filename = $fh->filename;
946 print $fh $logo_data;
949 run( [qw(ocroscript recognize), $filename], '>'=>"$filename.hocr" )
950 or die "ocroscript recognize failed\n";
952 run( [qw(ocroscript hocr-to-text), "$filename.hocr"], '>pipe'=>\*OUT )
953 or die "ocroscript hocr-to-text failed\n";
955 my @lines = split(/\n/, <OUT> );
957 foreach (@lines) { s/\.c0m\s*$/.com/; }
962 =item bytes_substr STRING, OFFSET[, LENGTH[, REPLACEMENT] ]
964 A replacement for "substr" that counts raw bytes rather than logical
965 characters. Unlike "bytes::substr", will suppress fragmented UTF-8 characters
966 rather than output them. Unlike real "substr", is not an lvalue.
971 my ($string, $offset, $length, $repl) = @_;
973 Encode::encode('utf8', $string),
976 Encode::encode('utf8', $repl)
978 my $chk = $DEBUG ? Encode::FB_WARN : Encode::FB_QUIET;
979 return Encode::decode('utf8', $bytes, $chk);
990 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
992 L<Fax::Hylafax::Client>