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