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