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