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