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