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 $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     unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
 703
 704   my $ps = '';
 705
 706   if ( $conf->exists('lpr-postscript_prefix') ) {
 707     my $prefix = $conf->config('lpr-postscript_prefix');
 708     $ps .= eval qq("$prefix");
 709   }
 710
 711   while (<POSTSCRIPT>) {
 712     $ps .= $_;
 713   }
 714
 715   close POSTSCRIPT;
 716
 717   if ( $conf->exists('lpr-postscript_suffix') ) {
 718     my $suffix = $conf->config('lpr-postscript_suffix');
 719     $ps .= eval qq("$suffix");
 720   }
 721
 722   return $ps;
 723
 724 }
 725
 726 =item generate_pdf FILENAME
 727
 728 Returns an PDF rendition of the LaTex file, as a scalar.  FILENAME does not
 729 contain the .tex suffix and is unlinked by this function.
 730
 731 =cut
 732
 733 use String::ShellQuote;
 734
 735 sub generate_pdf {
 736   my $file = shift;
 737
 738   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
 739   chdir($dir);
 740
 741   #system('pdflatex', "$file.tex");
 742   #system('pdflatex', "$file.tex");
 743   #! LaTeX Error: Unknown graphics extension: .eps.
 744
 745   _pslatex($file);
 746
 747   my $sfile = shell_quote $file;
 748
 749   #system('dvipdf', "$file.dvi", "$file.pdf" );
 750   system(
 751     "dvips -q -t letter -f $sfile.dvi ".
 752     "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
 753     "     -c save pop -"
 754   ) == 0
 755     or die "dvips | gs failed: $!";
 756
 757   open(PDF, "<$file.pdf")
 758     or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
 759
 760   unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex")
 761     unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
 762
 763   my $pdf = '';
 764   while (<PDF>) {
 765     $pdf .= $_;
 766   }
 767
 768   close PDF;
 769
 770   return $pdf;
 771
 772 }
 773
 774 sub _pslatex {
 775   my $file = shift;
 776
 777   #my $sfile = shell_quote $file;
 778
 779   my @cmd = (
 780     'latex',
 781     '-interaction=batchmode',
 782     '\AtBeginDocument{\RequirePackage{pslatex}}',
 783     '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
 784     '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
 785     '\PSLATEXTMP',
 786     "$file.tex"
 787   );
 788
 789   my $timeout = 30; #? should be more than enough
 790
 791   for ( 1, 2 ) {
 792
 793     local($SIG{CHLD}) = sub {};
 794     run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
 795       or warn "bad exit status from pslatex pass $_\n";
 796
 797   }
 798
 799   return if -e "$file.dvi" && -s "$file.dvi";
 800   die "pslatex $file.tex failed; see $file.log for details?\n";
 801
 802 }
 803
 804 =item do_print ARRAYREF [, OPTION => VALUE ... ]
 805
 806 Sends the lines in ARRAYREF to the printer.
 807
 808 Options available are:
 809
 810 =over 4
 811
 812 =item agentnum
 813
 814 Uses this agent's 'lpr' configuration setting override instead of the global
 815 value.
 816
 817 =item lpr
 818
 819 Uses this command instead of the configured lpr command (overrides both the
 820 global value and agentnum).
 821
 822 =cut
 823
 824 sub do_print {
 825   my( $data, %opt ) = @_;
 826
 827   my $lpr = ( exists($opt{'lpr'}) && $opt{'lpr'} )
 828               ? $opt{'lpr'}
 829               : $conf->config('lpr', $opt{'agentnum'} );
 830
 831   my $outerr = '';
 832   run3 $lpr, $data, \$outerr, \$outerr;
 833   if ( $? ) {
 834     $outerr = ": $outerr" if length($outerr);
 835     die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
 836   }
 837
 838 }
 839
 840 =item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ]
 841
 842 Converts the filehandle referenced by FILEREF from fixed length record
 843 lines to a CSV file according to the lengths specified in LENGTH_LISTREF.
 844 The CALLBACKS_LISTREF refers to a correpsonding list of coderefs.  Each
 845 should return the value to be substituted in place of its single argument.
 846
 847 Returns false on success or an error if one occurs.
 848
 849 =cut
 850
 851 sub csv_from_fixed {
 852   my( $fhref, $countref, $lengths, $callbacks) = @_;
 853
 854   eval { require Text::CSV_XS; };
 855   return $@ if $@;
 856
 857   my $ofh = $$fhref;
 858   my $unpacker = new Text::CSV_XS;
 859   my $total = 0;
 860   my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths;
 861
 862   my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc";
 863   my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX",
 864                            DIR      => $dir,
 865                            UNLINK   => 0,
 866                          ) or return "can't open temp file: $!\n"
 867     if $template;
 868
 869   while ( defined(my $line=<$ofh>) ) {
 870     $$countref++;
 871     if ( $template ) {
 872       my $column = 0;
 873
 874       chomp $line;
 875       return "unexpected input at line $$countref: $line".
 876              " -- expected $total but received ". length($line)
 877         unless length($line) == $total;
 878
 879       $unpacker->combine( map { my $i = $column++;
 880                                 defined( $callbacks->[$i] )
 881                                   ? &{ $callbacks->[$i] }( $_ )
 882                                   : $_
 883                               } unpack( $template, $line )
 884                         )
 885         or return "invalid data for CSV: ". $unpacker->error_input;
 886
 887       print $fh $unpacker->string(), "\n"
 888         or return "can't write temp file: $!\n";
 889     }
 890   }
 891
 892   if ( $template ) { close $$fhref; $$fhref = $fh }
 893
 894   seek $$fhref, 0, 0;
 895   '';
 896 }
 897
 898 =item ocr_image IMAGE_SCALAR
 899
 900 Runs OCR on the provided image data and returns a list of text lines.
 901
 902 =cut
 903
 904 sub ocr_image {
 905   my $logo_data = shift;
 906
 907   #XXX use conf dir location from Makefile
 908   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
 909   my $fh = new File::Temp(
 910     TEMPLATE => 'bizcard.XXXXXXXX',
 911     SUFFIX   => '.png', #XXX assuming, but should handle jpg, gif, etc. too
 912     DIR      => $dir,
 913     UNLINK   => 0,
 914   ) or die "can't open temp file: $!\n";
 915
 916   my $filename = $fh->filename;
 917
 918   print $fh $logo_data;
 919   close $fh;
 920
 921   run( [qw(ocroscript recognize), $filename], '>'=>"$filename.hocr" )
 922     or die "ocroscript recognize failed\n";
 923
 924   run( [qw(ocroscript hocr-to-text), "$filename.hocr"], '>pipe'=>\*OUT )
 925     or die "ocroscript hocr-to-text failed\n";
 926
 927   my @lines = split(/\n/, <OUT> );
 928
 929   foreach (@lines) { s/\.c0m\s*$/.com/; }
 930
 931   @lines;
 932 }
 933
 934 =back
 935
 936 =head1 BUGS
 937
 938 This package exists.
 939
 940 =head1 SEE ALSO
 941
 942 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
 943
 944 L<Fax::Hylafax::Client>
 945
 946 =cut
 947
 948 1;