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 # fully unpack all addresses found in @to (including Bcc) to make the
262 foreach my $dest (@to) {
263 push @env_to, map { $_->address } Email::Address->parse($dest);
266 local $@; # just in case
267 eval { sendmail($message, { transport => $transport,
272 if(ref($@) and $@->isa('Email::Sender::Failure')) {
273 $error = $@->code.' ' if $@->code;
274 $error .= $@->message;
281 if ( $conf->exists('log_sent_mail') ) {
282 my $cust_msg = FS::cust_msg->new({
283 'env_from' => $options{'from'},
284 'env_to' => join(', ', @env_to),
285 'header' => $message->header_as_string,
286 'body' => $message->body_as_string,
289 'custnum' => $options{'custnum'},
290 'msgnum' => $options{'msgnum'},
291 'status' => ($error ? 'failed' : 'sent'),
292 'msgtype' => $options{'msgtype'},
294 my $log_error = $cust_msg->insert;
295 warn "Error logging message: $log_error\n" if $log_error; # at least warn
301 =item generate_email OPTION => VALUE ...
309 Sender address, required
313 Recipient address, required
317 Blind copy address, optional
321 email subject, required
325 Email body (HTML alternative). Arrayref of lines, or scalar.
327 Will be placed inside an HTML <BODY> tag.
331 Email body (Text alternative). Arrayref of lines, or scalar.
333 =item custnum, msgnum (optional)
335 Customer and template numbers, passed through to send_email for logging.
339 Constructs a multipart message from text_body and html_body.
343 #false laziness w/FS::cust_bill::generate_email
351 my $me = '[FS::Misc::generate_email]';
353 my @fields = qw(from to bcc subject custnum msgnum msgtype);
355 @return{@fields} = @args{@fields};
357 warn "$me creating HTML/text multipart message"
360 $return{'nobody'} = 1;
362 my $alternative = build MIME::Entity
363 'Type' => 'multipart/alternative',
364 'Encoding' => '7bit',
365 'Disposition' => 'inline'
369 if ( ref($args{'text_body'}) eq 'ARRAY' ) {
370 $data = join("\n", @{ $args{'text_body'} });
372 $data = $args{'text_body'};
375 $alternative->attach(
376 'Type' => 'text/plain',
377 'Encoding' => 'quoted-printable',
378 'Charset' => 'UTF-8',
379 #'Encoding' => '7bit',
381 'Disposition' => 'inline',
385 if ( ref($args{'html_body'}) eq 'ARRAY' ) {
386 @html_data = @{ $args{'html_body'} };
388 @html_data = split(/\n/, $args{'html_body'});
391 $alternative->attach(
392 'Type' => 'text/html',
393 'Encoding' => 'quoted-printable',
394 'Data' => [ '<html>',
397 ' '. encode_entities($return{'subject'}),
400 ' <body bgcolor="#ffffff">',
405 'Disposition' => 'inline',
406 #'Filename' => 'invoice.pdf',
409 #no other attachment:
411 # multipart/alternative
415 $return{'content-type'} = 'multipart/related';
416 $return{'mimeparts'} = [ $alternative ];
417 $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
418 #$return{'disposition'} = 'inline';
424 =item send_fax OPTION => VALUE ...
428 I<dialstring> - (required) 10-digit phone number w/ area code
430 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
434 I<docfile> - (required) Filename of PostScript TIFF Class F document
436 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
445 die 'HylaFAX support has not been configured.'
446 unless $conf->exists('hylafax');
449 require Fax::Hylafax::Client;
453 if ($@ =~ /^Can't locate Fax.*/) {
454 die "You must have Fax::Hylafax::Client installed to use invoice faxing."
460 my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
462 die 'Called send_fax without a \'dialstring\'.'
463 unless exists($options{'dialstring'});
465 if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
466 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
467 my $fh = new File::Temp(
468 TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
471 ) or die "can't open temp file: $!\n";
473 $options{docfile} = $fh->filename;
475 print $fh @{$options{'docdata'}};
478 delete $options{'docdata'};
481 die 'Called send_fax without a \'docfile\' or \'docdata\'.'
482 unless exists($options{'docfile'});
484 #FIXME: Need to send canonical dialstring to HylaFAX, but this only
487 $options{'dialstring'} =~ s/[^\d\+]//g;
488 if ($options{'dialstring'} =~ /^\d{10}$/) {
489 $options{dialstring} = '+1' . $options{'dialstring'};
491 return 'Invalid dialstring ' . $options{'dialstring'} . '.';
494 my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
496 if ($faxjob->success) {
497 warn "Successfully queued fax to '$options{dialstring}' with jobid " .
502 return 'Error while sending FAX: ' . $faxjob->trace;
507 =item states_hash COUNTRY
509 Returns a list of key/value pairs containing state (or other sub-country
510 division) abbriviations and names.
514 use FS::Record qw(qsearch);
515 use Locale::SubCountry;
520 #a hash? not expecting an explosion of business from unrecognized countries..
521 return states_hash_nosubcountry($country) if $country eq 'XC';
525 map { s/[\n\r]//g; $_; }
529 'table' => 'cust_main_county',
530 'hashref' => { 'country' => $country },
531 'extra_sql' => 'GROUP BY state',
534 #it could throw a fatal "Invalid country code" error (for example "AX")
535 my $subcountry = eval { new Locale::SubCountry($country) }
536 or return (); # ( '', '(n/a)' );
538 #"i see your schwartz is as big as mine!"
539 map { ( $_->[0] => $_->[1] ) }
540 sort { $a->[1] cmp $b->[1] }
541 map { [ $_ => state_label($_, $subcountry) ] }
545 sub states_hash_nosubcountry {
550 map { s/[\n\r]//g; $_; }
554 'table' => 'cust_main_county',
555 'hashref' => { 'country' => $country },
556 'extra_sql' => 'GROUP BY state',
559 #"i see your schwartz is as big as mine!"
560 map { ( $_->[0] => $_->[1] ) }
561 sort { $a->[1] cmp $b->[1] }
566 =item counties STATE COUNTRY
568 Returns a list of counties for this state and country.
573 my( $state, $country ) = @_;
575 map { $_ } #return num_counties($state, $country) unless wantarray;
576 sort map { s/[\n\r]//g; $_; }
579 'select' => 'DISTINCT county',
580 'table' => 'cust_main_county',
581 'hashref' => { 'state' => $state,
582 'country' => $country,
587 =item cities COUNTY STATE COUNTRY
589 Returns a list of cities for this county, state and country.
594 my( $county, $state, $country ) = @_;
596 map { $_ } #return num_cities($county, $state, $country) unless wantarray;
597 sort map { s/[\n\r]//g; $_; }
600 'select' => 'DISTINCT city',
601 'table' => 'cust_main_county',
602 'hashref' => { 'county' => $county,
604 'country' => $country,
609 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
614 my( $state, $country ) = @_;
616 unless ( ref($country) ) {
617 $country = eval { new Locale::SubCountry($country) }
622 # US kludge to avoid changing existing behaviour
623 # also we actually *use* the abbriviations...
624 my $full_name = $country->country_code eq 'US'
626 : $country->full_name($state);
628 $full_name = '' if $full_name eq 'unknown';
629 $full_name =~ s/\(see also.*\)\s*$//;
630 $full_name .= " ($state)" if $full_name;
632 $full_name || $state || '(n/a)';
638 Returns a hash reference of the accepted credit card types. Keys are shorter
639 identifiers and values are the longer strings used by the system (see
640 L<Business::CreditCard>).
647 my $conf = new FS::Conf;
650 #displayname #value (Business::CreditCard)
651 "VISA" => "VISA card",
652 "MasterCard" => "MasterCard",
653 "Discover" => "Discover card",
654 "American Express" => "American Express card",
655 "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
656 "enRoute" => "enRoute",
658 "BankCard" => "BankCard",
659 "Switch" => "Switch",
662 my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
663 if ( @conf_card_types ) {
664 #perhaps the hash is backwards for this, but this way works better for
665 #usage in selfservice
666 %card_types = map { $_ => $card_types{$_} }
669 grep { $card_types{$d} eq $_ } @conf_card_types
679 Returns a hash reference of allowed package billing frequencies.
684 tie my %freq, 'Tie::IxHash', (
685 '0' => '(no recurring fee)',
688 '2d' => 'every two days',
689 '3d' => 'every three days',
691 '2w' => 'biweekly (every 2 weeks)',
693 '45d' => 'every 45 days',
694 '2' => 'bimonthly (every 2 months)',
695 '3' => 'quarterly (every 3 months)',
696 '4' => 'every 4 months',
697 '137d' => 'every 4 1/2 months (137 days)',
698 '6' => 'semiannually (every 6 months)',
700 '13' => 'every 13 months (annually +1 month)',
701 '24' => 'biannually (every 2 years)',
702 '36' => 'triannually (every 3 years)',
703 '48' => '(every 4 years)',
704 '60' => '(every 5 years)',
705 '120' => '(every 10 years)',
710 =item generate_ps FILENAME
712 Returns an postscript rendition of the LaTex file, as a scalar.
713 FILENAME does not contain the .tex suffix and is unlinked by this function.
717 use String::ShellQuote;
722 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
727 my $papersize = $conf->config('papersize') || 'letter';
729 system('dvips', '-q', '-t', $papersize, "$file.dvi", '-o', "$file.ps" ) == 0
730 or die "dvips failed";
732 open(POSTSCRIPT, "<$file.ps")
733 or die "can't open $file.ps: $! (error in LaTeX template?)\n";
735 unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex")
736 unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
740 if ( $conf->exists('lpr-postscript_prefix') ) {
741 my $prefix = $conf->config('lpr-postscript_prefix');
742 $ps .= eval qq("$prefix");
745 while (<POSTSCRIPT>) {
751 if ( $conf->exists('lpr-postscript_suffix') ) {
752 my $suffix = $conf->config('lpr-postscript_suffix');
753 $ps .= eval qq("$suffix");
760 =item generate_pdf FILENAME
762 Returns an PDF rendition of the LaTex file, as a scalar. FILENAME does not
763 contain the .tex suffix and is unlinked by this function.
767 use String::ShellQuote;
772 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
775 #system('pdflatex', "$file.tex");
776 #system('pdflatex', "$file.tex");
777 #! LaTeX Error: Unknown graphics extension: .eps.
781 my $sfile = shell_quote $file;
783 #system('dvipdf', "$file.dvi", "$file.pdf" );
784 my $papersize = $conf->config('papersize') || 'letter';
787 "dvips -q -f $sfile.dvi -t $papersize ".
788 "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
791 or die "dvips | gs failed: $!";
793 open(PDF, "<$file.pdf")
794 or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
796 unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex")
797 unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
813 #my $sfile = shell_quote $file;
817 '-interaction=batchmode',
818 '\AtBeginDocument{\RequirePackage{pslatex}}',
819 '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
820 '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
825 my $timeout = 30; #? should be more than enough
829 local($SIG{CHLD}) = sub {};
830 run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
831 or warn "bad exit status from pslatex pass $_\n";
835 return if -e "$file.dvi" && -s "$file.dvi";
836 die "pslatex $file.tex failed, see $file.log for details?\n";
840 =item do_print ARRAYREF [, OPTION => VALUE ... ]
842 Sends the lines in ARRAYREF to the printer.
844 Options available are:
850 Uses this agent's 'lpr' configuration setting override instead of the global
855 Uses this command instead of the configured lpr command (overrides both the
856 global value and agentnum).
861 my( $data, %opt ) = @_;
863 my $lpr = ( exists($opt{'lpr'}) && $opt{'lpr'} )
865 : $conf->config('lpr', $opt{'agentnum'} );
868 run3 $lpr, $data, \$outerr, \$outerr;
870 $outerr = ": $outerr" if length($outerr);
871 die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
876 =item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ]
878 Converts the filehandle referenced by FILEREF from fixed length record
879 lines to a CSV file according to the lengths specified in LENGTH_LISTREF.
880 The CALLBACKS_LISTREF refers to a correpsonding list of coderefs. Each
881 should return the value to be substituted in place of its single argument.
883 Returns false on success or an error if one occurs.
888 my( $fhref, $countref, $lengths, $callbacks) = @_;
890 eval { require Text::CSV_XS; };
894 my $unpacker = new Text::CSV_XS;
896 my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths;
898 my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc";
899 my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX",
902 ) or return "can't open temp file: $!\n"
905 while ( defined(my $line=<$ofh>) ) {
911 return "unexpected input at line $$countref: $line".
912 " -- expected $total but received ". length($line)
913 unless length($line) == $total;
915 $unpacker->combine( map { my $i = $column++;
916 defined( $callbacks->[$i] )
917 ? &{ $callbacks->[$i] }( $_ )
919 } unpack( $template, $line )
921 or return "invalid data for CSV: ". $unpacker->error_input;
923 print $fh $unpacker->string(), "\n"
924 or return "can't write temp file: $!\n";
928 if ( $template ) { close $$fhref; $$fhref = $fh }
934 =item ocr_image IMAGE_SCALAR
936 Runs OCR on the provided image data and returns a list of text lines.
941 my $logo_data = shift;
943 #XXX use conf dir location from Makefile
944 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
945 my $fh = new File::Temp(
946 TEMPLATE => 'bizcard.XXXXXXXX',
947 SUFFIX => '.png', #XXX assuming, but should handle jpg, gif, etc. too
950 ) or die "can't open temp file: $!\n";
952 my $filename = $fh->filename;
954 print $fh $logo_data;
957 run( [qw(ocroscript recognize), $filename], '>'=>"$filename.hocr" )
958 or die "ocroscript recognize failed\n";
960 run( [qw(ocroscript hocr-to-text), "$filename.hocr"], '>pipe'=>\*OUT )
961 or die "ocroscript hocr-to-text failed\n";
963 my @lines = split(/\n/, <OUT> );
965 foreach (@lines) { s/\.c0m\s*$/.com/; }
970 =item bytes_substr STRING, OFFSET[, LENGTH[, REPLACEMENT] ]
972 A replacement for "substr" that counts raw bytes rather than logical
973 characters. Unlike "bytes::substr", will suppress fragmented UTF-8 characters
974 rather than output them. Unlike real "substr", is not an lvalue.
979 my ($string, $offset, $length, $repl) = @_;
981 Encode::encode('utf8', $string),
984 Encode::encode('utf8', $repl)
986 my $chk = $DEBUG ? Encode::FB_WARN : Encode::FB_QUIET;
987 return Encode::decode('utf8', $bytes, $chk);
992 Accepts a postive or negative numerical value.
993 Returns amount formatted for display,
994 including money character.
1000 my $money_char = $conf->{'money_char'} || '$';
1001 $amount = sprintf("%0.2f",$amount);
1002 $amount =~ s/^(-?)/$1$money_char/;
1010 This package exists.
1014 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
1016 L<Fax::Hylafax::Client>