71513: Card tokenization [v3 test tweak]
[freeside.git] / FS / FS / Misc.pm
1 package FS::Misc;
2
3 use strict;
4 use vars qw ( @ISA @EXPORT_OK $DEBUG );
5 use Exporter;
6 use Carp;
7 use Data::Dumper;
8 use IPC::Run qw( run timeout );   # for _pslatex
9 use IPC::Run3; # for do_print... should just use IPC::Run i guess
10 use File::Temp;
11 use Tie::IxHash;
12 use Encode;
13 #do NOT depend on any FS:: modules here, causes weird (sometimes unreproducable
14 #until on client machine) dependancy loops.  put them in FS::Misc::Something
15 #instead
16
17 @ISA = qw( Exporter );
18 @EXPORT_OK = qw( send_email generate_email send_fax
19                  states_hash counties cities state_label
20                  card_types
21                  pkg_freqs
22                  generate_ps generate_pdf do_print
23                  csv_from_fixed
24                  ocr_image
25                  bytes_substr
26                  money_pretty
27                );
28
29 $DEBUG = 0;
30
31 =head1 NAME
32
33 FS::Misc - Miscellaneous subroutines
34
35 =head1 SYNOPSIS
36
37   use FS::Misc qw(send_email);
38
39   send_email();
40
41 =head1 DESCRIPTION
42
43 Miscellaneous subroutines.  This module contains miscellaneous subroutines
44 called from multiple other modules.  These are not OO or necessarily related,
45 but are collected here to eliminate code duplication.
46
47 =head1 SUBROUTINES
48
49 =over 4
50
51 =item send_email OPTION => VALUE ...
52
53 Options:
54
55 =over 4
56
57 =item from
58
59 (required)
60
61 =item to
62
63 (required) comma-separated scalar or arrayref of recipients
64
65 =item subject
66
67 (required)
68
69 =item content-type
70
71 (optional) MIME type for the body
72
73 =item body
74
75 (required unless I<nobody> is true) arrayref of body text lines
76
77 =item mimeparts
78
79 (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().
80
81 =item nobody
82
83 (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,
84 I<content-type>, if specified, overrides the default "multipart/mixed" for the outermost MIME container.
85
86 =item content-encoding
87
88 (optional) when using nobody, optional top-level MIME
89 encoding which, if specified, overrides the default "7bit".
90
91 =item type
92
93 (optional) type parameter for multipart/related messages
94
95 =item custnum
96
97 (optional) L<FS::cust_main> key; if passed, the message will be logged
98 (if logging is enabled) with this custnum.
99
100 =item msgnum
101
102 (optional) L<FS::msg_template> key, for logging.
103
104 =back
105
106 =cut
107
108 use vars qw( $conf );
109 use Date::Format;
110 use MIME::Entity;
111 use Email::Sender::Simple qw(sendmail);
112 use Email::Sender::Transport::SMTP;
113 use Email::Sender::Transport::SMTP::TLS 0.11;
114 use FS::UID;
115
116 FS::UID->install_callback( sub {
117   $conf = new FS::Conf;
118 } );
119
120 sub send_email {
121   my(%options) = @_;
122   if ( $DEBUG ) {
123     my %doptions = %options;
124     $doptions{'body'} = '(full body not shown in debug)';
125     warn "FS::Misc::send_email called with options:\n  ". Dumper(\%doptions);
126 #         join("\n", map { "  $_: ". $options{$_} } keys %options ). "\n"
127   }
128
129   my @to = ref($options{to}) ? @{ $options{to} } : ( $options{to} );
130
131   my @mimeargs = ();
132   my @mimeparts = ();
133   if ( $options{'nobody'} ) {
134
135     croak "'mimeparts' option required when 'nobody' option given\n"
136       unless $options{'mimeparts'};
137
138     @mimeparts = @{$options{'mimeparts'}};
139
140     @mimeargs = (
141       'Type'         => ( $options{'content-type'} || 'multipart/mixed' ),
142       'Encoding'     => ( $options{'content-encoding'} || '7bit' ),
143     );
144
145   } else {
146
147     @mimeparts = @{$options{'mimeparts'}}
148       if ref($options{'mimeparts'}) eq 'ARRAY';
149
150     if (scalar(@mimeparts)) {
151
152       @mimeargs = (
153         'Type'     => 'multipart/mixed',
154         'Encoding' => '7bit',
155       );
156   
157       unshift @mimeparts, { 
158         'Type'        => ( $options{'content-type'} || 'text/plain' ),
159         'Data'        => $options{'body'},
160         'Encoding'    => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
161         'Disposition' => 'inline',
162       };
163
164     } else {
165     
166       @mimeargs = (
167         'Type'     => ( $options{'content-type'} || 'text/plain' ),
168         'Data'     => $options{'body'},
169         'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
170       );
171
172     }
173
174   }
175
176   my $from = $options{from};
177   $from =~ s/^\s*//; $from =~ s/\s*$//;
178   if ( $from =~ /^(.*)\s*<(.*@.*)>$/ ) {
179     # a common idiom
180     $from = $2;
181   }
182
183   my $domain;
184   if ( $from =~ /\@([\w\.\-]+)/ ) {
185     $domain = $1;
186   } else {
187     warn 'no domain found in invoice from address '. $options{'from'}.
188          '; constructing Message-ID (and saying HELO) @example.com'; 
189     $domain = 'example.com';
190   }
191   my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
192
193   my $time = time;
194   my $message = MIME::Entity->build(
195     'From'       => $options{'from'},
196     'To'         => join(', ', @to),
197     'Sender'     => $options{'from'},
198     'Reply-To'   => $options{'from'},
199     'Date'       => time2str("%a, %d %b %Y %X %z", $time),
200     'Subject'    => Encode::encode('MIME-Header', $options{'subject'}),
201     'Message-ID' => "<$message_id>",
202     @mimeargs,
203   );
204
205   if ( $options{'type'} ) {
206     #false laziness w/cust_bill::generate_email
207     $message->head->replace('Content-type',
208       $message->mime_type.
209       '; boundary="'. $message->head->multipart_boundary. '"'.
210       '; type='. $options{'type'}
211     );
212   }
213
214   foreach my $part (@mimeparts) {
215
216     if ( UNIVERSAL::isa($part, 'MIME::Entity') ) {
217
218       warn "attaching MIME part from MIME::Entity object\n"
219         if $DEBUG;
220       $message->add_part($part);
221
222     } elsif ( ref($part) eq 'HASH' ) {
223
224       warn "attaching MIME part from hashref:\n".
225            join("\n", map "  $_: ".$part->{$_}, keys %$part ). "\n"
226         if $DEBUG;
227       $message->attach(%$part);
228
229     } else {
230       croak "mimepart $part isn't a hashref or MIME::Entity object!";
231     }
232
233   }
234
235   #send the email
236
237   my %smtp_opt = ( 'host' => $conf->config('smtpmachine'),
238                    'helo' => $domain,
239                  );
240
241   my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
242   $smtp_opt{'port'} = $port;
243
244   my $transport;
245   if ( defined($enc) && $enc eq 'starttls' ) {
246     $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password);
247     $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt );
248   } else {
249     if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
250       $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password);
251     }
252     $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls';
253     $transport = Email::Sender::Transport::SMTP->new( %smtp_opt );
254   }
255
256   push @to, $options{bcc} if defined($options{bcc});
257   # make sure 
258   my @env_to = split(/\s*,\s*/, join(', ', @to));
259   # strip display-name from envelope addresses
260   foreach (@env_to) {
261     s/^\s*//;
262     s/\s*$//;
263     s/^(.*)\s*<(.*@.*)>$/$2/;
264   }
265
266   local $@; # just in case
267   eval { sendmail($message, { transport => $transport,
268                               from      => $from,
269                               to        => \@env_to }) };
270
271   my $error = '';
272   if(ref($@) and $@->isa('Email::Sender::Failure')) {
273     $error = $@->code.' ' if $@->code;
274     $error .= $@->message;
275   }
276   else {
277     $error = $@;
278   }
279
280   # Logging
281   if ( $conf->exists('log_sent_mail') ) {
282     my $cust_msg = FS::cust_msg->new({
283         'env_from'  => $options{'from'},
284         'env_to'    => join(', ', @to),
285         'header'    => $message->header_as_string,
286         'body'      => $message->body_as_string,
287         '_date'     => $time,
288         'error'     => $error,
289         'custnum'   => $options{'custnum'},
290         'msgnum'    => $options{'msgnum'},
291         'status'    => ($error ? 'failed' : 'sent'),
292         'msgtype'   => $options{'msgtype'},
293     });
294     $cust_msg->insert; # ignore errors
295   }
296   $error;
297    
298 }
299
300 =item generate_email OPTION => VALUE ...
301
302 Options:
303
304 =over 4
305
306 =item from
307
308 Sender address, required
309
310 =item to
311
312 Recipient address, required
313
314 =item bcc
315
316 Blind copy address, optional
317
318 =item subject
319
320 email subject, required
321
322 =item html_body
323
324 Email body (HTML alternative).  Arrayref of lines, or scalar.
325
326 Will be placed inside an HTML <BODY> tag.
327
328 =item text_body
329
330 Email body (Text alternative).  Arrayref of lines, or scalar.
331
332 =item custnum, msgnum (optional)
333
334 Customer and template numbers, passed through to send_email for logging.
335
336 =back
337
338 Constructs a multipart message from text_body and html_body.
339
340 =cut
341
342 #false laziness w/FS::cust_bill::generate_email
343
344 use MIME::Entity;
345 use HTML::Entities;
346
347 sub generate_email {
348   my %args = @_;
349
350   my $me = '[FS::Misc::generate_email]';
351
352   my @fields = qw(from to bcc subject custnum msgnum msgtype);
353   my %return;
354   @return{@fields} = @args{@fields};
355
356   warn "$me creating HTML/text multipart message"
357     if $DEBUG;
358
359   $return{'nobody'} = 1;
360
361   my $alternative = build MIME::Entity
362     'Type'        => 'multipart/alternative',
363     'Encoding'    => '7bit',
364     'Disposition' => 'inline'
365   ;
366
367   my $data;
368   if ( ref($args{'text_body'}) eq 'ARRAY' ) {
369     $data = join("\n", @{ $args{'text_body'} });
370   } else {
371     $data = $args{'text_body'};
372   }
373
374   $alternative->attach(
375     'Type'        => 'text/plain',
376     'Encoding'    => 'quoted-printable',
377     #'Encoding'    => '7bit',
378     'Data'        => $data,
379     'Disposition' => 'inline',
380   );
381
382   my @html_data;
383   if ( ref($args{'html_body'}) eq 'ARRAY' ) {
384     @html_data = @{ $args{'html_body'} };
385   } else {
386     @html_data = split(/\n/, $args{'html_body'});
387   }
388
389   $alternative->attach(
390     'Type'        => 'text/html',
391     'Encoding'    => 'quoted-printable',
392     'Data'        => [ '<html>',
393                        '  <head>',
394                        '    <title>',
395                        '      '. encode_entities($return{'subject'}), 
396                        '    </title>',
397                        '  </head>',
398                        '  <body bgcolor="#ffffff">',
399                        @html_data,
400                        '  </body>',
401                        '</html>',
402                      ],
403     'Disposition' => 'inline',
404     #'Filename'    => 'invoice.pdf',
405   );
406
407   #no other attachment:
408   # multipart/related
409   #   multipart/alternative
410   #     text/plain
411   #     text/html
412
413   $return{'content-type'} = 'multipart/related';
414   $return{'mimeparts'} = [ $alternative ];
415   $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
416   #$return{'disposition'} = 'inline';
417
418   %return;
419
420 }
421
422 =item process_send_email OPTION => VALUE ...
423
424 Takes arguments as per generate_email() and sends the message.  This 
425 will die on any error and can be used in the job queue.
426
427 =cut
428
429 sub process_send_email {
430   my %message = @_;
431   my $error = send_email(generate_email(%message));
432   die "$error\n" if $error;
433   '';
434 }
435
436 =item process_send_generated_email OPTION => VALUE ...
437
438 Takes arguments as per send_email() and sends the message.  This 
439 will die on any error and can be used in the job queue.
440
441 =cut
442
443 sub process_send_generated_email {
444   my %args = @_;
445   my $error = send_email(%args);
446   die "$error\n" if $error;
447   '';
448 }
449
450 =item send_fax OPTION => VALUE ...
451
452 Options:
453
454 I<dialstring> - (required) 10-digit phone number w/ area code
455
456 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
457
458 -or-
459
460 I<docfile> - (required) Filename of PostScript TIFF Class F document
461
462 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
463
464
465 =cut
466
467 sub send_fax {
468
469   my %options = @_;
470
471   die 'HylaFAX support has not been configured.'
472     unless $conf->exists('hylafax');
473
474   eval {
475     require Fax::Hylafax::Client;
476   };
477
478   if ($@) {
479     if ($@ =~ /^Can't locate Fax.*/) {
480       die "You must have Fax::Hylafax::Client installed to use invoice faxing."
481     } else {
482       die $@;
483     }
484   }
485
486   my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
487
488   die 'Called send_fax without a \'dialstring\'.'
489     unless exists($options{'dialstring'});
490
491   if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
492       my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
493       my $fh = new File::Temp(
494         TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
495         DIR      => $dir,
496         UNLINK   => 0,
497       ) or die "can't open temp file: $!\n";
498
499       $options{docfile} = $fh->filename;
500
501       print $fh @{$options{'docdata'}};
502       close $fh;
503
504       delete $options{'docdata'};
505   }
506
507   die 'Called send_fax without a \'docfile\' or \'docdata\'.'
508     unless exists($options{'docfile'});
509
510   #FIXME: Need to send canonical dialstring to HylaFAX, but this only
511   #       works in the US.
512
513   $options{'dialstring'} =~ s/[^\d\+]//g;
514   if ($options{'dialstring'} =~ /^\d{10}$/) {
515     $options{dialstring} = '+1' . $options{'dialstring'};
516   } else {
517     return 'Invalid dialstring ' . $options{'dialstring'} . '.';
518   }
519
520   my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
521
522   if ($faxjob->success) {
523     warn "Successfully queued fax to '$options{dialstring}' with jobid " .
524            $faxjob->jobid
525       if $DEBUG;
526     return '';
527   } else {
528     return 'Error while sending FAX: ' . $faxjob->trace;
529   }
530
531 }
532
533 =item states_hash COUNTRY
534
535 Returns a list of key/value pairs containing state (or other sub-country
536 division) abbriviations and names.
537
538 =cut
539
540 use FS::Record qw(qsearch);
541 use Locale::SubCountry;
542
543 sub states_hash {
544   my($country) = @_;
545
546   #a hash?  not expecting an explosion of business from unrecognized countries..
547   return states_hash_nosubcountry($country) if $country eq 'XC';
548
549   my @states = 
550 #     sort
551      map { s/[\n\r]//g; $_; }
552      map { $_->state; }
553          qsearch({ 
554                    'select'    => 'state',
555                    'table'     => 'cust_main_county',
556                    'hashref'   => { 'country' => $country },
557                    'extra_sql' => 'GROUP BY state',
558                 });
559
560   #it could throw a fatal "Invalid country code" error (for example "AX")
561   my $subcountry = eval { new Locale::SubCountry($country) }
562     or return (); # ( '', '(n/a)' );
563
564   #"i see your schwartz is as big as mine!"
565   map  { ( $_->[0] => $_->[1] ) }
566   sort { $a->[1] cmp $b->[1] }
567   map  { [ $_ => state_label($_, $subcountry) ] }
568        @states;
569 }
570
571 sub states_hash_nosubcountry {
572   my($country) = @_;
573
574   my @states = 
575 #     sort
576      map { s/[\n\r]//g; $_; }
577      map { $_->state; }
578          qsearch({ 
579                    'select'    => 'state',
580                    'table'     => 'cust_main_county',
581                    'hashref'   => { 'country' => $country },
582                    'extra_sql' => 'GROUP BY state',
583                 });
584
585   #"i see your schwartz is as big as mine!"
586   map  { ( $_->[0] => $_->[1] ) }
587   sort { $a->[1] cmp $b->[1] }
588   map  { [ $_ => $_ ] }
589        @states;
590 }
591
592 =item counties STATE COUNTRY
593
594 Returns a list of counties for this state and country.
595
596 =cut
597
598 sub counties {
599   my( $state, $country ) = @_;
600
601   map { $_ } #return num_counties($state, $country) unless wantarray;
602   sort map { s/[\n\r]//g; $_; }
603        map { $_->county }
604            qsearch({
605              'select'  => 'DISTINCT county',
606              'table'   => 'cust_main_county',
607              'hashref' => { 'state'   => $state,
608                             'country' => $country,
609                           },
610            });
611 }
612
613 =item cities COUNTY STATE COUNTRY
614
615 Returns a list of cities for this county, state and country.
616
617 =cut
618
619 sub cities {
620   my( $county, $state, $country ) = @_;
621
622   map { $_ } #return num_cities($county, $state, $country) unless wantarray;
623   sort map { s/[\n\r]//g; $_; }
624        map { $_->city }
625            qsearch({
626              'select'  => 'DISTINCT city',
627              'table'   => 'cust_main_county',
628              'hashref' => { 'county'  => $county,
629                             'state'   => $state,
630                             'country' => $country,
631                           },
632            });
633 }
634
635 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
636
637 =cut
638
639 sub state_label {
640   my( $state, $country ) = @_;
641
642   unless ( ref($country) ) {
643     $country = eval { new Locale::SubCountry($country) }
644       or return'(n/a)';
645
646   }
647
648   # US kludge to avoid changing existing behaviour 
649   # also we actually *use* the abbriviations...
650   my $full_name = $country->country_code eq 'US'
651                     ? ''
652                     : $country->full_name($state);
653
654   $full_name = '' if $full_name eq 'unknown';
655   $full_name =~ s/\(see also.*\)\s*$//;
656   $full_name .= " ($state)" if $full_name;
657
658   $full_name || $state || '(n/a)';
659
660 }
661
662 =item card_types
663
664 Returns a hash reference of the accepted credit card types.  Keys are shorter
665 identifiers and values are the longer strings used by the system (see
666 L<Business::CreditCard>).
667
668 =cut
669
670 #$conf from above
671
672 sub card_types {
673   my $conf = new FS::Conf;
674
675   my %card_types = (
676     #displayname                    #value (Business::CreditCard)
677     "VISA"                       => "VISA card",
678     "MasterCard"                 => "MasterCard",
679     "Discover"                   => "Discover card",
680     "American Express"           => "American Express card",
681     "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
682     "enRoute"                    => "enRoute",
683     "JCB"                        => "JCB",
684     "BankCard"                   => "BankCard",
685     "Switch"                     => "Switch",
686     "Solo"                       => "Solo",
687   );
688   my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
689   if ( @conf_card_types ) {
690     #perhaps the hash is backwards for this, but this way works better for
691     #usage in selfservice
692     %card_types = map  { $_ => $card_types{$_} }
693                   grep {
694                          my $d = $_;
695                            grep { $card_types{$d} eq $_ } @conf_card_types
696                        }
697                     keys %card_types;
698   }
699
700   \%card_types;
701 }
702
703 =item pkg_freqs
704
705 Returns a hash reference of allowed package billing frequencies.
706
707 =cut
708
709 sub pkg_freqs {
710   tie my %freq, 'Tie::IxHash', (
711     '0'    => '(no recurring fee)',
712     '1h'   => 'hourly',
713     '1d'   => 'daily',
714     '2d'   => 'every two days',
715     '3d'   => 'every three days',
716     '1w'   => 'weekly',
717     '2w'   => 'biweekly (every 2 weeks)',
718     '1'    => 'monthly',
719     '45d'  => 'every 45 days',
720     '2'    => 'bimonthly (every 2 months)',
721     '3'    => 'quarterly (every 3 months)',
722     '4'    => 'every 4 months',
723     '137d' => 'every 4 1/2 months (137 days)',
724     '6'    => 'semiannually (every 6 months)',
725     '12'   => 'annually',
726     '13'   => 'every 13 months (annually +1 month)',
727     '24'   => 'biannually (every 2 years)',
728     '36'   => 'triannually (every 3 years)',
729     '48'   => '(every 4 years)',
730     '60'   => '(every 5 years)',
731     '120'  => '(every 10 years)',
732   ) ;
733   \%freq;
734 }
735
736 =item generate_ps FILENAME
737
738 Returns an postscript rendition of the LaTex file, as a scalar.
739 FILENAME does not contain the .tex suffix and is unlinked by this function.
740
741 =cut
742
743 use String::ShellQuote;
744
745 sub generate_ps {
746   my $file = shift;
747
748   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
749   chdir($dir);
750
751   _pslatex($file);
752
753   my $papersize = $conf->config('papersize') || 'letter';
754
755   system('dvips', '-q', '-t', $papersize, "$file.dvi", '-o', "$file.ps" ) == 0
756     or die "dvips failed";
757
758   open(POSTSCRIPT, "<$file.ps")
759     or die "can't open $file.ps: $! (error in LaTeX template?)\n";
760
761   unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex")
762     unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
763
764   my $ps = '';
765
766   if ( $conf->exists('lpr-postscript_prefix') ) {
767     my $prefix = $conf->config('lpr-postscript_prefix');
768     $ps .= eval qq("$prefix");
769   }
770
771   while (<POSTSCRIPT>) {
772     $ps .= $_;
773   }
774
775   close POSTSCRIPT;
776
777   if ( $conf->exists('lpr-postscript_suffix') ) {
778     my $suffix = $conf->config('lpr-postscript_suffix');
779     $ps .= eval qq("$suffix");
780   }
781
782   return $ps;
783
784 }
785
786 =item generate_pdf FILENAME
787
788 Returns an PDF rendition of the LaTex file, as a scalar.  FILENAME does not
789 contain the .tex suffix and is unlinked by this function.
790
791 =cut
792
793 use String::ShellQuote;
794
795 sub generate_pdf {
796   my $file = shift;
797
798   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
799   chdir($dir);
800
801   #system('pdflatex', "$file.tex");
802   #system('pdflatex', "$file.tex");
803   #! LaTeX Error: Unknown graphics extension: .eps.
804
805   _pslatex($file);
806
807   my $sfile = shell_quote $file;
808
809   #system('dvipdf', "$file.dvi", "$file.pdf" );
810   my $papersize = $conf->config('papersize') || 'letter';
811
812   system(
813     "dvips -q -f $sfile.dvi -t $papersize ".
814     "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
815     "     -c save pop -"
816   ) == 0
817     or die "dvips | gs failed: $!";
818
819   open(PDF, "<$file.pdf")
820     or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
821
822   unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex")
823     unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
824
825   my $pdf = '';
826   while (<PDF>) {
827     $pdf .= $_;
828   }
829
830   close PDF;
831
832   return $pdf;
833
834 }
835
836 sub _pslatex {
837   my $file = shift;
838
839   #my $sfile = shell_quote $file;
840
841   my @cmd = (
842     'latex',
843     '-interaction=batchmode',
844     '\AtBeginDocument{\RequirePackage{pslatex}}',
845     '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
846     '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
847     '\PSLATEXTMP',
848     "$file.tex"
849   );
850
851   my $timeout = 30; #? should be more than enough
852
853   for ( 1, 2 ) {
854
855     local($SIG{CHLD}) = sub {};
856     run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
857       or warn "bad exit status from pslatex pass $_\n";
858
859   }
860
861   return if -e "$file.dvi" && -s "$file.dvi";
862   die "pslatex $file.tex failed, see $file.log for details?\n";
863
864 }
865
866 =item do_print ARRAYREF [, OPTION => VALUE ... ]
867
868 Sends the lines in ARRAYREF to the printer.
869
870 Options available are:
871
872 =over 4
873
874 =item agentnum
875
876 Uses this agent's 'lpr' configuration setting override instead of the global
877 value.
878
879 =item lpr
880
881 Uses this command instead of the configured lpr command (overrides both the
882 global value and agentnum).
883
884 =cut
885
886 sub do_print {
887   my( $data, %opt ) = @_;
888
889   my $lpr = ( exists($opt{'lpr'}) && $opt{'lpr'} )
890               ? $opt{'lpr'}
891               : $conf->config('lpr', $opt{'agentnum'} );
892
893   my $outerr = '';
894   run3 $lpr, $data, \$outerr, \$outerr;
895   if ( $? ) {
896     $outerr = ": $outerr" if length($outerr);
897     die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
898   }
899
900 }
901
902 =item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ]
903
904 Converts the filehandle referenced by FILEREF from fixed length record
905 lines to a CSV file according to the lengths specified in LENGTH_LISTREF.
906 The CALLBACKS_LISTREF refers to a correpsonding list of coderefs.  Each
907 should return the value to be substituted in place of its single argument.
908
909 Returns false on success or an error if one occurs.
910
911 =cut
912
913 sub csv_from_fixed {
914   my( $fhref, $countref, $lengths, $callbacks) = @_;
915
916   eval { require Text::CSV_XS; };
917   return $@ if $@;
918
919   my $ofh = $$fhref;
920   my $unpacker = new Text::CSV_XS;
921   my $total = 0;
922   my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths;
923
924   my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc";
925   my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX",
926                            DIR      => $dir,
927                            UNLINK   => 0,
928                          ) or return "can't open temp file: $!\n"
929     if $template;
930
931   while ( defined(my $line=<$ofh>) ) {
932     $$countref++;
933     if ( $template ) {
934       my $column = 0;
935
936       chomp $line;
937       return "unexpected input at line $$countref: $line".
938              " -- expected $total but received ". length($line)
939         unless length($line) == $total;
940
941       $unpacker->combine( map { my $i = $column++;
942                                 defined( $callbacks->[$i] )
943                                   ? &{ $callbacks->[$i] }( $_ )
944                                   : $_
945                               } unpack( $template, $line )
946                         )
947         or return "invalid data for CSV: ". $unpacker->error_input;
948
949       print $fh $unpacker->string(), "\n"
950         or return "can't write temp file: $!\n";
951     }
952   }
953
954   if ( $template ) { close $$fhref; $$fhref = $fh }
955
956   seek $$fhref, 0, 0;
957   '';
958 }
959
960 =item ocr_image IMAGE_SCALAR
961
962 Runs OCR on the provided image data and returns a list of text lines.
963
964 =cut
965
966 sub ocr_image {
967   my $logo_data = shift;
968
969   #XXX use conf dir location from Makefile
970   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
971   my $fh = new File::Temp(
972     TEMPLATE => 'bizcard.XXXXXXXX',
973     SUFFIX   => '.png', #XXX assuming, but should handle jpg, gif, etc. too
974     DIR      => $dir,
975     UNLINK   => 0,
976   ) or die "can't open temp file: $!\n";
977
978   my $filename = $fh->filename;
979
980   print $fh $logo_data;
981   close $fh;
982
983   run( [qw(ocroscript recognize), $filename], '>'=>"$filename.hocr" )
984     or die "ocroscript recognize failed\n";
985
986   run( [qw(ocroscript hocr-to-text), "$filename.hocr"], '>pipe'=>\*OUT )
987     or die "ocroscript hocr-to-text failed\n";
988
989   my @lines = split(/\n/, <OUT> );
990
991   foreach (@lines) { s/\.c0m\s*$/.com/; }
992
993   @lines;
994 }
995
996 =item bytes_substr STRING, OFFSET[, LENGTH[, REPLACEMENT] ]
997
998 A replacement for "substr" that counts raw bytes rather than logical 
999 characters. Unlike "bytes::substr", will suppress fragmented UTF-8 characters
1000 rather than output them. Unlike real "substr", is not an lvalue.
1001
1002 =cut
1003
1004 sub bytes_substr {
1005   my ($string, $offset, $length, $repl) = @_;
1006   my $bytes = substr(
1007     Encode::encode('utf8', $string),
1008     $offset,
1009     $length,
1010     Encode::encode('utf8', $repl)
1011   );
1012   my $chk = $DEBUG ? Encode::FB_WARN : Encode::FB_QUIET;
1013   return Encode::decode('utf8', $bytes, $chk);
1014 }
1015
1016 =item money_pretty
1017
1018 Accepts a postive or negative numerical value.
1019 Returns amount formatted for display,
1020 including money character.
1021
1022 =cut
1023
1024 sub money_pretty {
1025   my $amount = shift;
1026   my $money_char = $conf->{'money_char'} || '$';
1027   $amount = sprintf("%0.2f",$amount);
1028   $amount =~ s/^(-?)/$1$money_char/;
1029   return $amount;
1030 }
1031
1032 =back
1033
1034 =head1 BUGS
1035
1036 This package exists.
1037
1038 =head1 SEE ALSO
1039
1040 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
1041
1042 L<Fax::Hylafax::Client>
1043
1044 =cut
1045
1046 1;