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