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   my @states =
 538 #     sort
 539      map { s/[\n\r]//g; $_; }
 540      map { $_->state; }
 541          qsearch({
 542                    'select'    => 'state',
 543                    'table'     => 'cust_main_county',
 544                    'hashref'   => { 'country' => $country },
 545                    'extra_sql' => 'GROUP BY state',
 546                 });
 547
 548   #it could throw a fatal "Invalid country code" error (for example "AX")
 549   my $subcountry = eval { new Locale::SubCountry($country) }
 550     or return (); # ( '', '(n/a)' );
 551
 552   #"i see your schwartz is as big as mine!"
 553   map  { ( $_->[0] => $_->[1] ) }
 554   sort { $a->[1] cmp $b->[1] }
 555   map  { [ $_ => state_label($_, $subcountry) ] }
 556        @states;
 557 }
 558
 559 =item counties STATE COUNTRY
 560
 561 Returns a list of counties for this state and country.
 562
 563 =cut
 564
 565 sub counties {
 566   my( $state, $country ) = @_;
 567
 568   map { $_ } #return num_counties($state, $country) unless wantarray;
 569   sort map { s/[\n\r]//g; $_; }
 570        map { $_->county }
 571            qsearch({
 572              'select'  => 'DISTINCT county',
 573              'table'   => 'cust_main_county',
 574              'hashref' => { 'state'   => $state,
 575                             'country' => $country,
 576                           },
 577            });
 578 }
 579
 580 =item cities COUNTY STATE COUNTRY
 581
 582 Returns a list of cities for this county, state and country.
 583
 584 =cut
 585
 586 sub cities {
 587   my( $county, $state, $country ) = @_;
 588
 589   map { $_ } #return num_cities($county, $state, $country) unless wantarray;
 590   sort map { s/[\n\r]//g; $_; }
 591        map { $_->city }
 592            qsearch({
 593              'select'  => 'DISTINCT city',
 594              'table'   => 'cust_main_county',
 595              'hashref' => { 'county'  => $county,
 596                             'state'   => $state,
 597                             'country' => $country,
 598                           },
 599            });
 600 }
 601
 602 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
 603
 604 =cut
 605
 606 sub state_label {
 607   my( $state, $country ) = @_;
 608
 609   unless ( ref($country) ) {
 610     $country = eval { new Locale::SubCountry($country) }
 611       or return'(n/a)';
 612
 613   }
 614
 615   # US kludge to avoid changing existing behaviour
 616   # also we actually *use* the abbriviations...
 617   my $full_name = $country->country_code eq 'US'
 618                     ? ''
 619                     : $country->full_name($state);
 620
 621   $full_name = '' if $full_name eq 'unknown';
 622   $full_name =~ s/\(see also.*\)\s*$//;
 623   $full_name .= " ($state)" if $full_name;
 624
 625   $full_name || $state || '(n/a)';
 626
 627 }
 628
 629 =item card_types
 630
 631 Returns a hash reference of the accepted credit card types.  Keys are shorter
 632 identifiers and values are the longer strings used by the system (see
 633 L<Business::CreditCard>).
 634
 635 =cut
 636
 637 #$conf from above
 638
 639 sub card_types {
 640   my $conf = new FS::Conf;
 641
 642   my %card_types = (
 643     #displayname                    #value (Business::CreditCard)
 644     "VISA"                       => "VISA card",
 645     "MasterCard"                 => "MasterCard",
 646     "Discover"                   => "Discover card",
 647     "American Express"           => "American Express card",
 648     "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
 649     "enRoute"                    => "enRoute",
 650     "JCB"                        => "JCB",
 651     "BankCard"                   => "BankCard",
 652     "Switch"                     => "Switch",
 653     "Solo"                       => "Solo",
 654   );
 655   my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
 656   if ( @conf_card_types ) {
 657     #perhaps the hash is backwards for this, but this way works better for
 658     #usage in selfservice
 659     %card_types = map  { $_ => $card_types{$_} }
 660                   grep {
 661                          my $d = $_;
 662                            grep { $card_types{$d} eq $_ } @conf_card_types
 663                        }
 664                     keys %card_types;
 665   }
 666
 667   \%card_types;
 668 }
 669
 670 =item pkg_freqs
 671
 672 Returns a hash reference of allowed package billing frequencies.
 673
 674 =cut
 675
 676 sub pkg_freqs {
 677   tie my %freq, 'Tie::IxHash', (
 678     '0'    => '(no recurring fee)',
 679     '1h'   => 'hourly',
 680     '1d'   => 'daily',
 681     '2d'   => 'every two days',
 682     '3d'   => 'every three days',
 683     '1w'   => 'weekly',
 684     '2w'   => 'biweekly (every 2 weeks)',
 685     '1'    => 'monthly',
 686     '45d'  => 'every 45 days',
 687     '2'    => 'bimonthly (every 2 months)',
 688     '3'    => 'quarterly (every 3 months)',
 689     '4'    => 'every 4 months',
 690     '137d' => 'every 4 1/2 months (137 days)',
 691     '6'    => 'semiannually (every 6 months)',
 692     '12'   => 'annually',
 693     '13'   => 'every 13 months (annually +1 month)',
 694     '24'   => 'biannually (every 2 years)',
 695     '36'   => 'triannually (every 3 years)',
 696     '48'   => '(every 4 years)',
 697     '60'   => '(every 5 years)',
 698     '120'  => '(every 10 years)',
 699   ) ;
 700   \%freq;
 701 }
 702
 703 =item generate_ps FILENAME
 704
 705 Returns an postscript rendition of the LaTex file, as a scalar.
 706 FILENAME does not contain the .tex suffix and is unlinked by this function.
 707
 708 =cut
 709
 710 use String::ShellQuote;
 711
 712 sub generate_ps {
 713   my $file = shift;
 714
 715   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
 716   chdir($dir);
 717
 718   _pslatex($file);
 719
 720   my $papersize = $conf->config('papersize') || 'letter';
 721
 722   system('dvips', '-q', '-t', $papersize, "$file.dvi", '-o', "$file.ps" ) == 0
 723     or die "dvips failed";
 724
 725   open(POSTSCRIPT, "<$file.ps")
 726     or die "can't open $file.ps: $! (error in LaTeX template?)\n";
 727
 728   unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex")
 729     unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
 730
 731   my $ps = '';
 732
 733   if ( $conf->exists('lpr-postscript_prefix') ) {
 734     my $prefix = $conf->config('lpr-postscript_prefix');
 735     $ps .= eval qq("$prefix");
 736   }
 737
 738   while (<POSTSCRIPT>) {
 739     $ps .= $_;
 740   }
 741
 742   close POSTSCRIPT;
 743
 744   if ( $conf->exists('lpr-postscript_suffix') ) {
 745     my $suffix = $conf->config('lpr-postscript_suffix');
 746     $ps .= eval qq("$suffix");
 747   }
 748
 749   return $ps;
 750
 751 }
 752
 753 =item generate_pdf FILENAME
 754
 755 Returns an PDF rendition of the LaTex file, as a scalar.  FILENAME does not
 756 contain the .tex suffix and is unlinked by this function.
 757
 758 =cut
 759
 760 use String::ShellQuote;
 761
 762 sub generate_pdf {
 763   my $file = shift;
 764
 765   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
 766   chdir($dir);
 767
 768   #system('pdflatex', "$file.tex");
 769   #system('pdflatex', "$file.tex");
 770   #! LaTeX Error: Unknown graphics extension: .eps.
 771
 772   _pslatex($file);
 773
 774   my $sfile = shell_quote $file;
 775
 776   #system('dvipdf', "$file.dvi", "$file.pdf" );
 777   my $papersize = $conf->config('papersize') || 'letter';
 778
 779   system(
 780     "dvips -q -f $sfile.dvi -t $papersize ".
 781     "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
 782     "     -c save pop -"
 783   ) == 0
 784     or die "dvips | gs failed: $!";
 785
 786   open(PDF, "<$file.pdf")
 787     or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
 788
 789   unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex")
 790     unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
 791
 792   my $pdf = '';
 793   while (<PDF>) {
 794     $pdf .= $_;
 795   }
 796
 797   close PDF;
 798
 799   return $pdf;
 800
 801 }
 802
 803 sub _pslatex {
 804   my $file = shift;
 805
 806   #my $sfile = shell_quote $file;
 807
 808   my @cmd = (
 809     'latex',
 810     '-interaction=batchmode',
 811     '\AtBeginDocument{\RequirePackage{pslatex}}',
 812     '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
 813     '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
 814     '\PSLATEXTMP',
 815     "$file.tex"
 816   );
 817
 818   my $timeout = 30; #? should be more than enough
 819
 820   for ( 1, 2 ) {
 821
 822     local($SIG{CHLD}) = sub {};
 823     run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
 824       or warn "bad exit status from pslatex pass $_\n";
 825
 826   }
 827
 828   return if -e "$file.dvi" && -s "$file.dvi";
 829   die "pslatex $file.tex failed, see $file.log for details?\n";
 830
 831 }
 832
 833 =item do_print ARRAYREF [, OPTION => VALUE ... ]
 834
 835 Sends the lines in ARRAYREF to the printer.
 836
 837 Options available are:
 838
 839 =over 4
 840
 841 =item agentnum
 842
 843 Uses this agent's 'lpr' configuration setting override instead of the global
 844 value.
 845
 846 =item lpr
 847
 848 Uses this command instead of the configured lpr command (overrides both the
 849 global value and agentnum).
 850
 851 =cut
 852
 853 sub do_print {
 854   my( $data, %opt ) = @_;
 855
 856   my $lpr = ( exists($opt{'lpr'}) && $opt{'lpr'} )
 857               ? $opt{'lpr'}
 858               : $conf->config('lpr', $opt{'agentnum'} );
 859
 860   my $outerr = '';
 861   run3 $lpr, $data, \$outerr, \$outerr;
 862   if ( $? ) {
 863     $outerr = ": $outerr" if length($outerr);
 864     die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
 865   }
 866
 867 }
 868
 869 =item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ]
 870
 871 Converts the filehandle referenced by FILEREF from fixed length record
 872 lines to a CSV file according to the lengths specified in LENGTH_LISTREF.
 873 The CALLBACKS_LISTREF refers to a correpsonding list of coderefs.  Each
 874 should return the value to be substituted in place of its single argument.
 875
 876 Returns false on success or an error if one occurs.
 877
 878 =cut
 879
 880 sub csv_from_fixed {
 881   my( $fhref, $countref, $lengths, $callbacks) = @_;
 882
 883   eval { require Text::CSV_XS; };
 884   return $@ if $@;
 885
 886   my $ofh = $$fhref;
 887   my $unpacker = new Text::CSV_XS;
 888   my $total = 0;
 889   my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths;
 890
 891   my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc";
 892   my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX",
 893                            DIR      => $dir,
 894                            UNLINK   => 0,
 895                          ) or return "can't open temp file: $!\n"
 896     if $template;
 897
 898   while ( defined(my $line=<$ofh>) ) {
 899     $$countref++;
 900     if ( $template ) {
 901       my $column = 0;
 902
 903       chomp $line;
 904       return "unexpected input at line $$countref: $line".
 905              " -- expected $total but received ". length($line)
 906         unless length($line) == $total;
 907
 908       $unpacker->combine( map { my $i = $column++;
 909                                 defined( $callbacks->[$i] )
 910                                   ? &{ $callbacks->[$i] }( $_ )
 911                                   : $_
 912                               } unpack( $template, $line )
 913                         )
 914         or return "invalid data for CSV: ". $unpacker->error_input;
 915
 916       print $fh $unpacker->string(), "\n"
 917         or return "can't write temp file: $!\n";
 918     }
 919   }
 920
 921   if ( $template ) { close $$fhref; $$fhref = $fh }
 922
 923   seek $$fhref, 0, 0;
 924   '';
 925 }
 926
 927 =item ocr_image IMAGE_SCALAR
 928
 929 Runs OCR on the provided image data and returns a list of text lines.
 930
 931 =cut
 932
 933 sub ocr_image {
 934   my $logo_data = shift;
 935
 936   #XXX use conf dir location from Makefile
 937   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
 938   my $fh = new File::Temp(
 939     TEMPLATE => 'bizcard.XXXXXXXX',
 940     SUFFIX   => '.png', #XXX assuming, but should handle jpg, gif, etc. too
 941     DIR      => $dir,
 942     UNLINK   => 0,
 943   ) or die "can't open temp file: $!\n";
 944
 945   my $filename = $fh->filename;
 946
 947   print $fh $logo_data;
 948   close $fh;
 949
 950   run( [qw(ocroscript recognize), $filename], '>'=>"$filename.hocr" )
 951     or die "ocroscript recognize failed\n";
 952
 953   run( [qw(ocroscript hocr-to-text), "$filename.hocr"], '>pipe'=>\*OUT )
 954     or die "ocroscript hocr-to-text failed\n";
 955
 956   my @lines = split(/\n/, <OUT> );
 957
 958   foreach (@lines) { s/\.c0m\s*$/.com/; }
 959
 960   @lines;
 961 }
 962
 963 =item bytes_substr STRING, OFFSET[, LENGTH[, REPLACEMENT] ]
 964
 965 A replacement for "substr" that counts raw bytes rather than logical
 966 characters. Unlike "bytes::substr", will suppress fragmented UTF-8 characters
 967 rather than output them. Unlike real "substr", is not an lvalue.
 968
 969 =cut
 970
 971 sub bytes_substr {
 972   my ($string, $offset, $length, $repl) = @_;
 973   my $bytes = substr(
 974     Encode::encode('utf8', $string),
 975     $offset,
 976     $length,
 977     Encode::encode('utf8', $repl)
 978   );
 979   my $chk = $DEBUG ? Encode::FB_WARN : Encode::FB_QUIET;
 980   return Encode::decode('utf8', $bytes, $chk);
 981 }
 982
 983 =item money_pretty
 984
 985 Accepts a postive or negative numerical value.
 986 Returns amount formatted for display,
 987 including money character.
 988
 989 =cut
 990
 991 sub money_pretty {
 992   my $amount = shift;
 993   my $money_char = $conf->{'money_char'} || '$';
 994   $amount = sprintf("%0.2f",$amount);
 995   $amount =~ s/^(-?)/$1$money_char/;
 996   return $amount;
 997 }
 998
 999 =back
1000
1001 =head1 BUGS
1002
1003 This package exists.
1004
1005 =head1 SEE ALSO
1006
1007 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
1008
1009 L<Fax::Hylafax::Client>
1010
1011 =cut
1012
1013 1;