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{'body'},
161 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
162 'Disposition' => 'inline',
168 'Type' => ( $options{'content-type'} || 'text/plain' ),
169 'Data' => $options{'body'},
170 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
171 'Charset' => 'UTF-8',
178 my $from = $options{from};
179 $from =~ s/^\s*//; $from =~ s/\s*$//;
180 if ( $from =~ /^(.*)\s*<(.*@.*)>$/ ) {
186 if ( $from =~ /\@([\w\.\-]+)/ ) {
189 warn 'no domain found in invoice from address '. $options{'from'}.
190 '; constructing Message-ID (and saying HELO) @example.com';
191 $domain = 'example.com';
193 my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
196 my $message = MIME::Entity->build(
197 'From' => $options{'from'},
198 'To' => join(', ', @to),
199 'Sender' => $options{'from'},
200 'Reply-To' => $options{'from'},
201 'Date' => time2str("%a, %d %b %Y %X %z", $time),
202 'Subject' => Encode::encode('MIME-Header', $options{'subject'}),
203 'Message-ID' => "<$message_id>",
207 if ( $options{'type'} ) {
208 #false laziness w/cust_bill::generate_email
209 $message->head->replace('Content-type',
211 '; boundary="'. $message->head->multipart_boundary. '"'.
212 '; type='. $options{'type'}
216 foreach my $part (@mimeparts) {
218 if ( UNIVERSAL::isa($part, 'MIME::Entity') ) {
220 warn "attaching MIME part from MIME::Entity object\n"
222 $message->add_part($part);
224 } elsif ( ref($part) eq 'HASH' ) {
226 warn "attaching MIME part from hashref:\n".
227 join("\n", map " $_: ".$part->{$_}, keys %$part ). "\n"
229 $message->attach(%$part);
232 croak "mimepart $part isn't a hashref or MIME::Entity object!";
239 my %smtp_opt = ( 'host' => $conf->config('smtpmachine'),
243 my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
244 $smtp_opt{'port'} = $port;
247 if ( defined($enc) && $enc eq 'starttls' ) {
248 $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password);
249 $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt );
251 if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
252 $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password);
254 $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls';
255 $transport = Email::Sender::Transport::SMTP->new( %smtp_opt );
258 push @to, $options{bcc} if defined($options{bcc});
259 local $@; # just in case
260 eval { sendmail($message, { transport => $transport,
265 if(ref($@) and $@->isa('Email::Sender::Failure')) {
266 $error = $@->code.' ' if $@->code;
267 $error .= $@->message;
274 if ( $conf->exists('log_sent_mail') ) {
275 my $cust_msg = FS::cust_msg->new({
276 'env_from' => $options{'from'},
277 'env_to' => join(', ', @to),
278 'header' => $message->header_as_string,
279 'body' => $message->body_as_string,
282 'custnum' => $options{'custnum'},
283 'msgnum' => $options{'msgnum'},
284 'status' => ($error ? 'failed' : 'sent'),
285 'msgtype' => $options{'msgtype'},
287 my $log_error = $cust_msg->insert;
288 warn "Error logging message: $log_error\n" if $log_error; # at least warn
294 =item generate_email OPTION => VALUE ...
302 Sender address, required
306 Recipient address, required
310 Blind copy address, optional
314 email subject, required
318 Email body (HTML alternative). Arrayref of lines, or scalar.
320 Will be placed inside an HTML <BODY> tag.
324 Email body (Text alternative). Arrayref of lines, or scalar.
326 =item custnum, msgnum (optional)
328 Customer and template numbers, passed through to send_email for logging.
332 Constructs a multipart message from text_body and html_body.
336 #false laziness w/FS::cust_bill::generate_email
344 my $me = '[FS::Misc::generate_email]';
346 my @fields = qw(from to bcc subject custnum msgnum msgtype);
348 @return{@fields} = @args{@fields};
350 warn "$me creating HTML/text multipart message"
353 $return{'nobody'} = 1;
355 my $alternative = build MIME::Entity
356 'Type' => 'multipart/alternative',
357 'Encoding' => '7bit',
358 'Disposition' => 'inline'
362 if ( ref($args{'text_body'}) eq 'ARRAY' ) {
363 $data = join("\n", @{ $args{'text_body'} });
365 $data = $args{'text_body'};
368 $alternative->attach(
369 'Type' => 'text/plain',
370 'Encoding' => 'quoted-printable',
371 'Charset' => 'UTF-8',
372 #'Encoding' => '7bit',
374 'Disposition' => 'inline',
378 if ( ref($args{'html_body'}) eq 'ARRAY' ) {
379 @html_data = @{ $args{'html_body'} };
381 @html_data = split(/\n/, $args{'html_body'});
384 $alternative->attach(
385 'Type' => 'text/html',
386 'Encoding' => 'quoted-printable',
387 'Data' => [ '<html>',
390 ' '. encode_entities($return{'subject'}),
393 ' <body bgcolor="#ffffff">',
398 'Disposition' => 'inline',
399 #'Filename' => 'invoice.pdf',
402 #no other attachment:
404 # multipart/alternative
408 $return{'content-type'} = 'multipart/related';
409 $return{'mimeparts'} = [ $alternative ];
410 $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
411 #$return{'disposition'} = 'inline';
417 =item process_send_email OPTION => VALUE ...
419 Takes arguments as per generate_email() and sends the message. This
420 will die on any error and can be used in the job queue.
424 sub process_send_email {
426 my $error = send_email(generate_email(%message));
427 die "$error\n" if $error;
431 =item process_send_generated_email OPTION => VALUE ...
433 Takes arguments as per send_email() and sends the message. This
434 will die on any error and can be used in the job queue.
438 sub process_send_generated_email {
440 my $error = send_email(%args);
441 die "$error\n" if $error;
445 =item send_fax OPTION => VALUE ...
449 I<dialstring> - (required) 10-digit phone number w/ area code
451 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
455 I<docfile> - (required) Filename of PostScript TIFF Class F document
457 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
466 die 'HylaFAX support has not been configured.'
467 unless $conf->exists('hylafax');
470 require Fax::Hylafax::Client;
474 if ($@ =~ /^Can't locate Fax.*/) {
475 die "You must have Fax::Hylafax::Client installed to use invoice faxing."
481 my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
483 die 'Called send_fax without a \'dialstring\'.'
484 unless exists($options{'dialstring'});
486 if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
487 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
488 my $fh = new File::Temp(
489 TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
492 ) or die "can't open temp file: $!\n";
494 $options{docfile} = $fh->filename;
496 print $fh @{$options{'docdata'}};
499 delete $options{'docdata'};
502 die 'Called send_fax without a \'docfile\' or \'docdata\'.'
503 unless exists($options{'docfile'});
505 #FIXME: Need to send canonical dialstring to HylaFAX, but this only
508 $options{'dialstring'} =~ s/[^\d\+]//g;
509 if ($options{'dialstring'} =~ /^\d{10}$/) {
510 $options{dialstring} = '+1' . $options{'dialstring'};
512 return 'Invalid dialstring ' . $options{'dialstring'} . '.';
515 my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
517 if ($faxjob->success) {
518 warn "Successfully queued fax to '$options{dialstring}' with jobid " .
523 return 'Error while sending FAX: ' . $faxjob->trace;
528 =item states_hash COUNTRY
530 Returns a list of key/value pairs containing state (or other sub-country
531 division) abbriviations and names.
535 use FS::Record qw(qsearch);
536 use Locale::SubCountry;
543 map { s/[\n\r]//g; $_; }
547 'table' => 'cust_main_county',
548 'hashref' => { 'country' => $country },
549 'extra_sql' => 'GROUP BY state',
552 #it could throw a fatal "Invalid country code" error (for example "AX")
553 my $subcountry = eval { new Locale::SubCountry($country) }
554 or return (); # ( '', '(n/a)' );
556 #"i see your schwartz is as big as mine!"
557 map { ( $_->[0] => $_->[1] ) }
558 sort { $a->[1] cmp $b->[1] }
559 map { [ $_ => state_label($_, $subcountry) ] }
563 =item counties STATE COUNTRY
565 Returns a list of counties for this state and country.
570 my( $state, $country ) = @_;
572 map { $_ } #return num_counties($state, $country) unless wantarray;
573 sort map { s/[\n\r]//g; $_; }
576 'select' => 'DISTINCT county',
577 'table' => 'cust_main_county',
578 'hashref' => { 'state' => $state,
579 'country' => $country,
584 =item cities COUNTY STATE COUNTRY
586 Returns a list of cities for this county, state and country.
591 my( $county, $state, $country ) = @_;
593 map { $_ } #return num_cities($county, $state, $country) unless wantarray;
594 sort map { s/[\n\r]//g; $_; }
597 'select' => 'DISTINCT city',
598 'table' => 'cust_main_county',
599 'hashref' => { 'county' => $county,
601 'country' => $country,
606 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
611 my( $state, $country ) = @_;
613 unless ( ref($country) ) {
614 $country = eval { new Locale::SubCountry($country) }
619 # US kludge to avoid changing existing behaviour
620 # also we actually *use* the abbriviations...
621 my $full_name = $country->country_code eq 'US'
623 : $country->full_name($state);
625 $full_name = '' if $full_name eq 'unknown';
626 $full_name =~ s/\(see also.*\)\s*$//;
627 $full_name .= " ($state)" if $full_name;
629 $full_name || $state || '(n/a)';
635 Returns a hash reference of the accepted credit card types. Keys are shorter
636 identifiers and values are the longer strings used by the system (see
637 L<Business::CreditCard>).
644 my $conf = new FS::Conf;
647 #displayname #value (Business::CreditCard)
648 "VISA" => "VISA card",
649 "MasterCard" => "MasterCard",
650 "Discover" => "Discover card",
651 "American Express" => "American Express card",
652 "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
653 "enRoute" => "enRoute",
655 "BankCard" => "BankCard",
656 "Switch" => "Switch",
659 my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
660 if ( @conf_card_types ) {
661 #perhaps the hash is backwards for this, but this way works better for
662 #usage in selfservice
663 %card_types = map { $_ => $card_types{$_} }
666 grep { $card_types{$d} eq $_ } @conf_card_types
676 Returns a hash reference of allowed package billing frequencies.
681 tie my %freq, 'Tie::IxHash', (
682 '0' => '(no recurring fee)',
685 '2d' => 'every two days',
686 '3d' => 'every three days',
688 '2w' => 'biweekly (every 2 weeks)',
690 '45d' => 'every 45 days',
691 '2' => 'bimonthly (every 2 months)',
692 '3' => 'quarterly (every 3 months)',
693 '4' => 'every 4 months',
694 '137d' => 'every 4 1/2 months (137 days)',
695 '6' => 'semiannually (every 6 months)',
697 '13' => 'every 13 months (annually +1 month)',
698 '24' => 'biannually (every 2 years)',
699 '36' => 'triannually (every 3 years)',
700 '48' => '(every 4 years)',
701 '60' => '(every 5 years)',
702 '120' => '(every 10 years)',
707 =item generate_ps FILENAME
709 Returns an postscript rendition of the LaTex file, as a scalar.
710 FILENAME does not contain the .tex suffix and is unlinked by this function.
714 use String::ShellQuote;
719 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
724 my $papersize = $conf->config('papersize') || 'letter';
726 system('dvips', '-q', '-t', $papersize, "$file.dvi", '-o', "$file.ps" ) == 0
727 or die "dvips failed";
729 open(POSTSCRIPT, "<$file.ps")
730 or die "can't open $file.ps: $! (error in LaTeX template?)\n";
732 unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex")
733 unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
737 if ( $conf->exists('lpr-postscript_prefix') ) {
738 my $prefix = $conf->config('lpr-postscript_prefix');
739 $ps .= eval qq("$prefix");
742 while (<POSTSCRIPT>) {
748 if ( $conf->exists('lpr-postscript_suffix') ) {
749 my $suffix = $conf->config('lpr-postscript_suffix');
750 $ps .= eval qq("$suffix");
757 =item generate_pdf FILENAME
759 Returns an PDF rendition of the LaTex file, as a scalar. FILENAME does not
760 contain the .tex suffix and is unlinked by this function.
764 use String::ShellQuote;
769 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
772 #system('pdflatex', "$file.tex");
773 #system('pdflatex', "$file.tex");
774 #! LaTeX Error: Unknown graphics extension: .eps.
778 my $sfile = shell_quote $file;
780 #system('dvipdf', "$file.dvi", "$file.pdf" );
781 my $papersize = $conf->config('papersize') || 'letter';
784 "dvips -q -f $sfile.dvi -t $papersize ".
785 "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
788 or die "dvips | gs failed: $!";
790 open(PDF, "<$file.pdf")
791 or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
793 unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex")
794 unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
810 #my $sfile = shell_quote $file;
814 '-interaction=batchmode',
815 '\AtBeginDocument{\RequirePackage{pslatex}}',
816 '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
817 '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
822 my $timeout = 30; #? should be more than enough
826 local($SIG{CHLD}) = sub {};
827 run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
828 or warn "bad exit status from pslatex pass $_\n";
832 return if -e "$file.dvi" && -s "$file.dvi";
833 die "pslatex $file.tex failed, see $file.log for details?\n";
837 =item do_print ARRAYREF [, OPTION => VALUE ... ]
839 Sends the lines in ARRAYREF to the printer.
841 Options available are:
847 Uses this agent's 'lpr' configuration setting override instead of the global
852 Uses this command instead of the configured lpr command (overrides both the
853 global value and agentnum).
858 my( $data, %opt ) = @_;
860 my $lpr = ( exists($opt{'lpr'}) && $opt{'lpr'} )
862 : $conf->config('lpr', $opt{'agentnum'} );
865 run3 $lpr, $data, \$outerr, \$outerr;
867 $outerr = ": $outerr" if length($outerr);
868 die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
873 =item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ]
875 Converts the filehandle referenced by FILEREF from fixed length record
876 lines to a CSV file according to the lengths specified in LENGTH_LISTREF.
877 The CALLBACKS_LISTREF refers to a correpsonding list of coderefs. Each
878 should return the value to be substituted in place of its single argument.
880 Returns false on success or an error if one occurs.
885 my( $fhref, $countref, $lengths, $callbacks) = @_;
887 eval { require Text::CSV_XS; };
891 my $unpacker = new Text::CSV_XS;
893 my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths;
895 my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc";
896 my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX",
899 ) or return "can't open temp file: $!\n"
902 while ( defined(my $line=<$ofh>) ) {
908 return "unexpected input at line $$countref: $line".
909 " -- expected $total but received ". length($line)
910 unless length($line) == $total;
912 $unpacker->combine( map { my $i = $column++;
913 defined( $callbacks->[$i] )
914 ? &{ $callbacks->[$i] }( $_ )
916 } unpack( $template, $line )
918 or return "invalid data for CSV: ". $unpacker->error_input;
920 print $fh $unpacker->string(), "\n"
921 or return "can't write temp file: $!\n";
925 if ( $template ) { close $$fhref; $$fhref = $fh }
931 =item ocr_image IMAGE_SCALAR
933 Runs OCR on the provided image data and returns a list of text lines.
938 my $logo_data = shift;
940 #XXX use conf dir location from Makefile
941 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
942 my $fh = new File::Temp(
943 TEMPLATE => 'bizcard.XXXXXXXX',
944 SUFFIX => '.png', #XXX assuming, but should handle jpg, gif, etc. too
947 ) or die "can't open temp file: $!\n";
949 my $filename = $fh->filename;
951 print $fh $logo_data;
954 run( [qw(ocroscript recognize), $filename], '>'=>"$filename.hocr" )
955 or die "ocroscript recognize failed\n";
957 run( [qw(ocroscript hocr-to-text), "$filename.hocr"], '>pipe'=>\*OUT )
958 or die "ocroscript hocr-to-text failed\n";
960 my @lines = split(/\n/, <OUT> );
962 foreach (@lines) { s/\.c0m\s*$/.com/; }
967 =item bytes_substr STRING, OFFSET[, LENGTH[, REPLACEMENT] ]
969 A replacement for "substr" that counts raw bytes rather than logical
970 characters. Unlike "bytes::substr", will suppress fragmented UTF-8 characters
971 rather than output them. Unlike real "substr", is not an lvalue.
976 my ($string, $offset, $length, $repl) = @_;
978 Encode::encode('utf8', $string),
981 Encode::encode('utf8', $repl)
983 my $chk = $DEBUG ? Encode::FB_WARN : Encode::FB_QUIET;
984 return Encode::decode('utf8', $bytes, $chk);
989 Accepts a postive or negative numerical value.
990 Returns amount formatted for display,
991 including money character.
997 my $money_char = $conf->{'money_char'} || '$';
998 $amount = sprintf("%0.2f",$amount);
999 $amount =~ s/^(-?)/$1$money_char/;
1007 This package exists.
1011 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
1013 L<Fax::Hylafax::Client>