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