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