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});
258 my @env_to = split(/\s*,\s*/, join(', ', @to));
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 $cust_msg->insert; # ignore errors
293 =item generate_email OPTION => VALUE ...
301 Sender address, required
305 Recipient address, required
309 Blind copy address, optional
313 email subject, required
317 Email body (HTML alternative). Arrayref of lines, or scalar.
319 Will be placed inside an HTML <BODY> tag.
323 Email body (Text alternative). Arrayref of lines, or scalar.
325 =item custnum, msgnum (optional)
327 Customer and template numbers, passed through to send_email for logging.
331 Constructs a multipart message from text_body and html_body.
335 #false laziness w/FS::cust_bill::generate_email
343 my $me = '[FS::Misc::generate_email]';
345 my @fields = qw(from to bcc subject custnum msgnum msgtype);
347 @return{@fields} = @args{@fields};
349 warn "$me creating HTML/text multipart message"
352 $return{'nobody'} = 1;
354 my $alternative = build MIME::Entity
355 'Type' => 'multipart/alternative',
356 'Encoding' => '7bit',
357 'Disposition' => 'inline'
361 if ( ref($args{'text_body'}) eq 'ARRAY' ) {
362 $data = join("\n", @{ $args{'text_body'} });
364 $data = $args{'text_body'};
367 $alternative->attach(
368 'Type' => 'text/plain',
369 'Encoding' => 'quoted-printable',
370 #'Encoding' => '7bit',
372 'Disposition' => 'inline',
376 if ( ref($args{'html_body'}) eq 'ARRAY' ) {
377 @html_data = @{ $args{'html_body'} };
379 @html_data = split(/\n/, $args{'html_body'});
382 $alternative->attach(
383 'Type' => 'text/html',
384 'Encoding' => 'quoted-printable',
385 'Data' => [ '<html>',
388 ' '. encode_entities($return{'subject'}),
391 ' <body bgcolor="#ffffff">',
396 'Disposition' => 'inline',
397 #'Filename' => 'invoice.pdf',
400 #no other attachment:
402 # multipart/alternative
406 $return{'content-type'} = 'multipart/related';
407 $return{'mimeparts'} = [ $alternative ];
408 $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
409 #$return{'disposition'} = 'inline';
415 =item process_send_email OPTION => VALUE ...
417 Takes arguments as per generate_email() and sends the message. This
418 will die on any error and can be used in the job queue.
422 sub process_send_email {
424 my $error = send_email(generate_email(%message));
425 die "$error\n" if $error;
429 =item process_send_generated_email OPTION => VALUE ...
431 Takes arguments as per send_email() and sends the message. This
432 will die on any error and can be used in the job queue.
436 sub process_send_generated_email {
438 my $error = send_email(%args);
439 die "$error\n" if $error;
443 =item send_fax OPTION => VALUE ...
447 I<dialstring> - (required) 10-digit phone number w/ area code
449 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
453 I<docfile> - (required) Filename of PostScript TIFF Class F document
455 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
464 die 'HylaFAX support has not been configured.'
465 unless $conf->exists('hylafax');
468 require Fax::Hylafax::Client;
472 if ($@ =~ /^Can't locate Fax.*/) {
473 die "You must have Fax::Hylafax::Client installed to use invoice faxing."
479 my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
481 die 'Called send_fax without a \'dialstring\'.'
482 unless exists($options{'dialstring'});
484 if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
485 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
486 my $fh = new File::Temp(
487 TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
490 ) or die "can't open temp file: $!\n";
492 $options{docfile} = $fh->filename;
494 print $fh @{$options{'docdata'}};
497 delete $options{'docdata'};
500 die 'Called send_fax without a \'docfile\' or \'docdata\'.'
501 unless exists($options{'docfile'});
503 #FIXME: Need to send canonical dialstring to HylaFAX, but this only
506 $options{'dialstring'} =~ s/[^\d\+]//g;
507 if ($options{'dialstring'} =~ /^\d{10}$/) {
508 $options{dialstring} = '+1' . $options{'dialstring'};
510 return 'Invalid dialstring ' . $options{'dialstring'} . '.';
513 my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
515 if ($faxjob->success) {
516 warn "Successfully queued fax to '$options{dialstring}' with jobid " .
521 return 'Error while sending FAX: ' . $faxjob->trace;
526 =item states_hash COUNTRY
528 Returns a list of key/value pairs containing state (or other sub-country
529 division) abbriviations and names.
533 use FS::Record qw(qsearch);
534 use Locale::SubCountry;
539 #a hash? not expecting an explosion of business from unrecognized countries..
540 return states_hash_nosubcountry($country) if $country eq 'XC';
544 map { s/[\n\r]//g; $_; }
548 'table' => 'cust_main_county',
549 'hashref' => { 'country' => $country },
550 'extra_sql' => 'GROUP BY state',
553 #it could throw a fatal "Invalid country code" error (for example "AX")
554 my $subcountry = eval { new Locale::SubCountry($country) }
555 or return (); # ( '', '(n/a)' );
557 #"i see your schwartz is as big as mine!"
558 map { ( $_->[0] => $_->[1] ) }
559 sort { $a->[1] cmp $b->[1] }
560 map { [ $_ => state_label($_, $subcountry) ] }
564 sub states_hash_nosubcountry {
569 map { s/[\n\r]//g; $_; }
573 'table' => 'cust_main_county',
574 'hashref' => { 'country' => $country },
575 'extra_sql' => 'GROUP BY state',
578 #"i see your schwartz is as big as mine!"
579 map { ( $_->[0] => $_->[1] ) }
580 sort { $a->[1] cmp $b->[1] }
585 =item counties STATE COUNTRY
587 Returns a list of counties for this state and country.
592 my( $state, $country ) = @_;
594 map { $_ } #return num_counties($state, $country) unless wantarray;
595 sort map { s/[\n\r]//g; $_; }
598 'select' => 'DISTINCT county',
599 'table' => 'cust_main_county',
600 'hashref' => { 'state' => $state,
601 'country' => $country,
606 =item cities COUNTY STATE COUNTRY
608 Returns a list of cities for this county, state and country.
613 my( $county, $state, $country ) = @_;
615 map { $_ } #return num_cities($county, $state, $country) unless wantarray;
616 sort map { s/[\n\r]//g; $_; }
619 'select' => 'DISTINCT city',
620 'table' => 'cust_main_county',
621 'hashref' => { 'county' => $county,
623 'country' => $country,
628 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
633 my( $state, $country ) = @_;
635 unless ( ref($country) ) {
636 $country = eval { new Locale::SubCountry($country) }
641 # US kludge to avoid changing existing behaviour
642 # also we actually *use* the abbriviations...
643 my $full_name = $country->country_code eq 'US'
645 : $country->full_name($state);
647 $full_name = '' if $full_name eq 'unknown';
648 $full_name =~ s/\(see also.*\)\s*$//;
649 $full_name .= " ($state)" if $full_name;
651 $full_name || $state || '(n/a)';
657 Returns a hash reference of the accepted credit card types. Keys are shorter
658 identifiers and values are the longer strings used by the system (see
659 L<Business::CreditCard>).
666 my $conf = new FS::Conf;
669 #displayname #value (Business::CreditCard)
670 "VISA" => "VISA card",
671 "MasterCard" => "MasterCard",
672 "Discover" => "Discover card",
673 "American Express" => "American Express card",
674 "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
675 "enRoute" => "enRoute",
677 "BankCard" => "BankCard",
678 "Switch" => "Switch",
681 my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
682 if ( @conf_card_types ) {
683 #perhaps the hash is backwards for this, but this way works better for
684 #usage in selfservice
685 %card_types = map { $_ => $card_types{$_} }
688 grep { $card_types{$d} eq $_ } @conf_card_types
698 Returns a hash reference of allowed package billing frequencies.
703 tie my %freq, 'Tie::IxHash', (
704 '0' => '(no recurring fee)',
707 '2d' => 'every two days',
708 '3d' => 'every three days',
710 '2w' => 'biweekly (every 2 weeks)',
712 '45d' => 'every 45 days',
713 '2' => 'bimonthly (every 2 months)',
714 '3' => 'quarterly (every 3 months)',
715 '4' => 'every 4 months',
716 '137d' => 'every 4 1/2 months (137 days)',
717 '6' => 'semiannually (every 6 months)',
719 '13' => 'every 13 months (annually +1 month)',
720 '24' => 'biannually (every 2 years)',
721 '36' => 'triannually (every 3 years)',
722 '48' => '(every 4 years)',
723 '60' => '(every 5 years)',
724 '120' => '(every 10 years)',
729 =item generate_ps FILENAME
731 Returns an postscript rendition of the LaTex file, as a scalar.
732 FILENAME does not contain the .tex suffix and is unlinked by this function.
736 use String::ShellQuote;
741 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
746 my $papersize = $conf->config('papersize') || 'letter';
748 system('dvips', '-q', '-t', $papersize, "$file.dvi", '-o', "$file.ps" ) == 0
749 or die "dvips failed";
751 open(POSTSCRIPT, "<$file.ps")
752 or die "can't open $file.ps: $! (error in LaTeX template?)\n";
754 unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex")
755 unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
759 if ( $conf->exists('lpr-postscript_prefix') ) {
760 my $prefix = $conf->config('lpr-postscript_prefix');
761 $ps .= eval qq("$prefix");
764 while (<POSTSCRIPT>) {
770 if ( $conf->exists('lpr-postscript_suffix') ) {
771 my $suffix = $conf->config('lpr-postscript_suffix');
772 $ps .= eval qq("$suffix");
779 =item generate_pdf FILENAME
781 Returns an PDF rendition of the LaTex file, as a scalar. FILENAME does not
782 contain the .tex suffix and is unlinked by this function.
786 use String::ShellQuote;
791 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
794 #system('pdflatex', "$file.tex");
795 #system('pdflatex', "$file.tex");
796 #! LaTeX Error: Unknown graphics extension: .eps.
800 my $sfile = shell_quote $file;
802 #system('dvipdf', "$file.dvi", "$file.pdf" );
803 my $papersize = $conf->config('papersize') || 'letter';
806 "dvips -q -f $sfile.dvi -t $papersize ".
807 "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
810 or die "dvips | gs failed: $!";
812 open(PDF, "<$file.pdf")
813 or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
815 unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex")
816 unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
832 #my $sfile = shell_quote $file;
836 '-interaction=batchmode',
837 '\AtBeginDocument{\RequirePackage{pslatex}}',
838 '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
839 '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
844 my $timeout = 30; #? should be more than enough
848 local($SIG{CHLD}) = sub {};
849 run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
850 or warn "bad exit status from pslatex pass $_\n";
854 return if -e "$file.dvi" && -s "$file.dvi";
855 die "pslatex $file.tex failed, see $file.log for details?\n";
859 =item do_print ARRAYREF [, OPTION => VALUE ... ]
861 Sends the lines in ARRAYREF to the printer.
863 Options available are:
869 Uses this agent's 'lpr' configuration setting override instead of the global
874 Uses this command instead of the configured lpr command (overrides both the
875 global value and agentnum).
880 my( $data, %opt ) = @_;
882 my $lpr = ( exists($opt{'lpr'}) && $opt{'lpr'} )
884 : $conf->config('lpr', $opt{'agentnum'} );
887 run3 $lpr, $data, \$outerr, \$outerr;
889 $outerr = ": $outerr" if length($outerr);
890 die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
895 =item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ]
897 Converts the filehandle referenced by FILEREF from fixed length record
898 lines to a CSV file according to the lengths specified in LENGTH_LISTREF.
899 The CALLBACKS_LISTREF refers to a correpsonding list of coderefs. Each
900 should return the value to be substituted in place of its single argument.
902 Returns false on success or an error if one occurs.
907 my( $fhref, $countref, $lengths, $callbacks) = @_;
909 eval { require Text::CSV_XS; };
913 my $unpacker = new Text::CSV_XS;
915 my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths;
917 my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc";
918 my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX",
921 ) or return "can't open temp file: $!\n"
924 while ( defined(my $line=<$ofh>) ) {
930 return "unexpected input at line $$countref: $line".
931 " -- expected $total but received ". length($line)
932 unless length($line) == $total;
934 $unpacker->combine( map { my $i = $column++;
935 defined( $callbacks->[$i] )
936 ? &{ $callbacks->[$i] }( $_ )
938 } unpack( $template, $line )
940 or return "invalid data for CSV: ". $unpacker->error_input;
942 print $fh $unpacker->string(), "\n"
943 or return "can't write temp file: $!\n";
947 if ( $template ) { close $$fhref; $$fhref = $fh }
953 =item ocr_image IMAGE_SCALAR
955 Runs OCR on the provided image data and returns a list of text lines.
960 my $logo_data = shift;
962 #XXX use conf dir location from Makefile
963 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
964 my $fh = new File::Temp(
965 TEMPLATE => 'bizcard.XXXXXXXX',
966 SUFFIX => '.png', #XXX assuming, but should handle jpg, gif, etc. too
969 ) or die "can't open temp file: $!\n";
971 my $filename = $fh->filename;
973 print $fh $logo_data;
976 run( [qw(ocroscript recognize), $filename], '>'=>"$filename.hocr" )
977 or die "ocroscript recognize failed\n";
979 run( [qw(ocroscript hocr-to-text), "$filename.hocr"], '>pipe'=>\*OUT )
980 or die "ocroscript hocr-to-text failed\n";
982 my @lines = split(/\n/, <OUT> );
984 foreach (@lines) { s/\.c0m\s*$/.com/; }
989 =item bytes_substr STRING, OFFSET[, LENGTH[, REPLACEMENT] ]
991 A replacement for "substr" that counts raw bytes rather than logical
992 characters. Unlike "bytes::substr", will suppress fragmented UTF-8 characters
993 rather than output them. Unlike real "substr", is not an lvalue.
998 my ($string, $offset, $length, $repl) = @_;
1000 Encode::encode('utf8', $string),
1003 Encode::encode('utf8', $repl)
1005 my $chk = $DEBUG ? Encode::FB_WARN : Encode::FB_QUIET;
1006 return Encode::decode('utf8', $bytes, $chk);
1011 Accepts a postive or negative numerical value.
1012 Returns amount formatted for display,
1013 including money character.
1019 my $money_char = $conf->{'money_char'} || '$';
1020 $amount = sprintf("%0.2f",$amount);
1021 $amount =~ s/^(-?)/$1$money_char/;
1029 This package exists.
1033 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
1035 L<Fax::Hylafax::Client>