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
33 FS::Misc - Miscellaneous subroutines
37 use FS::Misc qw(send_email);
43 Miscellaneous subroutines. This module contains miscellaneous subroutines
44 called from multiple other modules. These are not OO or necessarily related,
45 but are collected here to eliminate code duplication.
51 =item send_email OPTION => VALUE ...
63 (required) comma-separated scalar or arrayref of recipients
71 (optional) MIME type for the body
75 (required unless I<nobody> is true) arrayref of body text lines
79 (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().
83 (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,
84 I<content-type>, if specified, overrides the default "multipart/mixed" for the outermost MIME container.
86 =item content-encoding
88 (optional) when using nobody, optional top-level MIME
89 encoding which, if specified, overrides the default "7bit".
93 (optional) type parameter for multipart/related messages
97 (optional) L<FS::cust_main> key; if passed, the message will be logged
98 (if logging is enabled) with this custnum.
102 (optional) L<FS::msg_template> key, for logging.
108 use vars qw( $conf );
111 use Email::Sender::Simple qw(sendmail);
112 use Email::Sender::Transport::SMTP;
113 use Email::Sender::Transport::SMTP::TLS 0.11;
116 FS::UID->install_callback( sub {
117 $conf = new FS::Conf;
123 my %doptions = %options;
124 $doptions{'body'} = '(full body not shown in debug)';
125 warn "FS::Misc::send_email called with options:\n ". Dumper(\%doptions);
126 # join("\n", map { " $_: ". $options{$_} } keys %options ). "\n"
129 my @to = ref($options{to}) ? @{ $options{to} } : ( $options{to} );
133 if ( $options{'nobody'} ) {
135 croak "'mimeparts' option required when 'nobody' option given\n"
136 unless $options{'mimeparts'};
138 @mimeparts = @{$options{'mimeparts'}};
141 'Type' => ( $options{'content-type'} || 'multipart/mixed' ),
142 'Encoding' => ( $options{'content-encoding'} || '7bit' ),
147 @mimeparts = @{$options{'mimeparts'}}
148 if ref($options{'mimeparts'}) eq 'ARRAY';
150 if (scalar(@mimeparts)) {
153 'Type' => 'multipart/mixed',
154 'Encoding' => '7bit',
157 unshift @mimeparts, {
158 'Type' => ( $options{'content-type'} || 'text/plain' ),
159 'Data' => $options{'body'},
160 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
161 'Disposition' => 'inline',
167 'Type' => ( $options{'content-type'} || 'text/plain' ),
168 'Data' => $options{'body'},
169 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
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 # fully unpack all addresses found in @to (including Bcc) to make the
260 foreach my $dest (@to) {
261 push @env_to, map { $_->address } Email::Address->parse($dest);
264 local $@; # just in case
265 eval { sendmail($message, { transport => $transport,
270 if(ref($@) and $@->isa('Email::Sender::Failure')) {
271 $error = $@->code.' ' if $@->code;
272 $error .= $@->message;
279 if ( $conf->exists('log_sent_mail') ) {
280 my $cust_msg = FS::cust_msg->new({
281 'env_from' => $options{'from'},
282 'env_to' => join(', ', @env_to),
283 'header' => $message->header_as_string,
284 'body' => $message->body_as_string,
287 'custnum' => $options{'custnum'},
288 'msgnum' => $options{'msgnum'},
289 'status' => ($error ? 'failed' : 'sent'),
290 'msgtype' => $options{'msgtype'},
292 $cust_msg->insert; # ignore errors
298 =item generate_email OPTION => VALUE ...
306 Sender address, required
310 Recipient address, required
314 Blind copy address, optional
318 email subject, required
322 Email body (HTML alternative). Arrayref of lines, or scalar.
324 Will be placed inside an HTML <BODY> tag.
328 Email body (Text alternative). Arrayref of lines, or scalar.
330 =item custnum, msgnum (optional)
332 Customer and template numbers, passed through to send_email for logging.
336 Constructs a multipart message from text_body and html_body.
340 #false laziness w/FS::cust_bill::generate_email
348 my $me = '[FS::Misc::generate_email]';
350 my @fields = qw(from to bcc subject custnum msgnum msgtype);
352 @return{@fields} = @args{@fields};
354 warn "$me creating HTML/text multipart message"
357 $return{'nobody'} = 1;
359 my $alternative = build MIME::Entity
360 'Type' => 'multipart/alternative',
361 'Encoding' => '7bit',
362 'Disposition' => 'inline'
366 if ( ref($args{'text_body'}) eq 'ARRAY' ) {
367 $data = join("\n", @{ $args{'text_body'} });
369 $data = $args{'text_body'};
372 $alternative->attach(
373 'Type' => 'text/plain',
374 'Encoding' => 'quoted-printable',
375 #'Encoding' => '7bit',
377 'Disposition' => 'inline',
381 if ( ref($args{'html_body'}) eq 'ARRAY' ) {
382 @html_data = @{ $args{'html_body'} };
384 @html_data = split(/\n/, $args{'html_body'});
387 $alternative->attach(
388 'Type' => 'text/html',
389 'Encoding' => 'quoted-printable',
390 'Data' => [ '<html>',
393 ' '. encode_entities($return{'subject'}),
396 ' <body bgcolor="#ffffff">',
401 'Disposition' => 'inline',
402 #'Filename' => 'invoice.pdf',
405 #no other attachment:
407 # multipart/alternative
411 $return{'content-type'} = 'multipart/related';
412 $return{'mimeparts'} = [ $alternative ];
413 $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
414 #$return{'disposition'} = 'inline';
420 =item process_send_email OPTION => VALUE ...
422 Takes arguments as per generate_email() and sends the message. This
423 will die on any error and can be used in the job queue.
427 sub process_send_email {
429 my $error = send_email(generate_email(%message));
430 die "$error\n" if $error;
434 =item process_send_generated_email OPTION => VALUE ...
436 Takes arguments as per send_email() and sends the message. This
437 will die on any error and can be used in the job queue.
441 sub process_send_generated_email {
443 my $error = send_email(%args);
444 die "$error\n" if $error;
448 =item send_fax OPTION => VALUE ...
452 I<dialstring> - (required) 10-digit phone number w/ area code
454 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
458 I<docfile> - (required) Filename of PostScript TIFF Class F document
460 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
469 die 'HylaFAX support has not been configured.'
470 unless $conf->exists('hylafax');
473 require Fax::Hylafax::Client;
477 if ($@ =~ /^Can't locate Fax.*/) {
478 die "You must have Fax::Hylafax::Client installed to use invoice faxing."
484 my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
486 die 'Called send_fax without a \'dialstring\'.'
487 unless exists($options{'dialstring'});
489 if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
490 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
491 my $fh = new File::Temp(
492 TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
495 ) or die "can't open temp file: $!\n";
497 $options{docfile} = $fh->filename;
499 print $fh @{$options{'docdata'}};
502 delete $options{'docdata'};
505 die 'Called send_fax without a \'docfile\' or \'docdata\'.'
506 unless exists($options{'docfile'});
508 #FIXME: Need to send canonical dialstring to HylaFAX, but this only
511 $options{'dialstring'} =~ s/[^\d\+]//g;
512 if ($options{'dialstring'} =~ /^\d{10}$/) {
513 $options{dialstring} = '+1' . $options{'dialstring'};
515 return 'Invalid dialstring ' . $options{'dialstring'} . '.';
518 my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
520 if ($faxjob->success) {
521 warn "Successfully queued fax to '$options{dialstring}' with jobid " .
526 return 'Error while sending FAX: ' . $faxjob->trace;
531 =item states_hash COUNTRY
533 Returns a list of key/value pairs containing state (or other sub-country
534 division) abbriviations and names.
538 use FS::Record qw(qsearch);
539 use Locale::SubCountry;
544 #a hash? not expecting an explosion of business from unrecognized countries..
545 return states_hash_nosubcountry($country) if $country eq 'XC';
549 map { s/[\n\r]//g; $_; }
553 'table' => 'cust_main_county',
554 'hashref' => { 'country' => $country },
555 'extra_sql' => 'GROUP BY state',
558 #it could throw a fatal "Invalid country code" error (for example "AX")
559 my $subcountry = eval { new Locale::SubCountry($country) }
560 or return (); # ( '', '(n/a)' );
562 #"i see your schwartz is as big as mine!"
563 map { ( $_->[0] => $_->[1] ) }
564 sort { $a->[1] cmp $b->[1] }
565 map { [ $_ => state_label($_, $subcountry) ] }
569 sub states_hash_nosubcountry {
574 map { s/[\n\r]//g; $_; }
578 'table' => 'cust_main_county',
579 'hashref' => { 'country' => $country },
580 'extra_sql' => 'GROUP BY state',
583 #"i see your schwartz is as big as mine!"
584 map { ( $_->[0] => $_->[1] ) }
585 sort { $a->[1] cmp $b->[1] }
590 =item counties STATE COUNTRY
592 Returns a list of counties for this state and country.
597 my( $state, $country ) = @_;
599 map { $_ } #return num_counties($state, $country) unless wantarray;
600 sort map { s/[\n\r]//g; $_; }
603 'select' => 'DISTINCT county',
604 'table' => 'cust_main_county',
605 'hashref' => { 'state' => $state,
606 'country' => $country,
611 =item cities COUNTY STATE COUNTRY
613 Returns a list of cities for this county, state and country.
618 my( $county, $state, $country ) = @_;
620 map { $_ } #return num_cities($county, $state, $country) unless wantarray;
621 sort map { s/[\n\r]//g; $_; }
624 'select' => 'DISTINCT city',
625 'table' => 'cust_main_county',
626 'hashref' => { 'county' => $county,
628 'country' => $country,
633 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
638 my( $state, $country ) = @_;
640 unless ( ref($country) ) {
641 $country = eval { new Locale::SubCountry($country) }
646 # US kludge to avoid changing existing behaviour
647 # also we actually *use* the abbriviations...
648 my $full_name = $country->country_code eq 'US'
650 : $country->full_name($state);
652 $full_name = '' if $full_name eq 'unknown';
653 $full_name =~ s/\(see also.*\)\s*$//;
654 $full_name .= " ($state)" if $full_name;
656 $full_name || $state || '(n/a)';
662 Returns a hash reference of the accepted credit card types. Keys are shorter
663 identifiers and values are the longer strings used by the system (see
664 L<Business::CreditCard>).
671 my $conf = new FS::Conf;
674 #displayname #value (Business::CreditCard)
675 "VISA" => "VISA card",
676 "MasterCard" => "MasterCard",
677 "Discover" => "Discover card",
678 "American Express" => "American Express card",
679 "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
680 "enRoute" => "enRoute",
682 "BankCard" => "BankCard",
683 "Switch" => "Switch",
686 my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
687 if ( @conf_card_types ) {
688 #perhaps the hash is backwards for this, but this way works better for
689 #usage in selfservice
690 %card_types = map { $_ => $card_types{$_} }
693 grep { $card_types{$d} eq $_ } @conf_card_types
703 Returns a hash reference of allowed package billing frequencies.
708 tie my %freq, 'Tie::IxHash', (
709 '0' => '(no recurring fee)',
712 '2d' => 'every two days',
713 '3d' => 'every three days',
715 '2w' => 'biweekly (every 2 weeks)',
717 '45d' => 'every 45 days',
718 '2' => 'bimonthly (every 2 months)',
719 '3' => 'quarterly (every 3 months)',
720 '4' => 'every 4 months',
721 '137d' => 'every 4 1/2 months (137 days)',
722 '6' => 'semiannually (every 6 months)',
724 '13' => 'every 13 months (annually +1 month)',
725 '24' => 'biannually (every 2 years)',
726 '36' => 'triannually (every 3 years)',
727 '48' => '(every 4 years)',
728 '60' => '(every 5 years)',
729 '120' => '(every 10 years)',
734 =item generate_ps FILENAME
736 Returns an postscript rendition of the LaTex file, as a scalar.
737 FILENAME does not contain the .tex suffix and is unlinked by this function.
741 use String::ShellQuote;
746 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
751 my $papersize = $conf->config('papersize') || 'letter';
753 system('dvips', '-q', '-t', $papersize, "$file.dvi", '-o', "$file.ps" ) == 0
754 or die "dvips failed";
756 open(POSTSCRIPT, "<$file.ps")
757 or die "can't open $file.ps: $! (error in LaTeX template?)\n";
759 unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex")
760 unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
764 if ( $conf->exists('lpr-postscript_prefix') ) {
765 my $prefix = $conf->config('lpr-postscript_prefix');
766 $ps .= eval qq("$prefix");
769 while (<POSTSCRIPT>) {
775 if ( $conf->exists('lpr-postscript_suffix') ) {
776 my $suffix = $conf->config('lpr-postscript_suffix');
777 $ps .= eval qq("$suffix");
784 =item generate_pdf FILENAME
786 Returns an PDF rendition of the LaTex file, as a scalar. FILENAME does not
787 contain the .tex suffix and is unlinked by this function.
791 use String::ShellQuote;
796 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
799 #system('pdflatex', "$file.tex");
800 #system('pdflatex', "$file.tex");
801 #! LaTeX Error: Unknown graphics extension: .eps.
805 my $sfile = shell_quote $file;
807 #system('dvipdf', "$file.dvi", "$file.pdf" );
808 my $papersize = $conf->config('papersize') || 'letter';
811 "dvips -q -f $sfile.dvi -t $papersize ".
812 "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
815 or die "dvips | gs failed: $!";
817 open(PDF, "<$file.pdf")
818 or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
820 unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex")
821 unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
837 #my $sfile = shell_quote $file;
841 '-interaction=batchmode',
842 '\AtBeginDocument{\RequirePackage{pslatex}}',
843 '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
844 '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
849 my $timeout = 30; #? should be more than enough
853 local($SIG{CHLD}) = sub {};
854 run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
855 or warn "bad exit status from pslatex pass $_\n";
859 return if -e "$file.dvi" && -s "$file.dvi";
860 die "pslatex $file.tex failed, see $file.log for details?\n";
864 =item do_print ARRAYREF [, OPTION => VALUE ... ]
866 Sends the lines in ARRAYREF to the printer.
868 Options available are:
874 Uses this agent's 'lpr' configuration setting override instead of the global
879 Uses this command instead of the configured lpr command (overrides both the
880 global value and agentnum).
885 my( $data, %opt ) = @_;
887 my $lpr = ( exists($opt{'lpr'}) && $opt{'lpr'} )
889 : $conf->config('lpr', $opt{'agentnum'} );
892 run3 $lpr, $data, \$outerr, \$outerr;
894 $outerr = ": $outerr" if length($outerr);
895 die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
900 =item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ]
902 Converts the filehandle referenced by FILEREF from fixed length record
903 lines to a CSV file according to the lengths specified in LENGTH_LISTREF.
904 The CALLBACKS_LISTREF refers to a correpsonding list of coderefs. Each
905 should return the value to be substituted in place of its single argument.
907 Returns false on success or an error if one occurs.
912 my( $fhref, $countref, $lengths, $callbacks) = @_;
914 eval { require Text::CSV_XS; };
918 my $unpacker = new Text::CSV_XS;
920 my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths;
922 my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc";
923 my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX",
926 ) or return "can't open temp file: $!\n"
929 while ( defined(my $line=<$ofh>) ) {
935 return "unexpected input at line $$countref: $line".
936 " -- expected $total but received ". length($line)
937 unless length($line) == $total;
939 $unpacker->combine( map { my $i = $column++;
940 defined( $callbacks->[$i] )
941 ? &{ $callbacks->[$i] }( $_ )
943 } unpack( $template, $line )
945 or return "invalid data for CSV: ". $unpacker->error_input;
947 print $fh $unpacker->string(), "\n"
948 or return "can't write temp file: $!\n";
952 if ( $template ) { close $$fhref; $$fhref = $fh }
958 =item ocr_image IMAGE_SCALAR
960 Runs OCR on the provided image data and returns a list of text lines.
965 my $logo_data = shift;
967 #XXX use conf dir location from Makefile
968 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
969 my $fh = new File::Temp(
970 TEMPLATE => 'bizcard.XXXXXXXX',
971 SUFFIX => '.png', #XXX assuming, but should handle jpg, gif, etc. too
974 ) or die "can't open temp file: $!\n";
976 my $filename = $fh->filename;
978 print $fh $logo_data;
981 run( [qw(ocroscript recognize), $filename], '>'=>"$filename.hocr" )
982 or die "ocroscript recognize failed\n";
984 run( [qw(ocroscript hocr-to-text), "$filename.hocr"], '>pipe'=>\*OUT )
985 or die "ocroscript hocr-to-text failed\n";
987 my @lines = split(/\n/, <OUT> );
989 foreach (@lines) { s/\.c0m\s*$/.com/; }
994 =item bytes_substr STRING, OFFSET[, LENGTH[, REPLACEMENT] ]
996 A replacement for "substr" that counts raw bytes rather than logical
997 characters. Unlike "bytes::substr", will suppress fragmented UTF-8 characters
998 rather than output them. Unlike real "substr", is not an lvalue.
1003 my ($string, $offset, $length, $repl) = @_;
1005 Encode::encode('utf8', $string),
1008 Encode::encode('utf8', $repl)
1010 my $chk = $DEBUG ? Encode::FB_WARN : Encode::FB_QUIET;
1011 return Encode::decode('utf8', $bytes, $chk);
1016 Accepts a postive or negative numerical value.
1017 Returns amount formatted for display,
1018 including money character.
1024 my $money_char = $conf->{'money_char'} || '$';
1025 $amount = sprintf("%0.2f",$amount);
1026 $amount =~ s/^(-?)/$1$money_char/;
1034 This package exists.
1038 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
1040 L<Fax::Hylafax::Client>