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