FS/FS/Misc.pm

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