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
10 #do NOT depend on any FS:: modules here, causes weird (sometimes unreproducable
11 #until on client machine) dependancy loops. put them in FS::Misc::Something
14 @ISA = qw( Exporter );
15 @EXPORT_OK = qw( generate_email send_email send_fax
16 states_hash counties state_label
18 generate_ps generate_pdf do_print
25 FS::Misc - Miscellaneous subroutines
29 use FS::Misc qw(send_email);
35 Miscellaneous subroutines. This module contains miscellaneous subroutines
36 called from multiple other modules. These are not OO or necessarily related,
37 but are collected here to elimiate code duplication.
43 =item generate_email OPTION => VALUE ...
51 Sender address, required
55 Recipient address, required
59 email subject, required
63 Email body (HTML alternative). Arrayref of lines, or scalar.
65 Will be placed inside an HTML <BODY> tag.
69 Email body (Text alternative). Arrayref of lines, or scalar.
73 Returns an argument list to be passsed to L<send_email>.
77 #false laziness w/FS::cust_bill::generate_email
85 my $me = '[FS::Misc::generate_email]';
88 'from' => $args{'from'},
90 'subject' => $args{'subject'},
93 #if (ref($args{'to'}) eq 'ARRAY') {
94 # $return{'to'} = $args{'to'};
96 # $return{'to'} = [ grep { $_ !~ /^(POST|FAX)$/ }
97 # $self->cust_main->invoicing_list
101 warn "$me creating HTML/text multipart message"
104 $return{'nobody'} = 1;
106 my $alternative = build MIME::Entity
107 'Type' => 'multipart/alternative',
108 'Encoding' => '7bit',
109 'Disposition' => 'inline'
113 if ( ref($args{'text_body'}) eq 'ARRAY' ) {
114 $data = $args{'text_body'};
116 $data = [ split(/\n/, $args{'text_body'}) ];
119 $alternative->attach(
120 'Type' => 'text/plain',
121 #'Encoding' => 'quoted-printable',
122 'Encoding' => '7bit',
124 'Disposition' => 'inline',
128 if ( ref($args{'html_body'}) eq 'ARRAY' ) {
129 @html_data = @{ $args{'html_body'} };
131 @html_data = split(/\n/, $args{'html_body'});
134 $alternative->attach(
135 'Type' => 'text/html',
136 'Encoding' => 'quoted-printable',
137 'Data' => [ '<html>',
140 ' '. encode_entities($return{'subject'}),
143 ' <body bgcolor="#e8e8e8">',
148 'Disposition' => 'inline',
149 #'Filename' => 'invoice.pdf',
152 #no other attachment:
154 # multipart/alternative
158 $return{'content-type'} = 'multipart/related';
159 $return{'mimeparts'} = [ $alternative ];
160 $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
161 #$return{'disposition'} = 'inline';
167 =item send_email OPTION => VALUE ...
179 (required) comma-separated scalar or arrayref of recipients
187 (optional) MIME type for the body
191 (required unless I<nobody> is true) arrayref of body text lines
195 (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().
199 (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,
200 I<content-type>, if specified, overrides the default "multipart/mixed" for the outermost MIME container.
202 =item content-encoding
204 (optional) when using nobody, optional top-level MIME
205 encoding which, if specified, overrides the default "7bit".
209 (optional) type parameter for multipart/related messages
215 use vars qw( $conf );
218 use Mail::Internet 2.00;
222 FS::UID->install_callback( sub {
223 $conf = new FS::Conf;
229 my %doptions = %options;
230 $doptions{'body'} = '(full body not shown in debug)';
231 warn "FS::Misc::send_email called with options:\n ". Dumper(\%doptions);
232 # join("\n", map { " $_: ". $options{$_} } keys %options ). "\n"
235 $ENV{MAILADDRESS} = $options{'from'};
236 my $to = ref($options{to}) ? join(', ', @{ $options{to} } ) : $options{to};
240 if ( $options{'nobody'} ) {
242 croak "'mimeparts' option required when 'nobody' option given\n"
243 unless $options{'mimeparts'};
245 @mimeparts = @{$options{'mimeparts'}};
248 'Type' => ( $options{'content-type'} || 'multipart/mixed' ),
249 'Encoding' => ( $options{'content-encoding'} || '7bit' ),
254 @mimeparts = @{$options{'mimeparts'}}
255 if ref($options{'mimeparts'}) eq 'ARRAY';
257 if (scalar(@mimeparts)) {
260 'Type' => 'multipart/mixed',
261 'Encoding' => '7bit',
264 unshift @mimeparts, {
265 'Type' => ( $options{'content-type'} || 'text/plain' ),
266 'Data' => $options{'body'},
267 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
268 'Disposition' => 'inline',
274 'Type' => ( $options{'content-type'} || 'text/plain' ),
275 'Data' => $options{'body'},
276 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
284 if ( $options{'from'} =~ /\@([\w\.\-]+)/ ) {
287 warn 'no domain found in invoice from address '. $options{'from'}.
288 '; constructing Message-ID @example.com';
289 $domain = 'example.com';
291 my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
293 my $message = MIME::Entity->build(
294 'From' => $options{'from'},
296 'Sender' => $options{'from'},
297 'Reply-To' => $options{'from'},
298 'Date' => time2str("%a, %d %b %Y %X %z", time),
299 'Subject' => $options{'subject'},
300 'Message-ID' => "<$message_id>",
304 if ( $options{'type'} ) {
305 #false laziness w/cust_bill::generate_email
306 $message->head->replace('Content-type',
308 '; boundary="'. $message->head->multipart_boundary. '"'.
309 '; type='. $options{'type'}
313 foreach my $part (@mimeparts) {
315 if ( UNIVERSAL::isa($part, 'MIME::Entity') ) {
317 warn "attaching MIME part from MIME::Entity object\n"
319 $message->add_part($part);
321 } elsif ( ref($part) eq 'HASH' ) {
323 warn "attaching MIME part from hashref:\n".
324 join("\n", map " $_: ".$part->{$_}, keys %$part ). "\n"
326 $message->attach(%$part);
329 croak "mimepart $part isn't a hashref or MIME::Entity object!";
334 my $smtpmachine = $conf->config('smtpmachine');
337 $message->mysmtpsend( 'Host' => $smtpmachine,
338 'MailFrom' => $options{'from'},
343 #this kludges a "mysmtpsend" method into Mail::Internet for send_email above
344 #now updated for MailTools v2!
345 package Mail::Internet;
351 sub Mail::Internet::mysmtpsend($@) {
352 my ($self, %opt) = @_;
354 my $host = $opt{Host};
355 my $envelope = $opt{MailFrom}; # || mailaddress();
360 push @hello, Hello => $opt{Hello}
361 if defined $opt{Hello};
363 push @hello, Port => $opt{Port}
364 if exists $opt{Port};
366 push @hello, Debug => $opt{Debug}
367 if exists $opt{Debug};
370 # { local $SIG{__DIE__};
371 # my @hosts = qw(mailhost localhost);
372 # unshift @hosts, split /\:/, $ENV{SMTPHOSTS}
373 # if defined $ENV{SMTPHOSTS};
375 # foreach $host (@hosts)
376 # { $smtp = eval { Net::SMTP->new($host, @hello) };
377 # last if defined $smtp;
380 # elsif(ref($host) && UNIVERSAL::isa($host,'Net::SMTP'))
381 if(ref($host) && UNIVERSAL::isa($host,'Net::SMTP'))
386 { #local $SIG{__DIE__};
387 #$smtp = eval { Net::SMTP->new($host, @hello) };
388 $smtp = Net::SMTP->new($host, @hello);
391 unless ( defined($smtp) ) {
393 $err =~ s/Invalid argument/Unknown host/;
394 return "can't connect to $host: $err"
397 my $head = $self->cleaned_header_dup;
399 $head->delete('Bcc');
403 my @rcpt = map { ref $_ ? @$_ : $_ } grep { defined } @opt{'To','Cc','Bcc'};
404 @rcpt = map { $head->get($_) } qw(To Cc Bcc)
407 my @addr = map {$_->address} Mail::Address->parse(@rcpt);
409 return 'No valid destination addresses found!'
414 my $ok = $smtp->mail($envelope)
416 && $smtp->data(join("", @{$head->header}, "\n", @{$self->body}));
418 #$quit && $smtp->quit;
421 $quit && $smtp->quit;
424 return $smtp->code. ' '. $smtp->message;
430 =item send_fax OPTION => VALUE ...
434 I<dialstring> - (required) 10-digit phone number w/ area code
436 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
440 I<docfile> - (required) Filename of PostScript TIFF Class F document
442 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
451 die 'HylaFAX support has not been configured.'
452 unless $conf->exists('hylafax');
455 require Fax::Hylafax::Client;
459 if ($@ =~ /^Can't locate Fax.*/) {
460 die "You must have Fax::Hylafax::Client installed to use invoice faxing."
466 my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
468 die 'Called send_fax without a \'dialstring\'.'
469 unless exists($options{'dialstring'});
471 if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
472 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
473 my $fh = new File::Temp(
474 TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
477 ) or die "can't open temp file: $!\n";
479 $options{docfile} = $fh->filename;
481 print $fh @{$options{'docdata'}};
484 delete $options{'docdata'};
487 die 'Called send_fax without a \'docfile\' or \'docdata\'.'
488 unless exists($options{'docfile'});
490 #FIXME: Need to send canonical dialstring to HylaFAX, but this only
493 $options{'dialstring'} =~ s/[^\d\+]//g;
494 if ($options{'dialstring'} =~ /^\d{10}$/) {
495 $options{dialstring} = '+1' . $options{'dialstring'};
497 return 'Invalid dialstring ' . $options{'dialstring'} . '.';
500 my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
502 if ($faxjob->success) {
503 warn "Successfully queued fax to '$options{dialstring}' with jobid " .
508 return 'Error while sending FAX: ' . $faxjob->trace;
513 =item states_hash COUNTRY
515 Returns a list of key/value pairs containing state (or other sub-country
516 division) abbriviations and names.
520 use FS::Record qw(qsearch);
521 use Locale::SubCountry;
528 map { s/[\n\r]//g; $_; }
532 'table' => 'cust_main_county',
533 'hashref' => { 'country' => $country },
534 'extra_sql' => 'GROUP BY state',
537 #it could throw a fatal "Invalid country code" error (for example "AX")
538 my $subcountry = eval { new Locale::SubCountry($country) }
539 or return ( '', '(n/a)' );
541 #"i see your schwartz is as big as mine!"
542 map { ( $_->[0] => $_->[1] ) }
543 sort { $a->[1] cmp $b->[1] }
544 map { [ $_ => state_label($_, $subcountry) ] }
548 =item counties STATE COUNTRY
550 Returns a list of counties for this state and country.
555 my( $state, $country ) = @_;
557 sort map { s/[\n\r]//g; $_; }
560 'select' => 'DISTINCT county',
561 'table' => 'cust_main_county',
562 'hashref' => { 'state' => $state,
563 'country' => $country,
568 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
573 my( $state, $country ) = @_;
575 unless ( ref($country) ) {
576 $country = eval { new Locale::SubCountry($country) }
581 # US kludge to avoid changing existing behaviour
582 # also we actually *use* the abbriviations...
583 my $full_name = $country->country_code eq 'US'
585 : $country->full_name($state);
587 $full_name = '' if $full_name eq 'unknown';
588 $full_name =~ s/\(see also.*\)\s*$//;
589 $full_name .= " ($state)" if $full_name;
591 $full_name || $state || '(n/a)';
597 Returns a hash reference of the accepted credit card types. Keys are shorter
598 identifiers and values are the longer strings used by the system (see
599 L<Business::CreditCard>).
606 my $conf = new FS::Conf;
609 #displayname #value (Business::CreditCard)
610 "VISA" => "VISA card",
611 "MasterCard" => "MasterCard",
612 "Discover" => "Discover card",
613 "American Express" => "American Express card",
614 "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
615 "enRoute" => "enRoute",
617 "BankCard" => "BankCard",
618 "Switch" => "Switch",
621 my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
622 if ( @conf_card_types ) {
623 #perhaps the hash is backwards for this, but this way works better for
624 #usage in selfservice
625 %card_types = map { $_ => $card_types{$_} }
628 grep { $card_types{$d} eq $_ } @conf_card_types
636 =item generate_ps FILENAME
638 Returns an postscript rendition of the LaTex file, as a scalar.
639 FILENAME does not contain the .tex suffix and is unlinked by this function.
643 use String::ShellQuote;
648 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
653 system('dvips', '-q', '-t', 'letter', "$file.dvi", '-o', "$file.ps" ) == 0
654 or die "dvips failed";
656 open(POSTSCRIPT, "<$file.ps")
657 or die "can't open $file.ps: $! (error in LaTeX template?)\n";
659 unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex");
663 if ( $conf->exists('lpr-postscript_prefix') ) {
664 my $prefix = $conf->config('lpr-postscript_prefix');
665 $ps .= eval qq("$prefix");
668 while (<POSTSCRIPT>) {
674 if ( $conf->exists('lpr-postscript_suffix') ) {
675 my $suffix = $conf->config('lpr-postscript_suffix');
676 $ps .= eval qq("$suffix");
683 =item generate_pdf FILENAME
685 Returns an PDF rendition of the LaTex file, as a scalar. FILENAME does not
686 contain the .tex suffix and is unlinked by this function.
690 use String::ShellQuote;
695 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
698 #system('pdflatex', "$file.tex");
699 #system('pdflatex', "$file.tex");
700 #! LaTeX Error: Unknown graphics extension: .eps.
704 my $sfile = shell_quote $file;
706 #system('dvipdf', "$file.dvi", "$file.pdf" );
708 "dvips -q -t letter -f $sfile.dvi ".
709 "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
712 or die "dvips | gs failed: $!";
714 open(PDF, "<$file.pdf")
715 or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
717 unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex");
733 #my $sfile = shell_quote $file;
737 '-interaction=batchmode',
738 '\AtBeginDocument{\RequirePackage{pslatex}}',
739 '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
740 '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
745 my $timeout = 30; #? should be more than enough
749 local($SIG{CHLD}) = sub {};
750 run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
751 or die "pslatex $file.tex failed; see $file.log for details?\n";
759 Sends the lines in ARRAYREF to the printer.
766 my $lpr = $conf->config('lpr');
769 run3 $lpr, $data, \$outerr, \$outerr;
771 $outerr = ": $outerr" if length($outerr);
772 die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
785 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
787 L<Fax::Hylafax::Client>