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 Mail::Internet 2.00;
224 FS::UID->install_callback( sub {
225 $conf = new FS::Conf;
231 my %doptions = %options;
232 $doptions{'body'} = '(full body not shown in debug)';
233 warn "FS::Misc::send_email called with options:\n ". Dumper(\%doptions);
234 # join("\n", map { " $_: ". $options{$_} } keys %options ). "\n"
237 $ENV{MAILADDRESS} = $options{'from'};
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 @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!";
336 my $smtpmachine = $conf->config('smtpmachine');
339 $message->mysmtpsend( 'Host' => $smtpmachine,
340 'MailFrom' => $options{'from'},
345 #this kludges a "mysmtpsend" method into Mail::Internet for send_email above
346 #now updated for MailTools v2!
347 package Mail::Internet;
353 sub Mail::Internet::mysmtpsend($@) {
354 my ($self, %opt) = @_;
356 my $host = $opt{Host};
357 my $envelope = $opt{MailFrom}; # || mailaddress();
362 push @hello, Hello => $opt{Hello}
363 if defined $opt{Hello};
365 push @hello, Port => $opt{Port}
366 if exists $opt{Port};
368 push @hello, Debug => $opt{Debug}
369 if exists $opt{Debug};
372 # { local $SIG{__DIE__};
373 # my @hosts = qw(mailhost localhost);
374 # unshift @hosts, split /\:/, $ENV{SMTPHOSTS}
375 # if defined $ENV{SMTPHOSTS};
377 # foreach $host (@hosts)
378 # { $smtp = eval { Net::SMTP->new($host, @hello) };
379 # last if defined $smtp;
382 # elsif(ref($host) && UNIVERSAL::isa($host,'Net::SMTP'))
383 if(ref($host) && UNIVERSAL::isa($host,'Net::SMTP'))
388 { #local $SIG{__DIE__};
389 #$smtp = eval { Net::SMTP->new($host, @hello) };
390 $smtp = Net::SMTP->new($host, @hello);
393 unless ( defined($smtp) ) {
395 $err =~ s/Invalid argument/Unknown host/;
396 return "can't connect to $host: $err"
399 my $head = $self->cleaned_header_dup;
401 $head->delete('Bcc');
405 my @rcpt = map { ref $_ ? @$_ : $_ } grep { defined } @opt{'To','Cc','Bcc'};
406 @rcpt = map { $head->get($_) } qw(To Cc Bcc)
409 my @addr = map {$_->address} Mail::Address->parse(@rcpt);
411 return 'No valid destination addresses found!'
416 my $ok = $smtp->mail($envelope)
418 && $smtp->data(join("", @{$head->header}, "\n", @{$self->body}));
420 #$quit && $smtp->quit;
423 $quit && $smtp->quit;
426 return $smtp->code. ' '. $smtp->message;
432 =item send_fax OPTION => VALUE ...
436 I<dialstring> - (required) 10-digit phone number w/ area code
438 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
442 I<docfile> - (required) Filename of PostScript TIFF Class F document
444 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
453 die 'HylaFAX support has not been configured.'
454 unless $conf->exists('hylafax');
457 require Fax::Hylafax::Client;
461 if ($@ =~ /^Can't locate Fax.*/) {
462 die "You must have Fax::Hylafax::Client installed to use invoice faxing."
468 my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
470 die 'Called send_fax without a \'dialstring\'.'
471 unless exists($options{'dialstring'});
473 if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
474 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
475 my $fh = new File::Temp(
476 TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
479 ) or die "can't open temp file: $!\n";
481 $options{docfile} = $fh->filename;
483 print $fh @{$options{'docdata'}};
486 delete $options{'docdata'};
489 die 'Called send_fax without a \'docfile\' or \'docdata\'.'
490 unless exists($options{'docfile'});
492 #FIXME: Need to send canonical dialstring to HylaFAX, but this only
495 $options{'dialstring'} =~ s/[^\d\+]//g;
496 if ($options{'dialstring'} =~ /^\d{10}$/) {
497 $options{dialstring} = '+1' . $options{'dialstring'};
499 return 'Invalid dialstring ' . $options{'dialstring'} . '.';
502 my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
504 if ($faxjob->success) {
505 warn "Successfully queued fax to '$options{dialstring}' with jobid " .
510 return 'Error while sending FAX: ' . $faxjob->trace;
515 =item states_hash COUNTRY
517 Returns a list of key/value pairs containing state (or other sub-country
518 division) abbriviations and names.
522 use FS::Record qw(qsearch);
523 use Locale::SubCountry;
530 map { s/[\n\r]//g; $_; }
534 'table' => 'cust_main_county',
535 'hashref' => { 'country' => $country },
536 'extra_sql' => 'GROUP BY state',
539 #it could throw a fatal "Invalid country code" error (for example "AX")
540 my $subcountry = eval { new Locale::SubCountry($country) }
541 or return ( '', '(n/a)' );
543 #"i see your schwartz is as big as mine!"
544 map { ( $_->[0] => $_->[1] ) }
545 sort { $a->[1] cmp $b->[1] }
546 map { [ $_ => state_label($_, $subcountry) ] }
550 =item counties STATE COUNTRY
552 Returns a list of counties for this state and country.
557 my( $state, $country ) = @_;
559 map { $_ } #return num_counties($state, $country) unless wantarray;
560 sort map { s/[\n\r]//g; $_; }
563 'select' => 'DISTINCT county',
564 'table' => 'cust_main_county',
565 'hashref' => { 'state' => $state,
566 'country' => $country,
571 =item cities COUNTY STATE COUNTRY
573 Returns a list of cities for this county, state and country.
578 my( $county, $state, $country ) = @_;
580 map { $_ } #return num_cities($county, $state, $country) unless wantarray;
581 sort map { s/[\n\r]//g; $_; }
584 'select' => 'DISTINCT city',
585 'table' => 'cust_main_county',
586 'hashref' => { 'county' => $county,
588 'country' => $country,
593 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
598 my( $state, $country ) = @_;
600 unless ( ref($country) ) {
601 $country = eval { new Locale::SubCountry($country) }
606 # US kludge to avoid changing existing behaviour
607 # also we actually *use* the abbriviations...
608 my $full_name = $country->country_code eq 'US'
610 : $country->full_name($state);
612 $full_name = '' if $full_name eq 'unknown';
613 $full_name =~ s/\(see also.*\)\s*$//;
614 $full_name .= " ($state)" if $full_name;
616 $full_name || $state || '(n/a)';
622 Returns a hash reference of the accepted credit card types. Keys are shorter
623 identifiers and values are the longer strings used by the system (see
624 L<Business::CreditCard>).
631 my $conf = new FS::Conf;
634 #displayname #value (Business::CreditCard)
635 "VISA" => "VISA card",
636 "MasterCard" => "MasterCard",
637 "Discover" => "Discover card",
638 "American Express" => "American Express card",
639 "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
640 "enRoute" => "enRoute",
642 "BankCard" => "BankCard",
643 "Switch" => "Switch",
646 my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
647 if ( @conf_card_types ) {
648 #perhaps the hash is backwards for this, but this way works better for
649 #usage in selfservice
650 %card_types = map { $_ => $card_types{$_} }
653 grep { $card_types{$d} eq $_ } @conf_card_types
661 =item generate_ps FILENAME
663 Returns an postscript rendition of the LaTex file, as a scalar.
664 FILENAME does not contain the .tex suffix and is unlinked by this function.
668 use String::ShellQuote;
673 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
678 system('dvips', '-q', '-t', 'letter', "$file.dvi", '-o', "$file.ps" ) == 0
679 or die "dvips failed";
681 open(POSTSCRIPT, "<$file.ps")
682 or die "can't open $file.ps: $! (error in LaTeX template?)\n";
684 unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex");
688 if ( $conf->exists('lpr-postscript_prefix') ) {
689 my $prefix = $conf->config('lpr-postscript_prefix');
690 $ps .= eval qq("$prefix");
693 while (<POSTSCRIPT>) {
699 if ( $conf->exists('lpr-postscript_suffix') ) {
700 my $suffix = $conf->config('lpr-postscript_suffix');
701 $ps .= eval qq("$suffix");
708 =item generate_pdf FILENAME
710 Returns an PDF rendition of the LaTex file, as a scalar. FILENAME does not
711 contain the .tex suffix and is unlinked by this function.
715 use String::ShellQuote;
720 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
723 #system('pdflatex', "$file.tex");
724 #system('pdflatex', "$file.tex");
725 #! LaTeX Error: Unknown graphics extension: .eps.
729 my $sfile = shell_quote $file;
731 #system('dvipdf', "$file.dvi", "$file.pdf" );
733 "dvips -q -t letter -f $sfile.dvi ".
734 "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
737 or die "dvips | gs failed: $!";
739 open(PDF, "<$file.pdf")
740 or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
742 unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex");
758 #my $sfile = shell_quote $file;
762 '-interaction=batchmode',
763 '\AtBeginDocument{\RequirePackage{pslatex}}',
764 '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
765 '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
770 my $timeout = 30; #? should be more than enough
774 local($SIG{CHLD}) = sub {};
775 run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
776 or die "pslatex $file.tex failed; see $file.log for details?\n";
784 Sends the lines in ARRAYREF to the printer.
791 my $lpr = $conf->config('lpr');
794 run3 $lpr, $data, \$outerr, \$outerr;
796 $outerr = ": $outerr" if length($outerr);
797 die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
802 =item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ]
804 Converts the filehandle referenced by FILEREF from fixed length record
805 lines to a CSV file according to the lengths specified in LENGTH_LISTREF.
806 The CALLBACKS_LISTREF refers to a correpsonding list of coderefs. Each
807 should return the value to be substituted in place of its single argument.
809 Returns false on success or an error if one occurs.
814 my( $fhref, $countref, $lengths, $callbacks) = @_;
816 eval { require Text::CSV_XS; };
820 my $unpacker = new Text::CSV_XS;
822 my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths;
824 my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc";
825 my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX",
828 ) or return "can't open temp file: $!\n"
831 while ( defined(my $line=<$ofh>) ) {
837 return "unexpected input at line $$countref: $line".
838 " -- expected $total but received ". length($line)
839 unless length($line) == $total;
841 $unpacker->combine( map { my $i = $column++;
842 defined( $callbacks->[$i] )
843 ? &{ $callbacks->[$i] }( $_ )
845 } unpack( $template, $line )
847 or return "invalid data for CSV: ". $unpacker->error_input;
849 print $fh $unpacker->string(), "\n"
850 or return "can't write temp file: $!\n";
854 if ( $template ) { close $$fhref; $$fhref = $fh }
869 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
871 L<Fax::Hylafax::Client>