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