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 #do NOT depend on any FS:: modules here, causes weird (sometimes unreproducable
  13 #until on client machine) dependancy loops.  put them in FS::Misc::Something
  14 #instead
  15
  16 @ISA = qw( Exporter );
  17 @EXPORT_OK = qw( send_email generate_email send_fax
  18                  states_hash counties cities state_label
  19                  card_types
  20                  pkg_freqs
  21                  generate_ps generate_pdf do_print
  22                  csv_from_fixed
  23                );
  24
  25 $DEBUG = 0;
  26
  27 =head1 NAME
  28
  29 FS::Misc - Miscellaneous subroutines
  30
  31 =head1 SYNOPSIS
  32
  33   use FS::Misc qw(send_email);
  34
  35   send_email();
  36
  37 =head1 DESCRIPTION
  38
  39 Miscellaneous subroutines.  This module contains miscellaneous subroutines
  40 called from multiple other modules.  These are not OO or necessarily related,
  41 but are collected here to eliminate code duplication.
  42
  43 =head1 SUBROUTINES
  44
  45 =over 4
  46
  47 =item send_email OPTION => VALUE ...
  48
  49 Options:
  50
  51 =over 4
  52
  53 =item from
  54
  55 (required)
  56
  57 =item to
  58
  59 (required) comma-separated scalar or arrayref of recipients
  60
  61 =item subject
  62
  63 (required)
  64
  65 =item content-type
  66
  67 (optional) MIME type for the body
  68
  69 =item body
  70
  71 (required unless I<nobody> is true) arrayref of body text lines
  72
  73 =item mimeparts
  74
  75 (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().
  76
  77 =item nobody
  78
  79 (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,
  80 I<content-type>, if specified, overrides the default "multipart/mixed" for the outermost MIME container.
  81
  82 =item content-encoding
  83
  84 (optional) when using nobody, optional top-level MIME
  85 encoding which, if specified, overrides the default "7bit".
  86
  87 =item type
  88
  89 (optional) type parameter for multipart/related messages
  90
  91 =back
  92
  93 =cut
  94
  95 use vars qw( $conf );
  96 use Date::Format;
  97 use MIME::Entity;
  98 use Email::Sender::Simple qw(sendmail);
  99 use Email::Sender::Transport::SMTP;
 100 use Email::Sender::Transport::SMTP::TLS;
 101 use FS::UID;
 102
 103 FS::UID->install_callback( sub {
 104   $conf = new FS::Conf;
 105 } );
 106
 107 sub send_email {
 108   my(%options) = @_;
 109   if ( $DEBUG ) {
 110     my %doptions = %options;
 111     $doptions{'body'} = '(full body not shown in debug)';
 112     warn "FS::Misc::send_email called with options:\n  ". Dumper(\%doptions);
 113 #         join("\n", map { "  $_: ". $options{$_} } keys %options ). "\n"
 114   }
 115
 116   my @to = ref($options{to}) ? @{ $options{to} } : ( $options{to} );
 117
 118   my @mimeargs = ();
 119   my @mimeparts = ();
 120   if ( $options{'nobody'} ) {
 121
 122     croak "'mimeparts' option required when 'nobody' option given\n"
 123       unless $options{'mimeparts'};
 124
 125     @mimeparts = @{$options{'mimeparts'}};
 126
 127     @mimeargs = (
 128       'Type'         => ( $options{'content-type'} || 'multipart/mixed' ),
 129       'Encoding'     => ( $options{'content-encoding'} || '7bit' ),
 130     );
 131
 132   } else {
 133
 134     @mimeparts = @{$options{'mimeparts'}}
 135       if ref($options{'mimeparts'}) eq 'ARRAY';
 136
 137     if (scalar(@mimeparts)) {
 138
 139       @mimeargs = (
 140         'Type'     => 'multipart/mixed',
 141         'Encoding' => '7bit',
 142       );
 143
 144       unshift @mimeparts, {
 145         'Type'        => ( $options{'content-type'} || 'text/plain' ),
 146         'Data'        => $options{'body'},
 147         'Encoding'    => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
 148         'Disposition' => 'inline',
 149       };
 150
 151     } else {
 152
 153       @mimeargs = (
 154         'Type'     => ( $options{'content-type'} || 'text/plain' ),
 155         'Data'     => $options{'body'},
 156         'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
 157       );
 158
 159     }
 160
 161   }
 162
 163   my $domain;
 164   if ( $options{'from'} =~ /\@([\w\.\-]+)/ ) {
 165     $domain = $1;
 166   } else {
 167     warn 'no domain found in invoice from address '. $options{'from'}.
 168          '; constructing Message-ID (and saying HELO) @example.com';
 169     $domain = 'example.com';
 170   }
 171   my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
 172
 173   my $message = MIME::Entity->build(
 174     'From'       => $options{'from'},
 175     'To'         => join(', ', @to),
 176     'Sender'     => $options{'from'},
 177     'Reply-To'   => $options{'from'},
 178     'Date'       => time2str("%a, %d %b %Y %X %z", time),
 179     'Subject'    => $options{'subject'},
 180     'Message-ID' => "<$message_id>",
 181     @mimeargs,
 182   );
 183
 184   if ( $options{'type'} ) {
 185     #false laziness w/cust_bill::generate_email
 186     $message->head->replace('Content-type',
 187       $message->mime_type.
 188       '; boundary="'. $message->head->multipart_boundary. '"'.
 189       '; type='. $options{'type'}
 190     );
 191   }
 192
 193   foreach my $part (@mimeparts) {
 194
 195     if ( UNIVERSAL::isa($part, 'MIME::Entity') ) {
 196
 197       warn "attaching MIME part from MIME::Entity object\n"
 198         if $DEBUG;
 199       $message->add_part($part);
 200
 201     } elsif ( ref($part) eq 'HASH' ) {
 202
 203       warn "attaching MIME part from hashref:\n".
 204            join("\n", map "  $_: ".$part->{$_}, keys %$part ). "\n"
 205         if $DEBUG;
 206       $message->attach(%$part);
 207
 208     } else {
 209       croak "mimepart $part isn't a hashref or MIME::Entity object!";
 210     }
 211
 212   }
 213
 214   #send the email
 215
 216   my %smtp_opt = ( 'host' => $conf->config('smtpmachine'),
 217                    'helo' => $domain,
 218                  );
 219
 220   my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
 221   $smtp_opt{'port'} = $port;
 222
 223   my $transport;
 224   if ( defined($enc) && $enc eq 'starttls' ) {
 225     $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password);
 226     $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt );
 227   } else {
 228     if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
 229       $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password);
 230     }
 231     $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls';
 232     $transport = Email::Sender::Transport::SMTP->new( %smtp_opt );
 233   }
 234
 235   push @to, $options{bcc} if defined($options{bcc});
 236   local $@; # just in case
 237   eval { sendmail($message, { transport => $transport,
 238                               from      => $options{from},
 239                               to        => \@to }) };
 240
 241   if(ref($@) and $@->isa('Email::Sender::Failure')) {
 242     return ($@->code ? $@->code.' ' : '').$@->message
 243   }
 244   else {
 245     return $@;
 246   }
 247 }
 248
 249 =item generate_email OPTION => VALUE ...
 250
 251 Options:
 252
 253 =over 4
 254
 255 =item from
 256
 257 Sender address, required
 258
 259 =item to
 260
 261 Recipient address, required
 262
 263 =item bcc
 264
 265 Blind copy address, optional
 266
 267 =item subject
 268
 269 email subject, required
 270
 271 =item html_body
 272
 273 Email body (HTML alternative).  Arrayref of lines, or scalar.
 274
 275 Will be placed inside an HTML <BODY> tag.
 276
 277 =item text_body
 278
 279 Email body (Text alternative).  Arrayref of lines, or scalar.
 280
 281 =back
 282
 283 Constructs a multipart message from text_body and html_body.
 284
 285 =cut
 286
 287 #false laziness w/FS::cust_bill::generate_email
 288
 289 use MIME::Entity;
 290 use HTML::Entities;
 291
 292 sub generate_email {
 293   my %args = @_;
 294
 295   my $me = '[FS::Misc::generate_email]';
 296
 297   my %return = (
 298     'from'    => $args{'from'},
 299     'to'      => $args{'to'},
 300     'bcc'     => $args{'bcc'},
 301     'subject' => $args{'subject'},
 302   );
 303
 304   #if (ref($args{'to'}) eq 'ARRAY') {
 305   #  $return{'to'} = $args{'to'};
 306   #} else {
 307   #  $return{'to'} = [ grep { $_ !~ /^(POST|FAX)$/ }
 308   #                         $self->cust_main->invoicing_list
 309   #                  ];
 310   #}
 311
 312   warn "$me creating HTML/text multipart message"
 313     if $DEBUG;
 314
 315   $return{'nobody'} = 1;
 316
 317   my $alternative = build MIME::Entity
 318     'Type'        => 'multipart/alternative',
 319     'Encoding'    => '7bit',
 320     'Disposition' => 'inline'
 321   ;
 322
 323   my $data;
 324   if ( ref($args{'text_body'}) eq 'ARRAY' ) {
 325     $data = $args{'text_body'};
 326   } else {
 327     $data = [ split(/\n/, $args{'text_body'}) ];
 328   }
 329
 330   $alternative->attach(
 331     'Type'        => 'text/plain',
 332     #'Encoding'    => 'quoted-printable',
 333     'Encoding'    => '7bit',
 334     'Data'        => $data,
 335     'Disposition' => 'inline',
 336   );
 337
 338   my @html_data;
 339   if ( ref($args{'html_body'}) eq 'ARRAY' ) {
 340     @html_data = @{ $args{'html_body'} };
 341   } else {
 342     @html_data = split(/\n/, $args{'html_body'});
 343   }
 344
 345   $alternative->attach(
 346     'Type'        => 'text/html',
 347     'Encoding'    => 'quoted-printable',
 348     'Data'        => [ '<html>',
 349                        '  <head>',
 350                        '    <title>',
 351                        '      '. encode_entities($return{'subject'}),
 352                        '    </title>',
 353                        '  </head>',
 354                        '  <body bgcolor="#e8e8e8">',
 355                        @html_data,
 356                        '  </body>',
 357                        '</html>',
 358                      ],
 359     'Disposition' => 'inline',
 360     #'Filename'    => 'invoice.pdf',
 361   );
 362
 363   #no other attachment:
 364   # multipart/related
 365   #   multipart/alternative
 366   #     text/plain
 367   #     text/html
 368
 369   $return{'content-type'} = 'multipart/related';
 370   $return{'mimeparts'} = [ $alternative ];
 371   $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
 372   #$return{'disposition'} = 'inline';
 373
 374   %return;
 375
 376 }
 377
 378 =item process_send_email OPTION => VALUE ...
 379
 380 Takes arguments as per generate_email() and sends the message.  This
 381 will die on any error and can be used in the job queue.
 382
 383 =cut
 384
 385 sub process_send_email {
 386   my %message = @_;
 387   my $error = send_email(generate_email(%message));
 388   die "$error\n" if $error;
 389   '';
 390 }
 391
 392 =item send_fax OPTION => VALUE ...
 393
 394 Options:
 395
 396 I<dialstring> - (required) 10-digit phone number w/ area code
 397
 398 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
 399
 400 -or-
 401
 402 I<docfile> - (required) Filename of PostScript TIFF Class F document
 403
 404 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
 405
 406
 407 =cut
 408
 409 sub send_fax {
 410
 411   my %options = @_;
 412
 413   die 'HylaFAX support has not been configured.'
 414     unless $conf->exists('hylafax');
 415
 416   eval {
 417     require Fax::Hylafax::Client;
 418   };
 419
 420   if ($@) {
 421     if ($@ =~ /^Can't locate Fax.*/) {
 422       die "You must have Fax::Hylafax::Client installed to use invoice faxing."
 423     } else {
 424       die $@;
 425     }
 426   }
 427
 428   my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
 429
 430   die 'Called send_fax without a \'dialstring\'.'
 431     unless exists($options{'dialstring'});
 432
 433   if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
 434       my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
 435       my $fh = new File::Temp(
 436         TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
 437         DIR      => $dir,
 438         UNLINK   => 0,
 439       ) or die "can't open temp file: $!\n";
 440
 441       $options{docfile} = $fh->filename;
 442
 443       print $fh @{$options{'docdata'}};
 444       close $fh;
 445
 446       delete $options{'docdata'};
 447   }
 448
 449   die 'Called send_fax without a \'docfile\' or \'docdata\'.'
 450     unless exists($options{'docfile'});
 451
 452   #FIXME: Need to send canonical dialstring to HylaFAX, but this only
 453   #       works in the US.
 454
 455   $options{'dialstring'} =~ s/[^\d\+]//g;
 456   if ($options{'dialstring'} =~ /^\d{10}$/) {
 457     $options{dialstring} = '+1' . $options{'dialstring'};
 458   } else {
 459     return 'Invalid dialstring ' . $options{'dialstring'} . '.';
 460   }
 461
 462   my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
 463
 464   if ($faxjob->success) {
 465     warn "Successfully queued fax to '$options{dialstring}' with jobid " .
 466            $faxjob->jobid
 467       if $DEBUG;
 468     return '';
 469   } else {
 470     return 'Error while sending FAX: ' . $faxjob->trace;
 471   }
 472
 473 }
 474
 475 =item states_hash COUNTRY
 476
 477 Returns a list of key/value pairs containing state (or other sub-country
 478 division) abbriviations and names.
 479
 480 =cut
 481
 482 use FS::Record qw(qsearch);
 483 use Locale::SubCountry;
 484
 485 sub states_hash {
 486   my($country) = @_;
 487
 488   my @states =
 489 #     sort
 490      map { s/[\n\r]//g; $_; }
 491      map { $_->state; }
 492          qsearch({
 493                    'select'    => 'state',
 494                    'table'     => 'cust_main_county',
 495                    'hashref'   => { 'country' => $country },
 496                    'extra_sql' => 'GROUP BY state',
 497                 });
 498
 499   #it could throw a fatal "Invalid country code" error (for example "AX")
 500   my $subcountry = eval { new Locale::SubCountry($country) }
 501     or return ( '', '(n/a)' );
 502
 503   #"i see your schwartz is as big as mine!"
 504   map  { ( $_->[0] => $_->[1] ) }
 505   sort { $a->[1] cmp $b->[1] }
 506   map  { [ $_ => state_label($_, $subcountry) ] }
 507        @states;
 508 }
 509
 510 =item counties STATE COUNTRY
 511
 512 Returns a list of counties for this state and country.
 513
 514 =cut
 515
 516 sub counties {
 517   my( $state, $country ) = @_;
 518
 519   map { $_ } #return num_counties($state, $country) unless wantarray;
 520   sort map { s/[\n\r]//g; $_; }
 521        map { $_->county }
 522            qsearch({
 523              'select'  => 'DISTINCT county',
 524              'table'   => 'cust_main_county',
 525              'hashref' => { 'state'   => $state,
 526                             'country' => $country,
 527                           },
 528            });
 529 }
 530
 531 =item cities COUNTY STATE COUNTRY
 532
 533 Returns a list of cities for this county, state and country.
 534
 535 =cut
 536
 537 sub cities {
 538   my( $county, $state, $country ) = @_;
 539
 540   map { $_ } #return num_cities($county, $state, $country) unless wantarray;
 541   sort map { s/[\n\r]//g; $_; }
 542        map { $_->city }
 543            qsearch({
 544              'select'  => 'DISTINCT city',
 545              'table'   => 'cust_main_county',
 546              'hashref' => { 'county'  => $county,
 547                             'state'   => $state,
 548                             'country' => $country,
 549                           },
 550            });
 551 }
 552
 553 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
 554
 555 =cut
 556
 557 sub state_label {
 558   my( $state, $country ) = @_;
 559
 560   unless ( ref($country) ) {
 561     $country = eval { new Locale::SubCountry($country) }
 562       or return'(n/a)';
 563
 564   }
 565
 566   # US kludge to avoid changing existing behaviour
 567   # also we actually *use* the abbriviations...
 568   my $full_name = $country->country_code eq 'US'
 569                     ? ''
 570                     : $country->full_name($state);
 571
 572   $full_name = '' if $full_name eq 'unknown';
 573   $full_name =~ s/\(see also.*\)\s*$//;
 574   $full_name .= " ($state)" if $full_name;
 575
 576   $full_name || $state || '(n/a)';
 577
 578 }
 579
 580 =item card_types
 581
 582 Returns a hash reference of the accepted credit card types.  Keys are shorter
 583 identifiers and values are the longer strings used by the system (see
 584 L<Business::CreditCard>).
 585
 586 =cut
 587
 588 #$conf from above
 589
 590 sub card_types {
 591   my $conf = new FS::Conf;
 592
 593   my %card_types = (
 594     #displayname                    #value (Business::CreditCard)
 595     "VISA"                       => "VISA card",
 596     "MasterCard"                 => "MasterCard",
 597     "Discover"                   => "Discover card",
 598     "American Express"           => "American Express card",
 599     "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
 600     "enRoute"                    => "enRoute",
 601     "JCB"                        => "JCB",
 602     "BankCard"                   => "BankCard",
 603     "Switch"                     => "Switch",
 604     "Solo"                       => "Solo",
 605   );
 606   my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
 607   if ( @conf_card_types ) {
 608     #perhaps the hash is backwards for this, but this way works better for
 609     #usage in selfservice
 610     %card_types = map  { $_ => $card_types{$_} }
 611                   grep {
 612                          my $d = $_;
 613                            grep { $card_types{$d} eq $_ } @conf_card_types
 614                        }
 615                     keys %card_types;
 616   }
 617
 618   \%card_types;
 619 }
 620
 621 =item pkg_freqs
 622
 623 Returns a hash reference of allowed package billing frequencies.
 624
 625 =cut
 626
 627 sub pkg_freqs {
 628   tie my %freq, 'Tie::IxHash', (
 629     '0'    => '(no recurring fee)',
 630     '1h'   => 'hourly',
 631     '1d'   => 'daily',
 632     '2d'   => 'every two days',
 633     '3d'   => 'every three days',
 634     '1w'   => 'weekly',
 635     '2w'   => 'biweekly (every 2 weeks)',
 636     '1'    => 'monthly',
 637     '45d'  => 'every 45 days',
 638     '2'    => 'bimonthly (every 2 months)',
 639     '3'    => 'quarterly (every 3 months)',
 640     '4'    => 'every 4 months',
 641     '137d' => 'every 4 1/2 months (137 days)',
 642     '6'    => 'semiannually (every 6 months)',
 643     '12'   => 'annually',
 644     '13'   => 'every 13 months (annually +1 month)',
 645     '24'   => 'biannually (every 2 years)',
 646     '36'   => 'triannually (every 3 years)',
 647     '48'   => '(every 4 years)',
 648     '60'   => '(every 5 years)',
 649     '120'  => '(every 10 years)',
 650   ) ;
 651   \%freq;
 652 }
 653
 654 =item generate_ps FILENAME
 655
 656 Returns an postscript rendition of the LaTex file, as a scalar.
 657 FILENAME does not contain the .tex suffix and is unlinked by this function.
 658
 659 =cut
 660
 661 use String::ShellQuote;
 662
 663 sub generate_ps {
 664   my $file = shift;
 665
 666   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
 667   chdir($dir);
 668
 669   _pslatex($file);
 670
 671   system('dvips', '-q', '-t', 'letter', "$file.dvi", '-o', "$file.ps" ) == 0
 672     or die "dvips failed";
 673
 674   open(POSTSCRIPT, "<$file.ps")
 675     or die "can't open $file.ps: $! (error in LaTeX template?)\n";
 676
 677   unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex");
 678
 679   my $ps = '';
 680
 681   if ( $conf->exists('lpr-postscript_prefix') ) {
 682     my $prefix = $conf->config('lpr-postscript_prefix');
 683     $ps .= eval qq("$prefix");
 684   }
 685
 686   while (<POSTSCRIPT>) {
 687     $ps .= $_;
 688   }
 689
 690   close POSTSCRIPT;
 691
 692   if ( $conf->exists('lpr-postscript_suffix') ) {
 693     my $suffix = $conf->config('lpr-postscript_suffix');
 694     $ps .= eval qq("$suffix");
 695   }
 696
 697   return $ps;
 698
 699 }
 700
 701 =item generate_pdf FILENAME
 702
 703 Returns an PDF rendition of the LaTex file, as a scalar.  FILENAME does not
 704 contain the .tex suffix and is unlinked by this function.
 705
 706 =cut
 707
 708 use String::ShellQuote;
 709
 710 sub generate_pdf {
 711   my $file = shift;
 712
 713   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
 714   chdir($dir);
 715
 716   #system('pdflatex', "$file.tex");
 717   #system('pdflatex', "$file.tex");
 718   #! LaTeX Error: Unknown graphics extension: .eps.
 719
 720   _pslatex($file);
 721
 722   my $sfile = shell_quote $file;
 723
 724   #system('dvipdf', "$file.dvi", "$file.pdf" );
 725   system(
 726     "dvips -q -t letter -f $sfile.dvi ".
 727     "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
 728     "     -c save pop -"
 729   ) == 0
 730     or die "dvips | gs failed: $!";
 731
 732   open(PDF, "<$file.pdf")
 733     or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
 734
 735   unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex");
 736
 737   my $pdf = '';
 738   while (<PDF>) {
 739     $pdf .= $_;
 740   }
 741
 742   close PDF;
 743
 744   return $pdf;
 745
 746 }
 747
 748 sub _pslatex {
 749   my $file = shift;
 750
 751   #my $sfile = shell_quote $file;
 752
 753   my @cmd = (
 754     'latex',
 755     '-interaction=batchmode',
 756     '\AtBeginDocument{\RequirePackage{pslatex}}',
 757     '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
 758     '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
 759     '\PSLATEXTMP',
 760     "$file.tex"
 761   );
 762
 763   my $timeout = 30; #? should be more than enough
 764
 765   for ( 1, 2 ) {
 766
 767     local($SIG{CHLD}) = sub {};
 768     run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
 769       or die "pslatex $file.tex failed; see $file.log for details?\n";
 770
 771   }
 772
 773 }
 774
 775 =item print ARRAYREF
 776
 777 Sends the lines in ARRAYREF to the printer.
 778
 779 =cut
 780
 781 sub do_print {
 782   my $data = shift;
 783
 784   my $lpr = $conf->config('lpr');
 785
 786   my $outerr = '';
 787   run3 $lpr, $data, \$outerr, \$outerr;
 788   if ( $? ) {
 789     $outerr = ": $outerr" if length($outerr);
 790     die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
 791   }
 792
 793 }
 794
 795 =item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ]
 796
 797 Converts the filehandle referenced by FILEREF from fixed length record
 798 lines to a CSV file according to the lengths specified in LENGTH_LISTREF.
 799 The CALLBACKS_LISTREF refers to a correpsonding list of coderefs.  Each
 800 should return the value to be substituted in place of its single argument.
 801
 802 Returns false on success or an error if one occurs.
 803
 804 =cut
 805
 806 sub csv_from_fixed {
 807   my( $fhref, $countref, $lengths, $callbacks) = @_;
 808
 809   eval { require Text::CSV_XS; };
 810   return $@ if $@;
 811
 812   my $ofh = $$fhref;
 813   my $unpacker = new Text::CSV_XS;
 814   my $total = 0;
 815   my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths;
 816
 817   my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc";
 818   my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX",
 819                            DIR      => $dir,
 820                            UNLINK   => 0,
 821                          ) or return "can't open temp file: $!\n"
 822     if $template;
 823
 824   while ( defined(my $line=<$ofh>) ) {
 825     $$countref++;
 826     if ( $template ) {
 827       my $column = 0;
 828
 829       chomp $line;
 830       return "unexpected input at line $$countref: $line".
 831              " -- expected $total but received ". length($line)
 832         unless length($line) == $total;
 833
 834       $unpacker->combine( map { my $i = $column++;
 835                                 defined( $callbacks->[$i] )
 836                                   ? &{ $callbacks->[$i] }( $_ )
 837                                   : $_
 838                               } unpack( $template, $line )
 839                         )
 840         or return "invalid data for CSV: ". $unpacker->error_input;
 841
 842       print $fh $unpacker->string(), "\n"
 843         or return "can't write temp file: $!\n";
 844     }
 845   }
 846
 847   if ( $template ) { close $$fhref; $$fhref = $fh }
 848
 849   seek $$fhref, 0, 0;
 850   '';
 851 }
 852
 853
 854 =back
 855
 856 =head1 BUGS
 857
 858 This package exists.
 859
 860 =head1 SEE ALSO
 861
 862 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
 863
 864 L<Fax::Hylafax::Client>
 865
 866 =cut
 867
 868 1;