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
11 #do NOT depend on any FS:: modules here, causes weird (sometimes unreproducable
12 #until on client machine) dependancy loops. put them in FS::Misc::Something
15 @ISA = qw( Exporter );
16 @EXPORT_OK = qw( send_email generate_email send_fax
17 states_hash counties cities state_label
19 generate_ps generate_pdf do_print
27 FS::Misc - Miscellaneous subroutines
31 use FS::Misc qw(send_email);
37 Miscellaneous subroutines. This module contains miscellaneous subroutines
38 called from multiple other modules. These are not OO or necessarily related,
39 but are collected here to eliminate code duplication.
45 =item send_email OPTION => VALUE ...
57 (required) comma-separated scalar or arrayref of recipients
65 (optional) MIME type for the body
69 (required unless I<nobody> is true) arrayref of body text lines
73 (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().
77 (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,
78 I<content-type>, if specified, overrides the default "multipart/mixed" for the outermost MIME container.
80 =item content-encoding
82 (optional) when using nobody, optional top-level MIME
83 encoding which, if specified, overrides the default "7bit".
87 (optional) type parameter for multipart/related messages
96 use Email::Sender::Simple qw(sendmail);
97 use Email::Sender::Transport::SMTP;
98 use Email::Sender::Transport::SMTP::TLS;
101 FS::UID->install_callback( sub {
102 $conf = new FS::Conf;
108 my %doptions = %options;
109 $doptions{'body'} = '(full body not shown in debug)';
110 warn "FS::Misc::send_email called with options:\n ". Dumper(\%doptions);
111 # join("\n", map { " $_: ". $options{$_} } keys %options ). "\n"
114 my $to = ref($options{to}) ? join(', ', @{ $options{to} } ) : $options{to};
118 if ( $options{'nobody'} ) {
120 croak "'mimeparts' option required when 'nobody' option given\n"
121 unless $options{'mimeparts'};
123 @mimeparts = @{$options{'mimeparts'}};
126 'Type' => ( $options{'content-type'} || 'multipart/mixed' ),
127 'Encoding' => ( $options{'content-encoding'} || '7bit' ),
132 @mimeparts = @{$options{'mimeparts'}}
133 if ref($options{'mimeparts'}) eq 'ARRAY';
135 if (scalar(@mimeparts)) {
138 'Type' => 'multipart/mixed',
139 'Encoding' => '7bit',
142 unshift @mimeparts, {
143 'Type' => ( $options{'content-type'} || 'text/plain' ),
144 'Data' => $options{'body'},
145 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
146 'Disposition' => 'inline',
152 'Type' => ( $options{'content-type'} || 'text/plain' ),
153 'Data' => $options{'body'},
154 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
162 if ( $options{'from'} =~ /\@([\w\.\-]+)/ ) {
165 warn 'no domain found in invoice from address '. $options{'from'}.
166 '; constructing Message-ID (and saying HELO) @example.com';
167 $domain = 'example.com';
169 my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
171 my $message = MIME::Entity->build(
172 'From' => $options{'from'},
174 'Sender' => $options{'from'},
175 'Reply-To' => $options{'from'},
176 'Date' => time2str("%a, %d %b %Y %X %z", time),
177 'Subject' => $options{'subject'},
178 'Message-ID' => "<$message_id>",
182 if ( $options{'type'} ) {
183 #false laziness w/cust_bill::generate_email
184 $message->head->replace('Content-type',
186 '; boundary="'. $message->head->multipart_boundary. '"'.
187 '; type='. $options{'type'}
191 foreach my $part (@mimeparts) {
193 if ( UNIVERSAL::isa($part, 'MIME::Entity') ) {
195 warn "attaching MIME part from MIME::Entity object\n"
197 $message->add_part($part);
199 } elsif ( ref($part) eq 'HASH' ) {
201 warn "attaching MIME part from hashref:\n".
202 join("\n", map " $_: ".$part->{$_}, keys %$part ). "\n"
204 $message->attach(%$part);
207 croak "mimepart $part isn't a hashref or MIME::Entity object!";
214 my %smtp_opt = ( 'host' => $conf->config('smtpmachine'),
218 my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
219 $smtp_opt{'port'} = $port;
222 if ( defined($enc) && $enc eq 'starttls' ) {
223 $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password);
224 $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt );
226 if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
227 $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password);
229 $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls';
230 $transport = Email::Sender::Transport::SMTP->new( %smtp_opt );
233 local $@; # just in case
234 eval { sendmail($message, { transport => $transport }) };
236 if(ref($@) and $@->isa('Email::Sender::Failure')) {
237 return ($@->code ? $@->code.' ' : '').$@->message
244 =item generate_email OPTION => VALUE ...
252 Sender address, required
256 Recipient address, required
260 email subject, required
264 Email body (HTML alternative). Arrayref of lines, or scalar.
266 Will be placed inside an HTML <BODY> tag.
270 Email body (Text alternative). Arrayref of lines, or scalar.
274 Constructs a multipart message from text_body and html_body.
278 #false laziness w/FS::cust_bill::generate_email
286 my $me = '[FS::Misc::generate_email]';
289 'from' => $args{'from'},
291 'subject' => $args{'subject'},
294 #if (ref($args{'to'}) eq 'ARRAY') {
295 # $return{'to'} = $args{'to'};
297 # $return{'to'} = [ grep { $_ !~ /^(POST|FAX)$/ }
298 # $self->cust_main->invoicing_list
302 warn "$me creating HTML/text multipart message"
305 $return{'nobody'} = 1;
307 my $alternative = build MIME::Entity
308 'Type' => 'multipart/alternative',
309 'Encoding' => '7bit',
310 'Disposition' => 'inline'
314 if ( ref($args{'text_body'}) eq 'ARRAY' ) {
315 $data = $args{'text_body'};
317 $data = [ split(/\n/, $args{'text_body'}) ];
320 $alternative->attach(
321 'Type' => 'text/plain',
322 #'Encoding' => 'quoted-printable',
323 'Encoding' => '7bit',
325 'Disposition' => 'inline',
329 if ( ref($args{'html_body'}) eq 'ARRAY' ) {
330 @html_data = @{ $args{'html_body'} };
332 @html_data = split(/\n/, $args{'html_body'});
335 $alternative->attach(
336 'Type' => 'text/html',
337 'Encoding' => 'quoted-printable',
338 'Data' => [ '<html>',
341 ' '. encode_entities($return{'subject'}),
344 ' <body bgcolor="#e8e8e8">',
349 'Disposition' => 'inline',
350 #'Filename' => 'invoice.pdf',
353 #no other attachment:
355 # multipart/alternative
359 $return{'content-type'} = 'multipart/related';
360 $return{'mimeparts'} = [ $alternative ];
361 $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
362 #$return{'disposition'} = 'inline';
368 =item process_send_email OPTION => VALUE ...
370 Takes arguments as per generate_email() and sends the message. This
371 will die on any error and can be used in the job queue.
375 sub process_send_email {
377 my $error = send_email(generate_email(%message));
378 die "$error\n" if $error;
382 =item send_fax OPTION => VALUE ...
386 I<dialstring> - (required) 10-digit phone number w/ area code
388 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
392 I<docfile> - (required) Filename of PostScript TIFF Class F document
394 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
403 die 'HylaFAX support has not been configured.'
404 unless $conf->exists('hylafax');
407 require Fax::Hylafax::Client;
411 if ($@ =~ /^Can't locate Fax.*/) {
412 die "You must have Fax::Hylafax::Client installed to use invoice faxing."
418 my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
420 die 'Called send_fax without a \'dialstring\'.'
421 unless exists($options{'dialstring'});
423 if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
424 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
425 my $fh = new File::Temp(
426 TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
429 ) or die "can't open temp file: $!\n";
431 $options{docfile} = $fh->filename;
433 print $fh @{$options{'docdata'}};
436 delete $options{'docdata'};
439 die 'Called send_fax without a \'docfile\' or \'docdata\'.'
440 unless exists($options{'docfile'});
442 #FIXME: Need to send canonical dialstring to HylaFAX, but this only
445 $options{'dialstring'} =~ s/[^\d\+]//g;
446 if ($options{'dialstring'} =~ /^\d{10}$/) {
447 $options{dialstring} = '+1' . $options{'dialstring'};
449 return 'Invalid dialstring ' . $options{'dialstring'} . '.';
452 my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
454 if ($faxjob->success) {
455 warn "Successfully queued fax to '$options{dialstring}' with jobid " .
460 return 'Error while sending FAX: ' . $faxjob->trace;
465 =item states_hash COUNTRY
467 Returns a list of key/value pairs containing state (or other sub-country
468 division) abbriviations and names.
472 use FS::Record qw(qsearch);
473 use Locale::SubCountry;
480 map { s/[\n\r]//g; $_; }
484 'table' => 'cust_main_county',
485 'hashref' => { 'country' => $country },
486 'extra_sql' => 'GROUP BY state',
489 #it could throw a fatal "Invalid country code" error (for example "AX")
490 my $subcountry = eval { new Locale::SubCountry($country) }
491 or return ( '', '(n/a)' );
493 #"i see your schwartz is as big as mine!"
494 map { ( $_->[0] => $_->[1] ) }
495 sort { $a->[1] cmp $b->[1] }
496 map { [ $_ => state_label($_, $subcountry) ] }
500 =item counties STATE COUNTRY
502 Returns a list of counties for this state and country.
507 my( $state, $country ) = @_;
509 map { $_ } #return num_counties($state, $country) unless wantarray;
510 sort map { s/[\n\r]//g; $_; }
513 'select' => 'DISTINCT county',
514 'table' => 'cust_main_county',
515 'hashref' => { 'state' => $state,
516 'country' => $country,
521 =item cities COUNTY STATE COUNTRY
523 Returns a list of cities for this county, state and country.
528 my( $county, $state, $country ) = @_;
530 map { $_ } #return num_cities($county, $state, $country) unless wantarray;
531 sort map { s/[\n\r]//g; $_; }
534 'select' => 'DISTINCT city',
535 'table' => 'cust_main_county',
536 'hashref' => { 'county' => $county,
538 'country' => $country,
543 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
548 my( $state, $country ) = @_;
550 unless ( ref($country) ) {
551 $country = eval { new Locale::SubCountry($country) }
556 # US kludge to avoid changing existing behaviour
557 # also we actually *use* the abbriviations...
558 my $full_name = $country->country_code eq 'US'
560 : $country->full_name($state);
562 $full_name = '' if $full_name eq 'unknown';
563 $full_name =~ s/\(see also.*\)\s*$//;
564 $full_name .= " ($state)" if $full_name;
566 $full_name || $state || '(n/a)';
572 Returns a hash reference of the accepted credit card types. Keys are shorter
573 identifiers and values are the longer strings used by the system (see
574 L<Business::CreditCard>).
581 my $conf = new FS::Conf;
584 #displayname #value (Business::CreditCard)
585 "VISA" => "VISA card",
586 "MasterCard" => "MasterCard",
587 "Discover" => "Discover card",
588 "American Express" => "American Express card",
589 "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
590 "enRoute" => "enRoute",
592 "BankCard" => "BankCard",
593 "Switch" => "Switch",
596 my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
597 if ( @conf_card_types ) {
598 #perhaps the hash is backwards for this, but this way works better for
599 #usage in selfservice
600 %card_types = map { $_ => $card_types{$_} }
603 grep { $card_types{$d} eq $_ } @conf_card_types
611 =item generate_ps FILENAME
613 Returns an postscript rendition of the LaTex file, as a scalar.
614 FILENAME does not contain the .tex suffix and is unlinked by this function.
618 use String::ShellQuote;
623 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
628 system('dvips', '-q', '-t', 'letter', "$file.dvi", '-o', "$file.ps" ) == 0
629 or die "dvips failed";
631 open(POSTSCRIPT, "<$file.ps")
632 or die "can't open $file.ps: $! (error in LaTeX template?)\n";
634 unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex");
638 if ( $conf->exists('lpr-postscript_prefix') ) {
639 my $prefix = $conf->config('lpr-postscript_prefix');
640 $ps .= eval qq("$prefix");
643 while (<POSTSCRIPT>) {
649 if ( $conf->exists('lpr-postscript_suffix') ) {
650 my $suffix = $conf->config('lpr-postscript_suffix');
651 $ps .= eval qq("$suffix");
658 =item generate_pdf FILENAME
660 Returns an PDF rendition of the LaTex file, as a scalar. FILENAME does not
661 contain the .tex suffix and is unlinked by this function.
665 use String::ShellQuote;
670 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
673 #system('pdflatex', "$file.tex");
674 #system('pdflatex', "$file.tex");
675 #! LaTeX Error: Unknown graphics extension: .eps.
679 my $sfile = shell_quote $file;
681 #system('dvipdf', "$file.dvi", "$file.pdf" );
683 "dvips -q -t letter -f $sfile.dvi ".
684 "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
687 or die "dvips | gs failed: $!";
689 open(PDF, "<$file.pdf")
690 or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
692 unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex");
708 #my $sfile = shell_quote $file;
712 '-interaction=batchmode',
713 '\AtBeginDocument{\RequirePackage{pslatex}}',
714 '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
715 '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
720 my $timeout = 30; #? should be more than enough
724 local($SIG{CHLD}) = sub {};
725 run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
726 or die "pslatex $file.tex failed; see $file.log for details?\n";
734 Sends the lines in ARRAYREF to the printer.
741 my $lpr = $conf->config('lpr');
744 run3 $lpr, $data, \$outerr, \$outerr;
746 $outerr = ": $outerr" if length($outerr);
747 die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
752 =item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ]
754 Converts the filehandle referenced by FILEREF from fixed length record
755 lines to a CSV file according to the lengths specified in LENGTH_LISTREF.
756 The CALLBACKS_LISTREF refers to a correpsonding list of coderefs. Each
757 should return the value to be substituted in place of its single argument.
759 Returns false on success or an error if one occurs.
764 my( $fhref, $countref, $lengths, $callbacks) = @_;
766 eval { require Text::CSV_XS; };
770 my $unpacker = new Text::CSV_XS;
772 my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths;
774 my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc";
775 my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX",
778 ) or return "can't open temp file: $!\n"
781 while ( defined(my $line=<$ofh>) ) {
787 return "unexpected input at line $$countref: $line".
788 " -- expected $total but received ". length($line)
789 unless length($line) == $total;
791 $unpacker->combine( map { my $i = $column++;
792 defined( $callbacks->[$i] )
793 ? &{ $callbacks->[$i] }( $_ )
795 } unpack( $template, $line )
797 or return "invalid data for CSV: ". $unpacker->error_input;
799 print $fh $unpacker->string(), "\n"
800 or return "can't write temp file: $!\n";
804 if ( $template ) { close $$fhref; $$fhref = $fh }
819 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
821 L<Fax::Hylafax::Client>