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( generate_email send_email send_fax
18 states_hash counties 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 elimiate code duplication.
47 =item generate_email OPTION => VALUE ...
55 Sender address, required
59 Recipient address, required
63 email subject, required
67 Email body (HTML alternative). Arrayref of lines, or scalar.
69 Will be placed inside an HTML <BODY> tag.
73 Email body (Text alternative). Arrayref of lines, or scalar.
77 Returns an argument list to be passsed to L<send_email>.
81 #false laziness w/FS::cust_bill::generate_email
89 my $me = '[FS::Misc::generate_email]';
92 'from' => $args{'from'},
94 'subject' => $args{'subject'},
97 #if (ref($args{'to'}) eq 'ARRAY') {
98 # $return{'to'} = $args{'to'};
100 # $return{'to'} = [ grep { $_ !~ /^(POST|FAX)$/ }
101 # $self->cust_main->invoicing_list
105 warn "$me creating HTML/text multipart message"
108 $return{'nobody'} = 1;
110 my $alternative = build MIME::Entity
111 'Type' => 'multipart/alternative',
112 'Encoding' => '7bit',
113 'Disposition' => 'inline'
117 if ( ref($args{'text_body'}) eq 'ARRAY' ) {
118 $data = $args{'text_body'};
120 $data = [ split(/\n/, $args{'text_body'}) ];
123 $alternative->attach(
124 'Type' => 'text/plain',
125 #'Encoding' => 'quoted-printable',
126 'Encoding' => '7bit',
128 'Disposition' => 'inline',
132 if ( ref($args{'html_body'}) eq 'ARRAY' ) {
133 @html_data = @{ $args{'html_body'} };
135 @html_data = split(/\n/, $args{'html_body'});
138 $alternative->attach(
139 'Type' => 'text/html',
140 'Encoding' => 'quoted-printable',
141 'Data' => [ '<html>',
144 ' '. encode_entities($return{'subject'}),
147 ' <body bgcolor="#e8e8e8">',
152 'Disposition' => 'inline',
153 #'Filename' => 'invoice.pdf',
156 #no other attachment:
158 # multipart/alternative
162 $return{'content-type'} = 'multipart/related';
163 $return{'mimeparts'} = [ $alternative ];
164 $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
165 #$return{'disposition'} = 'inline';
171 =item send_email OPTION => VALUE ...
183 (required) comma-separated scalar or arrayref of recipients
191 (optional) MIME type for the body
195 (required unless I<nobody> is true) arrayref of body text lines
199 (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().
203 (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,
204 I<content-type>, if specified, overrides the default "multipart/mixed" for the outermost MIME container.
206 =item content-encoding
208 (optional) when using nobody, optional top-level MIME
209 encoding which, if specified, overrides the default "7bit".
213 (optional) type parameter for multipart/related messages
219 use vars qw( $conf );
222 use Email::Sender::Simple qw(sendmail);
223 use Email::Sender::Transport::SMTP;
224 use Email::Sender::Transport::SMTP::TLS;
227 FS::UID->install_callback( sub {
228 $conf = new FS::Conf;
234 my %doptions = %options;
235 $doptions{'body'} = '(full body not shown in debug)';
236 warn "FS::Misc::send_email called with options:\n ". Dumper(\%doptions);
237 # join("\n", map { " $_: ". $options{$_} } keys %options ). "\n"
240 my $to = ref($options{to}) ? join(', ', @{ $options{to} } ) : $options{to};
244 if ( $options{'nobody'} ) {
246 croak "'mimeparts' option required when 'nobody' option given\n"
247 unless $options{'mimeparts'};
249 @mimeparts = @{$options{'mimeparts'}};
252 'Type' => ( $options{'content-type'} || 'multipart/mixed' ),
253 'Encoding' => ( $options{'content-encoding'} || '7bit' ),
258 @mimeparts = @{$options{'mimeparts'}}
259 if ref($options{'mimeparts'}) eq 'ARRAY';
261 if (scalar(@mimeparts)) {
264 'Type' => 'multipart/mixed',
265 'Encoding' => '7bit',
268 unshift @mimeparts, {
269 'Type' => ( $options{'content-type'} || 'text/plain' ),
270 'Data' => $options{'body'},
271 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
272 'Disposition' => 'inline',
278 'Type' => ( $options{'content-type'} || 'text/plain' ),
279 'Data' => $options{'body'},
280 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
288 if ( $options{'from'} =~ /\@([\w\.\-]+)/ ) {
291 warn 'no domain found in invoice from address '. $options{'from'}.
292 '; constructing Message-ID (and saying HELO) @example.com';
293 $domain = 'example.com';
295 my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
297 my $message = MIME::Entity->build(
298 'From' => $options{'from'},
300 'Sender' => $options{'from'},
301 'Reply-To' => $options{'from'},
302 'Date' => time2str("%a, %d %b %Y %X %z", time),
303 'Subject' => $options{'subject'},
304 'Message-ID' => "<$message_id>",
308 if ( $options{'type'} ) {
309 #false laziness w/cust_bill::generate_email
310 $message->head->replace('Content-type',
312 '; boundary="'. $message->head->multipart_boundary. '"'.
313 '; type='. $options{'type'}
317 foreach my $part (@mimeparts) {
319 if ( UNIVERSAL::isa($part, 'MIME::Entity') ) {
321 warn "attaching MIME part from MIME::Entity object\n"
323 $message->add_part($part);
325 } elsif ( ref($part) eq 'HASH' ) {
327 warn "attaching MIME part from hashref:\n".
328 join("\n", map " $_: ".$part->{$_}, keys %$part ). "\n"
330 $message->attach(%$part);
333 croak "mimepart $part isn't a hashref or MIME::Entity object!";
340 my %smtp_opt = ( 'host' => $conf->config('smtpmachine'),
344 my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
345 $smtp_opt{'port'} = $port;
348 if ( defined($enc) && $enc eq 'starttls' ) {
349 $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password);
350 $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt );
352 if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
353 $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password);
355 $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls';
356 $transport = Email::Sender::Transport::SMTP->new( %smtp_opt );
359 local $@; # just in case
360 eval { sendmail($message, { transport => $transport }) };
362 if(ref($@) and $@->isa('Email::Sender::Failure')) {
363 return ($@->code ? $@->code.' ' : '').$@->message
370 =item send_fax OPTION => VALUE ...
374 I<dialstring> - (required) 10-digit phone number w/ area code
376 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
380 I<docfile> - (required) Filename of PostScript TIFF Class F document
382 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
391 die 'HylaFAX support has not been configured.'
392 unless $conf->exists('hylafax');
395 require Fax::Hylafax::Client;
399 if ($@ =~ /^Can't locate Fax.*/) {
400 die "You must have Fax::Hylafax::Client installed to use invoice faxing."
406 my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
408 die 'Called send_fax without a \'dialstring\'.'
409 unless exists($options{'dialstring'});
411 if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
412 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
413 my $fh = new File::Temp(
414 TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
417 ) or die "can't open temp file: $!\n";
419 $options{docfile} = $fh->filename;
421 print $fh @{$options{'docdata'}};
424 delete $options{'docdata'};
427 die 'Called send_fax without a \'docfile\' or \'docdata\'.'
428 unless exists($options{'docfile'});
430 #FIXME: Need to send canonical dialstring to HylaFAX, but this only
433 $options{'dialstring'} =~ s/[^\d\+]//g;
434 if ($options{'dialstring'} =~ /^\d{10}$/) {
435 $options{dialstring} = '+1' . $options{'dialstring'};
437 return 'Invalid dialstring ' . $options{'dialstring'} . '.';
440 my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
442 if ($faxjob->success) {
443 warn "Successfully queued fax to '$options{dialstring}' with jobid " .
448 return 'Error while sending FAX: ' . $faxjob->trace;
453 =item states_hash COUNTRY
455 Returns a list of key/value pairs containing state (or other sub-country
456 division) abbriviations and names.
460 use FS::Record qw(qsearch);
461 use Locale::SubCountry;
468 map { s/[\n\r]//g; $_; }
472 'table' => 'cust_main_county',
473 'hashref' => { 'country' => $country },
474 'extra_sql' => 'GROUP BY state',
477 #it could throw a fatal "Invalid country code" error (for example "AX")
478 my $subcountry = eval { new Locale::SubCountry($country) }
479 or return ( '', '(n/a)' );
481 #"i see your schwartz is as big as mine!"
482 map { ( $_->[0] => $_->[1] ) }
483 sort { $a->[1] cmp $b->[1] }
484 map { [ $_ => state_label($_, $subcountry) ] }
488 =item counties STATE COUNTRY
490 Returns a list of counties for this state and country.
495 my( $state, $country ) = @_;
497 sort map { s/[\n\r]//g; $_; }
500 'select' => 'DISTINCT county',
501 'table' => 'cust_main_county',
502 'hashref' => { 'state' => $state,
503 'country' => $country,
508 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
513 my( $state, $country ) = @_;
515 unless ( ref($country) ) {
516 $country = eval { new Locale::SubCountry($country) }
521 # US kludge to avoid changing existing behaviour
522 # also we actually *use* the abbriviations...
523 my $full_name = $country->country_code eq 'US'
525 : $country->full_name($state);
527 $full_name = '' if $full_name eq 'unknown';
528 $full_name =~ s/\(see also.*\)\s*$//;
529 $full_name .= " ($state)" if $full_name;
531 $full_name || $state || '(n/a)';
537 Returns a hash reference of the accepted credit card types. Keys are shorter
538 identifiers and values are the longer strings used by the system (see
539 L<Business::CreditCard>).
546 my $conf = new FS::Conf;
549 #displayname #value (Business::CreditCard)
550 "VISA" => "VISA card",
551 "MasterCard" => "MasterCard",
552 "Discover" => "Discover card",
553 "American Express" => "American Express card",
554 "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
555 "enRoute" => "enRoute",
557 "BankCard" => "BankCard",
558 "Switch" => "Switch",
561 my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
562 if ( @conf_card_types ) {
563 #perhaps the hash is backwards for this, but this way works better for
564 #usage in selfservice
565 %card_types = map { $_ => $card_types{$_} }
568 grep { $card_types{$d} eq $_ } @conf_card_types
576 =item generate_ps FILENAME
578 Returns an postscript rendition of the LaTex file, as a scalar.
579 FILENAME does not contain the .tex suffix and is unlinked by this function.
583 use String::ShellQuote;
588 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
593 system('dvips', '-q', '-t', 'letter', "$file.dvi", '-o', "$file.ps" ) == 0
594 or die "dvips failed";
596 open(POSTSCRIPT, "<$file.ps")
597 or die "can't open $file.ps: $! (error in LaTeX template?)\n";
599 unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex");
603 if ( $conf->exists('lpr-postscript_prefix') ) {
604 my $prefix = $conf->config('lpr-postscript_prefix');
605 $ps .= eval qq("$prefix");
608 while (<POSTSCRIPT>) {
614 if ( $conf->exists('lpr-postscript_suffix') ) {
615 my $suffix = $conf->config('lpr-postscript_suffix');
616 $ps .= eval qq("$suffix");
625 Returns a hash reference of allowed package billing frequencies.
630 tie my %freq, 'Tie::IxHash', (
631 '0' => '(no recurring fee)',
634 '2d' => 'every two days',
635 '3d' => 'every three days',
637 '2w' => 'biweekly (every 2 weeks)',
639 '45d' => 'every 45 days',
640 '2' => 'bimonthly (every 2 months)',
641 '3' => 'quarterly (every 3 months)',
642 '4' => 'every 4 months',
643 '137d' => 'every 4 1/2 months (137 days)',
644 '6' => 'semiannually (every 6 months)',
646 '13' => 'every 13 months (annually +1 month)',
647 '24' => 'biannually (every 2 years)',
648 '36' => 'triannually (every 3 years)',
649 '48' => '(every 4 years)',
650 '60' => '(every 5 years)',
651 '120' => '(every 10 years)',
656 =item generate_pdf FILENAME
658 Returns an PDF rendition of the LaTex file, as a scalar. FILENAME does not
659 contain the .tex suffix and is unlinked by this function.
663 use String::ShellQuote;
668 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
671 #system('pdflatex', "$file.tex");
672 #system('pdflatex', "$file.tex");
673 #! LaTeX Error: Unknown graphics extension: .eps.
677 my $sfile = shell_quote $file;
679 #system('dvipdf', "$file.dvi", "$file.pdf" );
681 "dvips -q -t letter -f $sfile.dvi ".
682 "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
685 or die "dvips | gs failed: $!";
687 open(PDF, "<$file.pdf")
688 or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
690 unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex");
706 #my $sfile = shell_quote $file;
710 '-interaction=batchmode',
711 '\AtBeginDocument{\RequirePackage{pslatex}}',
712 '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
713 '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
718 my $timeout = 30; #? should be more than enough
722 local($SIG{CHLD}) = sub {};
723 run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
724 or die "pslatex $file.tex failed; see $file.log for details?\n";
732 Sends the lines in ARRAYREF to the printer.
739 my $lpr = $conf->config('lpr');
742 run3 $lpr, $data, \$outerr, \$outerr;
744 $outerr = ": $outerr" if length($outerr);
745 die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
750 =item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ]
752 Converts the filehandle referenced by FILEREF from fixed length record
753 lines to a CSV file according to the lengths specified in LENGTH_LISTREF.
754 The CALLBACKS_LISTREF refers to a correpsonding list of coderefs. Each
755 should return the value to be substituted in place of its single argument.
757 Returns false on success or an error if one occurs.
762 my( $fhref, $countref, $lengths, $callbacks) = @_;
764 eval { require Text::CSV_XS; };
768 my $unpacker = new Text::CSV_XS;
770 my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths;
772 my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc";
773 my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX",
776 ) or return "can't open temp file: $!\n"
779 while ( defined(my $line=<$ofh>) ) {
785 return "unexpected input at line $$countref: $line".
786 " -- expected $total but received ". length($line)
787 unless length($line) == $total;
789 $unpacker->combine( map { my $i = $column++;
790 defined( $callbacks->[$i] )
791 ? &{ $callbacks->[$i] }( $_ )
793 } unpack( $template, $line )
795 or return "invalid data for CSV: ". $unpacker->error_input;
797 print $fh $unpacker->string(), "\n"
798 or return "can't write temp file: $!\n";
802 if ( $template ) { close $$fhref; $$fhref = $fh }
817 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
819 L<Fax::Hylafax::Client>