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