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                );
  26
  27 $DEBUG = 0;
  28
  29 =head1 NAME
  30
  31 FS::Misc - Miscellaneous subroutines
  32
  33 =head1 SYNOPSIS
  34
  35   use FS::Misc qw(send_email);
  36
  37   send_email();
  38
  39 =head1 DESCRIPTION
  40
  41 Miscellaneous subroutines.  This module contains miscellaneous subroutines
  42 called from multiple other modules.  These are not OO or necessarily related,
  43 but are collected here to eliminate code duplication.
  44
  45 =head1 SUBROUTINES
  46
  47 =over 4
  48
  49 =item send_email OPTION => VALUE ...
  50
  51 Options:
  52
  53 =over 4
  54
  55 =item from
  56
  57 (required)
  58
  59 =item to
  60
  61 (required) comma-separated scalar or arrayref of recipients
  62
  63 =item subject
  64
  65 (required)
  66
  67 =item content-type
  68
  69 (optional) MIME type for the body
  70
  71 =item body
  72
  73 (required unless I<nobody> is true) arrayref of body text lines
  74
  75 =item mimeparts
  76
  77 (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().
  78
  79 =item nobody
  80
  81 (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,
  82 I<content-type>, if specified, overrides the default "multipart/mixed" for the outermost MIME container.
  83
  84 =item content-encoding
  85
  86 (optional) when using nobody, optional top-level MIME
  87 encoding which, if specified, overrides the default "7bit".
  88
  89 =item type
  90
  91 (optional) type parameter for multipart/related messages
  92
  93 =item custnum
  94
  95 (optional) L<FS::cust_main> key; if passed, the message will be logged
  96 (if logging is enabled) with this custnum.
  97
  98 =item msgnum
  99
 100 (optional) L<FS::msg_template> key, for logging.
 101
 102 =back
 103
 104 =cut
 105
 106 use vars qw( $conf );
 107 use Date::Format;
 108 use MIME::Entity;
 109 use Email::Sender::Simple qw(sendmail);
 110 use Email::Sender::Transport::SMTP;
 111 use Email::Sender::Transport::SMTP::TLS 0.11;
 112 use FS::UID;
 113
 114 FS::UID->install_callback( sub {
 115   $conf = new FS::Conf;
 116 } );
 117
 118 sub send_email {
 119   my(%options) = @_;
 120   if ( $DEBUG ) {
 121     my %doptions = %options;
 122     $doptions{'body'} = '(full body not shown in debug)';
 123     warn "FS::Misc::send_email called with options:\n  ". Dumper(\%doptions);
 124 #         join("\n", map { "  $_: ". $options{$_} } keys %options ). "\n"
 125   }
 126
 127   my @to = ref($options{to}) ? @{ $options{to} } : ( $options{to} );
 128
 129   my @mimeargs = ();
 130   my @mimeparts = ();
 131   if ( $options{'nobody'} ) {
 132
 133     croak "'mimeparts' option required when 'nobody' option given\n"
 134       unless $options{'mimeparts'};
 135
 136     @mimeparts = @{$options{'mimeparts'}};
 137
 138     @mimeargs = (
 139       'Type'         => ( $options{'content-type'} || 'multipart/mixed' ),
 140       'Encoding'     => ( $options{'content-encoding'} || '7bit' ),
 141     );
 142
 143   } else {
 144
 145     @mimeparts = @{$options{'mimeparts'}}
 146       if ref($options{'mimeparts'}) eq 'ARRAY';
 147
 148     if (scalar(@mimeparts)) {
 149
 150       @mimeargs = (
 151         'Type'     => 'multipart/mixed',
 152         'Encoding' => '7bit',
 153       );
 154
 155       unshift @mimeparts, {
 156         'Type'        => ( $options{'content-type'} || 'text/plain' ),
 157         'Charset'     => 'UTF-8',
 158         'Data'        => $options{'body'},
 159         'Encoding'    => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
 160         'Disposition' => 'inline',
 161       };
 162
 163     } else {
 164
 165       @mimeargs = (
 166         'Type'     => ( $options{'content-type'} || 'text/plain' ),
 167         'Data'     => $options{'body'},
 168         'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
 169         'Charset'  => 'UTF-8',
 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     'Charset'     => 'UTF-8',
 369     #'Encoding'    => '7bit',
 370     'Data'        => $data,
 371     'Disposition' => 'inline',
 372   );
 373
 374   my @html_data;
 375   if ( ref($args{'html_body'}) eq 'ARRAY' ) {
 376     @html_data = @{ $args{'html_body'} };
 377   } else {
 378     @html_data = split(/\n/, $args{'html_body'});
 379   }
 380
 381   $alternative->attach(
 382     'Type'        => 'text/html',
 383     'Encoding'    => 'quoted-printable',
 384     'Data'        => [ '<html>',
 385                        '  <head>',
 386                        '    <title>',
 387                        '      '. encode_entities($return{'subject'}),
 388                        '    </title>',
 389                        '  </head>',
 390                        '  <body bgcolor="#ffffff">',
 391                        @html_data,
 392                        '  </body>',
 393                        '</html>',
 394                      ],
 395     'Disposition' => 'inline',
 396     #'Filename'    => 'invoice.pdf',
 397   );
 398
 399   #no other attachment:
 400   # multipart/related
 401   #   multipart/alternative
 402   #     text/plain
 403   #     text/html
 404
 405   $return{'content-type'} = 'multipart/related';
 406   $return{'mimeparts'} = [ $alternative ];
 407   $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
 408   #$return{'disposition'} = 'inline';
 409
 410   %return;
 411
 412 }
 413
 414 =item process_send_email OPTION => VALUE ...
 415
 416 Takes arguments as per generate_email() and sends the message.  This
 417 will die on any error and can be used in the job queue.
 418
 419 =cut
 420
 421 sub process_send_email {
 422   my %message = @_;
 423   my $error = send_email(generate_email(%message));
 424   die "$error\n" if $error;
 425   '';
 426 }
 427
 428 =item process_send_generated_email OPTION => VALUE ...
 429
 430 Takes arguments as per send_email() and sends the message.  This
 431 will die on any error and can be used in the job queue.
 432
 433 =cut
 434
 435 sub process_send_generated_email {
 436   my %args = @_;
 437   my $error = send_email(%args);
 438   die "$error\n" if $error;
 439   '';
 440 }
 441
 442 =item send_fax OPTION => VALUE ...
 443
 444 Options:
 445
 446 I<dialstring> - (required) 10-digit phone number w/ area code
 447
 448 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
 449
 450 -or-
 451
 452 I<docfile> - (required) Filename of PostScript TIFF Class F document
 453
 454 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
 455
 456
 457 =cut
 458
 459 sub send_fax {
 460
 461   my %options = @_;
 462
 463   die 'HylaFAX support has not been configured.'
 464     unless $conf->exists('hylafax');
 465
 466   eval {
 467     require Fax::Hylafax::Client;
 468   };
 469
 470   if ($@) {
 471     if ($@ =~ /^Can't locate Fax.*/) {
 472       die "You must have Fax::Hylafax::Client installed to use invoice faxing."
 473     } else {
 474       die $@;
 475     }
 476   }
 477
 478   my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
 479
 480   die 'Called send_fax without a \'dialstring\'.'
 481     unless exists($options{'dialstring'});
 482
 483   if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
 484       my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
 485       my $fh = new File::Temp(
 486         TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
 487         DIR      => $dir,
 488         UNLINK   => 0,
 489       ) or die "can't open temp file: $!\n";
 490
 491       $options{docfile} = $fh->filename;
 492
 493       print $fh @{$options{'docdata'}};
 494       close $fh;
 495
 496       delete $options{'docdata'};
 497   }
 498
 499   die 'Called send_fax without a \'docfile\' or \'docdata\'.'
 500     unless exists($options{'docfile'});
 501
 502   #FIXME: Need to send canonical dialstring to HylaFAX, but this only
 503   #       works in the US.
 504
 505   $options{'dialstring'} =~ s/[^\d\+]//g;
 506   if ($options{'dialstring'} =~ /^\d{10}$/) {
 507     $options{dialstring} = '+1' . $options{'dialstring'};
 508   } else {
 509     return 'Invalid dialstring ' . $options{'dialstring'} . '.';
 510   }
 511
 512   my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
 513
 514   if ($faxjob->success) {
 515     warn "Successfully queued fax to '$options{dialstring}' with jobid " .
 516            $faxjob->jobid
 517       if $DEBUG;
 518     return '';
 519   } else {
 520     return 'Error while sending FAX: ' . $faxjob->trace;
 521   }
 522
 523 }
 524
 525 =item states_hash COUNTRY
 526
 527 Returns a list of key/value pairs containing state (or other sub-country
 528 division) abbriviations and names.
 529
 530 =cut
 531
 532 use FS::Record qw(qsearch);
 533 use Locale::SubCountry;
 534
 535 sub states_hash {
 536   my($country) = @_;
 537
 538   my @states =
 539 #     sort
 540      map { s/[\n\r]//g; $_; }
 541      map { $_->state; }
 542          qsearch({
 543                    'select'    => 'state',
 544                    'table'     => 'cust_main_county',
 545                    'hashref'   => { 'country' => $country },
 546                    'extra_sql' => 'GROUP BY state',
 547                 });
 548
 549   #it could throw a fatal "Invalid country code" error (for example "AX")
 550   my $subcountry = eval { new Locale::SubCountry($country) }
 551     or return (); # ( '', '(n/a)' );
 552
 553   #"i see your schwartz is as big as mine!"
 554   map  { ( $_->[0] => $_->[1] ) }
 555   sort { $a->[1] cmp $b->[1] }
 556   map  { [ $_ => state_label($_, $subcountry) ] }
 557        @states;
 558 }
 559
 560 =item counties STATE COUNTRY
 561
 562 Returns a list of counties for this state and country.
 563
 564 =cut
 565
 566 sub counties {
 567   my( $state, $country ) = @_;
 568
 569   map { $_ } #return num_counties($state, $country) unless wantarray;
 570   sort map { s/[\n\r]//g; $_; }
 571        map { $_->county }
 572            qsearch({
 573              'select'  => 'DISTINCT county',
 574              'table'   => 'cust_main_county',
 575              'hashref' => { 'state'   => $state,
 576                             'country' => $country,
 577                           },
 578            });
 579 }
 580
 581 =item cities COUNTY STATE COUNTRY
 582
 583 Returns a list of cities for this county, state and country.
 584
 585 =cut
 586
 587 sub cities {
 588   my( $county, $state, $country ) = @_;
 589
 590   map { $_ } #return num_cities($county, $state, $country) unless wantarray;
 591   sort map { s/[\n\r]//g; $_; }
 592        map { $_->city }
 593            qsearch({
 594              'select'  => 'DISTINCT city',
 595              'table'   => 'cust_main_county',
 596              'hashref' => { 'county'  => $county,
 597                             'state'   => $state,
 598                             'country' => $country,
 599                           },
 600            });
 601 }
 602
 603 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
 604
 605 =cut
 606
 607 sub state_label {
 608   my( $state, $country ) = @_;
 609
 610   unless ( ref($country) ) {
 611     $country = eval { new Locale::SubCountry($country) }
 612       or return'(n/a)';
 613
 614   }
 615
 616   # US kludge to avoid changing existing behaviour
 617   # also we actually *use* the abbriviations...
 618   my $full_name = $country->country_code eq 'US'
 619                     ? ''
 620                     : $country->full_name($state);
 621
 622   $full_name = '' if $full_name eq 'unknown';
 623   $full_name =~ s/\(see also.*\)\s*$//;
 624   $full_name .= " ($state)" if $full_name;
 625
 626   $full_name || $state || '(n/a)';
 627
 628 }
 629
 630 =item card_types
 631
 632 Returns a hash reference of the accepted credit card types.  Keys are shorter
 633 identifiers and values are the longer strings used by the system (see
 634 L<Business::CreditCard>).
 635
 636 =cut
 637
 638 #$conf from above
 639
 640 sub card_types {
 641   my $conf = new FS::Conf;
 642
 643   my %card_types = (
 644     #displayname                    #value (Business::CreditCard)
 645     "VISA"                       => "VISA card",
 646     "MasterCard"                 => "MasterCard",
 647     "Discover"                   => "Discover card",
 648     "American Express"           => "American Express card",
 649     "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
 650     "enRoute"                    => "enRoute",
 651     "JCB"                        => "JCB",
 652     "BankCard"                   => "BankCard",
 653     "Switch"                     => "Switch",
 654     "Solo"                       => "Solo",
 655   );
 656   my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
 657   if ( @conf_card_types ) {
 658     #perhaps the hash is backwards for this, but this way works better for
 659     #usage in selfservice
 660     %card_types = map  { $_ => $card_types{$_} }
 661                   grep {
 662                          my $d = $_;
 663                            grep { $card_types{$d} eq $_ } @conf_card_types
 664                        }
 665                     keys %card_types;
 666   }
 667
 668   \%card_types;
 669 }
 670
 671 =item pkg_freqs
 672
 673 Returns a hash reference of allowed package billing frequencies.
 674
 675 =cut
 676
 677 sub pkg_freqs {
 678   tie my %freq, 'Tie::IxHash', (
 679     '0'    => '(no recurring fee)',
 680     '1h'   => 'hourly',
 681     '1d'   => 'daily',
 682     '2d'   => 'every two days',
 683     '3d'   => 'every three days',
 684     '1w'   => 'weekly',
 685     '2w'   => 'biweekly (every 2 weeks)',
 686     '1'    => 'monthly',
 687     '45d'  => 'every 45 days',
 688     '2'    => 'bimonthly (every 2 months)',
 689     '3'    => 'quarterly (every 3 months)',
 690     '4'    => 'every 4 months',
 691     '137d' => 'every 4 1/2 months (137 days)',
 692     '6'    => 'semiannually (every 6 months)',
 693     '12'   => 'annually',
 694     '13'   => 'every 13 months (annually +1 month)',
 695     '24'   => 'biannually (every 2 years)',
 696     '36'   => 'triannually (every 3 years)',
 697     '48'   => '(every 4 years)',
 698     '60'   => '(every 5 years)',
 699     '120'  => '(every 10 years)',
 700   ) ;
 701   \%freq;
 702 }
 703
 704 =item generate_ps FILENAME
 705
 706 Returns an postscript rendition of the LaTex file, as a scalar.
 707 FILENAME does not contain the .tex suffix and is unlinked by this function.
 708
 709 =cut
 710
 711 use String::ShellQuote;
 712
 713 sub generate_ps {
 714   my $file = shift;
 715
 716   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
 717   chdir($dir);
 718
 719   _pslatex($file);
 720
 721   my $papersize = $conf->config('papersize') || 'letter';
 722
 723   system('dvips', '-q', '-t', $papersize, "$file.dvi", '-o', "$file.ps" ) == 0
 724     or die "dvips failed";
 725
 726   open(POSTSCRIPT, "<$file.ps")
 727     or die "can't open $file.ps: $! (error in LaTeX template?)\n";
 728
 729   unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex")
 730     unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
 731
 732   my $ps = '';
 733
 734   if ( $conf->exists('lpr-postscript_prefix') ) {
 735     my $prefix = $conf->config('lpr-postscript_prefix');
 736     $ps .= eval qq("$prefix");
 737   }
 738
 739   while (<POSTSCRIPT>) {
 740     $ps .= $_;
 741   }
 742
 743   close POSTSCRIPT;
 744
 745   if ( $conf->exists('lpr-postscript_suffix') ) {
 746     my $suffix = $conf->config('lpr-postscript_suffix');
 747     $ps .= eval qq("$suffix");
 748   }
 749
 750   return $ps;
 751
 752 }
 753
 754 =item generate_pdf FILENAME
 755
 756 Returns an PDF rendition of the LaTex file, as a scalar.  FILENAME does not
 757 contain the .tex suffix and is unlinked by this function.
 758
 759 =cut
 760
 761 use String::ShellQuote;
 762
 763 sub generate_pdf {
 764   my $file = shift;
 765
 766   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
 767   chdir($dir);
 768
 769   #system('pdflatex', "$file.tex");
 770   #system('pdflatex', "$file.tex");
 771   #! LaTeX Error: Unknown graphics extension: .eps.
 772
 773   _pslatex($file);
 774
 775   my $sfile = shell_quote $file;
 776
 777   #system('dvipdf', "$file.dvi", "$file.pdf" );
 778   my $papersize = $conf->config('papersize') || 'letter';
 779
 780   system(
 781     "dvips -q -f $sfile.dvi -t $papersize ".
 782     "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
 783     "     -c save pop -"
 784   ) == 0
 785     or die "dvips | gs failed: $!";
 786
 787   open(PDF, "<$file.pdf")
 788     or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
 789
 790   unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex")
 791     unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting');
 792
 793   my $pdf = '';
 794   while (<PDF>) {
 795     $pdf .= $_;
 796   }
 797
 798   close PDF;
 799
 800   return $pdf;
 801
 802 }
 803
 804 sub _pslatex {
 805   my $file = shift;
 806
 807   #my $sfile = shell_quote $file;
 808
 809   my @cmd = (
 810     'latex',
 811     '-interaction=batchmode',
 812     '\AtBeginDocument{\RequirePackage{pslatex}}',
 813     '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
 814     '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
 815     '\PSLATEXTMP',
 816     "$file.tex"
 817   );
 818
 819   my $timeout = 30; #? should be more than enough
 820
 821   for ( 1, 2 ) {
 822
 823     local($SIG{CHLD}) = sub {};
 824     run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
 825       or warn "bad exit status from pslatex pass $_\n";
 826
 827   }
 828
 829   return if -e "$file.dvi" && -s "$file.dvi";
 830   die "pslatex $file.tex failed; see $file.log for details?\n";
 831
 832 }
 833
 834 =item do_print ARRAYREF [, OPTION => VALUE ... ]
 835
 836 Sends the lines in ARRAYREF to the printer.
 837
 838 Options available are:
 839
 840 =over 4
 841
 842 =item agentnum
 843
 844 Uses this agent's 'lpr' configuration setting override instead of the global
 845 value.
 846
 847 =item lpr
 848
 849 Uses this command instead of the configured lpr command (overrides both the
 850 global value and agentnum).
 851
 852 =cut
 853
 854 sub do_print {
 855   my( $data, %opt ) = @_;
 856
 857   my $lpr = ( exists($opt{'lpr'}) && $opt{'lpr'} )
 858               ? $opt{'lpr'}
 859               : $conf->config('lpr', $opt{'agentnum'} );
 860
 861   my $outerr = '';
 862   run3 $lpr, $data, \$outerr, \$outerr;
 863   if ( $? ) {
 864     $outerr = ": $outerr" if length($outerr);
 865     die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
 866   }
 867
 868 }
 869
 870 =item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ]
 871
 872 Converts the filehandle referenced by FILEREF from fixed length record
 873 lines to a CSV file according to the lengths specified in LENGTH_LISTREF.
 874 The CALLBACKS_LISTREF refers to a correpsonding list of coderefs.  Each
 875 should return the value to be substituted in place of its single argument.
 876
 877 Returns false on success or an error if one occurs.
 878
 879 =cut
 880
 881 sub csv_from_fixed {
 882   my( $fhref, $countref, $lengths, $callbacks) = @_;
 883
 884   eval { require Text::CSV_XS; };
 885   return $@ if $@;
 886
 887   my $ofh = $$fhref;
 888   my $unpacker = new Text::CSV_XS;
 889   my $total = 0;
 890   my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths;
 891
 892   my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc";
 893   my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX",
 894                            DIR      => $dir,
 895                            UNLINK   => 0,
 896                          ) or return "can't open temp file: $!\n"
 897     if $template;
 898
 899   while ( defined(my $line=<$ofh>) ) {
 900     $$countref++;
 901     if ( $template ) {
 902       my $column = 0;
 903
 904       chomp $line;
 905       return "unexpected input at line $$countref: $line".
 906              " -- expected $total but received ". length($line)
 907         unless length($line) == $total;
 908
 909       $unpacker->combine( map { my $i = $column++;
 910                                 defined( $callbacks->[$i] )
 911                                   ? &{ $callbacks->[$i] }( $_ )
 912                                   : $_
 913                               } unpack( $template, $line )
 914                         )
 915         or return "invalid data for CSV: ". $unpacker->error_input;
 916
 917       print $fh $unpacker->string(), "\n"
 918         or return "can't write temp file: $!\n";
 919     }
 920   }
 921
 922   if ( $template ) { close $$fhref; $$fhref = $fh }
 923
 924   seek $$fhref, 0, 0;
 925   '';
 926 }
 927
 928 =item ocr_image IMAGE_SCALAR
 929
 930 Runs OCR on the provided image data and returns a list of text lines.
 931
 932 =cut
 933
 934 sub ocr_image {
 935   my $logo_data = shift;
 936
 937   #XXX use conf dir location from Makefile
 938   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
 939   my $fh = new File::Temp(
 940     TEMPLATE => 'bizcard.XXXXXXXX',
 941     SUFFIX   => '.png', #XXX assuming, but should handle jpg, gif, etc. too
 942     DIR      => $dir,
 943     UNLINK   => 0,
 944   ) or die "can't open temp file: $!\n";
 945
 946   my $filename = $fh->filename;
 947
 948   print $fh $logo_data;
 949   close $fh;
 950
 951   run( [qw(ocroscript recognize), $filename], '>'=>"$filename.hocr" )
 952     or die "ocroscript recognize failed\n";
 953
 954   run( [qw(ocroscript hocr-to-text), "$filename.hocr"], '>pipe'=>\*OUT )
 955     or die "ocroscript hocr-to-text failed\n";
 956
 957   my @lines = split(/\n/, <OUT> );
 958
 959   foreach (@lines) { s/\.c0m\s*$/.com/; }
 960
 961   @lines;
 962 }
 963
 964 =back
 965
 966 =head1 BUGS
 967
 968 This package exists.
 969
 970 =head1 SEE ALSO
 971
 972 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
 973
 974 L<Fax::Hylafax::Client>
 975
 976 =cut
 977
 978 1;