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( generate_email send_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 elimiate code duplication.
45 =item generate_email OPTION => VALUE ...
53 Sender address, required
57 Recipient address, required
61 email subject, required
65 Email body (HTML alternative). Arrayref of lines, or scalar.
67 Will be placed inside an HTML <BODY> tag.
71 Email body (Text alternative). Arrayref of lines, or scalar.
75 Returns an argument list to be passsed to L<send_email>.
79 #false laziness w/FS::cust_bill::generate_email
87 my $me = '[FS::Misc::generate_email]';
90 'from' => $args{'from'},
92 'subject' => $args{'subject'},
95 #if (ref($args{'to'}) eq 'ARRAY') {
96 # $return{'to'} = $args{'to'};
98 # $return{'to'} = [ grep { $_ !~ /^(POST|FAX)$/ }
99 # $self->cust_main->invoicing_list
103 warn "$me creating HTML/text multipart message"
106 $return{'nobody'} = 1;
108 my $alternative = build MIME::Entity
109 'Type' => 'multipart/alternative',
110 'Encoding' => '7bit',
111 'Disposition' => 'inline'
115 if ( ref($args{'text_body'}) eq 'ARRAY' ) {
116 $data = $args{'text_body'};
118 $data = [ split(/\n/, $args{'text_body'}) ];
121 $alternative->attach(
122 'Type' => 'text/plain',
123 #'Encoding' => 'quoted-printable',
124 'Encoding' => '7bit',
126 'Disposition' => 'inline',
130 if ( ref($args{'html_body'}) eq 'ARRAY' ) {
131 @html_data = @{ $args{'html_body'} };
133 @html_data = split(/\n/, $args{'html_body'});
136 $alternative->attach(
137 'Type' => 'text/html',
138 'Encoding' => 'quoted-printable',
139 'Data' => [ '<html>',
142 ' '. encode_entities($return{'subject'}),
145 ' <body bgcolor="#e8e8e8">',
150 'Disposition' => 'inline',
151 #'Filename' => 'invoice.pdf',
154 #no other attachment:
156 # multipart/alternative
160 $return{'content-type'} = 'multipart/related';
161 $return{'mimeparts'} = [ $alternative ];
162 $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
163 #$return{'disposition'} = 'inline';
169 =item send_email OPTION => VALUE ...
181 (required) comma-separated scalar or arrayref of recipients
189 (optional) MIME type for the body
193 (required unless I<nobody> is true) arrayref of body text lines
197 (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().
201 (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,
202 I<content-type>, if specified, overrides the default "multipart/mixed" for the outermost MIME container.
204 =item content-encoding
206 (optional) when using nobody, optional top-level MIME
207 encoding which, if specified, overrides the default "7bit".
211 (optional) type parameter for multipart/related messages
217 use vars qw( $conf );
220 use Email::Sender::Simple qw(sendmail);
221 use Email::Sender::Transport::SMTP;
222 use Email::Sender::Transport::SMTP::TLS;
225 FS::UID->install_callback( sub {
226 $conf = new FS::Conf;
232 my %doptions = %options;
233 $doptions{'body'} = '(full body not shown in debug)';
234 warn "FS::Misc::send_email called with options:\n ". Dumper(\%doptions);
235 # join("\n", map { " $_: ". $options{$_} } keys %options ). "\n"
238 my $to = ref($options{to}) ? join(', ', @{ $options{to} } ) : $options{to};
242 if ( $options{'nobody'} ) {
244 croak "'mimeparts' option required when 'nobody' option given\n"
245 unless $options{'mimeparts'};
247 @mimeparts = @{$options{'mimeparts'}};
250 'Type' => ( $options{'content-type'} || 'multipart/mixed' ),
251 'Encoding' => ( $options{'content-encoding'} || '7bit' ),
256 @mimeparts = @{$options{'mimeparts'}}
257 if ref($options{'mimeparts'}) eq 'ARRAY';
259 if (scalar(@mimeparts)) {
262 'Type' => 'multipart/mixed',
263 'Encoding' => '7bit',
266 unshift @mimeparts, {
267 'Type' => ( $options{'content-type'} || 'text/plain' ),
268 'Data' => $options{'body'},
269 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
270 'Disposition' => 'inline',
276 'Type' => ( $options{'content-type'} || 'text/plain' ),
277 'Data' => $options{'body'},
278 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
286 if ( $options{'from'} =~ /\@([\w\.\-]+)/ ) {
289 warn 'no domain found in invoice from address '. $options{'from'}.
290 '; constructing Message-ID (and saying HELO) @example.com';
291 $domain = 'example.com';
293 my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
295 my $message = MIME::Entity->build(
296 'From' => $options{'from'},
298 'Sender' => $options{'from'},
299 'Reply-To' => $options{'from'},
300 'Date' => time2str("%a, %d %b %Y %X %z", time),
301 'Subject' => $options{'subject'},
302 'Message-ID' => "<$message_id>",
306 if ( $options{'type'} ) {
307 #false laziness w/cust_bill::generate_email
308 $message->head->replace('Content-type',
310 '; boundary="'. $message->head->multipart_boundary. '"'.
311 '; type='. $options{'type'}
315 foreach my $part (@mimeparts) {
317 if ( UNIVERSAL::isa($part, 'MIME::Entity') ) {
319 warn "attaching MIME part from MIME::Entity object\n"
321 $message->add_part($part);
323 } elsif ( ref($part) eq 'HASH' ) {
325 warn "attaching MIME part from hashref:\n".
326 join("\n", map " $_: ".$part->{$_}, keys %$part ). "\n"
328 $message->attach(%$part);
331 croak "mimepart $part isn't a hashref or MIME::Entity object!";
338 my %smtp_opt = ( 'host' => $conf->config('smtpmachine'),
342 my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
343 $smtp_opt{'port'} = $port;
346 if ( defined($enc) && $enc eq 'starttls' ) {
347 $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password);
348 $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt );
350 if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
351 $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password);
353 $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls';
354 $transport = Email::Sender::Transport::SMTP->new( %smtp_opt );
357 local $@; # just in case
358 eval { sendmail($message, { transport => $transport }) };
360 if(ref($@) and $@->isa('Email::Sender::Failure')) {
361 return ($@->code ? $@->code.' ' : '').$@->message
368 =item send_fax OPTION => VALUE ...
372 I<dialstring> - (required) 10-digit phone number w/ area code
374 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
378 I<docfile> - (required) Filename of PostScript TIFF Class F document
380 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
389 die 'HylaFAX support has not been configured.'
390 unless $conf->exists('hylafax');
393 require Fax::Hylafax::Client;
397 if ($@ =~ /^Can't locate Fax.*/) {
398 die "You must have Fax::Hylafax::Client installed to use invoice faxing."
404 my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
406 die 'Called send_fax without a \'dialstring\'.'
407 unless exists($options{'dialstring'});
409 if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
410 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
411 my $fh = new File::Temp(
412 TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
415 ) or die "can't open temp file: $!\n";
417 $options{docfile} = $fh->filename;
419 print $fh @{$options{'docdata'}};
422 delete $options{'docdata'};
425 die 'Called send_fax without a \'docfile\' or \'docdata\'.'
426 unless exists($options{'docfile'});
428 #FIXME: Need to send canonical dialstring to HylaFAX, but this only
431 $options{'dialstring'} =~ s/[^\d\+]//g;
432 if ($options{'dialstring'} =~ /^\d{10}$/) {
433 $options{dialstring} = '+1' . $options{'dialstring'};
435 return 'Invalid dialstring ' . $options{'dialstring'} . '.';
438 my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
440 if ($faxjob->success) {
441 warn "Successfully queued fax to '$options{dialstring}' with jobid " .
446 return 'Error while sending FAX: ' . $faxjob->trace;
451 =item states_hash COUNTRY
453 Returns a list of key/value pairs containing state (or other sub-country
454 division) abbriviations and names.
458 use FS::Record qw(qsearch);
459 use Locale::SubCountry;
466 map { s/[\n\r]//g; $_; }
470 'table' => 'cust_main_county',
471 'hashref' => { 'country' => $country },
472 'extra_sql' => 'GROUP BY state',
475 #it could throw a fatal "Invalid country code" error (for example "AX")
476 my $subcountry = eval { new Locale::SubCountry($country) }
477 or return ( '', '(n/a)' );
479 #"i see your schwartz is as big as mine!"
480 map { ( $_->[0] => $_->[1] ) }
481 sort { $a->[1] cmp $b->[1] }
482 map { [ $_ => state_label($_, $subcountry) ] }
486 =item counties STATE COUNTRY
488 Returns a list of counties for this state and country.
493 my( $state, $country ) = @_;
495 map { $_ } #return num_counties($state, $country) unless wantarray;
496 sort map { s/[\n\r]//g; $_; }
499 'select' => 'DISTINCT county',
500 'table' => 'cust_main_county',
501 'hashref' => { 'state' => $state,
502 'country' => $country,
507 =item cities COUNTY STATE COUNTRY
509 Returns a list of cities for this county, state and country.
514 my( $county, $state, $country ) = @_;
516 map { $_ } #return num_cities($county, $state, $country) unless wantarray;
517 sort map { s/[\n\r]//g; $_; }
520 'select' => 'DISTINCT city',
521 'table' => 'cust_main_county',
522 'hashref' => { 'county' => $county,
524 'country' => $country,
529 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
534 my( $state, $country ) = @_;
536 unless ( ref($country) ) {
537 $country = eval { new Locale::SubCountry($country) }
542 # US kludge to avoid changing existing behaviour
543 # also we actually *use* the abbriviations...
544 my $full_name = $country->country_code eq 'US'
546 : $country->full_name($state);
548 $full_name = '' if $full_name eq 'unknown';
549 $full_name =~ s/\(see also.*\)\s*$//;
550 $full_name .= " ($state)" if $full_name;
552 $full_name || $state || '(n/a)';
558 Returns a hash reference of the accepted credit card types. Keys are shorter
559 identifiers and values are the longer strings used by the system (see
560 L<Business::CreditCard>).
567 my $conf = new FS::Conf;
570 #displayname #value (Business::CreditCard)
571 "VISA" => "VISA card",
572 "MasterCard" => "MasterCard",
573 "Discover" => "Discover card",
574 "American Express" => "American Express card",
575 "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
576 "enRoute" => "enRoute",
578 "BankCard" => "BankCard",
579 "Switch" => "Switch",
582 my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
583 if ( @conf_card_types ) {
584 #perhaps the hash is backwards for this, but this way works better for
585 #usage in selfservice
586 %card_types = map { $_ => $card_types{$_} }
589 grep { $card_types{$d} eq $_ } @conf_card_types
597 =item generate_ps FILENAME
599 Returns an postscript rendition of the LaTex file, as a scalar.
600 FILENAME does not contain the .tex suffix and is unlinked by this function.
604 use String::ShellQuote;
609 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
614 system('dvips', '-q', '-t', 'letter', "$file.dvi", '-o', "$file.ps" ) == 0
615 or die "dvips failed";
617 open(POSTSCRIPT, "<$file.ps")
618 or die "can't open $file.ps: $! (error in LaTeX template?)\n";
620 unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex");
624 if ( $conf->exists('lpr-postscript_prefix') ) {
625 my $prefix = $conf->config('lpr-postscript_prefix');
626 $ps .= eval qq("$prefix");
629 while (<POSTSCRIPT>) {
635 if ( $conf->exists('lpr-postscript_suffix') ) {
636 my $suffix = $conf->config('lpr-postscript_suffix');
637 $ps .= eval qq("$suffix");
644 =item generate_pdf FILENAME
646 Returns an PDF rendition of the LaTex file, as a scalar. FILENAME does not
647 contain the .tex suffix and is unlinked by this function.
651 use String::ShellQuote;
656 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
659 #system('pdflatex', "$file.tex");
660 #system('pdflatex', "$file.tex");
661 #! LaTeX Error: Unknown graphics extension: .eps.
665 my $sfile = shell_quote $file;
667 #system('dvipdf', "$file.dvi", "$file.pdf" );
669 "dvips -q -t letter -f $sfile.dvi ".
670 "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
673 or die "dvips | gs failed: $!";
675 open(PDF, "<$file.pdf")
676 or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
678 unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex");
694 #my $sfile = shell_quote $file;
698 '-interaction=batchmode',
699 '\AtBeginDocument{\RequirePackage{pslatex}}',
700 '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
701 '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
706 my $timeout = 30; #? should be more than enough
710 local($SIG{CHLD}) = sub {};
711 run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
712 or die "pslatex $file.tex failed; see $file.log for details?\n";
720 Sends the lines in ARRAYREF to the printer.
727 my $lpr = $conf->config('lpr');
730 run3 $lpr, $data, \$outerr, \$outerr;
732 $outerr = ": $outerr" if length($outerr);
733 die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
738 =item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ]
740 Converts the filehandle referenced by FILEREF from fixed length record
741 lines to a CSV file according to the lengths specified in LENGTH_LISTREF.
742 The CALLBACKS_LISTREF refers to a correpsonding list of coderefs. Each
743 should return the value to be substituted in place of its single argument.
745 Returns false on success or an error if one occurs.
750 my( $fhref, $countref, $lengths, $callbacks) = @_;
752 eval { require Text::CSV_XS; };
756 my $unpacker = new Text::CSV_XS;
758 my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths;
760 my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc";
761 my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX",
764 ) or return "can't open temp file: $!\n"
767 while ( defined(my $line=<$ofh>) ) {
773 return "unexpected input at line $$countref: $line".
774 " -- expected $total but received ". length($line)
775 unless length($line) == $total;
777 $unpacker->combine( map { my $i = $column++;
778 defined( $callbacks->[$i] )
779 ? &{ $callbacks->[$i] }( $_ )
781 } unpack( $template, $line )
783 or return "invalid data for CSV: ". $unpacker->error_input;
785 print $fh $unpacker->string(), "\n"
786 or return "can't write temp file: $!\n";
790 if ( $template ) { close $$fhref; $$fhref = $fh }
805 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
807 L<Fax::Hylafax::Client>