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
12 #do NOT depend on any FS:: modules here, causes weird (sometimes unreproducable
13 #until on client machine) dependancy loops. put them in FS::Misc::Something
16 @ISA = qw( Exporter );
17 @EXPORT_OK = qw( send_email generate_email send_fax
18 states_hash counties cities state_label
21 generate_ps generate_pdf do_print
30 FS::Misc - Miscellaneous subroutines
34 use FS::Misc qw(send_email);
40 Miscellaneous subroutines. This module contains miscellaneous subroutines
41 called from multiple other modules. These are not OO or necessarily related,
42 but are collected here to eliminate code duplication.
48 =item send_email OPTION => VALUE ...
60 (required) comma-separated scalar or arrayref of recipients
68 (optional) MIME type for the body
72 (required unless I<nobody> is true) arrayref of body text lines
76 (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().
80 (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,
81 I<content-type>, if specified, overrides the default "multipart/mixed" for the outermost MIME container.
83 =item content-encoding
85 (optional) when using nobody, optional top-level MIME
86 encoding which, if specified, overrides the default "7bit".
90 (optional) type parameter for multipart/related messages
94 (optional) L<FS::cust_main> key; if passed, the message will be logged
95 (if logging is enabled) with this custnum.
99 (optional) L<FS::msg_template> key, for logging.
105 use vars qw( $conf );
108 use Email::Sender::Simple qw(sendmail);
109 use Email::Sender::Transport::SMTP;
110 use Email::Sender::Transport::SMTP::TLS;
113 FS::UID->install_callback( sub {
114 $conf = new FS::Conf;
120 my %doptions = %options;
121 $doptions{'body'} = '(full body not shown in debug)';
122 warn "FS::Misc::send_email called with options:\n ". Dumper(\%doptions);
123 # join("\n", map { " $_: ". $options{$_} } keys %options ). "\n"
126 my @to = ref($options{to}) ? @{ $options{to} } : ( $options{to} );
130 if ( $options{'nobody'} ) {
132 croak "'mimeparts' option required when 'nobody' option given\n"
133 unless $options{'mimeparts'};
135 @mimeparts = @{$options{'mimeparts'}};
138 'Type' => ( $options{'content-type'} || 'multipart/mixed' ),
139 'Encoding' => ( $options{'content-encoding'} || '7bit' ),
144 @mimeparts = @{$options{'mimeparts'}}
145 if ref($options{'mimeparts'}) eq 'ARRAY';
147 if (scalar(@mimeparts)) {
150 'Type' => 'multipart/mixed',
151 'Encoding' => '7bit',
154 unshift @mimeparts, {
155 'Type' => ( $options{'content-type'} || 'text/plain' ),
156 'Data' => $options{'body'},
157 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
158 'Disposition' => 'inline',
164 'Type' => ( $options{'content-type'} || 'text/plain' ),
165 'Data' => $options{'body'},
166 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
174 if ( $options{'from'} =~ /\@([\w\.\-]+)/ ) {
177 warn 'no domain found in invoice from address '. $options{'from'}.
178 '; constructing Message-ID (and saying HELO) @example.com';
179 $domain = 'example.com';
181 my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
184 my $message = MIME::Entity->build(
185 'From' => $options{'from'},
186 'To' => join(', ', @to),
187 'Sender' => $options{'from'},
188 'Reply-To' => $options{'from'},
189 'Date' => time2str("%a, %d %b %Y %X %z", $time),
190 'Subject' => $options{'subject'},
191 'Message-ID' => "<$message_id>",
195 if ( $options{'type'} ) {
196 #false laziness w/cust_bill::generate_email
197 $message->head->replace('Content-type',
199 '; boundary="'. $message->head->multipart_boundary. '"'.
200 '; type='. $options{'type'}
204 foreach my $part (@mimeparts) {
206 if ( UNIVERSAL::isa($part, 'MIME::Entity') ) {
208 warn "attaching MIME part from MIME::Entity object\n"
210 $message->add_part($part);
212 } elsif ( ref($part) eq 'HASH' ) {
214 warn "attaching MIME part from hashref:\n".
215 join("\n", map " $_: ".$part->{$_}, keys %$part ). "\n"
217 $message->attach(%$part);
220 croak "mimepart $part isn't a hashref or MIME::Entity object!";
227 my %smtp_opt = ( 'host' => $conf->config('smtpmachine'),
231 my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
232 $smtp_opt{'port'} = $port;
235 if ( defined($enc) && $enc eq 'starttls' ) {
236 $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password);
237 $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt );
239 if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
240 $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password);
242 $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls';
243 $transport = Email::Sender::Transport::SMTP->new( %smtp_opt );
246 push @to, $options{bcc} if defined($options{bcc});
247 local $@; # just in case
248 eval { sendmail($message, { transport => $transport,
249 from => $options{from},
253 if(ref($@) and $@->isa('Email::Sender::Failure')) {
254 $error = $@->code.' ' if $@->code;
255 $error .= $@->message;
262 if ( $conf->exists('log_sent_mail') and $options{'custnum'} ) {
263 my $cust_msg = FS::cust_msg->new({
264 'env_from' => $options{'from'},
265 'env_to' => join(', ', @to),
266 'header' => $message->header_as_string,
267 'body' => $message->body_as_string,
270 'custnum' => $options{'custnum'},
271 'msgnum' => $options{'msgnum'},
272 'status' => ($error ? 'failed' : 'sent'),
274 $cust_msg->insert; # ignore errors
279 =item generate_email OPTION => VALUE ...
287 Sender address, required
291 Recipient address, required
295 Blind copy address, optional
299 email subject, required
303 Email body (HTML alternative). Arrayref of lines, or scalar.
305 Will be placed inside an HTML <BODY> tag.
309 Email body (Text alternative). Arrayref of lines, or scalar.
311 =item custnum, msgnum (optional)
313 Customer and template numbers, passed through to send_email for logging.
317 Constructs a multipart message from text_body and html_body.
321 #false laziness w/FS::cust_bill::generate_email
329 my $me = '[FS::Misc::generate_email]';
331 my @fields = qw(from to bcc subject custnum msgnum);
333 @return{@fields} = @args{@fields};
335 warn "$me creating HTML/text multipart message"
338 $return{'nobody'} = 1;
340 my $alternative = build MIME::Entity
341 'Type' => 'multipart/alternative',
342 'Encoding' => '7bit',
343 'Disposition' => 'inline'
347 if ( ref($args{'text_body'}) eq 'ARRAY' ) {
348 $data = join("\n", @{ $args{'text_body'} });
350 $data = $args{'text_body'};
353 $alternative->attach(
354 'Type' => 'text/plain',
355 #'Encoding' => 'quoted-printable',
356 'Encoding' => '7bit',
358 'Disposition' => 'inline',
362 if ( ref($args{'html_body'}) eq 'ARRAY' ) {
363 @html_data = @{ $args{'html_body'} };
365 @html_data = split(/\n/, $args{'html_body'});
368 $alternative->attach(
369 'Type' => 'text/html',
370 'Encoding' => 'quoted-printable',
371 'Data' => [ '<html>',
374 ' '. encode_entities($return{'subject'}),
377 ' <body bgcolor="#e8e8e8">',
382 'Disposition' => 'inline',
383 #'Filename' => 'invoice.pdf',
386 #no other attachment:
388 # multipart/alternative
392 $return{'content-type'} = 'multipart/related';
393 $return{'mimeparts'} = [ $alternative ];
394 $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
395 #$return{'disposition'} = 'inline';
401 =item process_send_email OPTION => VALUE ...
403 Takes arguments as per generate_email() and sends the message. This
404 will die on any error and can be used in the job queue.
408 sub process_send_email {
410 my $error = send_email(generate_email(%message));
411 die "$error\n" if $error;
415 =item send_fax OPTION => VALUE ...
419 I<dialstring> - (required) 10-digit phone number w/ area code
421 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
425 I<docfile> - (required) Filename of PostScript TIFF Class F document
427 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
436 die 'HylaFAX support has not been configured.'
437 unless $conf->exists('hylafax');
440 require Fax::Hylafax::Client;
444 if ($@ =~ /^Can't locate Fax.*/) {
445 die "You must have Fax::Hylafax::Client installed to use invoice faxing."
451 my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
453 die 'Called send_fax without a \'dialstring\'.'
454 unless exists($options{'dialstring'});
456 if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
457 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
458 my $fh = new File::Temp(
459 TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
462 ) or die "can't open temp file: $!\n";
464 $options{docfile} = $fh->filename;
466 print $fh @{$options{'docdata'}};
469 delete $options{'docdata'};
472 die 'Called send_fax without a \'docfile\' or \'docdata\'.'
473 unless exists($options{'docfile'});
475 #FIXME: Need to send canonical dialstring to HylaFAX, but this only
478 $options{'dialstring'} =~ s/[^\d\+]//g;
479 if ($options{'dialstring'} =~ /^\d{10}$/) {
480 $options{dialstring} = '+1' . $options{'dialstring'};
482 return 'Invalid dialstring ' . $options{'dialstring'} . '.';
485 my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
487 if ($faxjob->success) {
488 warn "Successfully queued fax to '$options{dialstring}' with jobid " .
493 return 'Error while sending FAX: ' . $faxjob->trace;
498 =item states_hash COUNTRY
500 Returns a list of key/value pairs containing state (or other sub-country
501 division) abbriviations and names.
505 use FS::Record qw(qsearch);
506 use Locale::SubCountry;
513 map { s/[\n\r]//g; $_; }
517 'table' => 'cust_main_county',
518 'hashref' => { 'country' => $country },
519 'extra_sql' => 'GROUP BY state',
522 #it could throw a fatal "Invalid country code" error (for example "AX")
523 my $subcountry = eval { new Locale::SubCountry($country) }
524 or return ( '', '(n/a)' );
526 #"i see your schwartz is as big as mine!"
527 map { ( $_->[0] => $_->[1] ) }
528 sort { $a->[1] cmp $b->[1] }
529 map { [ $_ => state_label($_, $subcountry) ] }
533 =item counties STATE COUNTRY
535 Returns a list of counties for this state and country.
540 my( $state, $country ) = @_;
542 map { $_ } #return num_counties($state, $country) unless wantarray;
543 sort map { s/[\n\r]//g; $_; }
546 'select' => 'DISTINCT county',
547 'table' => 'cust_main_county',
548 'hashref' => { 'state' => $state,
549 'country' => $country,
554 =item cities COUNTY STATE COUNTRY
556 Returns a list of cities for this county, state and country.
561 my( $county, $state, $country ) = @_;
563 map { $_ } #return num_cities($county, $state, $country) unless wantarray;
564 sort map { s/[\n\r]//g; $_; }
567 'select' => 'DISTINCT city',
568 'table' => 'cust_main_county',
569 'hashref' => { 'county' => $county,
571 'country' => $country,
576 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
581 my( $state, $country ) = @_;
583 unless ( ref($country) ) {
584 $country = eval { new Locale::SubCountry($country) }
589 # US kludge to avoid changing existing behaviour
590 # also we actually *use* the abbriviations...
591 my $full_name = $country->country_code eq 'US'
593 : $country->full_name($state);
595 $full_name = '' if $full_name eq 'unknown';
596 $full_name =~ s/\(see also.*\)\s*$//;
597 $full_name .= " ($state)" if $full_name;
599 $full_name || $state || '(n/a)';
605 Returns a hash reference of the accepted credit card types. Keys are shorter
606 identifiers and values are the longer strings used by the system (see
607 L<Business::CreditCard>).
614 my $conf = new FS::Conf;
617 #displayname #value (Business::CreditCard)
618 "VISA" => "VISA card",
619 "MasterCard" => "MasterCard",
620 "Discover" => "Discover card",
621 "American Express" => "American Express card",
622 "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
623 "enRoute" => "enRoute",
625 "BankCard" => "BankCard",
626 "Switch" => "Switch",
629 my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
630 if ( @conf_card_types ) {
631 #perhaps the hash is backwards for this, but this way works better for
632 #usage in selfservice
633 %card_types = map { $_ => $card_types{$_} }
636 grep { $card_types{$d} eq $_ } @conf_card_types
646 Returns a hash reference of allowed package billing frequencies.
651 tie my %freq, 'Tie::IxHash', (
652 '0' => '(no recurring fee)',
655 '2d' => 'every two days',
656 '3d' => 'every three days',
658 '2w' => 'biweekly (every 2 weeks)',
660 '45d' => 'every 45 days',
661 '2' => 'bimonthly (every 2 months)',
662 '3' => 'quarterly (every 3 months)',
663 '4' => 'every 4 months',
664 '137d' => 'every 4 1/2 months (137 days)',
665 '6' => 'semiannually (every 6 months)',
667 '13' => 'every 13 months (annually +1 month)',
668 '24' => 'biannually (every 2 years)',
669 '36' => 'triannually (every 3 years)',
670 '48' => '(every 4 years)',
671 '60' => '(every 5 years)',
672 '120' => '(every 10 years)',
677 =item generate_ps FILENAME
679 Returns an postscript rendition of the LaTex file, as a scalar.
680 FILENAME does not contain the .tex suffix and is unlinked by this function.
684 use String::ShellQuote;
689 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
694 system('dvips', '-q', '-t', 'letter', "$file.dvi", '-o', "$file.ps" ) == 0
695 or die "dvips failed";
697 open(POSTSCRIPT, "<$file.ps")
698 or die "can't open $file.ps: $! (error in LaTeX template?)\n";
700 unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex");
704 if ( $conf->exists('lpr-postscript_prefix') ) {
705 my $prefix = $conf->config('lpr-postscript_prefix');
706 $ps .= eval qq("$prefix");
709 while (<POSTSCRIPT>) {
715 if ( $conf->exists('lpr-postscript_suffix') ) {
716 my $suffix = $conf->config('lpr-postscript_suffix');
717 $ps .= eval qq("$suffix");
724 =item generate_pdf FILENAME
726 Returns an PDF rendition of the LaTex file, as a scalar. FILENAME does not
727 contain the .tex suffix and is unlinked by this function.
731 use String::ShellQuote;
736 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
739 #system('pdflatex', "$file.tex");
740 #system('pdflatex', "$file.tex");
741 #! LaTeX Error: Unknown graphics extension: .eps.
745 my $sfile = shell_quote $file;
747 #system('dvipdf', "$file.dvi", "$file.pdf" );
749 "dvips -q -t letter -f $sfile.dvi ".
750 "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
753 or die "dvips | gs failed: $!";
755 open(PDF, "<$file.pdf")
756 or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
758 unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex");
774 #my $sfile = shell_quote $file;
778 '-interaction=batchmode',
779 '\AtBeginDocument{\RequirePackage{pslatex}}',
780 '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
781 '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
786 my $timeout = 30; #? should be more than enough
790 local($SIG{CHLD}) = sub {};
791 run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
792 or warn "bad exit status from pslatex pass $_\n";
796 return if -e "$file.dvi" && -s "$file.dvi";
797 die "pslatex $file.tex failed; see $file.log for details?\n";
803 Sends the lines in ARRAYREF to the printer.
810 my $lpr = $conf->config('lpr');
813 run3 $lpr, $data, \$outerr, \$outerr;
815 $outerr = ": $outerr" if length($outerr);
816 die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
821 =item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ]
823 Converts the filehandle referenced by FILEREF from fixed length record
824 lines to a CSV file according to the lengths specified in LENGTH_LISTREF.
825 The CALLBACKS_LISTREF refers to a correpsonding list of coderefs. Each
826 should return the value to be substituted in place of its single argument.
828 Returns false on success or an error if one occurs.
833 my( $fhref, $countref, $lengths, $callbacks) = @_;
835 eval { require Text::CSV_XS; };
839 my $unpacker = new Text::CSV_XS;
841 my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths;
843 my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc";
844 my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX",
847 ) or return "can't open temp file: $!\n"
850 while ( defined(my $line=<$ofh>) ) {
856 return "unexpected input at line $$countref: $line".
857 " -- expected $total but received ". length($line)
858 unless length($line) == $total;
860 $unpacker->combine( map { my $i = $column++;
861 defined( $callbacks->[$i] )
862 ? &{ $callbacks->[$i] }( $_ )
864 } unpack( $template, $line )
866 or return "invalid data for CSV: ". $unpacker->error_input;
868 print $fh $unpacker->string(), "\n"
869 or return "can't write temp file: $!\n";
873 if ( $template ) { close $$fhref; $$fhref = $fh }
879 =item ocr_image IMAGE_SCALAR
881 Runs OCR on the provided image data and returns a list of text lines.
886 my $logo_data = shift;
888 #XXX use conf dir location from Makefile
889 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
890 my $fh = new File::Temp(
891 TEMPLATE => 'bizcard.XXXXXXXX',
892 SUFFIX => '.png', #XXX assuming, but should handle jpg, gif, etc. too
895 ) or die "can't open temp file: $!\n";
897 my $filename = $fh->filename;
899 print $fh $logo_data;
902 run( [qw(ocroscript recognize), $filename], '>'=>"$filename.hocr" )
903 or die "ocroscript recognize failed\n";
905 run( [qw(ocroscript hocr-to-text), "$filename.hocr"], '>pipe'=>\*OUT )
906 or die "ocroscript hocr-to-text failed\n";
908 my @lines = split(/\n/, <OUT> );
910 foreach (@lines) { s/\.c0m\s*$/.com/; }
923 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
925 L<Fax::Hylafax::Client>