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
12 #do NOT depend on any FS:: modules here, causes weird (sometimes unreproducable
13 #until on client machine) dependancy loops. put them in FS::Misc::Something
16 @ISA = qw( Exporter );
17 @EXPORT_OK = qw( send_email generate_email send_fax
18 states_hash counties cities state_label
21 generate_ps generate_pdf do_print
29 FS::Misc - Miscellaneous subroutines
33 use FS::Misc qw(send_email);
39 Miscellaneous subroutines. This module contains miscellaneous subroutines
40 called from multiple other modules. These are not OO or necessarily related,
41 but are collected here to eliminate code duplication.
47 =item send_email OPTION => VALUE ...
59 (required) comma-separated scalar or arrayref of recipients
67 (optional) MIME type for the body
71 (required unless I<nobody> is true) arrayref of body text lines
75 (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().
79 (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,
80 I<content-type>, if specified, overrides the default "multipart/mixed" for the outermost MIME container.
82 =item content-encoding
84 (optional) when using nobody, optional top-level MIME
85 encoding which, if specified, overrides the default "7bit".
89 (optional) type parameter for multipart/related messages
98 use Email::Sender::Simple qw(sendmail);
99 use Email::Sender::Transport::SMTP;
100 use Email::Sender::Transport::SMTP::TLS;
103 FS::UID->install_callback( sub {
104 $conf = new FS::Conf;
110 my %doptions = %options;
111 $doptions{'body'} = '(full body not shown in debug)';
112 warn "FS::Misc::send_email called with options:\n ". Dumper(\%doptions);
113 # join("\n", map { " $_: ". $options{$_} } keys %options ). "\n"
116 my @to = ref($options{to}) ? @{ $options{to} } : ( $options{to} );
120 if ( $options{'nobody'} ) {
122 croak "'mimeparts' option required when 'nobody' option given\n"
123 unless $options{'mimeparts'};
125 @mimeparts = @{$options{'mimeparts'}};
128 'Type' => ( $options{'content-type'} || 'multipart/mixed' ),
129 'Encoding' => ( $options{'content-encoding'} || '7bit' ),
134 @mimeparts = @{$options{'mimeparts'}}
135 if ref($options{'mimeparts'}) eq 'ARRAY';
137 if (scalar(@mimeparts)) {
140 'Type' => 'multipart/mixed',
141 'Encoding' => '7bit',
144 unshift @mimeparts, {
145 'Type' => ( $options{'content-type'} || 'text/plain' ),
146 'Data' => $options{'body'},
147 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
148 'Disposition' => 'inline',
154 'Type' => ( $options{'content-type'} || 'text/plain' ),
155 'Data' => $options{'body'},
156 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
164 if ( $options{'from'} =~ /\@([\w\.\-]+)/ ) {
167 warn 'no domain found in invoice from address '. $options{'from'}.
168 '; constructing Message-ID (and saying HELO) @example.com';
169 $domain = 'example.com';
171 my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
173 my $message = MIME::Entity->build(
174 'From' => $options{'from'},
175 'To' => join(', ', @to),
176 'Sender' => $options{'from'},
177 'Reply-To' => $options{'from'},
178 'Date' => time2str("%a, %d %b %Y %X %z", time),
179 'Subject' => $options{'subject'},
180 'Message-ID' => "<$message_id>",
184 if ( $options{'type'} ) {
185 #false laziness w/cust_bill::generate_email
186 $message->head->replace('Content-type',
188 '; boundary="'. $message->head->multipart_boundary. '"'.
189 '; type='. $options{'type'}
193 foreach my $part (@mimeparts) {
195 if ( UNIVERSAL::isa($part, 'MIME::Entity') ) {
197 warn "attaching MIME part from MIME::Entity object\n"
199 $message->add_part($part);
201 } elsif ( ref($part) eq 'HASH' ) {
203 warn "attaching MIME part from hashref:\n".
204 join("\n", map " $_: ".$part->{$_}, keys %$part ). "\n"
206 $message->attach(%$part);
209 croak "mimepart $part isn't a hashref or MIME::Entity object!";
216 my %smtp_opt = ( 'host' => $conf->config('smtpmachine'),
220 my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
221 $smtp_opt{'port'} = $port;
224 if ( defined($enc) && $enc eq 'starttls' ) {
225 $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password);
226 $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt );
228 if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
229 $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password);
231 $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls';
232 $transport = Email::Sender::Transport::SMTP->new( %smtp_opt );
235 push @to, $options{bcc} if defined($options{bcc});
236 local $@; # just in case
237 eval { sendmail($message, { transport => $transport,
238 from => $options{from},
241 if(ref($@) and $@->isa('Email::Sender::Failure')) {
242 return ($@->code ? $@->code.' ' : '').$@->message
249 =item generate_email OPTION => VALUE ...
257 Sender address, required
261 Recipient address, required
265 Blind copy address, optional
269 email subject, required
273 Email body (HTML alternative). Arrayref of lines, or scalar.
275 Will be placed inside an HTML <BODY> tag.
279 Email body (Text alternative). Arrayref of lines, or scalar.
283 Constructs a multipart message from text_body and html_body.
287 #false laziness w/FS::cust_bill::generate_email
295 my $me = '[FS::Misc::generate_email]';
298 'from' => $args{'from'},
300 'bcc' => $args{'bcc'},
301 'subject' => $args{'subject'},
304 #if (ref($args{'to'}) eq 'ARRAY') {
305 # $return{'to'} = $args{'to'};
307 # $return{'to'} = [ grep { $_ !~ /^(POST|FAX)$/ }
308 # $self->cust_main->invoicing_list
312 warn "$me creating HTML/text multipart message"
315 $return{'nobody'} = 1;
317 my $alternative = build MIME::Entity
318 'Type' => 'multipart/alternative',
319 'Encoding' => '7bit',
320 'Disposition' => 'inline'
324 if ( ref($args{'text_body'}) eq 'ARRAY' ) {
325 $data = $args{'text_body'};
327 $data = [ split(/\n/, $args{'text_body'}) ];
330 $alternative->attach(
331 'Type' => 'text/plain',
332 #'Encoding' => 'quoted-printable',
333 'Encoding' => '7bit',
335 'Disposition' => 'inline',
339 if ( ref($args{'html_body'}) eq 'ARRAY' ) {
340 @html_data = @{ $args{'html_body'} };
342 @html_data = split(/\n/, $args{'html_body'});
345 $alternative->attach(
346 'Type' => 'text/html',
347 'Encoding' => 'quoted-printable',
348 'Data' => [ '<html>',
351 ' '. encode_entities($return{'subject'}),
354 ' <body bgcolor="#e8e8e8">',
359 'Disposition' => 'inline',
360 #'Filename' => 'invoice.pdf',
363 #no other attachment:
365 # multipart/alternative
369 $return{'content-type'} = 'multipart/related';
370 $return{'mimeparts'} = [ $alternative ];
371 $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
372 #$return{'disposition'} = 'inline';
378 =item process_send_email OPTION => VALUE ...
380 Takes arguments as per generate_email() and sends the message. This
381 will die on any error and can be used in the job queue.
385 sub process_send_email {
387 my $error = send_email(generate_email(%message));
388 die "$error\n" if $error;
392 =item send_fax OPTION => VALUE ...
396 I<dialstring> - (required) 10-digit phone number w/ area code
398 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
402 I<docfile> - (required) Filename of PostScript TIFF Class F document
404 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
413 die 'HylaFAX support has not been configured.'
414 unless $conf->exists('hylafax');
417 require Fax::Hylafax::Client;
421 if ($@ =~ /^Can't locate Fax.*/) {
422 die "You must have Fax::Hylafax::Client installed to use invoice faxing."
428 my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
430 die 'Called send_fax without a \'dialstring\'.'
431 unless exists($options{'dialstring'});
433 if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
434 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
435 my $fh = new File::Temp(
436 TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
439 ) or die "can't open temp file: $!\n";
441 $options{docfile} = $fh->filename;
443 print $fh @{$options{'docdata'}};
446 delete $options{'docdata'};
449 die 'Called send_fax without a \'docfile\' or \'docdata\'.'
450 unless exists($options{'docfile'});
452 #FIXME: Need to send canonical dialstring to HylaFAX, but this only
455 $options{'dialstring'} =~ s/[^\d\+]//g;
456 if ($options{'dialstring'} =~ /^\d{10}$/) {
457 $options{dialstring} = '+1' . $options{'dialstring'};
459 return 'Invalid dialstring ' . $options{'dialstring'} . '.';
462 my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
464 if ($faxjob->success) {
465 warn "Successfully queued fax to '$options{dialstring}' with jobid " .
470 return 'Error while sending FAX: ' . $faxjob->trace;
475 =item states_hash COUNTRY
477 Returns a list of key/value pairs containing state (or other sub-country
478 division) abbriviations and names.
482 use FS::Record qw(qsearch);
483 use Locale::SubCountry;
490 map { s/[\n\r]//g; $_; }
494 'table' => 'cust_main_county',
495 'hashref' => { 'country' => $country },
496 'extra_sql' => 'GROUP BY state',
499 #it could throw a fatal "Invalid country code" error (for example "AX")
500 my $subcountry = eval { new Locale::SubCountry($country) }
501 or return ( '', '(n/a)' );
503 #"i see your schwartz is as big as mine!"
504 map { ( $_->[0] => $_->[1] ) }
505 sort { $a->[1] cmp $b->[1] }
506 map { [ $_ => state_label($_, $subcountry) ] }
510 =item counties STATE COUNTRY
512 Returns a list of counties for this state and country.
517 my( $state, $country ) = @_;
519 map { $_ } #return num_counties($state, $country) unless wantarray;
520 sort map { s/[\n\r]//g; $_; }
523 'select' => 'DISTINCT county',
524 'table' => 'cust_main_county',
525 'hashref' => { 'state' => $state,
526 'country' => $country,
531 =item cities COUNTY STATE COUNTRY
533 Returns a list of cities for this county, state and country.
538 my( $county, $state, $country ) = @_;
540 map { $_ } #return num_cities($county, $state, $country) unless wantarray;
541 sort map { s/[\n\r]//g; $_; }
544 'select' => 'DISTINCT city',
545 'table' => 'cust_main_county',
546 'hashref' => { 'county' => $county,
548 'country' => $country,
553 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
558 my( $state, $country ) = @_;
560 unless ( ref($country) ) {
561 $country = eval { new Locale::SubCountry($country) }
566 # US kludge to avoid changing existing behaviour
567 # also we actually *use* the abbriviations...
568 my $full_name = $country->country_code eq 'US'
570 : $country->full_name($state);
572 $full_name = '' if $full_name eq 'unknown';
573 $full_name =~ s/\(see also.*\)\s*$//;
574 $full_name .= " ($state)" if $full_name;
576 $full_name || $state || '(n/a)';
582 Returns a hash reference of the accepted credit card types. Keys are shorter
583 identifiers and values are the longer strings used by the system (see
584 L<Business::CreditCard>).
591 my $conf = new FS::Conf;
594 #displayname #value (Business::CreditCard)
595 "VISA" => "VISA card",
596 "MasterCard" => "MasterCard",
597 "Discover" => "Discover card",
598 "American Express" => "American Express card",
599 "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
600 "enRoute" => "enRoute",
602 "BankCard" => "BankCard",
603 "Switch" => "Switch",
606 my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
607 if ( @conf_card_types ) {
608 #perhaps the hash is backwards for this, but this way works better for
609 #usage in selfservice
610 %card_types = map { $_ => $card_types{$_} }
613 grep { $card_types{$d} eq $_ } @conf_card_types
623 Returns a hash reference of allowed package billing frequencies.
628 tie my %freq, 'Tie::IxHash', (
629 '0' => '(no recurring fee)',
632 '2d' => 'every two days',
633 '3d' => 'every three days',
635 '2w' => 'biweekly (every 2 weeks)',
637 '45d' => 'every 45 days',
638 '2' => 'bimonthly (every 2 months)',
639 '3' => 'quarterly (every 3 months)',
640 '4' => 'every 4 months',
641 '137d' => 'every 4 1/2 months (137 days)',
642 '6' => 'semiannually (every 6 months)',
644 '13' => 'every 13 months (annually +1 month)',
645 '24' => 'biannually (every 2 years)',
646 '36' => 'triannually (every 3 years)',
647 '48' => '(every 4 years)',
648 '60' => '(every 5 years)',
649 '120' => '(every 10 years)',
654 =item generate_ps FILENAME
656 Returns an postscript rendition of the LaTex file, as a scalar.
657 FILENAME does not contain the .tex suffix and is unlinked by this function.
661 use String::ShellQuote;
666 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
671 system('dvips', '-q', '-t', 'letter', "$file.dvi", '-o', "$file.ps" ) == 0
672 or die "dvips failed";
674 open(POSTSCRIPT, "<$file.ps")
675 or die "can't open $file.ps: $! (error in LaTeX template?)\n";
677 unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex");
681 if ( $conf->exists('lpr-postscript_prefix') ) {
682 my $prefix = $conf->config('lpr-postscript_prefix');
683 $ps .= eval qq("$prefix");
686 while (<POSTSCRIPT>) {
692 if ( $conf->exists('lpr-postscript_suffix') ) {
693 my $suffix = $conf->config('lpr-postscript_suffix');
694 $ps .= eval qq("$suffix");
701 =item generate_pdf FILENAME
703 Returns an PDF rendition of the LaTex file, as a scalar. FILENAME does not
704 contain the .tex suffix and is unlinked by this function.
708 use String::ShellQuote;
713 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
716 #system('pdflatex', "$file.tex");
717 #system('pdflatex', "$file.tex");
718 #! LaTeX Error: Unknown graphics extension: .eps.
722 my $sfile = shell_quote $file;
724 #system('dvipdf', "$file.dvi", "$file.pdf" );
726 "dvips -q -t letter -f $sfile.dvi ".
727 "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
730 or die "dvips | gs failed: $!";
732 open(PDF, "<$file.pdf")
733 or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
735 unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex");
751 #my $sfile = shell_quote $file;
755 '-interaction=batchmode',
756 '\AtBeginDocument{\RequirePackage{pslatex}}',
757 '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
758 '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
763 my $timeout = 30; #? should be more than enough
767 local($SIG{CHLD}) = sub {};
768 run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
769 or die "pslatex $file.tex failed; see $file.log for details?\n";
777 Sends the lines in ARRAYREF to the printer.
784 my $lpr = $conf->config('lpr');
787 run3 $lpr, $data, \$outerr, \$outerr;
789 $outerr = ": $outerr" if length($outerr);
790 die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
795 =item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ]
797 Converts the filehandle referenced by FILEREF from fixed length record
798 lines to a CSV file according to the lengths specified in LENGTH_LISTREF.
799 The CALLBACKS_LISTREF refers to a correpsonding list of coderefs. Each
800 should return the value to be substituted in place of its single argument.
802 Returns false on success or an error if one occurs.
807 my( $fhref, $countref, $lengths, $callbacks) = @_;
809 eval { require Text::CSV_XS; };
813 my $unpacker = new Text::CSV_XS;
815 my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths;
817 my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc";
818 my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX",
821 ) or return "can't open temp file: $!\n"
824 while ( defined(my $line=<$ofh>) ) {
830 return "unexpected input at line $$countref: $line".
831 " -- expected $total but received ". length($line)
832 unless length($line) == $total;
834 $unpacker->combine( map { my $i = $column++;
835 defined( $callbacks->[$i] )
836 ? &{ $callbacks->[$i] }( $_ )
838 } unpack( $template, $line )
840 or return "invalid data for CSV: ". $unpacker->error_input;
842 print $fh $unpacker->string(), "\n"
843 or return "can't write temp file: $!\n";
847 if ( $template ) { close $$fhref; $$fhref = $fh }
862 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
864 L<Fax::Hylafax::Client>