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 local $@; # just in case
258 eval { sendmail($message, { transport => $transport,
263 if(ref($@) and $@->isa('Email::Sender::Failure')) {
264 $error = $@->code.' ' if $@->code;
265 $error .= $@->message;
272 if ( $conf->exists('log_sent_mail') ) {
273 my $cust_msg = FS::cust_msg->new({
274 'env_from' => $options{'from'},
275 'env_to' => join(', ', @to),
276 'header' => $message->header_as_string,
277 'body' => $message->body_as_string,
280 'custnum' => $options{'custnum'},
281 'msgnum' => $options{'msgnum'},
282 'status' => ($error ? 'failed' : 'sent'),
283 'msgtype' => $options{'msgtype'},
285 $cust_msg->insert; # ignore errors
291 =item generate_email OPTION => VALUE ...
299 Sender address, required
303 Recipient address, required
307 Blind copy address, optional
311 email subject, required
315 Email body (HTML alternative). Arrayref of lines, or scalar.
317 Will be placed inside an HTML <BODY> tag.
321 Email body (Text alternative). Arrayref of lines, or scalar.
323 =item custnum, msgnum (optional)
325 Customer and template numbers, passed through to send_email for logging.
329 Constructs a multipart message from text_body and html_body.
333 #false laziness w/FS::cust_bill::generate_email
341 my $me = '[FS::Misc::generate_email]';
343 my @fields = qw(from to bcc subject custnum msgnum msgtype);
345 @return{@fields} = @args{@fields};
347 warn "$me creating HTML/text multipart message"
350 $return{'nobody'} = 1;
352 my $alternative = build MIME::Entity
353 'Type' => 'multipart/alternative',
354 'Encoding' => '7bit',
355 'Disposition' => 'inline'
359 if ( ref($args{'text_body'}) eq 'ARRAY' ) {
360 $data = join("\n", @{ $args{'text_body'} });
362 $data = $args{'text_body'};
365 $alternative->attach(
366 'Type' => 'text/plain',
367 'Encoding' => 'quoted-printable',
368 #'Encoding' => '7bit',
370 'Disposition' => 'inline',
374 if ( ref($args{'html_body'}) eq 'ARRAY' ) {
375 @html_data = @{ $args{'html_body'} };
377 @html_data = split(/\n/, $args{'html_body'});
380 $alternative->attach(
381 'Type' => 'text/html',
382 'Encoding' => 'quoted-printable',
383 'Data' => [ '<html>',
386 ' '. encode_entities($return{'subject'}),
389 ' <body bgcolor="#ffffff">',
394 'Disposition' => 'inline',
395 #'Filename' => 'invoice.pdf',
398 #no other attachment:
400 # multipart/alternative
404 $return{'content-type'} = 'multipart/related';
405 $return{'mimeparts'} = [ $alternative ];
406 $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
407 #$return{'disposition'} = 'inline';
413 =item process_send_email OPTION => VALUE ...
415 Takes arguments as per generate_email() and sends the message. This
416 will die on any error and can be used in the job queue.
420 sub process_send_email {
422 my $error = send_email(generate_email(%message));
423 die "$error\n" if $error;
427 =item process_send_generated_email OPTION => VALUE ...
429 Takes arguments as per send_email() and sends the message. This
430 will die on any error and can be used in the job queue.
434 sub process_send_generated_email {
436 my $error = send_email(%args);
437 die "$error\n" if $error;
441 =item send_fax OPTION => VALUE ...
445 I<dialstring> - (required) 10-digit phone number w/ area code
447 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
451 I<docfile> - (required) Filename of PostScript TIFF Class F document
453 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
462 die 'HylaFAX support has not been configured.'
463 unless $conf->exists('hylafax');
466 require Fax::Hylafax::Client;
470 if ($@ =~ /^Can't locate Fax.*/) {
471 die "You must have Fax::Hylafax::Client installed to use invoice faxing."
477 my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
479 die 'Called send_fax without a \'dialstring\'.'
480 unless exists($options{'dialstring'});
482 if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
483 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
484 my $fh = new File::Temp(
485 TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
488 ) or die "can't open temp file: $!\n";
490 $options{docfile} = $fh->filename;
492 print $fh @{$options{'docdata'}};
495 delete $options{'docdata'};
498 die 'Called send_fax without a \'docfile\' or \'docdata\'.'
499 unless exists($options{'docfile'});
501 #FIXME: Need to send canonical dialstring to HylaFAX, but this only
504 $options{'dialstring'} =~ s/[^\d\+]//g;
505 if ($options{'dialstring'} =~ /^\d{10}$/) {
506 $options{dialstring} = '+1' . $options{'dialstring'};
508 return 'Invalid dialstring ' . $options{'dialstring'} . '.';
511 my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
513 if ($faxjob->success) {
514 warn "Successfully queued fax to '$options{dialstring}' with jobid " .
519 return 'Error while sending FAX: ' . $faxjob->trace;
524 =item states_hash COUNTRY
526 Returns a list of key/value pairs containing state (or other sub-country
527 division) abbriviations and names.
531 use FS::Record qw(qsearch);
532 use Locale::SubCountry;
537 #a hash? not expecting an explosion of business from unrecognized countries..
538 return states_hash_nosubcountry($country) if $country eq 'XC';
542 map { s/[\n\r]//g; $_; }
546 'table' => 'cust_main_county',
547 'hashref' => { 'country' => $country },
548 'extra_sql' => 'GROUP BY state',
551 #it could throw a fatal "Invalid country code" error (for example "AX")
552 my $subcountry = eval { new Locale::SubCountry($country) }
553 or return (); # ( '', '(n/a)' );
555 #"i see your schwartz is as big as mine!"
556 map { ( $_->[0] => $_->[1] ) }
557 sort { $a->[1] cmp $b->[1] }
558 map { [ $_ => state_label($_, $subcountry) ] }
562 sub states_hash_nosubcountry {
567 map { s/[\n\r]//g; $_; }
571 'table' => 'cust_main_county',
572 'hashref' => { 'country' => $country },
573 'extra_sql' => 'GROUP BY state',
576 #"i see your schwartz is as big as mine!"
577 map { ( $_->[0] => $_->[1] ) }
578 sort { $a->[1] cmp $b->[1] }
583 =item counties STATE COUNTRY
585 Returns a list of counties for this state and country.
590 my( $state, $country ) = @_;
592 map { $_ } #return num_counties($state, $country) unless wantarray;
593 sort map { s/[\n\r]//g; $_; }
596 'select' => 'DISTINCT county',
597 'table' => 'cust_main_county',
598 'hashref' => { 'state' => $state,
599 'country' => $country,
604 =item cities COUNTY STATE COUNTRY
606 Returns a list of cities for this county, state and country.
611 my( $county, $state, $country ) = @_;
613 map { $_ } #return num_cities($county, $state, $country) unless wantarray;
614 sort map { s/[\n\r]//g; $_; }
617 'select' => 'DISTINCT city',
618 'table' => 'cust_main_county',
619 'hashref' => { 'county' => $county,
621 'country' => $country,
626 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
631 my( $state, $country ) = @_;
633 unless ( ref($country) ) {
634 $country = eval { new Locale::SubCountry($country) }
639 # US kludge to avoid changing existing behaviour
640 # also we actually *use* the abbriviations...
641 my $full_name = $country->country_code eq 'US'
643 : $country->full_name($state);
645 $full_name = '' if $full_name eq 'unknown';
646 $full_name =~ s/\(see also.*\)\s*$//;
647 $full_name .= " ($state)" if $full_name;
649 $full_name || $state || '(n/a)';
655 Returns a hash reference of the accepted credit card types. Keys are shorter
656 identifiers and values are the longer strings used by the system (see
657 L<Business::CreditCard>).
664 my $conf = new FS::Conf;
667 #displayname #value (Business::CreditCard)
668 "VISA" => "VISA card",
669 "MasterCard" => "MasterCard",
670 "Discover" => "Discover card",
671 "American Express" => "American Express card",
672 "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
673 "enRoute" => "enRoute",
675 "BankCard" => "BankCard",
676 "Switch" => "Switch",
679 my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
680 if ( @conf_card_types ) {
681 #perhaps the hash is backwards for this, but this way works better for
682 #usage in selfservice
683 %card_types = map { $_ => $card_types{$_} }
686 grep { $card_types{$d} eq $_ } @conf_card_types
696 Returns a hash reference of allowed package billing frequencies.
701 tie my %freq, 'Tie::IxHash', (
702 '0' => '(no recurring fee)',
705 '2d' => 'every two days',
706 '3d' => 'every three days',
708 '2w' => 'biweekly (every 2 weeks)',
710 '45d' => 'every 45 days',
711 '2' => 'bimonthly (every 2 months)',
712 '3' => 'quarterly (every 3 months)',
713 '4' => 'every 4 months',
714 '137d' => 'every 4 1/2 months (137 days)',
715 '6' => 'semiannually (every 6 months)',
717 '13' => 'every 13 months (annually +1 month)',
718 '24' => 'biannually (every 2 years)',
719 '36' => 'triannually (every 3 years)',
720 '48' => '(every 4 years)',
721 '60' => '(every 5 years)',
722 '120' => '(every 10 years)',
727 =item generate_ps FILENAME
729 Returns an postscript rendition of the LaTex file, as a scalar.
730 FILENAME does not contain the .tex suffix and is unlinked by this function.
734 use String::ShellQuote;
739 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
744 my $papersize = $conf->config('papersize') || 'letter';
746 system('dvips', '-q', '-t', $papersize, "$file.dvi", '-o', "$file.ps" ) == 0
747 or die "dvips failed";
749 open(POSTSCRIPT, "<$file.ps")
750 or die "can't open $file.ps: $! (error in LaTeX template?)\n";
752 unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex")
753 unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
757 if ( $conf->exists('lpr-postscript_prefix') ) {
758 my $prefix = $conf->config('lpr-postscript_prefix');
759 $ps .= eval qq("$prefix");
762 while (<POSTSCRIPT>) {
768 if ( $conf->exists('lpr-postscript_suffix') ) {
769 my $suffix = $conf->config('lpr-postscript_suffix');
770 $ps .= eval qq("$suffix");
777 =item generate_pdf FILENAME
779 Returns an PDF rendition of the LaTex file, as a scalar. FILENAME does not
780 contain the .tex suffix and is unlinked by this function.
784 use String::ShellQuote;
789 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
792 #system('pdflatex', "$file.tex");
793 #system('pdflatex', "$file.tex");
794 #! LaTeX Error: Unknown graphics extension: .eps.
798 my $sfile = shell_quote $file;
800 #system('dvipdf', "$file.dvi", "$file.pdf" );
801 my $papersize = $conf->config('papersize') || 'letter';
804 "dvips -q -f $sfile.dvi -t $papersize ".
805 "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
808 or die "dvips | gs failed: $!";
810 open(PDF, "<$file.pdf")
811 or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
813 unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex")
814 unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
830 #my $sfile = shell_quote $file;
834 '-interaction=batchmode',
835 '\AtBeginDocument{\RequirePackage{pslatex}}',
836 '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
837 '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
842 my $timeout = 30; #? should be more than enough
846 local($SIG{CHLD}) = sub {};
847 run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
848 or warn "bad exit status from pslatex pass $_\n";
852 return if -e "$file.dvi" && -s "$file.dvi";
853 die "pslatex $file.tex failed, see $file.log for details?\n";
857 =item do_print ARRAYREF [, OPTION => VALUE ... ]
859 Sends the lines in ARRAYREF to the printer.
861 Options available are:
867 Uses this agent's 'lpr' configuration setting override instead of the global
872 Uses this command instead of the configured lpr command (overrides both the
873 global value and agentnum).
878 my( $data, %opt ) = @_;
880 my $lpr = ( exists($opt{'lpr'}) && $opt{'lpr'} )
882 : $conf->config('lpr', $opt{'agentnum'} );
885 run3 $lpr, $data, \$outerr, \$outerr;
887 $outerr = ": $outerr" if length($outerr);
888 die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
893 =item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ]
895 Converts the filehandle referenced by FILEREF from fixed length record
896 lines to a CSV file according to the lengths specified in LENGTH_LISTREF.
897 The CALLBACKS_LISTREF refers to a correpsonding list of coderefs. Each
898 should return the value to be substituted in place of its single argument.
900 Returns false on success or an error if one occurs.
905 my( $fhref, $countref, $lengths, $callbacks) = @_;
907 eval { require Text::CSV_XS; };
911 my $unpacker = new Text::CSV_XS;
913 my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths;
915 my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc";
916 my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX",
919 ) or return "can't open temp file: $!\n"
922 while ( defined(my $line=<$ofh>) ) {
928 return "unexpected input at line $$countref: $line".
929 " -- expected $total but received ". length($line)
930 unless length($line) == $total;
932 $unpacker->combine( map { my $i = $column++;
933 defined( $callbacks->[$i] )
934 ? &{ $callbacks->[$i] }( $_ )
936 } unpack( $template, $line )
938 or return "invalid data for CSV: ". $unpacker->error_input;
940 print $fh $unpacker->string(), "\n"
941 or return "can't write temp file: $!\n";
945 if ( $template ) { close $$fhref; $$fhref = $fh }
951 =item ocr_image IMAGE_SCALAR
953 Runs OCR on the provided image data and returns a list of text lines.
958 my $logo_data = shift;
960 #XXX use conf dir location from Makefile
961 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
962 my $fh = new File::Temp(
963 TEMPLATE => 'bizcard.XXXXXXXX',
964 SUFFIX => '.png', #XXX assuming, but should handle jpg, gif, etc. too
967 ) or die "can't open temp file: $!\n";
969 my $filename = $fh->filename;
971 print $fh $logo_data;
974 run( [qw(ocroscript recognize), $filename], '>'=>"$filename.hocr" )
975 or die "ocroscript recognize failed\n";
977 run( [qw(ocroscript hocr-to-text), "$filename.hocr"], '>pipe'=>\*OUT )
978 or die "ocroscript hocr-to-text failed\n";
980 my @lines = split(/\n/, <OUT> );
982 foreach (@lines) { s/\.c0m\s*$/.com/; }
987 =item bytes_substr STRING, OFFSET[, LENGTH[, REPLACEMENT] ]
989 A replacement for "substr" that counts raw bytes rather than logical
990 characters. Unlike "bytes::substr", will suppress fragmented UTF-8 characters
991 rather than output them. Unlike real "substr", is not an lvalue.
996 my ($string, $offset, $length, $repl) = @_;
998 Encode::encode('utf8', $string),
1001 Encode::encode('utf8', $repl)
1003 my $chk = $DEBUG ? Encode::FB_WARN : Encode::FB_QUIET;
1004 return Encode::decode('utf8', $bytes, $chk);
1009 Accepts a postive or negative numerical value.
1010 Returns amount formatted for display,
1011 including money character.
1017 my $money_char = $conf->{'money_char'} || '$';
1018 $amount = sprintf("%0.2f",$amount);
1019 $amount =~ s/^(-?)/$1$money_char/;
1027 This package exists.
1031 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
1033 L<Fax::Hylafax::Client>