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