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}) ? join(', ', @{ $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'         => $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   local $@; # just in case
 236   eval { sendmail($message, { transport => $transport }) };
 237
 238   if(ref($@) and $@->isa('Email::Sender::Failure')) {
 239     return ($@->code ? $@->code.' ' : '').$@->message
 240   }
 241   else {
 242     return $@;
 243   }
 244 }
 245
 246 =item generate_email OPTION => VALUE ...
 247
 248 Options:
 249
 250 =over 4
 251
 252 =item from
 253
 254 Sender address, required
 255
 256 =item to
 257
 258 Recipient address, required
 259
 260 =item subject
 261
 262 email subject, required
 263
 264 =item html_body
 265
 266 Email body (HTML alternative).  Arrayref of lines, or scalar.
 267
 268 Will be placed inside an HTML <BODY> tag.
 269
 270 =item text_body
 271
 272 Email body (Text alternative).  Arrayref of lines, or scalar.
 273
 274 =back
 275
 276 Constructs a multipart message from text_body and html_body.
 277
 278 =cut
 279
 280 #false laziness w/FS::cust_bill::generate_email
 281
 282 use MIME::Entity;
 283 use HTML::Entities;
 284
 285 sub generate_email {
 286   my %args = @_;
 287
 288   my $me = '[FS::Misc::generate_email]';
 289
 290   my %return = (
 291     'from'    => $args{'from'},
 292     'to'      => $args{'to'},
 293     'subject' => $args{'subject'},
 294   );
 295
 296   #if (ref($args{'to'}) eq 'ARRAY') {
 297   #  $return{'to'} = $args{'to'};
 298   #} else {
 299   #  $return{'to'} = [ grep { $_ !~ /^(POST|FAX)$/ }
 300   #                         $self->cust_main->invoicing_list
 301   #                  ];
 302   #}
 303
 304   warn "$me creating HTML/text multipart message"
 305     if $DEBUG;
 306
 307   $return{'nobody'} = 1;
 308
 309   my $alternative = build MIME::Entity
 310     'Type'        => 'multipart/alternative',
 311     'Encoding'    => '7bit',
 312     'Disposition' => 'inline'
 313   ;
 314
 315   my $data;
 316   if ( ref($args{'text_body'}) eq 'ARRAY' ) {
 317     $data = $args{'text_body'};
 318   } else {
 319     $data = [ split(/\n/, $args{'text_body'}) ];
 320   }
 321
 322   $alternative->attach(
 323     'Type'        => 'text/plain',
 324     #'Encoding'    => 'quoted-printable',
 325     'Encoding'    => '7bit',
 326     'Data'        => $data,
 327     'Disposition' => 'inline',
 328   );
 329
 330   my @html_data;
 331   if ( ref($args{'html_body'}) eq 'ARRAY' ) {
 332     @html_data = @{ $args{'html_body'} };
 333   } else {
 334     @html_data = split(/\n/, $args{'html_body'});
 335   }
 336
 337   $alternative->attach(
 338     'Type'        => 'text/html',
 339     'Encoding'    => 'quoted-printable',
 340     'Data'        => [ '<html>',
 341                        '  <head>',
 342                        '    <title>',
 343                        '      '. encode_entities($return{'subject'}),
 344                        '    </title>',
 345                        '  </head>',
 346                        '  <body bgcolor="#e8e8e8">',
 347                        @html_data,
 348                        '  </body>',
 349                        '</html>',
 350                      ],
 351     'Disposition' => 'inline',
 352     #'Filename'    => 'invoice.pdf',
 353   );
 354
 355   #no other attachment:
 356   # multipart/related
 357   #   multipart/alternative
 358   #     text/plain
 359   #     text/html
 360
 361   $return{'content-type'} = 'multipart/related';
 362   $return{'mimeparts'} = [ $alternative ];
 363   $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
 364   #$return{'disposition'} = 'inline';
 365
 366   %return;
 367
 368 }
 369
 370 =item process_send_email OPTION => VALUE ...
 371
 372 Takes arguments as per generate_email() and sends the message.  This
 373 will die on any error and can be used in the job queue.
 374
 375 =cut
 376
 377 sub process_send_email {
 378   my %message = @_;
 379   my $error = send_email(generate_email(%message));
 380   die "$error\n" if $error;
 381   '';
 382 }
 383
 384 =item send_fax OPTION => VALUE ...
 385
 386 Options:
 387
 388 I<dialstring> - (required) 10-digit phone number w/ area code
 389
 390 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
 391
 392 -or-
 393
 394 I<docfile> - (required) Filename of PostScript TIFF Class F document
 395
 396 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
 397
 398
 399 =cut
 400
 401 sub send_fax {
 402
 403   my %options = @_;
 404
 405   die 'HylaFAX support has not been configured.'
 406     unless $conf->exists('hylafax');
 407
 408   eval {
 409     require Fax::Hylafax::Client;
 410   };
 411
 412   if ($@) {
 413     if ($@ =~ /^Can't locate Fax.*/) {
 414       die "You must have Fax::Hylafax::Client installed to use invoice faxing."
 415     } else {
 416       die $@;
 417     }
 418   }
 419
 420   my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
 421
 422   die 'Called send_fax without a \'dialstring\'.'
 423     unless exists($options{'dialstring'});
 424
 425   if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
 426       my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
 427       my $fh = new File::Temp(
 428         TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
 429         DIR      => $dir,
 430         UNLINK   => 0,
 431       ) or die "can't open temp file: $!\n";
 432
 433       $options{docfile} = $fh->filename;
 434
 435       print $fh @{$options{'docdata'}};
 436       close $fh;
 437
 438       delete $options{'docdata'};
 439   }
 440
 441   die 'Called send_fax without a \'docfile\' or \'docdata\'.'
 442     unless exists($options{'docfile'});
 443
 444   #FIXME: Need to send canonical dialstring to HylaFAX, but this only
 445   #       works in the US.
 446
 447   $options{'dialstring'} =~ s/[^\d\+]//g;
 448   if ($options{'dialstring'} =~ /^\d{10}$/) {
 449     $options{dialstring} = '+1' . $options{'dialstring'};
 450   } else {
 451     return 'Invalid dialstring ' . $options{'dialstring'} . '.';
 452   }
 453
 454   my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
 455
 456   if ($faxjob->success) {
 457     warn "Successfully queued fax to '$options{dialstring}' with jobid " .
 458            $faxjob->jobid
 459       if $DEBUG;
 460     return '';
 461   } else {
 462     return 'Error while sending FAX: ' . $faxjob->trace;
 463   }
 464
 465 }
 466
 467 =item states_hash COUNTRY
 468
 469 Returns a list of key/value pairs containing state (or other sub-country
 470 division) abbriviations and names.
 471
 472 =cut
 473
 474 use FS::Record qw(qsearch);
 475 use Locale::SubCountry;
 476
 477 sub states_hash {
 478   my($country) = @_;
 479
 480   my @states =
 481 #     sort
 482      map { s/[\n\r]//g; $_; }
 483      map { $_->state; }
 484          qsearch({
 485                    'select'    => 'state',
 486                    'table'     => 'cust_main_county',
 487                    'hashref'   => { 'country' => $country },
 488                    'extra_sql' => 'GROUP BY state',
 489                 });
 490
 491   #it could throw a fatal "Invalid country code" error (for example "AX")
 492   my $subcountry = eval { new Locale::SubCountry($country) }
 493     or return ( '', '(n/a)' );
 494
 495   #"i see your schwartz is as big as mine!"
 496   map  { ( $_->[0] => $_->[1] ) }
 497   sort { $a->[1] cmp $b->[1] }
 498   map  { [ $_ => state_label($_, $subcountry) ] }
 499        @states;
 500 }
 501
 502 =item counties STATE COUNTRY
 503
 504 Returns a list of counties for this state and country.
 505
 506 =cut
 507
 508 sub counties {
 509   my( $state, $country ) = @_;
 510
 511   map { $_ } #return num_counties($state, $country) unless wantarray;
 512   sort map { s/[\n\r]//g; $_; }
 513        map { $_->county }
 514            qsearch({
 515              'select'  => 'DISTINCT county',
 516              'table'   => 'cust_main_county',
 517              'hashref' => { 'state'   => $state,
 518                             'country' => $country,
 519                           },
 520            });
 521 }
 522
 523 =item cities COUNTY STATE COUNTRY
 524
 525 Returns a list of cities for this county, state and country.
 526
 527 =cut
 528
 529 sub cities {
 530   my( $county, $state, $country ) = @_;
 531
 532   map { $_ } #return num_cities($county, $state, $country) unless wantarray;
 533   sort map { s/[\n\r]//g; $_; }
 534        map { $_->city }
 535            qsearch({
 536              'select'  => 'DISTINCT city',
 537              'table'   => 'cust_main_county',
 538              'hashref' => { 'county'  => $county,
 539                             'state'   => $state,
 540                             'country' => $country,
 541                           },
 542            });
 543 }
 544
 545 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
 546
 547 =cut
 548
 549 sub state_label {
 550   my( $state, $country ) = @_;
 551
 552   unless ( ref($country) ) {
 553     $country = eval { new Locale::SubCountry($country) }
 554       or return'(n/a)';
 555
 556   }
 557
 558   # US kludge to avoid changing existing behaviour
 559   # also we actually *use* the abbriviations...
 560   my $full_name = $country->country_code eq 'US'
 561                     ? ''
 562                     : $country->full_name($state);
 563
 564   $full_name = '' if $full_name eq 'unknown';
 565   $full_name =~ s/\(see also.*\)\s*$//;
 566   $full_name .= " ($state)" if $full_name;
 567
 568   $full_name || $state || '(n/a)';
 569
 570 }
 571
 572 =item card_types
 573
 574 Returns a hash reference of the accepted credit card types.  Keys are shorter
 575 identifiers and values are the longer strings used by the system (see
 576 L<Business::CreditCard>).
 577
 578 =cut
 579
 580 #$conf from above
 581
 582 sub card_types {
 583   my $conf = new FS::Conf;
 584
 585   my %card_types = (
 586     #displayname                    #value (Business::CreditCard)
 587     "VISA"                       => "VISA card",
 588     "MasterCard"                 => "MasterCard",
 589     "Discover"                   => "Discover card",
 590     "American Express"           => "American Express card",
 591     "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
 592     "enRoute"                    => "enRoute",
 593     "JCB"                        => "JCB",
 594     "BankCard"                   => "BankCard",
 595     "Switch"                     => "Switch",
 596     "Solo"                       => "Solo",
 597   );
 598   my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
 599   if ( @conf_card_types ) {
 600     #perhaps the hash is backwards for this, but this way works better for
 601     #usage in selfservice
 602     %card_types = map  { $_ => $card_types{$_} }
 603                   grep {
 604                          my $d = $_;
 605                            grep { $card_types{$d} eq $_ } @conf_card_types
 606                        }
 607                     keys %card_types;
 608   }
 609
 610   \%card_types;
 611 }
 612
 613 =item pkg_freqs
 614
 615 Returns a hash reference of allowed package billing frequencies.
 616
 617 =cut
 618
 619 sub pkg_freqs {
 620   tie my %freq, 'Tie::IxHash', (
 621     '0'    => '(no recurring fee)',
 622     '1h'   => 'hourly',
 623     '1d'   => 'daily',
 624     '2d'   => 'every two days',
 625     '3d'   => 'every three days',
 626     '1w'   => 'weekly',
 627     '2w'   => 'biweekly (every 2 weeks)',
 628     '1'    => 'monthly',
 629     '45d'  => 'every 45 days',
 630     '2'    => 'bimonthly (every 2 months)',
 631     '3'    => 'quarterly (every 3 months)',
 632     '4'    => 'every 4 months',
 633     '137d' => 'every 4 1/2 months (137 days)',
 634     '6'    => 'semiannually (every 6 months)',
 635     '12'   => 'annually',
 636     '13'   => 'every 13 months (annually +1 month)',
 637     '24'   => 'biannually (every 2 years)',
 638     '36'   => 'triannually (every 3 years)',
 639     '48'   => '(every 4 years)',
 640     '60'   => '(every 5 years)',
 641     '120'  => '(every 10 years)',
 642   ) ;
 643   \%freq;
 644 }
 645
 646 =item generate_ps FILENAME
 647
 648 Returns an postscript rendition of the LaTex file, as a scalar.
 649 FILENAME does not contain the .tex suffix and is unlinked by this function.
 650
 651 =cut
 652
 653 use String::ShellQuote;
 654
 655 sub generate_ps {
 656   my $file = shift;
 657
 658   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
 659   chdir($dir);
 660
 661   _pslatex($file);
 662
 663   system('dvips', '-q', '-t', 'letter', "$file.dvi", '-o', "$file.ps" ) == 0
 664     or die "dvips failed";
 665
 666   open(POSTSCRIPT, "<$file.ps")
 667     or die "can't open $file.ps: $! (error in LaTeX template?)\n";
 668
 669   unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex");
 670
 671   my $ps = '';
 672
 673   if ( $conf->exists('lpr-postscript_prefix') ) {
 674     my $prefix = $conf->config('lpr-postscript_prefix');
 675     $ps .= eval qq("$prefix");
 676   }
 677
 678   while (<POSTSCRIPT>) {
 679     $ps .= $_;
 680   }
 681
 682   close POSTSCRIPT;
 683
 684   if ( $conf->exists('lpr-postscript_suffix') ) {
 685     my $suffix = $conf->config('lpr-postscript_suffix');
 686     $ps .= eval qq("$suffix");
 687   }
 688
 689   return $ps;
 690
 691 }
 692
 693 =item generate_pdf FILENAME
 694
 695 Returns an PDF rendition of the LaTex file, as a scalar.  FILENAME does not
 696 contain the .tex suffix and is unlinked by this function.
 697
 698 =cut
 699
 700 use String::ShellQuote;
 701
 702 sub generate_pdf {
 703   my $file = shift;
 704
 705   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
 706   chdir($dir);
 707
 708   #system('pdflatex', "$file.tex");
 709   #system('pdflatex', "$file.tex");
 710   #! LaTeX Error: Unknown graphics extension: .eps.
 711
 712   _pslatex($file);
 713
 714   my $sfile = shell_quote $file;
 715
 716   #system('dvipdf', "$file.dvi", "$file.pdf" );
 717   system(
 718     "dvips -q -t letter -f $sfile.dvi ".
 719     "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
 720     "     -c save pop -"
 721   ) == 0
 722     or die "dvips | gs failed: $!";
 723
 724   open(PDF, "<$file.pdf")
 725     or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
 726
 727   unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex");
 728
 729   my $pdf = '';
 730   while (<PDF>) {
 731     $pdf .= $_;
 732   }
 733
 734   close PDF;
 735
 736   return $pdf;
 737
 738 }
 739
 740 sub _pslatex {
 741   my $file = shift;
 742
 743   #my $sfile = shell_quote $file;
 744
 745   my @cmd = (
 746     'latex',
 747     '-interaction=batchmode',
 748     '\AtBeginDocument{\RequirePackage{pslatex}}',
 749     '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
 750     '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
 751     '\PSLATEXTMP',
 752     "$file.tex"
 753   );
 754
 755   my $timeout = 30; #? should be more than enough
 756
 757   for ( 1, 2 ) {
 758
 759     local($SIG{CHLD}) = sub {};
 760     run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
 761       or die "pslatex $file.tex failed; see $file.log for details?\n";
 762
 763   }
 764
 765 }
 766
 767 =item print ARRAYREF
 768
 769 Sends the lines in ARRAYREF to the printer.
 770
 771 =cut
 772
 773 sub do_print {
 774   my $data = shift;
 775
 776   my $lpr = $conf->config('lpr');
 777
 778   my $outerr = '';
 779   run3 $lpr, $data, \$outerr, \$outerr;
 780   if ( $? ) {
 781     $outerr = ": $outerr" if length($outerr);
 782     die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
 783   }
 784
 785 }
 786
 787 =item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ]
 788
 789 Converts the filehandle referenced by FILEREF from fixed length record
 790 lines to a CSV file according to the lengths specified in LENGTH_LISTREF.
 791 The CALLBACKS_LISTREF refers to a correpsonding list of coderefs.  Each
 792 should return the value to be substituted in place of its single argument.
 793
 794 Returns false on success or an error if one occurs.
 795
 796 =cut
 797
 798 sub csv_from_fixed {
 799   my( $fhref, $countref, $lengths, $callbacks) = @_;
 800
 801   eval { require Text::CSV_XS; };
 802   return $@ if $@;
 803
 804   my $ofh = $$fhref;
 805   my $unpacker = new Text::CSV_XS;
 806   my $total = 0;
 807   my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths;
 808
 809   my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc";
 810   my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX",
 811                            DIR      => $dir,
 812                            UNLINK   => 0,
 813                          ) or return "can't open temp file: $!\n"
 814     if $template;
 815
 816   while ( defined(my $line=<$ofh>) ) {
 817     $$countref++;
 818     if ( $template ) {
 819       my $column = 0;
 820
 821       chomp $line;
 822       return "unexpected input at line $$countref: $line".
 823              " -- expected $total but received ". length($line)
 824         unless length($line) == $total;
 825
 826       $unpacker->combine( map { my $i = $column++;
 827                                 defined( $callbacks->[$i] )
 828                                   ? &{ $callbacks->[$i] }( $_ )
 829                                   : $_
 830                               } unpack( $template, $line )
 831                         )
 832         or return "invalid data for CSV: ". $unpacker->error_input;
 833
 834       print $fh $unpacker->string(), "\n"
 835         or return "can't write temp file: $!\n";
 836     }
 837   }
 838
 839   if ( $template ) { close $$fhref; $$fhref = $fh }
 840
 841   seek $$fhref, 0, 0;
 842   '';
 843 }
 844
 845
 846 =back
 847
 848 =head1 BUGS
 849
 850 This package exists.
 851
 852 =head1 SEE ALSO
 853
 854 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
 855
 856 L<Fax::Hylafax::Client>
 857
 858 =cut
 859
 860 1;