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