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