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' ),
177 'Charset' => 'UTF-8',
184 my $from = $options{from};
185 $from =~ s/^\s*//; $from =~ s/\s*$//;
186 if ( $from =~ /^(.*)\s*<(.*@.*)>$/ ) {
192 if ( $from =~ /\@([\w\.\-]+)/ ) {
195 warn 'no domain found in invoice from address '. $options{'from'}.
196 '; constructing Message-ID (and saying HELO) @example.com';
197 $domain = 'example.com';
199 my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
202 my $message = MIME::Entity->build(
203 'From' => $options{'from'},
204 'To' => join(', ', @to),
205 'Sender' => $options{'from'},
206 'Reply-To' => $options{'from'},
207 'Date' => time2str("%a, %d %b %Y %X %z", $time),
208 'Subject' => Encode::encode('MIME-Header', $options{'subject'}),
209 'Message-ID' => "<$message_id>",
213 if ( $options{'type'} ) {
214 #false laziness w/cust_bill::generate_email
215 $message->head->replace('Content-type',
217 '; boundary="'. $message->head->multipart_boundary. '"'.
218 '; type='. $options{'type'}
222 foreach my $part (@mimeparts) {
224 if ( UNIVERSAL::isa($part, 'MIME::Entity') ) {
226 warn "attaching MIME part from MIME::Entity object\n"
228 $message->add_part($part);
230 } elsif ( ref($part) eq 'HASH' ) {
232 warn "attaching MIME part from hashref:\n".
233 join("\n", map " $_: ".$part->{$_}, keys %$part ). "\n"
235 $message->attach(%$part);
238 croak "mimepart $part isn't a hashref or MIME::Entity object!";
245 my %smtp_opt = ( 'host' => $conf->config('smtpmachine'),
249 my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
250 $smtp_opt{'port'} = $port;
253 if ( defined($enc) && $enc eq 'starttls' ) {
254 $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password);
255 $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt );
257 if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
258 $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password);
260 $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls';
261 $transport = Email::Sender::Transport::SMTP->new( %smtp_opt );
264 push @to, $options{bcc} if defined($options{bcc});
265 # fully unpack all addresses found in @to (including Bcc) to make the
268 foreach my $dest (@to) {
269 push @env_to, map { $_->address } Email::Address->parse($dest);
272 local $@; # just in case
273 eval { sendmail($message, { transport => $transport,
278 if(ref($@) and $@->isa('Email::Sender::Failure')) {
279 $error = $@->code.' ' if $@->code;
280 $error .= $@->message;
287 if ( $conf->exists('log_sent_mail') ) {
288 my $cust_msg = FS::cust_msg->new({
289 'env_from' => $options{'from'},
290 'env_to' => join(', ', @env_to),
291 'header' => $message->header_as_string,
292 'body' => $message->body_as_string,
295 'custnum' => $options{'custnum'},
296 'msgnum' => $options{'msgnum'},
297 'status' => ($error ? 'failed' : 'sent'),
298 'msgtype' => $options{'msgtype'},
300 my $log_error = $cust_msg->insert;
301 warn "Error logging message: $log_error\n" if $log_error; # at least warn
307 =item generate_email OPTION => VALUE ...
315 Sender address, required
319 Recipient address, required
323 Blind copy address, optional
327 email subject, required
331 Email body (HTML alternative). Arrayref of lines, or scalar.
333 Will be placed inside an HTML <BODY> tag.
337 Email body (Text alternative). Arrayref of lines, or scalar.
339 =item custnum, msgnum (optional)
341 Customer and template numbers, passed through to send_email for logging.
345 Constructs a multipart message from text_body and html_body.
349 #false laziness w/FS::cust_bill::generate_email
357 my $me = '[FS::Misc::generate_email]';
359 my @fields = qw(from to bcc subject custnum msgnum msgtype);
361 @return{@fields} = @args{@fields};
363 warn "$me creating HTML/text multipart message"
366 $return{'nobody'} = 1;
368 my $alternative = build MIME::Entity
369 'Type' => 'multipart/alternative',
370 'Encoding' => '7bit',
371 'Disposition' => 'inline'
375 if ( ref($args{'text_body'}) eq 'ARRAY' ) {
376 $data = join("\n", @{ $args{'text_body'} });
378 $data = $args{'text_body'};
381 $alternative->attach(
382 'Type' => 'text/plain',
383 'Encoding' => 'quoted-printable',
384 'Charset' => 'UTF-8',
385 #'Encoding' => '7bit',
386 'Data' => Encode::encode_utf8($data),
387 'Disposition' => 'inline',
391 if ( ref($args{'html_body'}) eq 'ARRAY' ) {
392 @html_data = @{ $args{'html_body'} };
394 @html_data = split(/\n/, $args{'html_body'});
397 $alternative->attach(
398 'Type' => 'text/html',
399 'Encoding' => 'quoted-printable',
400 'Data' => [ '<html>',
403 ' '. encode_entities($return{'subject'}),
406 ' <body bgcolor="#ffffff">',
407 ( map Encode::encode_utf8($_), @html_data ),
411 'Disposition' => 'inline',
412 #'Filename' => 'invoice.pdf',
415 #no other attachment:
417 # multipart/alternative
421 $return{'content-type'} = 'multipart/related';
422 $return{'mimeparts'} = [ $alternative ];
423 $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
424 #$return{'disposition'} = 'inline';
430 =item send_fax OPTION => VALUE ...
434 I<dialstring> - (required) 10-digit phone number w/ area code
436 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
440 I<docfile> - (required) Filename of PostScript TIFF Class F document
442 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
451 die 'HylaFAX support has not been configured.'
452 unless $conf->exists('hylafax');
455 require Fax::Hylafax::Client;
459 if ($@ =~ /^Can't locate Fax.*/) {
460 die "You must have Fax::Hylafax::Client installed to use invoice faxing."
466 my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
468 die 'Called send_fax without a \'dialstring\'.'
469 unless exists($options{'dialstring'});
471 if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
472 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
473 my $fh = new File::Temp(
474 TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
477 ) or die "can't open temp file: $!\n";
479 $options{docfile} = $fh->filename;
481 print $fh @{$options{'docdata'}};
484 delete $options{'docdata'};
487 die 'Called send_fax without a \'docfile\' or \'docdata\'.'
488 unless exists($options{'docfile'});
490 #FIXME: Need to send canonical dialstring to HylaFAX, but this only
493 $options{'dialstring'} =~ s/[^\d\+]//g;
494 if ($options{'dialstring'} =~ /^\d{10}$/) {
495 $options{dialstring} = '+1' . $options{'dialstring'};
497 return 'Invalid dialstring ' . $options{'dialstring'} . '.';
500 my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
502 if ($faxjob->success) {
503 warn "Successfully queued fax to '$options{dialstring}' with jobid " .
508 return 'Error while sending FAX: ' . $faxjob->trace;
513 =item states_hash COUNTRY
515 Returns a list of key/value pairs containing state (or other sub-country
516 division) abbriviations and names.
520 use FS::Record qw(qsearch);
521 use Locale::SubCountry;
526 #a hash? not expecting an explosion of business from unrecognized countries..
527 return states_hash_nosubcountry($country) if $country eq 'XC';
531 map { s/[\n\r]//g; $_; }
535 'table' => 'cust_main_county',
536 'hashref' => { 'country' => $country },
537 'extra_sql' => 'GROUP BY state',
540 #it could throw a fatal "Invalid country code" error (for example "AX")
541 my $subcountry = eval { new Locale::SubCountry($country) }
542 or return (); # ( '', '(n/a)' );
544 #"i see your schwartz is as big as mine!"
545 map { ( $_->[0] => $_->[1] ) }
546 sort { $a->[1] cmp $b->[1] }
547 map { [ $_ => state_label($_, $subcountry) ] }
551 sub states_hash_nosubcountry {
556 map { s/[\n\r]//g; $_; }
560 'table' => 'cust_main_county',
561 'hashref' => { 'country' => $country },
562 'extra_sql' => 'GROUP BY state',
565 #"i see your schwartz is as big as mine!"
566 map { ( $_->[0] => $_->[1] ) }
567 sort { $a->[1] cmp $b->[1] }
572 =item counties STATE COUNTRY
574 Returns a list of counties for this state and country.
579 my( $state, $country ) = @_;
581 map { $_ } #return num_counties($state, $country) unless wantarray;
582 sort map { s/[\n\r]//g; $_; }
585 'select' => 'DISTINCT county',
586 'table' => 'cust_main_county',
587 'hashref' => { 'state' => $state,
588 'country' => $country,
593 =item cities COUNTY STATE COUNTRY
595 Returns a list of cities for this county, state and country.
600 my( $county, $state, $country ) = @_;
602 map { $_ } #return num_cities($county, $state, $country) unless wantarray;
603 sort map { s/[\n\r]//g; $_; }
606 'select' => 'DISTINCT city',
607 'table' => 'cust_main_county',
608 'hashref' => { 'county' => $county,
610 'country' => $country,
615 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
620 my( $state, $country ) = @_;
622 unless ( ref($country) ) {
623 $country = eval { new Locale::SubCountry($country) }
628 # US kludge to avoid changing existing behaviour
629 # also we actually *use* the abbriviations...
630 my $full_name = $country->country_code eq 'US'
632 : $country->full_name($state);
634 $full_name = '' if $full_name eq 'unknown';
635 $full_name =~ s/\(see also.*\)\s*$//;
636 $full_name .= " ($state)" if $full_name;
638 $full_name || $state || '(n/a)';
644 Returns a hash reference of the accepted credit card types. Keys are shorter
645 identifiers and values are the longer strings used by the system (see
646 L<Business::CreditCard>).
653 my $conf = new FS::Conf;
656 #displayname #value (Business::CreditCard)
657 "VISA" => "VISA card",
658 "MasterCard" => "MasterCard",
659 "Discover" => "Discover card",
660 "American Express" => "American Express card",
661 "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
662 "enRoute" => "enRoute",
664 "BankCard" => "BankCard",
665 "Switch" => "Switch",
668 my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
669 if ( @conf_card_types ) {
670 #perhaps the hash is backwards for this, but this way works better for
671 #usage in selfservice
672 %card_types = map { $_ => $card_types{$_} }
675 grep { $card_types{$d} eq $_ } @conf_card_types
685 Returns a hash reference of allowed package billing frequencies.
690 tie my %freq, 'Tie::IxHash', (
691 '0' => '(no recurring fee)',
694 '2d' => 'every two days',
695 '3d' => 'every three days',
697 '2w' => 'biweekly (every 2 weeks)',
699 '45d' => 'every 45 days',
700 '2' => 'bimonthly (every 2 months)',
701 '3' => 'quarterly (every 3 months)',
702 '4' => 'every 4 months',
703 '137d' => 'every 4 1/2 months (137 days)',
704 '6' => 'semiannually (every 6 months)',
706 '13' => 'every 13 months (annually +1 month)',
707 '24' => 'biannually (every 2 years)',
708 '36' => 'triannually (every 3 years)',
709 '48' => '(every 4 years)',
710 '60' => '(every 5 years)',
711 '120' => '(every 10 years)',
716 =item generate_ps FILENAME
718 Returns an postscript rendition of the LaTex file, as a scalar.
719 FILENAME does not contain the .tex suffix and is unlinked by this function.
723 use String::ShellQuote;
728 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
733 my $papersize = $conf->config('papersize') || 'letter';
735 local($SIG{CHLD}) = sub {};
737 system('dvips', '-q', '-t', $papersize, "$file.dvi", '-o', "$file.ps" ) == 0
738 or die "dvips failed";
740 open(POSTSCRIPT, "<$file.ps")
741 or die "can't open $file.ps: $! (error in LaTeX template?)\n";
743 unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex")
744 unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
748 if ( $conf->exists('lpr-postscript_prefix') ) {
749 my $prefix = $conf->config('lpr-postscript_prefix');
750 $ps .= eval qq("$prefix");
753 while (<POSTSCRIPT>) {
759 if ( $conf->exists('lpr-postscript_suffix') ) {
760 my $suffix = $conf->config('lpr-postscript_suffix');
761 $ps .= eval qq("$suffix");
768 =item generate_pdf FILENAME
770 Returns an PDF rendition of the LaTex file, as a scalar. FILENAME does not
771 contain the .tex suffix and is unlinked by this function.
775 use String::ShellQuote;
780 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
783 #system('pdflatex', "$file.tex");
784 #system('pdflatex', "$file.tex");
785 #! LaTeX Error: Unknown graphics extension: .eps.
789 my $sfile = shell_quote $file;
791 #system('dvipdf', "$file.dvi", "$file.pdf" );
792 my $papersize = $conf->config('papersize') || 'letter';
794 local($SIG{CHLD}) = sub {};
797 "dvips -q -f $sfile.dvi -t $papersize ".
798 "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
801 or die "dvips | gs failed: $!";
803 open(PDF, "<$file.pdf")
804 or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
806 unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex")
807 unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
823 #my $sfile = shell_quote $file;
827 '-interaction=batchmode',
828 '\AtBeginDocument{\RequirePackage{pslatex}}',
829 '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
830 '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
835 my $timeout = 30; #? should be more than enough
839 local($SIG{CHLD}) = sub {};
840 run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
841 or warn "bad exit status from pslatex pass $_\n";
845 return if -e "$file.dvi" && -s "$file.dvi";
846 die "pslatex $file.tex failed, see $file.log for details?\n";
850 =item do_print ARRAYREF [, OPTION => VALUE ... ]
852 Sends the lines in ARRAYREF to the printer.
854 Options available are:
860 Uses this agent's 'lpr' configuration setting override instead of the global
865 Uses this command instead of the configured lpr command (overrides both the
866 global value and agentnum).
871 my( $data, %opt ) = @_;
873 my $lpr = ( exists($opt{'lpr'}) && $opt{'lpr'} )
875 : $conf->config('lpr', $opt{'agentnum'} );
878 local($SIG{CHLD}) = sub {};
879 run3 $lpr, $data, \$outerr, \$outerr;
881 $outerr = ": $outerr" if length($outerr);
882 die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
887 =item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ]
889 Converts the filehandle referenced by FILEREF from fixed length record
890 lines to a CSV file according to the lengths specified in LENGTH_LISTREF.
891 The CALLBACKS_LISTREF refers to a correpsonding list of coderefs. Each
892 should return the value to be substituted in place of its single argument.
894 Returns false on success or an error if one occurs.
899 my( $fhref, $countref, $lengths, $callbacks) = @_;
901 eval { require Text::CSV_XS; };
905 my $unpacker = new Text::CSV_XS;
907 my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths;
909 my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc";
910 my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX",
913 ) or return "can't open temp file: $!\n"
916 while ( defined(my $line=<$ofh>) ) {
922 return "unexpected input at line $$countref: $line".
923 " -- expected $total but received ". length($line)
924 unless length($line) == $total;
926 $unpacker->combine( map { my $i = $column++;
927 defined( $callbacks->[$i] )
928 ? &{ $callbacks->[$i] }( $_ )
930 } unpack( $template, $line )
932 or return "invalid data for CSV: ". $unpacker->error_input;
934 print $fh $unpacker->string(), "\n"
935 or return "can't write temp file: $!\n";
939 if ( $template ) { close $$fhref; $$fhref = $fh }
945 =item ocr_image IMAGE_SCALAR
947 Runs OCR on the provided image data and returns a list of text lines.
952 my $logo_data = shift;
954 #XXX use conf dir location from Makefile
955 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
956 my $fh = new File::Temp(
957 TEMPLATE => 'bizcard.XXXXXXXX',
958 SUFFIX => '.png', #XXX assuming, but should handle jpg, gif, etc. too
961 ) or die "can't open temp file: $!\n";
963 my $filename = $fh->filename;
965 print $fh $logo_data;
968 local($SIG{CHLD}) = sub {};
970 run( [qw(ocroscript recognize), $filename], '>'=>"$filename.hocr" )
971 or die "ocroscript recognize failed\n";
973 run( [qw(ocroscript hocr-to-text), "$filename.hocr"], '>pipe'=>\*OUT )
974 or die "ocroscript hocr-to-text failed\n";
976 my @lines = split(/\n/, <OUT> );
978 foreach (@lines) { s/\.c0m\s*$/.com/; }
983 =item bytes_substr STRING, OFFSET[, LENGTH[, REPLACEMENT] ]
985 A replacement for "substr" that counts raw bytes rather than logical
986 characters. Unlike "bytes::substr", will suppress fragmented UTF-8 characters
987 rather than output them. Unlike real "substr", is not an lvalue.
992 my ($string, $offset, $length, $repl) = @_;
994 Encode::encode('utf8', $string),
997 Encode::encode('utf8', $repl)
999 my $chk = $DEBUG ? Encode::FB_WARN : Encode::FB_QUIET;
1000 return Encode::decode('utf8', $bytes, $chk);
1005 Accepts a postive or negative numerical value.
1006 Returns amount formatted for display,
1007 including money character.
1013 my $money_char = $conf->{'money_char'} || '$';
1014 $amount = sprintf("%0.2f",$amount);
1015 $amount =~ s/^(-?)/$1$money_char/;
1023 This package exists.
1027 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
1029 L<Fax::Hylafax::Client>