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 'Charset' => 'UTF-8',
159 'Data' => ( $options{'content-type'} =~ /^text\//
160 ? Encode::encode_utf8( $options{'body'} )
163 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
164 'Disposition' => 'inline',
170 'Type' => ( $options{'content-type'} || 'text/plain' ),
171 'Data' => ( $options{'content-type'} =~ /^text\//
172 ? Encode::encode_utf8( $options{'body'} )
175 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
182 my $from = $options{from};
183 $from =~ s/^\s*//; $from =~ s/\s*$//;
184 if ( $from =~ /^(.*)\s*<(.*@.*)>$/ ) {
190 if ( $from =~ /\@([\w\.\-]+)/ ) {
193 warn 'no domain found in invoice from address '. $options{'from'}.
194 '; constructing Message-ID (and saying HELO) @example.com';
195 $domain = 'example.com';
197 my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
200 my $message = MIME::Entity->build(
201 'From' => $options{'from'},
202 'To' => join(', ', @to),
203 'Sender' => $options{'from'},
204 'Reply-To' => $options{'from'},
205 'Date' => time2str("%a, %d %b %Y %X %z", $time),
206 'Subject' => Encode::encode('MIME-Header', $options{'subject'}),
207 'Message-ID' => "<$message_id>",
211 if ( $options{'type'} ) {
212 #false laziness w/cust_bill::generate_email
213 $message->head->replace('Content-type',
215 '; boundary="'. $message->head->multipart_boundary. '"'.
216 '; type='. $options{'type'}
220 foreach my $part (@mimeparts) {
222 if ( UNIVERSAL::isa($part, 'MIME::Entity') ) {
224 warn "attaching MIME part from MIME::Entity object\n"
226 $message->add_part($part);
228 } elsif ( ref($part) eq 'HASH' ) {
230 warn "attaching MIME part from hashref:\n".
231 join("\n", map " $_: ".$part->{$_}, keys %$part ). "\n"
233 $message->attach(%$part);
236 croak "mimepart $part isn't a hashref or MIME::Entity object!";
243 my %smtp_opt = ( 'host' => $conf->config('smtpmachine'),
247 my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
248 $smtp_opt{'port'} = $port;
251 if ( defined($enc) && $enc eq 'starttls' ) {
252 $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password);
253 $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt );
255 if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
256 $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password);
258 $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls';
259 $transport = Email::Sender::Transport::SMTP->new( %smtp_opt );
262 push @to, $options{bcc} if defined($options{bcc});
263 # fully unpack all addresses found in @to (including Bcc) to make the
266 foreach my $dest (@to) {
267 push @env_to, map { $_->address } Email::Address->parse($dest);
270 local $@; # just in case
271 eval { sendmail($message, { transport => $transport,
276 if(ref($@) and $@->isa('Email::Sender::Failure')) {
277 $error = $@->code.' ' if $@->code;
278 $error .= $@->message;
285 if ( $conf->exists('log_sent_mail') ) {
286 my $cust_msg = FS::cust_msg->new({
287 'env_from' => $options{'from'},
288 'env_to' => join(', ', @env_to),
289 'header' => $message->header_as_string,
290 'body' => $message->body_as_string,
293 'custnum' => $options{'custnum'},
294 'msgnum' => $options{'msgnum'},
295 'status' => ($error ? 'failed' : 'sent'),
296 'msgtype' => $options{'msgtype'},
298 $cust_msg->insert; # ignore errors
304 =item generate_email OPTION => VALUE ...
312 Sender address, required
316 Recipient address, required
320 Blind copy address, optional
324 email subject, required
328 Email body (HTML alternative). Arrayref of lines, or scalar.
330 Will be placed inside an HTML <BODY> tag.
334 Email body (Text alternative). Arrayref of lines, or scalar.
336 =item custnum, msgnum (optional)
338 Customer and template numbers, passed through to send_email for logging.
342 Constructs a multipart message from text_body and html_body.
346 #false laziness w/FS::cust_bill::generate_email
354 my $me = '[FS::Misc::generate_email]';
356 my @fields = qw(from to bcc subject custnum msgnum msgtype);
358 @return{@fields} = @args{@fields};
360 warn "$me creating HTML/text multipart message"
363 $return{'nobody'} = 1;
365 my $alternative = build MIME::Entity
366 'Type' => 'multipart/alternative',
367 'Encoding' => '7bit',
368 'Disposition' => 'inline'
372 if ( ref($args{'text_body'}) eq 'ARRAY' ) {
373 $data = join("\n", @{ $args{'text_body'} });
375 $data = $args{'text_body'};
378 $alternative->attach(
379 'Type' => 'text/plain',
380 'Encoding' => 'quoted-printable',
381 #'Encoding' => '7bit',
382 'Data' => Encode::encode_utf8($data),
383 'Disposition' => 'inline',
387 if ( ref($args{'html_body'}) eq 'ARRAY' ) {
388 @html_data = @{ $args{'html_body'} };
390 @html_data = split(/\n/, $args{'html_body'});
393 $alternative->attach(
394 'Type' => 'text/html',
395 'Encoding' => 'quoted-printable',
396 'Data' => [ '<html>',
399 ' '. encode_entities($return{'subject'}),
402 ' <body bgcolor="#ffffff">',
403 ( map Encode::encode_utf8($_), @html_data ),
407 'Disposition' => 'inline',
408 #'Filename' => 'invoice.pdf',
411 #no other attachment:
413 # multipart/alternative
417 $return{'content-type'} = 'multipart/related';
418 $return{'mimeparts'} = [ $alternative ];
419 $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
420 #$return{'disposition'} = 'inline';
426 =item process_send_email OPTION => VALUE ...
428 Takes arguments as per generate_email() and sends the message. This
429 will die on any error and can be used in the job queue.
433 sub process_send_email {
435 my $error = send_email(generate_email(%message));
436 die "$error\n" if $error;
440 =item process_send_generated_email OPTION => VALUE ...
442 Takes arguments as per send_email() and sends the message. This
443 will die on any error and can be used in the job queue.
447 sub process_send_generated_email {
449 my $error = send_email(%args);
450 die "$error\n" if $error;
454 =item send_fax OPTION => VALUE ...
458 I<dialstring> - (required) 10-digit phone number w/ area code
460 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
464 I<docfile> - (required) Filename of PostScript TIFF Class F document
466 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
475 die 'HylaFAX support has not been configured.'
476 unless $conf->exists('hylafax');
479 require Fax::Hylafax::Client;
483 if ($@ =~ /^Can't locate Fax.*/) {
484 die "You must have Fax::Hylafax::Client installed to use invoice faxing."
490 my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
492 die 'Called send_fax without a \'dialstring\'.'
493 unless exists($options{'dialstring'});
495 if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
496 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
497 my $fh = new File::Temp(
498 TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
501 ) or die "can't open temp file: $!\n";
503 $options{docfile} = $fh->filename;
505 print $fh @{$options{'docdata'}};
508 delete $options{'docdata'};
511 die 'Called send_fax without a \'docfile\' or \'docdata\'.'
512 unless exists($options{'docfile'});
514 #FIXME: Need to send canonical dialstring to HylaFAX, but this only
517 $options{'dialstring'} =~ s/[^\d\+]//g;
518 if ($options{'dialstring'} =~ /^\d{10}$/) {
519 $options{dialstring} = '+1' . $options{'dialstring'};
521 return 'Invalid dialstring ' . $options{'dialstring'} . '.';
524 my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
526 if ($faxjob->success) {
527 warn "Successfully queued fax to '$options{dialstring}' with jobid " .
532 return 'Error while sending FAX: ' . $faxjob->trace;
537 =item states_hash COUNTRY
539 Returns a list of key/value pairs containing state (or other sub-country
540 division) abbriviations and names.
544 use FS::Record qw(qsearch);
545 use Locale::SubCountry;
550 #a hash? not expecting an explosion of business from unrecognized countries..
551 return states_hash_nosubcountry($country) if $country eq 'XC';
555 map { s/[\n\r]//g; $_; }
559 'table' => 'cust_main_county',
560 'hashref' => { 'country' => $country },
561 'extra_sql' => 'GROUP BY state',
564 #it could throw a fatal "Invalid country code" error (for example "AX")
565 my $subcountry = eval { new Locale::SubCountry($country) }
566 or return (); # ( '', '(n/a)' );
568 #"i see your schwartz is as big as mine!"
569 map { ( $_->[0] => $_->[1] ) }
570 sort { $a->[1] cmp $b->[1] }
571 map { [ $_ => state_label($_, $subcountry) ] }
575 sub states_hash_nosubcountry {
580 map { s/[\n\r]//g; $_; }
584 'table' => 'cust_main_county',
585 'hashref' => { 'country' => $country },
586 'extra_sql' => 'GROUP BY state',
589 #"i see your schwartz is as big as mine!"
590 map { ( $_->[0] => $_->[1] ) }
591 sort { $a->[1] cmp $b->[1] }
596 =item counties STATE COUNTRY
598 Returns a list of counties for this state and country.
603 my( $state, $country ) = @_;
605 map { $_ } #return num_counties($state, $country) unless wantarray;
606 sort map { s/[\n\r]//g; $_; }
609 'select' => 'DISTINCT county',
610 'table' => 'cust_main_county',
611 'hashref' => { 'state' => $state,
612 'country' => $country,
617 =item cities COUNTY STATE COUNTRY
619 Returns a list of cities for this county, state and country.
624 my( $county, $state, $country ) = @_;
626 map { $_ } #return num_cities($county, $state, $country) unless wantarray;
627 sort map { s/[\n\r]//g; $_; }
630 'select' => 'DISTINCT city',
631 'table' => 'cust_main_county',
632 'hashref' => { 'county' => $county,
634 'country' => $country,
639 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
644 my( $state, $country ) = @_;
646 unless ( ref($country) ) {
647 $country = eval { new Locale::SubCountry($country) }
652 # US kludge to avoid changing existing behaviour
653 # also we actually *use* the abbriviations...
654 my $full_name = $country->country_code eq 'US'
656 : $country->full_name($state);
658 $full_name = '' if $full_name eq 'unknown';
659 $full_name =~ s/\(see also.*\)\s*$//;
660 $full_name .= " ($state)" if $full_name;
662 $full_name || $state || '(n/a)';
668 Returns a hash reference of the accepted credit card types. Keys are shorter
669 identifiers and values are the longer strings used by the system (see
670 L<Business::CreditCard>).
677 my $conf = new FS::Conf;
680 #displayname #value (Business::CreditCard)
681 "VISA" => "VISA card",
682 "MasterCard" => "MasterCard",
683 "Discover" => "Discover card",
684 "American Express" => "American Express card",
685 "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
686 "enRoute" => "enRoute",
688 "BankCard" => "BankCard",
689 "Switch" => "Switch",
692 my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
693 if ( @conf_card_types ) {
694 #perhaps the hash is backwards for this, but this way works better for
695 #usage in selfservice
696 %card_types = map { $_ => $card_types{$_} }
699 grep { $card_types{$d} eq $_ } @conf_card_types
709 Returns a hash reference of allowed package billing frequencies.
714 tie my %freq, 'Tie::IxHash', (
715 '0' => '(no recurring fee)',
718 '2d' => 'every two days',
719 '3d' => 'every three days',
721 '2w' => 'biweekly (every 2 weeks)',
723 '45d' => 'every 45 days',
724 '2' => 'bimonthly (every 2 months)',
725 '3' => 'quarterly (every 3 months)',
726 '4' => 'every 4 months',
727 '137d' => 'every 4 1/2 months (137 days)',
728 '6' => 'semiannually (every 6 months)',
730 '13' => 'every 13 months (annually +1 month)',
731 '24' => 'biannually (every 2 years)',
732 '36' => 'triannually (every 3 years)',
733 '48' => '(every 4 years)',
734 '60' => '(every 5 years)',
735 '120' => '(every 10 years)',
740 =item generate_ps FILENAME
742 Returns an postscript rendition of the LaTex file, as a scalar.
743 FILENAME does not contain the .tex suffix and is unlinked by this function.
747 use String::ShellQuote;
752 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
757 my $papersize = $conf->config('papersize') || 'letter';
759 local($SIG{CHLD}) = sub {};
761 system('dvips', '-q', '-t', $papersize, "$file.dvi", '-o', "$file.ps" ) == 0
762 or die "dvips failed";
764 open(POSTSCRIPT, "<$file.ps")
765 or die "can't open $file.ps: $! (error in LaTeX template?)\n";
767 unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex")
768 unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
772 if ( $conf->exists('lpr-postscript_prefix') ) {
773 my $prefix = $conf->config('lpr-postscript_prefix');
774 $ps .= eval qq("$prefix");
777 while (<POSTSCRIPT>) {
783 if ( $conf->exists('lpr-postscript_suffix') ) {
784 my $suffix = $conf->config('lpr-postscript_suffix');
785 $ps .= eval qq("$suffix");
792 =item generate_pdf FILENAME
794 Returns an PDF rendition of the LaTex file, as a scalar. FILENAME does not
795 contain the .tex suffix and is unlinked by this function.
799 use String::ShellQuote;
804 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
807 #system('pdflatex', "$file.tex");
808 #system('pdflatex', "$file.tex");
809 #! LaTeX Error: Unknown graphics extension: .eps.
813 my $sfile = shell_quote $file;
815 #system('dvipdf', "$file.dvi", "$file.pdf" );
816 my $papersize = $conf->config('papersize') || 'letter';
818 local($SIG{CHLD}) = sub {};
821 "dvips -q -f $sfile.dvi -t $papersize ".
822 "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
825 or die "dvips | gs failed: $!";
827 open(PDF, "<$file.pdf")
828 or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
830 unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex")
831 unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
847 #my $sfile = shell_quote $file;
851 '-interaction=batchmode',
852 '\AtBeginDocument{\RequirePackage{pslatex}}',
853 '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
854 '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
859 my $timeout = 30; #? should be more than enough
863 local($SIG{CHLD}) = sub {};
864 run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
865 or warn "bad exit status from pslatex pass $_\n";
869 return if -e "$file.dvi" && -s "$file.dvi";
870 die "pslatex $file.tex failed, see $file.log for details?\n";
874 =item do_print ARRAYREF [, OPTION => VALUE ... ]
876 Sends the lines in ARRAYREF to the printer.
878 Options available are:
884 Uses this agent's 'lpr' configuration setting override instead of the global
889 Uses this command instead of the configured lpr command (overrides both the
890 global value and agentnum).
895 my( $data, %opt ) = @_;
897 my $lpr = ( exists($opt{'lpr'}) && $opt{'lpr'} )
899 : $conf->config('lpr', $opt{'agentnum'} );
902 local($SIG{CHLD}) = sub {};
903 run3 $lpr, $data, \$outerr, \$outerr;
905 $outerr = ": $outerr" if length($outerr);
906 die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
911 =item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ]
913 Converts the filehandle referenced by FILEREF from fixed length record
914 lines to a CSV file according to the lengths specified in LENGTH_LISTREF.
915 The CALLBACKS_LISTREF refers to a correpsonding list of coderefs. Each
916 should return the value to be substituted in place of its single argument.
918 Returns false on success or an error if one occurs.
923 my( $fhref, $countref, $lengths, $callbacks) = @_;
925 eval { require Text::CSV_XS; };
929 my $unpacker = new Text::CSV_XS;
931 my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths;
933 my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc";
934 my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX",
937 ) or return "can't open temp file: $!\n"
940 while ( defined(my $line=<$ofh>) ) {
946 return "unexpected input at line $$countref: $line".
947 " -- expected $total but received ". length($line)
948 unless length($line) == $total;
950 $unpacker->combine( map { my $i = $column++;
951 defined( $callbacks->[$i] )
952 ? &{ $callbacks->[$i] }( $_ )
954 } unpack( $template, $line )
956 or return "invalid data for CSV: ". $unpacker->error_input;
958 print $fh $unpacker->string(), "\n"
959 or return "can't write temp file: $!\n";
963 if ( $template ) { close $$fhref; $$fhref = $fh }
969 =item ocr_image IMAGE_SCALAR
971 Runs OCR on the provided image data and returns a list of text lines.
976 my $logo_data = shift;
978 #XXX use conf dir location from Makefile
979 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
980 my $fh = new File::Temp(
981 TEMPLATE => 'bizcard.XXXXXXXX',
982 SUFFIX => '.png', #XXX assuming, but should handle jpg, gif, etc. too
985 ) or die "can't open temp file: $!\n";
987 my $filename = $fh->filename;
989 print $fh $logo_data;
992 local($SIG{CHLD}) = sub {};
994 run( [qw(ocroscript recognize), $filename], '>'=>"$filename.hocr" )
995 or die "ocroscript recognize failed\n";
997 run( [qw(ocroscript hocr-to-text), "$filename.hocr"], '>pipe'=>\*OUT )
998 or die "ocroscript hocr-to-text failed\n";
1000 my @lines = split(/\n/, <OUT> );
1002 foreach (@lines) { s/\.c0m\s*$/.com/; }
1007 =item bytes_substr STRING, OFFSET[, LENGTH[, REPLACEMENT] ]
1010 Use Unicode::Truncate truncate_egc instead
1012 A replacement for "substr" that counts raw bytes rather than logical
1013 characters. Unlike "bytes::substr", will suppress fragmented UTF-8 characters
1014 rather than output them. Unlike real "substr", is not an lvalue.
1018 # sub bytes_substr {
1019 # my ($string, $offset, $length, $repl) = @_;
1020 # my $bytes = substr(
1021 # Encode::encode('utf8', $string),
1024 # Encode::encode('utf8', $repl)
1026 # my $chk = $DEBUG ? Encode::FB_WARN : Encode::FB_QUIET;
1027 # return Encode::decode('utf8', $bytes, $chk);
1032 Accepts a postive or negative numerical value.
1033 Returns amount formatted for display,
1034 including money character.
1040 my $money_char = $conf->{'money_char'} || '$';
1041 $amount = sprintf("%0.2f",$amount);
1042 $amount =~ s/^(-?)/$1$money_char/;
1050 This package exists.
1054 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
1056 L<Fax::Hylafax::Client>