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