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