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 'Charset' => 'UTF-8',
160 'Data' => ( $options{'content-type'} =~ /^text\//
161 ? Encode::encode_utf8( $options{'body'} )
164 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
165 'Disposition' => 'inline',
171 'Type' => ( $options{'content-type'} || 'text/plain' ),
172 'Data' => ( $options{'content-type'} =~ /^text\//
173 ? Encode::encode_utf8( $options{'body'} )
176 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
183 my $from = $options{from};
184 $from =~ s/^\s*//; $from =~ s/\s*$//;
185 if ( $from =~ /^(.*)\s*<(.*@.*)>$/ ) {
191 if ( $from =~ /\@([\w\.\-]+)/ ) {
194 warn 'no domain found in invoice from address '. $options{'from'}.
195 '; constructing Message-ID (and saying HELO) @example.com';
196 $domain = 'example.com';
198 my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
201 my $message = MIME::Entity->build(
202 'From' => $options{'from'},
203 'To' => join(', ', @to),
204 'Sender' => $options{'from'},
205 'Reply-To' => $options{'from'},
206 'Date' => time2str("%a, %d %b %Y %X %z", $time),
207 'Subject' => Encode::encode('MIME-Header', $options{'subject'}),
208 'Message-ID' => "<$message_id>",
212 if ( $options{'type'} ) {
213 #false laziness w/cust_bill::generate_email
214 $message->head->replace('Content-type',
216 '; boundary="'. $message->head->multipart_boundary. '"'.
217 '; type='. $options{'type'}
221 foreach my $part (@mimeparts) {
223 if ( UNIVERSAL::isa($part, 'MIME::Entity') ) {
225 warn "attaching MIME part from MIME::Entity object\n"
227 $message->add_part($part);
229 } elsif ( ref($part) eq 'HASH' ) {
231 warn "attaching MIME part from hashref:\n".
232 join("\n", map " $_: ".$part->{$_}, keys %$part ). "\n"
234 $message->attach(%$part);
237 croak "mimepart $part isn't a hashref or MIME::Entity object!";
244 my %smtp_opt = ( 'host' => $conf->config('smtpmachine'),
248 my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
249 $smtp_opt{'port'} = $port;
252 if ( defined($enc) && $enc eq 'starttls' ) {
253 $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password);
254 $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt );
256 if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
257 $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password);
259 $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls';
260 $transport = Email::Sender::Transport::SMTP->new( %smtp_opt );
263 push @to, $options{bcc} if defined($options{bcc});
264 # fully unpack all addresses found in @to (including Bcc) to make the
267 foreach my $dest (@to) {
268 push @env_to, map { $_->address } Email::Address->parse($dest);
271 local $@; # just in case
272 eval { sendmail($message, { transport => $transport,
277 if(ref($@) and $@->isa('Email::Sender::Failure')) {
278 $error = $@->code.' ' if $@->code;
279 $error .= $@->message;
286 if ( $conf->exists('log_sent_mail') ) {
287 my $cust_msg = FS::cust_msg->new({
288 'env_from' => $options{'from'},
289 'env_to' => join(', ', @env_to),
290 'header' => $message->header_as_string,
291 'body' => $message->body_as_string,
294 'custnum' => $options{'custnum'},
295 'msgnum' => $options{'msgnum'},
296 'status' => ($error ? 'failed' : 'sent'),
297 'msgtype' => $options{'msgtype'},
299 $cust_msg->insert; # ignore errors
305 =item generate_email OPTION => VALUE ...
313 Sender address, required
317 Recipient address, required
321 Blind copy address, optional
325 email subject, required
329 Email body (HTML alternative). Arrayref of lines, or scalar.
331 Will be placed inside an HTML <BODY> tag.
335 Email body (Text alternative). Arrayref of lines, or scalar.
337 =item custnum, msgnum (optional)
339 Customer and template numbers, passed through to send_email for logging.
343 Constructs a multipart message from text_body and html_body.
347 #false laziness w/FS::cust_bill::generate_email
355 my $me = '[FS::Misc::generate_email]';
357 my @fields = qw(from to bcc subject custnum msgnum msgtype);
359 @return{@fields} = @args{@fields};
361 warn "$me creating HTML/text multipart message"
364 $return{'nobody'} = 1;
366 my $alternative = build MIME::Entity
367 'Type' => 'multipart/alternative',
368 'Encoding' => '7bit',
369 'Disposition' => 'inline'
373 if ( ref($args{'text_body'}) eq 'ARRAY' ) {
374 $data = join("\n", @{ $args{'text_body'} });
376 $data = $args{'text_body'};
379 $alternative->attach(
380 'Type' => 'text/plain',
381 'Encoding' => 'quoted-printable',
382 #'Encoding' => '7bit',
383 'Data' => Encode::encode_utf8($data),
384 'Disposition' => 'inline',
388 if ( ref($args{'html_body'}) eq 'ARRAY' ) {
389 @html_data = @{ $args{'html_body'} };
391 @html_data = split(/\n/, $args{'html_body'});
394 $alternative->attach(
395 'Type' => 'text/html',
396 'Encoding' => 'quoted-printable',
397 'Data' => [ '<html>',
400 ' '. encode_entities($return{'subject'}),
403 ' <body bgcolor="#ffffff">',
404 ( map Encode::encode_utf8($_), @html_data ),
408 'Disposition' => 'inline',
409 #'Filename' => 'invoice.pdf',
412 #no other attachment:
414 # multipart/alternative
418 $return{'content-type'} = 'multipart/related';
419 $return{'mimeparts'} = [ $alternative ];
420 $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
421 #$return{'disposition'} = 'inline';
427 =item process_send_email OPTION => VALUE ...
429 Takes arguments as per generate_email() and sends the message. This
430 will die on any error and can be used in the job queue.
434 sub process_send_email {
436 my $error = send_email(generate_email(%message));
437 die "$error\n" if $error;
441 =item process_send_generated_email OPTION => VALUE ...
443 Takes arguments as per send_email() and sends the message. This
444 will die on any error and can be used in the job queue.
448 sub process_send_generated_email {
450 my $error = send_email(%args);
451 die "$error\n" if $error;
455 =item send_fax OPTION => VALUE ...
459 I<dialstring> - (required) 10-digit phone number w/ area code
461 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
465 I<docfile> - (required) Filename of PostScript TIFF Class F document
467 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
476 die 'HylaFAX support has not been configured.'
477 unless $conf->exists('hylafax');
480 require Fax::Hylafax::Client;
484 if ($@ =~ /^Can't locate Fax.*/) {
485 die "You must have Fax::Hylafax::Client installed to use invoice faxing."
491 my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
493 die 'Called send_fax without a \'dialstring\'.'
494 unless exists($options{'dialstring'});
496 if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
497 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
498 my $fh = new File::Temp(
499 TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
502 ) or die "can't open temp file: $!\n";
504 $options{docfile} = $fh->filename;
506 print $fh @{$options{'docdata'}};
509 delete $options{'docdata'};
512 die 'Called send_fax without a \'docfile\' or \'docdata\'.'
513 unless exists($options{'docfile'});
515 #FIXME: Need to send canonical dialstring to HylaFAX, but this only
518 $options{'dialstring'} =~ s/[^\d\+]//g;
519 if ($options{'dialstring'} =~ /^\d{10}$/) {
520 $options{dialstring} = '+1' . $options{'dialstring'};
522 return 'Invalid dialstring ' . $options{'dialstring'} . '.';
525 my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
527 if ($faxjob->success) {
528 warn "Successfully queued fax to '$options{dialstring}' with jobid " .
533 return 'Error while sending FAX: ' . $faxjob->trace;
538 =item states_hash COUNTRY
540 Returns a list of key/value pairs containing state (or other sub-country
541 division) abbriviations and names.
545 use FS::Record qw(qsearch);
546 use Locale::SubCountry;
551 #a hash? not expecting an explosion of business from unrecognized countries..
552 return states_hash_nosubcountry($country) if $country eq 'XC';
556 map { s/[\n\r]//g; $_; }
560 'table' => 'cust_main_county',
561 'hashref' => { 'country' => $country },
562 'extra_sql' => 'GROUP BY state',
565 #it could throw a fatal "Invalid country code" error (for example "AX")
566 my $subcountry = eval { new Locale::SubCountry($country) }
567 or return (); # ( '', '(n/a)' );
569 #"i see your schwartz is as big as mine!"
570 map { ( $_->[0] => $_->[1] ) }
571 sort { $a->[1] cmp $b->[1] }
572 map { [ $_ => state_label($_, $subcountry) ] }
576 sub states_hash_nosubcountry {
581 map { s/[\n\r]//g; $_; }
585 'table' => 'cust_main_county',
586 'hashref' => { 'country' => $country },
587 'extra_sql' => 'GROUP BY state',
590 #"i see your schwartz is as big as mine!"
591 map { ( $_->[0] => $_->[1] ) }
592 sort { $a->[1] cmp $b->[1] }
597 =item counties STATE COUNTRY
599 Returns a list of counties for this state and country.
604 my( $state, $country ) = @_;
606 map { $_ } #return num_counties($state, $country) unless wantarray;
607 sort map { s/[\n\r]//g; $_; }
610 'select' => 'DISTINCT county',
611 'table' => 'cust_main_county',
612 'hashref' => { 'state' => $state,
613 'country' => $country,
618 =item cities COUNTY STATE COUNTRY
620 Returns a list of cities for this county, state and country.
625 my( $county, $state, $country ) = @_;
627 map { $_ } #return num_cities($county, $state, $country) unless wantarray;
628 sort map { s/[\n\r]//g; $_; }
631 'select' => 'DISTINCT city',
632 'table' => 'cust_main_county',
633 'hashref' => { 'county' => $county,
635 'country' => $country,
640 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
645 my( $state, $country ) = @_;
647 unless ( ref($country) ) {
648 $country = eval { new Locale::SubCountry($country) }
653 # US kludge to avoid changing existing behaviour
654 # also we actually *use* the abbriviations...
655 my $full_name = $country->country_code eq 'US'
657 : $country->full_name($state);
659 $full_name = '' if $full_name eq 'unknown';
660 $full_name =~ s/\(see also.*\)\s*$//;
661 $full_name .= " ($state)" if $full_name;
663 $full_name || $state || '(n/a)';
669 Returns a hash reference of the accepted credit card types. Keys are shorter
670 identifiers and values are the longer strings used by the system (see
671 L<Business::CreditCard>).
678 my $conf = new FS::Conf;
681 #displayname #value (Business::CreditCard)
682 "VISA" => "VISA card",
683 "MasterCard" => "MasterCard",
684 "Discover" => "Discover card",
685 "American Express" => "American Express card",
686 "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
687 "enRoute" => "enRoute",
689 "BankCard" => "BankCard",
690 "Switch" => "Switch",
693 my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
694 if ( @conf_card_types ) {
695 #perhaps the hash is backwards for this, but this way works better for
696 #usage in selfservice
697 %card_types = map { $_ => $card_types{$_} }
700 grep { $card_types{$d} eq $_ } @conf_card_types
710 Returns a hash reference of allowed package billing frequencies.
715 tie my %freq, 'Tie::IxHash', (
716 '0' => '(no recurring fee)',
719 '2d' => 'every two days',
720 '3d' => 'every three days',
722 '2w' => 'biweekly (every 2 weeks)',
724 '45d' => 'every 45 days',
725 '2' => 'bimonthly (every 2 months)',
726 '3' => 'quarterly (every 3 months)',
727 '4' => 'every 4 months',
728 '137d' => 'every 4 1/2 months (137 days)',
729 '6' => 'semiannually (every 6 months)',
731 '13' => 'every 13 months (annually +1 month)',
732 '24' => 'biannually (every 2 years)',
733 '36' => 'triannually (every 3 years)',
734 '48' => '(every 4 years)',
735 '60' => '(every 5 years)',
736 '120' => '(every 10 years)',
741 =item generate_ps FILENAME
743 Returns an postscript rendition of the LaTex file, as a scalar.
744 FILENAME does not contain the .tex suffix and is unlinked by this function.
748 use String::ShellQuote;
753 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
758 my $papersize = $conf->config('papersize') || 'letter';
760 local($SIG{CHLD}) = sub {};
762 system('dvips', '-q', '-t', $papersize, "$file.dvi", '-o', "$file.ps" ) == 0
763 or die "dvips failed";
765 open(POSTSCRIPT, "<$file.ps")
766 or die "can't open $file.ps: $! (error in LaTeX template?)\n";
768 unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex")
769 unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
773 if ( $conf->exists('lpr-postscript_prefix') ) {
774 my $prefix = $conf->config('lpr-postscript_prefix');
775 $ps .= eval qq("$prefix");
778 while (<POSTSCRIPT>) {
784 if ( $conf->exists('lpr-postscript_suffix') ) {
785 my $suffix = $conf->config('lpr-postscript_suffix');
786 $ps .= eval qq("$suffix");
793 =item generate_pdf FILENAME
795 Returns an PDF rendition of the LaTex file, as a scalar. FILENAME does not
796 contain the .tex suffix and is unlinked by this function.
800 use String::ShellQuote;
805 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
808 #system('pdflatex', "$file.tex");
809 #system('pdflatex', "$file.tex");
810 #! LaTeX Error: Unknown graphics extension: .eps.
814 my $sfile = shell_quote $file;
816 #system('dvipdf', "$file.dvi", "$file.pdf" );
817 my $papersize = $conf->config('papersize') || 'letter';
819 local($SIG{CHLD}) = sub {};
822 "dvips -q -f $sfile.dvi -t $papersize ".
823 "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
826 or die "dvips | gs failed: $!";
828 open(PDF, "<$file.pdf")
829 or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
831 unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex")
832 unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
848 #my $sfile = shell_quote $file;
852 '-interaction=batchmode',
853 '\AtBeginDocument{\RequirePackage{pslatex}}',
854 '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
855 '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
860 my $timeout = 30; #? should be more than enough
864 local($SIG{CHLD}) = sub {};
865 run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
866 or warn "bad exit status from pslatex pass $_\n";
870 return if -e "$file.dvi" && -s "$file.dvi";
871 die "pslatex $file.tex failed, see $file.log for details?\n";
875 =item do_print ARRAYREF [, OPTION => VALUE ... ]
877 Sends the lines in ARRAYREF to the printer.
879 Options available are:
885 Uses this agent's 'lpr' configuration setting override instead of the global
890 Uses this command instead of the configured lpr command (overrides both the
891 global value and agentnum).
896 my( $data, %opt ) = @_;
898 my $lpr = ( exists($opt{'lpr'}) && $opt{'lpr'} )
900 : $conf->config('lpr', $opt{'agentnum'} );
903 local($SIG{CHLD}) = sub {};
904 run3 $lpr, $data, \$outerr, \$outerr;
906 $outerr = ": $outerr" if length($outerr);
907 die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
912 =item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ]
914 Converts the filehandle referenced by FILEREF from fixed length record
915 lines to a CSV file according to the lengths specified in LENGTH_LISTREF.
916 The CALLBACKS_LISTREF refers to a correpsonding list of coderefs. Each
917 should return the value to be substituted in place of its single argument.
919 Returns false on success or an error if one occurs.
924 my( $fhref, $countref, $lengths, $callbacks) = @_;
926 eval { require Text::CSV_XS; };
930 my $unpacker = new Text::CSV_XS;
932 my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths;
934 my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc";
935 my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX",
938 ) or return "can't open temp file: $!\n"
941 while ( defined(my $line=<$ofh>) ) {
947 return "unexpected input at line $$countref: $line".
948 " -- expected $total but received ". length($line)
949 unless length($line) == $total;
951 $unpacker->combine( map { my $i = $column++;
952 defined( $callbacks->[$i] )
953 ? &{ $callbacks->[$i] }( $_ )
955 } unpack( $template, $line )
957 or return "invalid data for CSV: ". $unpacker->error_input;
959 print $fh $unpacker->string(), "\n"
960 or return "can't write temp file: $!\n";
964 if ( $template ) { close $$fhref; $$fhref = $fh }
970 =item ocr_image IMAGE_SCALAR
972 Runs OCR on the provided image data and returns a list of text lines.
977 my $logo_data = shift;
979 #XXX use conf dir location from Makefile
980 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
981 my $fh = new File::Temp(
982 TEMPLATE => 'bizcard.XXXXXXXX',
983 SUFFIX => '.png', #XXX assuming, but should handle jpg, gif, etc. too
986 ) or die "can't open temp file: $!\n";
988 my $filename = $fh->filename;
990 print $fh $logo_data;
993 local($SIG{CHLD}) = sub {};
995 run( [qw(ocroscript recognize), $filename], '>'=>"$filename.hocr" )
996 or die "ocroscript recognize failed\n";
998 run( [qw(ocroscript hocr-to-text), "$filename.hocr"], '>pipe'=>\*OUT )
999 or die "ocroscript hocr-to-text failed\n";
1001 my @lines = split(/\n/, <OUT> );
1003 foreach (@lines) { s/\.c0m\s*$/.com/; }
1008 =item bytes_substr STRING, OFFSET[, LENGTH[, REPLACEMENT] ]
1010 A replacement for "substr" that counts raw bytes rather than logical
1011 characters. Unlike "bytes::substr", will suppress fragmented UTF-8 characters
1012 rather than output them. Unlike real "substr", is not an lvalue.
1017 my ($string, $offset, $length, $repl) = @_;
1019 Encode::encode('utf8', $string),
1022 Encode::encode('utf8', $repl)
1024 my $chk = $DEBUG ? Encode::FB_WARN : Encode::FB_QUIET;
1025 return Encode::decode('utf8', $bytes, $chk);
1030 Accepts a postive or negative numerical value.
1031 Returns amount formatted for display,
1032 including money character.
1038 my $money_char = $conf->{'money_char'} || '$';
1039 $amount = sprintf("%0.2f",$amount);
1040 $amount =~ s/^(-?)/$1$money_char/;
1048 This package exists.
1052 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
1054 L<Fax::Hylafax::Client>