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
29 FS::Misc - Miscellaneous subroutines
33 use FS::Misc qw(send_email);
39 Miscellaneous subroutines. This module contains miscellaneous subroutines
40 called from multiple other modules. These are not OO or necessarily related,
41 but are collected here to eliminate code duplication.
47 =item send_email OPTION => VALUE ...
59 (required) comma-separated scalar or arrayref of recipients
67 (optional) MIME type for the body
71 (required unless I<nobody> is true) arrayref of body text lines
75 (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().
79 (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,
80 I<content-type>, if specified, overrides the default "multipart/mixed" for the outermost MIME container.
82 =item content-encoding
84 (optional) when using nobody, optional top-level MIME
85 encoding which, if specified, overrides the default "7bit".
89 (optional) type parameter for multipart/related messages
98 use Email::Sender::Simple qw(sendmail);
99 use Email::Sender::Transport::SMTP;
100 use Email::Sender::Transport::SMTP::TLS;
103 FS::UID->install_callback( sub {
104 $conf = new FS::Conf;
110 my %doptions = %options;
111 $doptions{'body'} = '(full body not shown in debug)';
112 warn "FS::Misc::send_email called with options:\n ". Dumper(\%doptions);
113 # join("\n", map { " $_: ". $options{$_} } keys %options ). "\n"
116 my $to = ref($options{to}) ? join(', ', @{ $options{to} } ) : $options{to};
120 if ( $options{'nobody'} ) {
122 croak "'mimeparts' option required when 'nobody' option given\n"
123 unless $options{'mimeparts'};
125 @mimeparts = @{$options{'mimeparts'}};
128 'Type' => ( $options{'content-type'} || 'multipart/mixed' ),
129 'Encoding' => ( $options{'content-encoding'} || '7bit' ),
134 @mimeparts = @{$options{'mimeparts'}}
135 if ref($options{'mimeparts'}) eq 'ARRAY';
137 if (scalar(@mimeparts)) {
140 'Type' => 'multipart/mixed',
141 'Encoding' => '7bit',
144 unshift @mimeparts, {
145 'Type' => ( $options{'content-type'} || 'text/plain' ),
146 'Data' => $options{'body'},
147 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
148 'Disposition' => 'inline',
154 'Type' => ( $options{'content-type'} || 'text/plain' ),
155 'Data' => $options{'body'},
156 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
164 if ( $options{'from'} =~ /\@([\w\.\-]+)/ ) {
167 warn 'no domain found in invoice from address '. $options{'from'}.
168 '; constructing Message-ID (and saying HELO) @example.com';
169 $domain = 'example.com';
171 my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
173 my $message = MIME::Entity->build(
174 'From' => $options{'from'},
176 'Sender' => $options{'from'},
177 'Reply-To' => $options{'from'},
178 'Date' => time2str("%a, %d %b %Y %X %z", time),
179 'Subject' => $options{'subject'},
180 'Message-ID' => "<$message_id>",
184 if ( $options{'type'} ) {
185 #false laziness w/cust_bill::generate_email
186 $message->head->replace('Content-type',
188 '; boundary="'. $message->head->multipart_boundary. '"'.
189 '; type='. $options{'type'}
193 foreach my $part (@mimeparts) {
195 if ( UNIVERSAL::isa($part, 'MIME::Entity') ) {
197 warn "attaching MIME part from MIME::Entity object\n"
199 $message->add_part($part);
201 } elsif ( ref($part) eq 'HASH' ) {
203 warn "attaching MIME part from hashref:\n".
204 join("\n", map " $_: ".$part->{$_}, keys %$part ). "\n"
206 $message->attach(%$part);
209 croak "mimepart $part isn't a hashref or MIME::Entity object!";
216 my %smtp_opt = ( 'host' => $conf->config('smtpmachine'),
220 my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
221 $smtp_opt{'port'} = $port;
224 if ( defined($enc) && $enc eq 'starttls' ) {
225 $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password);
226 $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt );
228 if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
229 $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password);
231 $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls';
232 $transport = Email::Sender::Transport::SMTP->new( %smtp_opt );
235 local $@; # just in case
236 eval { sendmail($message, { transport => $transport }) };
238 if(ref($@) and $@->isa('Email::Sender::Failure')) {
239 return ($@->code ? $@->code.' ' : '').$@->message
246 =item generate_email OPTION => VALUE ...
254 Sender address, required
258 Recipient address, required
262 email subject, required
266 Email body (HTML alternative). Arrayref of lines, or scalar.
268 Will be placed inside an HTML <BODY> tag.
272 Email body (Text alternative). Arrayref of lines, or scalar.
276 Constructs a multipart message from text_body and html_body.
280 #false laziness w/FS::cust_bill::generate_email
288 my $me = '[FS::Misc::generate_email]';
291 'from' => $args{'from'},
293 'subject' => $args{'subject'},
296 #if (ref($args{'to'}) eq 'ARRAY') {
297 # $return{'to'} = $args{'to'};
299 # $return{'to'} = [ grep { $_ !~ /^(POST|FAX)$/ }
300 # $self->cust_main->invoicing_list
304 warn "$me creating HTML/text multipart message"
307 $return{'nobody'} = 1;
309 my $alternative = build MIME::Entity
310 'Type' => 'multipart/alternative',
311 'Encoding' => '7bit',
312 'Disposition' => 'inline'
316 if ( ref($args{'text_body'}) eq 'ARRAY' ) {
317 $data = $args{'text_body'};
319 $data = [ split(/\n/, $args{'text_body'}) ];
322 $alternative->attach(
323 'Type' => 'text/plain',
324 #'Encoding' => 'quoted-printable',
325 'Encoding' => '7bit',
327 'Disposition' => 'inline',
331 if ( ref($args{'html_body'}) eq 'ARRAY' ) {
332 @html_data = @{ $args{'html_body'} };
334 @html_data = split(/\n/, $args{'html_body'});
337 $alternative->attach(
338 'Type' => 'text/html',
339 'Encoding' => 'quoted-printable',
340 'Data' => [ '<html>',
343 ' '. encode_entities($return{'subject'}),
346 ' <body bgcolor="#e8e8e8">',
351 'Disposition' => 'inline',
352 #'Filename' => 'invoice.pdf',
355 #no other attachment:
357 # multipart/alternative
361 $return{'content-type'} = 'multipart/related';
362 $return{'mimeparts'} = [ $alternative ];
363 $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
364 #$return{'disposition'} = 'inline';
370 =item process_send_email OPTION => VALUE ...
372 Takes arguments as per generate_email() and sends the message. This
373 will die on any error and can be used in the job queue.
377 sub process_send_email {
379 my $error = send_email(generate_email(%message));
380 die "$error\n" if $error;
384 =item send_fax OPTION => VALUE ...
388 I<dialstring> - (required) 10-digit phone number w/ area code
390 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
394 I<docfile> - (required) Filename of PostScript TIFF Class F document
396 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
405 die 'HylaFAX support has not been configured.'
406 unless $conf->exists('hylafax');
409 require Fax::Hylafax::Client;
413 if ($@ =~ /^Can't locate Fax.*/) {
414 die "You must have Fax::Hylafax::Client installed to use invoice faxing."
420 my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
422 die 'Called send_fax without a \'dialstring\'.'
423 unless exists($options{'dialstring'});
425 if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
426 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
427 my $fh = new File::Temp(
428 TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
431 ) or die "can't open temp file: $!\n";
433 $options{docfile} = $fh->filename;
435 print $fh @{$options{'docdata'}};
438 delete $options{'docdata'};
441 die 'Called send_fax without a \'docfile\' or \'docdata\'.'
442 unless exists($options{'docfile'});
444 #FIXME: Need to send canonical dialstring to HylaFAX, but this only
447 $options{'dialstring'} =~ s/[^\d\+]//g;
448 if ($options{'dialstring'} =~ /^\d{10}$/) {
449 $options{dialstring} = '+1' . $options{'dialstring'};
451 return 'Invalid dialstring ' . $options{'dialstring'} . '.';
454 my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
456 if ($faxjob->success) {
457 warn "Successfully queued fax to '$options{dialstring}' with jobid " .
462 return 'Error while sending FAX: ' . $faxjob->trace;
467 =item states_hash COUNTRY
469 Returns a list of key/value pairs containing state (or other sub-country
470 division) abbriviations and names.
474 use FS::Record qw(qsearch);
475 use Locale::SubCountry;
482 map { s/[\n\r]//g; $_; }
486 'table' => 'cust_main_county',
487 'hashref' => { 'country' => $country },
488 'extra_sql' => 'GROUP BY state',
491 #it could throw a fatal "Invalid country code" error (for example "AX")
492 my $subcountry = eval { new Locale::SubCountry($country) }
493 or return ( '', '(n/a)' );
495 #"i see your schwartz is as big as mine!"
496 map { ( $_->[0] => $_->[1] ) }
497 sort { $a->[1] cmp $b->[1] }
498 map { [ $_ => state_label($_, $subcountry) ] }
502 =item counties STATE COUNTRY
504 Returns a list of counties for this state and country.
509 my( $state, $country ) = @_;
511 map { $_ } #return num_counties($state, $country) unless wantarray;
512 sort map { s/[\n\r]//g; $_; }
515 'select' => 'DISTINCT county',
516 'table' => 'cust_main_county',
517 'hashref' => { 'state' => $state,
518 'country' => $country,
523 =item cities COUNTY STATE COUNTRY
525 Returns a list of cities for this county, state and country.
530 my( $county, $state, $country ) = @_;
532 map { $_ } #return num_cities($county, $state, $country) unless wantarray;
533 sort map { s/[\n\r]//g; $_; }
536 'select' => 'DISTINCT city',
537 'table' => 'cust_main_county',
538 'hashref' => { 'county' => $county,
540 'country' => $country,
545 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
550 my( $state, $country ) = @_;
552 unless ( ref($country) ) {
553 $country = eval { new Locale::SubCountry($country) }
558 # US kludge to avoid changing existing behaviour
559 # also we actually *use* the abbriviations...
560 my $full_name = $country->country_code eq 'US'
562 : $country->full_name($state);
564 $full_name = '' if $full_name eq 'unknown';
565 $full_name =~ s/\(see also.*\)\s*$//;
566 $full_name .= " ($state)" if $full_name;
568 $full_name || $state || '(n/a)';
574 Returns a hash reference of the accepted credit card types. Keys are shorter
575 identifiers and values are the longer strings used by the system (see
576 L<Business::CreditCard>).
583 my $conf = new FS::Conf;
586 #displayname #value (Business::CreditCard)
587 "VISA" => "VISA card",
588 "MasterCard" => "MasterCard",
589 "Discover" => "Discover card",
590 "American Express" => "American Express card",
591 "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
592 "enRoute" => "enRoute",
594 "BankCard" => "BankCard",
595 "Switch" => "Switch",
598 my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
599 if ( @conf_card_types ) {
600 #perhaps the hash is backwards for this, but this way works better for
601 #usage in selfservice
602 %card_types = map { $_ => $card_types{$_} }
605 grep { $card_types{$d} eq $_ } @conf_card_types
615 Returns a hash reference of allowed package billing frequencies.
620 tie my %freq, 'Tie::IxHash', (
621 '0' => '(no recurring fee)',
624 '2d' => 'every two days',
625 '3d' => 'every three days',
627 '2w' => 'biweekly (every 2 weeks)',
629 '45d' => 'every 45 days',
630 '2' => 'bimonthly (every 2 months)',
631 '3' => 'quarterly (every 3 months)',
632 '4' => 'every 4 months',
633 '137d' => 'every 4 1/2 months (137 days)',
634 '6' => 'semiannually (every 6 months)',
636 '13' => 'every 13 months (annually +1 month)',
637 '24' => 'biannually (every 2 years)',
638 '36' => 'triannually (every 3 years)',
639 '48' => '(every 4 years)',
640 '60' => '(every 5 years)',
641 '120' => '(every 10 years)',
646 =item generate_ps FILENAME
648 Returns an postscript rendition of the LaTex file, as a scalar.
649 FILENAME does not contain the .tex suffix and is unlinked by this function.
653 use String::ShellQuote;
658 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
663 system('dvips', '-q', '-t', 'letter', "$file.dvi", '-o', "$file.ps" ) == 0
664 or die "dvips failed";
666 open(POSTSCRIPT, "<$file.ps")
667 or die "can't open $file.ps: $! (error in LaTeX template?)\n";
669 unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex");
673 if ( $conf->exists('lpr-postscript_prefix') ) {
674 my $prefix = $conf->config('lpr-postscript_prefix');
675 $ps .= eval qq("$prefix");
678 while (<POSTSCRIPT>) {
684 if ( $conf->exists('lpr-postscript_suffix') ) {
685 my $suffix = $conf->config('lpr-postscript_suffix');
686 $ps .= eval qq("$suffix");
693 =item generate_pdf FILENAME
695 Returns an PDF rendition of the LaTex file, as a scalar. FILENAME does not
696 contain the .tex suffix and is unlinked by this function.
700 use String::ShellQuote;
705 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
708 #system('pdflatex', "$file.tex");
709 #system('pdflatex', "$file.tex");
710 #! LaTeX Error: Unknown graphics extension: .eps.
714 my $sfile = shell_quote $file;
716 #system('dvipdf', "$file.dvi", "$file.pdf" );
718 "dvips -q -t letter -f $sfile.dvi ".
719 "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
722 or die "dvips | gs failed: $!";
724 open(PDF, "<$file.pdf")
725 or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
727 unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex");
743 #my $sfile = shell_quote $file;
747 '-interaction=batchmode',
748 '\AtBeginDocument{\RequirePackage{pslatex}}',
749 '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
750 '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
755 my $timeout = 30; #? should be more than enough
759 local($SIG{CHLD}) = sub {};
760 run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
761 or die "pslatex $file.tex failed; see $file.log for details?\n";
769 Sends the lines in ARRAYREF to the printer.
776 my $lpr = $conf->config('lpr');
779 run3 $lpr, $data, \$outerr, \$outerr;
781 $outerr = ": $outerr" if length($outerr);
782 die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
787 =item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ]
789 Converts the filehandle referenced by FILEREF from fixed length record
790 lines to a CSV file according to the lengths specified in LENGTH_LISTREF.
791 The CALLBACKS_LISTREF refers to a correpsonding list of coderefs. Each
792 should return the value to be substituted in place of its single argument.
794 Returns false on success or an error if one occurs.
799 my( $fhref, $countref, $lengths, $callbacks) = @_;
801 eval { require Text::CSV_XS; };
805 my $unpacker = new Text::CSV_XS;
807 my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths;
809 my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc";
810 my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX",
813 ) or return "can't open temp file: $!\n"
816 while ( defined(my $line=<$ofh>) ) {
822 return "unexpected input at line $$countref: $line".
823 " -- expected $total but received ". length($line)
824 unless length($line) == $total;
826 $unpacker->combine( map { my $i = $column++;
827 defined( $callbacks->[$i] )
828 ? &{ $callbacks->[$i] }( $_ )
830 } unpack( $template, $line )
832 or return "invalid data for CSV: ". $unpacker->error_input;
834 print $fh $unpacker->string(), "\n"
835 or return "can't write temp file: $!\n";
839 if ( $template ) { close $$fhref; $$fhref = $fh }
854 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
856 L<Fax::Hylafax::Client>