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 ...
49 Sender address, required
53 Recipient address, required
57 email subject, required
61 Email body (HTML alternative). Arrayref of lines, or scalar.
63 Will be placed inside an HTML <BODY> tag.
67 Email body (Text alternative). Arrayref of lines, or scalar.
71 Returns an argument list to be passsed to L<send_email>.
75 #false laziness w/FS::cust_bill::generate_email
83 my $me = '[FS::Misc::generate_email]';
86 'from' => $args{'from'},
88 'subject' => $args{'subject'},
91 #if (ref($args{'to'}) eq 'ARRAY') {
92 # $return{'to'} = $args{'to'};
94 # $return{'to'} = [ grep { $_ !~ /^(POST|FAX)$/ }
95 # $self->cust_main->invoicing_list
99 warn "$me creating HTML/text multipart message"
102 $return{'nobody'} = 1;
104 my $alternative = build MIME::Entity
105 'Type' => 'multipart/alternative',
106 'Encoding' => '7bit',
107 'Disposition' => 'inline'
111 if ( ref($args{'text_body'}) eq 'ARRAY' ) {
112 $data = $args{'text_body'};
114 $data = [ split(/\n/, $args{'text_body'}) ];
117 $alternative->attach(
118 'Type' => 'text/plain',
119 #'Encoding' => 'quoted-printable',
120 'Encoding' => '7bit',
122 'Disposition' => 'inline',
126 if ( ref($args{'html_body'}) eq 'ARRAY' ) {
127 @html_data = @{ $args{'html_body'} };
129 @html_data = split(/\n/, $args{'html_body'});
132 $alternative->attach(
133 'Type' => 'text/html',
134 'Encoding' => 'quoted-printable',
135 'Data' => [ '<html>',
138 ' '. encode_entities($return{'subject'}),
141 ' <body bgcolor="#e8e8e8">',
146 'Disposition' => 'inline',
147 #'Filename' => 'invoice.pdf',
150 #no other attachment:
152 # multipart/alternative
156 $return{'content-type'} = 'multipart/related';
157 $return{'mimeparts'} = [ $alternative ];
158 $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
159 #$return{'disposition'} = 'inline';
165 =item send_email OPTION => VALUE ...
177 (required) comma-separated scalar or arrayref of recipients
185 (optional) MIME type for the body
189 (required unless I<nobody> is true) arrayref of body text lines
193 (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().
197 (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,
198 I<content-type>, if specified, overrides the default "multipart/mixed" for the outermost MIME container.
200 =item content-encoding
202 (optional) when using nobody, optional top-level MIME
203 encoding which, if specified, overrides the default "7bit".
207 (optional) type parameter for multipart/related messages
213 use vars qw( $conf );
216 use Mail::Internet 2.00;
220 FS::UID->install_callback( sub {
221 $conf = new FS::Conf;
227 my %doptions = %options;
228 $doptions{'body'} = '(full body not shown in debug)';
229 warn "FS::Misc::send_email called with options:\n ". Dumper(\%doptions);
230 # join("\n", map { " $_: ". $options{$_} } keys %options ). "\n"
233 $ENV{MAILADDRESS} = $options{'from'};
234 my $to = ref($options{to}) ? join(', ', @{ $options{to} } ) : $options{to};
238 if ( $options{'nobody'} ) {
240 croak "'mimeparts' option required when 'nobody' option given\n"
241 unless $options{'mimeparts'};
243 @mimeparts = @{$options{'mimeparts'}};
246 'Type' => ( $options{'content-type'} || 'multipart/mixed' ),
247 'Encoding' => ( $options{'content-encoding'} || '7bit' ),
252 @mimeparts = @{$options{'mimeparts'}}
253 if ref($options{'mimeparts'}) eq 'ARRAY';
255 if (scalar(@mimeparts)) {
258 'Type' => 'multipart/mixed',
259 'Encoding' => '7bit',
262 unshift @mimeparts, {
263 'Type' => ( $options{'content-type'} || 'text/plain' ),
264 'Data' => $options{'body'},
265 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
266 'Disposition' => 'inline',
272 'Type' => ( $options{'content-type'} || 'text/plain' ),
273 'Data' => $options{'body'},
274 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
282 if ( $options{'from'} =~ /\@([\w\.\-]+)/ ) {
285 warn 'no domain found in invoice from address '. $options{'from'}.
286 '; constructing Message-ID @example.com';
287 $domain = 'example.com';
289 my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
291 my $message = MIME::Entity->build(
292 'From' => $options{'from'},
294 'Sender' => $options{'from'},
295 'Reply-To' => $options{'from'},
296 'Date' => time2str("%a, %d %b %Y %X %z", time),
297 'Subject' => $options{'subject'},
298 'Message-ID' => "<$message_id>",
302 if ( $options{'type'} ) {
303 #false laziness w/cust_bill::generate_email
304 $message->head->replace('Content-type',
306 '; boundary="'. $message->head->multipart_boundary. '"'.
307 '; type='. $options{'type'}
311 foreach my $part (@mimeparts) {
313 if ( UNIVERSAL::isa($part, 'MIME::Entity') ) {
315 warn "attaching MIME part from MIME::Entity object\n"
317 $message->add_part($part);
319 } elsif ( ref($part) eq 'HASH' ) {
321 warn "attaching MIME part from hashref:\n".
322 join("\n", map " $_: ".$part->{$_}, keys %$part ). "\n"
324 $message->attach(%$part);
327 croak "mimepart $part isn't a hashref or MIME::Entity object!";
332 my $smtpmachine = $conf->config('smtpmachine');
335 $message->mysmtpsend( 'Host' => $smtpmachine,
336 'MailFrom' => $options{'from'},
341 #this kludges a "mysmtpsend" method into Mail::Internet for send_email above
342 #now updated for MailTools v2!
343 package Mail::Internet;
349 sub Mail::Internet::mysmtpsend($@) {
350 my ($self, %opt) = @_;
352 my $host = $opt{Host};
353 my $envelope = $opt{MailFrom}; # || mailaddress();
358 push @hello, Hello => $opt{Hello}
359 if defined $opt{Hello};
361 push @hello, Port => $opt{Port}
362 if exists $opt{Port};
364 push @hello, Debug => $opt{Debug}
365 if exists $opt{Debug};
368 # { local $SIG{__DIE__};
369 # my @hosts = qw(mailhost localhost);
370 # unshift @hosts, split /\:/, $ENV{SMTPHOSTS}
371 # if defined $ENV{SMTPHOSTS};
373 # foreach $host (@hosts)
374 # { $smtp = eval { Net::SMTP->new($host, @hello) };
375 # last if defined $smtp;
378 # elsif(ref($host) && UNIVERSAL::isa($host,'Net::SMTP'))
379 if(ref($host) && UNIVERSAL::isa($host,'Net::SMTP'))
384 { #local $SIG{__DIE__};
385 #$smtp = eval { Net::SMTP->new($host, @hello) };
386 $smtp = Net::SMTP->new($host, @hello);
389 unless ( defined($smtp) ) {
391 $err =~ s/Invalid argument/Unknown host/;
392 return "can't connect to $host: $err"
395 my $head = $self->cleaned_header_dup;
397 $head->delete('Bcc');
401 my @rcpt = map { ref $_ ? @$_ : $_ } grep { defined } @opt{'To','Cc','Bcc'};
402 @rcpt = map { $head->get($_) } qw(To Cc Bcc)
405 my @addr = map {$_->address} Mail::Address->parse(@rcpt);
407 return 'No valid destination addresses found!'
412 my $ok = $smtp->mail($envelope)
414 && $smtp->data(join("", @{$head->header}, "\n", @{$self->body}));
416 #$quit && $smtp->quit;
419 $quit && $smtp->quit;
422 return $smtp->code. ' '. $smtp->message;
428 =item send_fax OPTION => VALUE ...
432 I<dialstring> - (required) 10-digit phone number w/ area code
434 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
438 I<docfile> - (required) Filename of PostScript TIFF Class F document
440 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
449 die 'HylaFAX support has not been configured.'
450 unless $conf->exists('hylafax');
453 require Fax::Hylafax::Client;
457 if ($@ =~ /^Can't locate Fax.*/) {
458 die "You must have Fax::Hylafax::Client installed to use invoice faxing."
464 my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
466 die 'Called send_fax without a \'dialstring\'.'
467 unless exists($options{'dialstring'});
469 if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
470 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
471 my $fh = new File::Temp(
472 TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
475 ) or die "can't open temp file: $!\n";
477 $options{docfile} = $fh->filename;
479 print $fh @{$options{'docdata'}};
482 delete $options{'docdata'};
485 die 'Called send_fax without a \'docfile\' or \'docdata\'.'
486 unless exists($options{'docfile'});
488 #FIXME: Need to send canonical dialstring to HylaFAX, but this only
491 $options{'dialstring'} =~ s/[^\d\+]//g;
492 if ($options{'dialstring'} =~ /^\d{10}$/) {
493 $options{dialstring} = '+1' . $options{'dialstring'};
495 return 'Invalid dialstring ' . $options{'dialstring'} . '.';
498 my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
500 if ($faxjob->success) {
501 warn "Successfully queued fax to '$options{dialstring}' with jobid " .
506 return 'Error while sending FAX: ' . $faxjob->trace;
511 =item states_hash COUNTRY
513 Returns a list of key/value pairs containing state (or other sub-country
514 division) abbriviations and names.
518 use FS::Record qw(qsearch);
519 use Locale::SubCountry;
526 map { s/[\n\r]//g; $_; }
530 'table' => 'cust_main_county',
531 'hashref' => { 'country' => $country },
532 'extra_sql' => 'GROUP BY state',
535 #it could throw a fatal "Invalid country code" error (for example "AX")
536 my $subcountry = eval { new Locale::SubCountry($country) }
537 or return ( '', '(n/a)' );
539 #"i see your schwartz is as big as mine!"
540 map { ( $_->[0] => $_->[1] ) }
541 sort { $a->[1] cmp $b->[1] }
542 map { [ $_ => state_label($_, $subcountry) ] }
546 =item counties STATE COUNTRY
548 Returns a list of counties for this state and country.
553 my( $state, $country ) = @_;
555 sort map { s/[\n\r]//g; $_; }
558 'select' => 'DISTINCT county',
559 'table' => 'cust_main_county',
560 'hashref' => { 'state' => $state,
561 'country' => $country,
566 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
571 my( $state, $country ) = @_;
573 unless ( ref($country) ) {
574 $country = eval { new Locale::SubCountry($country) }
579 # US kludge to avoid changing existing behaviour
580 # also we actually *use* the abbriviations...
581 my $full_name = $country->country_code eq 'US'
583 : $country->full_name($state);
585 $full_name = '' if $full_name eq 'unknown';
586 $full_name =~ s/\(see also.*\)\s*$//;
587 $full_name .= " ($state)" if $full_name;
589 $full_name || $state || '(n/a)';
595 Returns a hash reference of the accepted credit card types. Keys are shorter
596 identifiers and values are the longer strings used by the system (see
597 L<Business::CreditCard>).
604 my $conf = new FS::Conf;
607 #displayname #value (Business::CreditCard)
608 "VISA" => "VISA card",
609 "MasterCard" => "MasterCard",
610 "Discover" => "Discover card",
611 "American Express" => "American Express card",
612 "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
613 "enRoute" => "enRoute",
615 "BankCard" => "BankCard",
616 "Switch" => "Switch",
619 my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
620 if ( @conf_card_types ) {
621 #perhaps the hash is backwards for this, but this way works better for
622 #usage in selfservice
623 %card_types = map { $_ => $card_types{$_} }
626 grep { $card_types{$d} eq $_ } @conf_card_types
634 =item generate_ps FILENAME
636 Returns an postscript rendition of the LaTex file, as a scalar.
637 FILENAME does not contain the .tex suffix and is unlinked by this function.
641 use String::ShellQuote;
646 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
651 system('dvips', '-q', '-t', 'letter', "$file.dvi", '-o', "$file.ps" ) == 0
652 or die "dvips failed";
654 open(POSTSCRIPT, "<$file.ps")
655 or die "can't open $file.ps: $! (error in LaTeX template?)\n";
657 unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex");
661 if ( $conf->exists('lpr-postscript_prefix') ) {
662 my $prefix = $conf->config('lpr-postscript_prefix');
663 $ps .= eval qq("$prefix");
666 while (<POSTSCRIPT>) {
672 if ( $conf->exists('lpr-postscript_suffix') ) {
673 my $suffix = $conf->config('lpr-postscript_suffix');
674 $ps .= eval qq("$suffix");
681 =item generate_pdf FILENAME
683 Returns an PDF rendition of the LaTex file, as a scalar. FILENAME does not
684 contain the .tex suffix and is unlinked by this function.
688 use String::ShellQuote;
693 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
696 #system('pdflatex', "$file.tex");
697 #system('pdflatex', "$file.tex");
698 #! LaTeX Error: Unknown graphics extension: .eps.
702 my $sfile = shell_quote $file;
704 #system('dvipdf', "$file.dvi", "$file.pdf" );
706 "dvips -q -t letter -f $sfile.dvi ".
707 "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
710 or die "dvips | gs failed: $!";
712 open(PDF, "<$file.pdf")
713 or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
715 unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex");
731 #my $sfile = shell_quote $file;
735 '-interaction=batchmode',
736 '\AtBeginDocument{\RequirePackage{pslatex}}',
737 '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
738 '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
743 my $timeout = 30; #? should be more than enough
747 local($SIG{CHLD}) = sub {};
748 run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
749 or die "pslatex $file.tex failed; see $file.log for details?\n";
757 Sends the lines in ARRAYREF to the printer.
764 my $lpr = $conf->config('lpr');
767 run3 $lpr, $data, \$outerr, \$outerr;
769 $outerr = ": $outerr" if length($outerr);
770 die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
783 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
785 L<Fax::Hylafax::Client>