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