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