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