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