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