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 $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 'Charset' => 'UTF-8',
371 #'Encoding' => '7bit',
373 'Disposition' => 'inline',
377 if ( ref($args{'html_body'}) eq 'ARRAY' ) {
378 @html_data = @{ $args{'html_body'} };
380 @html_data = split(/\n/, $args{'html_body'});
383 $alternative->attach(
384 'Type' => 'text/html',
385 'Encoding' => 'quoted-printable',
386 'Data' => [ '<html>',
389 ' '. encode_entities($return{'subject'}),
392 ' <body bgcolor="#ffffff">',
397 'Disposition' => 'inline',
398 #'Filename' => 'invoice.pdf',
401 #no other attachment:
403 # multipart/alternative
407 $return{'content-type'} = 'multipart/related';
408 $return{'mimeparts'} = [ $alternative ];
409 $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
410 #$return{'disposition'} = 'inline';
416 =item process_send_email OPTION => VALUE ...
418 Takes arguments as per generate_email() and sends the message. This
419 will die on any error and can be used in the job queue.
423 sub process_send_email {
425 my $error = send_email(generate_email(%message));
426 die "$error\n" if $error;
430 =item process_send_generated_email OPTION => VALUE ...
432 Takes arguments as per send_email() and sends the message. This
433 will die on any error and can be used in the job queue.
437 sub process_send_generated_email {
439 my $error = send_email(%args);
440 die "$error\n" if $error;
444 =item send_fax OPTION => VALUE ...
448 I<dialstring> - (required) 10-digit phone number w/ area code
450 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
454 I<docfile> - (required) Filename of PostScript TIFF Class F document
456 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
465 die 'HylaFAX support has not been configured.'
466 unless $conf->exists('hylafax');
469 require Fax::Hylafax::Client;
473 if ($@ =~ /^Can't locate Fax.*/) {
474 die "You must have Fax::Hylafax::Client installed to use invoice faxing."
480 my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
482 die 'Called send_fax without a \'dialstring\'.'
483 unless exists($options{'dialstring'});
485 if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
486 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
487 my $fh = new File::Temp(
488 TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
491 ) or die "can't open temp file: $!\n";
493 $options{docfile} = $fh->filename;
495 print $fh @{$options{'docdata'}};
498 delete $options{'docdata'};
501 die 'Called send_fax without a \'docfile\' or \'docdata\'.'
502 unless exists($options{'docfile'});
504 #FIXME: Need to send canonical dialstring to HylaFAX, but this only
507 $options{'dialstring'} =~ s/[^\d\+]//g;
508 if ($options{'dialstring'} =~ /^\d{10}$/) {
509 $options{dialstring} = '+1' . $options{'dialstring'};
511 return 'Invalid dialstring ' . $options{'dialstring'} . '.';
514 my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
516 if ($faxjob->success) {
517 warn "Successfully queued fax to '$options{dialstring}' with jobid " .
522 return 'Error while sending FAX: ' . $faxjob->trace;
527 =item states_hash COUNTRY
529 Returns a list of key/value pairs containing state (or other sub-country
530 division) abbriviations and names.
534 use FS::Record qw(qsearch);
535 use Locale::SubCountry;
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 =item counties STATE COUNTRY
564 Returns a list of counties for this state and country.
569 my( $state, $country ) = @_;
571 map { $_ } #return num_counties($state, $country) unless wantarray;
572 sort map { s/[\n\r]//g; $_; }
575 'select' => 'DISTINCT county',
576 'table' => 'cust_main_county',
577 'hashref' => { 'state' => $state,
578 'country' => $country,
583 =item cities COUNTY STATE COUNTRY
585 Returns a list of cities for this county, state and country.
590 my( $county, $state, $country ) = @_;
592 map { $_ } #return num_cities($county, $state, $country) unless wantarray;
593 sort map { s/[\n\r]//g; $_; }
596 'select' => 'DISTINCT city',
597 'table' => 'cust_main_county',
598 'hashref' => { 'county' => $county,
600 'country' => $country,
605 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
610 my( $state, $country ) = @_;
612 unless ( ref($country) ) {
613 $country = eval { new Locale::SubCountry($country) }
618 # US kludge to avoid changing existing behaviour
619 # also we actually *use* the abbriviations...
620 my $full_name = $country->country_code eq 'US'
622 : $country->full_name($state);
624 $full_name = '' if $full_name eq 'unknown';
625 $full_name =~ s/\(see also.*\)\s*$//;
626 $full_name .= " ($state)" if $full_name;
628 $full_name || $state || '(n/a)';
634 Returns a hash reference of the accepted credit card types. Keys are shorter
635 identifiers and values are the longer strings used by the system (see
636 L<Business::CreditCard>).
643 my $conf = new FS::Conf;
646 #displayname #value (Business::CreditCard)
647 "VISA" => "VISA card",
648 "MasterCard" => "MasterCard",
649 "Discover" => "Discover card",
650 "American Express" => "American Express card",
651 "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
652 "enRoute" => "enRoute",
654 "BankCard" => "BankCard",
655 "Switch" => "Switch",
658 my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
659 if ( @conf_card_types ) {
660 #perhaps the hash is backwards for this, but this way works better for
661 #usage in selfservice
662 %card_types = map { $_ => $card_types{$_} }
665 grep { $card_types{$d} eq $_ } @conf_card_types
675 Returns a hash reference of allowed package billing frequencies.
680 tie my %freq, 'Tie::IxHash', (
681 '0' => '(no recurring fee)',
684 '2d' => 'every two days',
685 '3d' => 'every three days',
687 '2w' => 'biweekly (every 2 weeks)',
689 '45d' => 'every 45 days',
690 '2' => 'bimonthly (every 2 months)',
691 '3' => 'quarterly (every 3 months)',
692 '4' => 'every 4 months',
693 '137d' => 'every 4 1/2 months (137 days)',
694 '6' => 'semiannually (every 6 months)',
696 '13' => 'every 13 months (annually +1 month)',
697 '24' => 'biannually (every 2 years)',
698 '36' => 'triannually (every 3 years)',
699 '48' => '(every 4 years)',
700 '60' => '(every 5 years)',
701 '120' => '(every 10 years)',
706 =item generate_ps FILENAME
708 Returns an postscript rendition of the LaTex file, as a scalar.
709 FILENAME does not contain the .tex suffix and is unlinked by this function.
713 use String::ShellQuote;
718 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
723 my $papersize = $conf->config('papersize') || 'letter';
725 system('dvips', '-q', '-t', $papersize, "$file.dvi", '-o', "$file.ps" ) == 0
726 or die "dvips failed";
728 open(POSTSCRIPT, "<$file.ps")
729 or die "can't open $file.ps: $! (error in LaTeX template?)\n";
731 unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex")
732 unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
736 if ( $conf->exists('lpr-postscript_prefix') ) {
737 my $prefix = $conf->config('lpr-postscript_prefix');
738 $ps .= eval qq("$prefix");
741 while (<POSTSCRIPT>) {
747 if ( $conf->exists('lpr-postscript_suffix') ) {
748 my $suffix = $conf->config('lpr-postscript_suffix');
749 $ps .= eval qq("$suffix");
756 =item generate_pdf FILENAME
758 Returns an PDF rendition of the LaTex file, as a scalar. FILENAME does not
759 contain the .tex suffix and is unlinked by this function.
763 use String::ShellQuote;
768 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
771 #system('pdflatex', "$file.tex");
772 #system('pdflatex', "$file.tex");
773 #! LaTeX Error: Unknown graphics extension: .eps.
777 my $sfile = shell_quote $file;
779 #system('dvipdf', "$file.dvi", "$file.pdf" );
780 my $papersize = $conf->config('papersize') || 'letter';
783 "dvips -q -f $sfile.dvi -t $papersize ".
784 "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
787 or die "dvips | gs failed: $!";
789 open(PDF, "<$file.pdf")
790 or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
792 unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex")
793 unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
809 #my $sfile = shell_quote $file;
813 '-interaction=batchmode',
814 '\AtBeginDocument{\RequirePackage{pslatex}}',
815 '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
816 '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
821 my $timeout = 30; #? should be more than enough
825 local($SIG{CHLD}) = sub {};
826 run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
827 or warn "bad exit status from pslatex pass $_\n";
831 return if -e "$file.dvi" && -s "$file.dvi";
832 die "pslatex $file.tex failed, see $file.log for details?\n";
836 =item do_print ARRAYREF [, OPTION => VALUE ... ]
838 Sends the lines in ARRAYREF to the printer.
840 Options available are:
846 Uses this agent's 'lpr' configuration setting override instead of the global
851 Uses this command instead of the configured lpr command (overrides both the
852 global value and agentnum).
857 my( $data, %opt ) = @_;
859 my $lpr = ( exists($opt{'lpr'}) && $opt{'lpr'} )
861 : $conf->config('lpr', $opt{'agentnum'} );
864 run3 $lpr, $data, \$outerr, \$outerr;
866 $outerr = ": $outerr" if length($outerr);
867 die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
872 =item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ]
874 Converts the filehandle referenced by FILEREF from fixed length record
875 lines to a CSV file according to the lengths specified in LENGTH_LISTREF.
876 The CALLBACKS_LISTREF refers to a correpsonding list of coderefs. Each
877 should return the value to be substituted in place of its single argument.
879 Returns false on success or an error if one occurs.
884 my( $fhref, $countref, $lengths, $callbacks) = @_;
886 eval { require Text::CSV_XS; };
890 my $unpacker = new Text::CSV_XS;
892 my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths;
894 my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc";
895 my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX",
898 ) or return "can't open temp file: $!\n"
901 while ( defined(my $line=<$ofh>) ) {
907 return "unexpected input at line $$countref: $line".
908 " -- expected $total but received ". length($line)
909 unless length($line) == $total;
911 $unpacker->combine( map { my $i = $column++;
912 defined( $callbacks->[$i] )
913 ? &{ $callbacks->[$i] }( $_ )
915 } unpack( $template, $line )
917 or return "invalid data for CSV: ". $unpacker->error_input;
919 print $fh $unpacker->string(), "\n"
920 or return "can't write temp file: $!\n";
924 if ( $template ) { close $$fhref; $$fhref = $fh }
930 =item ocr_image IMAGE_SCALAR
932 Runs OCR on the provided image data and returns a list of text lines.
937 my $logo_data = shift;
939 #XXX use conf dir location from Makefile
940 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
941 my $fh = new File::Temp(
942 TEMPLATE => 'bizcard.XXXXXXXX',
943 SUFFIX => '.png', #XXX assuming, but should handle jpg, gif, etc. too
946 ) or die "can't open temp file: $!\n";
948 my $filename = $fh->filename;
950 print $fh $logo_data;
953 run( [qw(ocroscript recognize), $filename], '>'=>"$filename.hocr" )
954 or die "ocroscript recognize failed\n";
956 run( [qw(ocroscript hocr-to-text), "$filename.hocr"], '>pipe'=>\*OUT )
957 or die "ocroscript hocr-to-text failed\n";
959 my @lines = split(/\n/, <OUT> );
961 foreach (@lines) { s/\.c0m\s*$/.com/; }
966 =item bytes_substr STRING, OFFSET[, LENGTH[, REPLACEMENT] ]
968 A replacement for "substr" that counts raw bytes rather than logical
969 characters. Unlike "bytes::substr", will suppress fragmented UTF-8 characters
970 rather than output them. Unlike real "substr", is not an lvalue.
975 my ($string, $offset, $length, $repl) = @_;
977 Encode::encode('utf8', $string),
980 Encode::encode('utf8', $repl)
982 my $chk = $DEBUG ? Encode::FB_WARN : Encode::FB_QUIET;
983 return Encode::decode('utf8', $bytes, $chk);
988 Accepts a postive or negative numerical value.
989 Returns amount formatted for display,
990 including money character.
996 my $money_char = $conf->{'money_char'} || '$';
997 $amount = sprintf("%0.2f",$amount);
998 $amount =~ s/^(-?)/$1$money_char/;
1006 This package exists.
1010 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
1012 L<Fax::Hylafax::Client>