FS/FS/Misc.pm

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