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