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