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