FS/FS/Cron/upload.pm

   1 package FS::Cron::upload;
   2
   3 use strict;
   4 use vars qw( @ISA @EXPORT_OK $me $DEBUG );
   5 use Exporter;
   6 use Date::Format;
   7 use FS::UID qw(dbh);
   8 use FS::Record qw( qsearch qsearchs );
   9 use FS::Conf;
  10 use FS::queue;
  11 use FS::agent;
  12 use FS::Misc qw( send_email ); #for bridgestone
  13 use FS::upload_target;
  14 use LWP::UserAgent;
  15 use HTTP::Request;
  16 use HTTP::Request::Common;
  17 use HTTP::Response;
  18 use Net::FTP;
  19 use List::Util qw( sum );
  20
  21 @ISA = qw( Exporter );
  22 @EXPORT_OK = qw ( upload );
  23 $DEBUG = 0;
  24 $me = '[FS::Cron::upload]';
  25
  26 #freeside-daily %opt:
  27 #  -v: enable debugging
  28 #  -l: debugging level
  29 #  -m: Experimental multi-process mode uses the job queue for multi-process and/or multi-machine billing.
  30 #  -r: Multi-process mode dry run option
  31 #  -a: Only process customers with the specified agentnum
  32
  33
  34 sub upload {
  35   my %opt = @_;
  36
  37   my $debug = 0;
  38   $debug = 1 if $opt{'v'};
  39   $debug = $opt{'l'} if $opt{'l'};
  40
  41   local $DEBUG = $debug if $debug;
  42
  43   warn "$me upload called\n" if $DEBUG;
  44
  45   my @tasks;
  46
  47   my $date =  time2str('%Y%m%d%H%M%S', $^T); # more?
  48
  49   my $conf = new FS::Conf;
  50
  51   my @agents = $opt{'a'} ? FS::agent->by_key($opt{'a'}) : qsearch('agent', {});
  52
  53   my %task = (
  54     'date'      => $date,
  55     'l'         => $opt{'l'},
  56     'm'         => $opt{'m'},
  57     'v'         => $opt{'v'},
  58   );
  59
  60   my @agentnums = ('', map {$_->agentnum} @agents);
  61
  62   foreach my $target (qsearch('upload_target', {})) {
  63     # We don't know here if it's spooled on a per-agent basis or not.
  64     # (It could even be both, via different events.)  So queue up an
  65     # upload for each agent, plus one with null agentnum, and we'll
  66     # upload as many files as we find.
  67     foreach my $a (@agentnums) {
  68       push @tasks, {
  69         %task,
  70         'agentnum'  => $a,
  71         'targetnum' => $target->targetnum,
  72         'handling'  => $target->handling,
  73       };
  74     }
  75   }
  76
  77   # deprecated billco method
  78   foreach (@agents) {
  79     my $agentnum = $_->agentnum;
  80
  81     if ( $conf->config( 'billco-username', $agentnum, 1 ) ) {
  82       my $username = $conf->config('billco-username', $agentnum, 1);
  83       my $password = $conf->config('billco-password', $agentnum, 1);
  84       my $clicode  = $conf->config('billco-clicode',  $agentnum, 1);
  85       my $url      = $conf->config('billco-url',      $agentnum);
  86       push @tasks, {
  87         %task,
  88         'agentnum' => $agentnum,
  89         'username' => $username,
  90         'password' => $password,
  91         'url'      => $url,
  92         'clicode'  => $clicode,
  93         'handling' => 'billco',
  94       };
  95     }
  96   } # foreach @agents
  97
  98   foreach (@tasks) {
  99
 100     my $agentnum = $_->{agentnum};
 101
 102     if ( $opt{'m'} ) {
 103
 104       if ( $opt{'r'} ) {
 105         warn "DRY RUN: would add agent $agentnum for queued upload\n";
 106       } else {
 107         my $queue = new FS::queue {
 108           'job'      => 'FS::Cron::upload::spool_upload',
 109         };
 110         my $error = $queue->insert( %$_ );
 111       }
 112
 113     } else {
 114
 115       eval { spool_upload(%$_) };
 116       warn "spool_upload failed: $@\n"
 117         if $@;
 118
 119     }
 120
 121   }
 122
 123 }
 124
 125 sub spool_upload {
 126   my %opt = @_;
 127
 128   warn "$me spool_upload called\n" if $DEBUG;
 129   my $conf = new FS::Conf;
 130   my $dir = '%%%FREESIDE_EXPORT%%%/export.'. $FS::UID::datasrc. '/cust_bill';
 131
 132   my $date = $opt{date} or die "no date provided\n";
 133
 134   local $SIG{HUP} = 'IGNORE';
 135   local $SIG{INT} = 'IGNORE';
 136   local $SIG{QUIT} = 'IGNORE';
 137   local $SIG{TERM} = 'IGNORE';
 138   local $SIG{TSTP} = 'IGNORE';
 139   local $SIG{PIPE} = 'IGNORE';
 140
 141   my $oldAutoCommit = $FS::UID::AutoCommit;
 142   local $FS::UID::AutoCommit = 0;
 143   my $dbh = dbh;
 144
 145   my $agentnum = $opt{agentnum};
 146
 147   # wait for any ongoing billing jobs to complete
 148   # (should this exclude status='failed')?
 149   if ($opt{m}) {
 150     my $sql = "SELECT count(*) FROM queue LEFT JOIN cust_main USING(custnum) ".
 151     "WHERE queue.job='FS::cust_main::queued_bill'";
 152     $sql .= " AND cust_main.agentnum = $agentnum" if $agentnum =~ /^\d+$/;
 153     my $sth = $dbh->prepare($sql) or die $dbh->errstr;
 154     while (1) {
 155       $sth->execute()
 156         or die "Unexpected error executing statement $sql: ". $sth->errstr;
 157       last if $sth->fetchrow_arrayref->[0] == 0;
 158       sleep 300;
 159     }
 160   }
 161
 162   my $agent;
 163   if ( $agentnum ) {
 164     $agent = qsearchs( 'agent', { agentnum => $agentnum } )
 165       or die "no such agent: $agentnum";
 166     $agent->select_for_update; #mutex
 167   }
 168
 169   if ( $opt{'handling'} eq 'billco' ) {
 170
 171     my $file = "agentnum$agentnum";
 172     my $zipfile  = "$dir/$file-$date.zip";
 173
 174     unless ( -f "$dir/$file-header.csv" ||
 175              -f "$dir/$file-detail.csv" )
 176     {
 177       warn "$me neither $dir/$file-header.csv nor ".
 178            "$dir/$file-detail.csv found\n" if $DEBUG > 1;
 179       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 180       return;
 181     }
 182
 183     my $url      = $opt{url} or die "no url for agent $agentnum\n";
 184     $url =~ s/^\s+//; $url =~ s/\s+$//;
 185
 186     my $username = $opt{username} or die "no username for agent $agentnum\n";
 187     my $password = $opt{password} or die "no password for agent $agentnum\n";
 188
 189     foreach ( qw ( header detail ) ) {
 190       rename "$dir/$file-$_.csv",
 191              "$dir/$file-$date-$_.csv";
 192     }
 193
 194     my $command = "cd $dir; zip $zipfile ".
 195                   "$file-$date-header.csv ".
 196                   "$file-$date-detail.csv";
 197
 198     system($command) and die "$command failed\n";
 199
 200     unlink "$file-$date-header.csv",
 201            "$file-$date-detail.csv";
 202
 203     if ( $url =~ /^http/i ) {
 204
 205       my $ua = new LWP::UserAgent;
 206       my $res = $ua->request( POST( $url,
 207                                     'Content_Type' => 'form-data',
 208                                     'Content' => [ 'username' => $username,
 209                                                    'pass'     => $password,
 210                                                    'custid'   => $username,
 211                                                    'clicode'  => $opt{clicode},
 212                                                    'file1'    => [ $zipfile ],
 213                                                  ],
 214                                   )
 215                             );
 216
 217       die "upload failed: ". $res->status_line. "\n"
 218         unless $res->is_success;
 219
 220     } elsif ( $url =~ /^ftp:\/\/([\w\.]+)(\/.*)$/i ) {
 221
 222       my($hostname, $path) = ($1, $2);
 223
 224       my $ftp = new Net::FTP($hostname, Passive=>1)
 225         or die "can't connect to $hostname: $@\n";
 226       $ftp->login($username, $password)
 227         or die "can't login to $hostname: ". $ftp->message."\n";
 228       unless ( $ftp->cwd($path) ) {
 229         my $msg = "can't cd $path on $hostname: ". $ftp->message. "\n";
 230         ( $path eq '/' ) ? warn $msg : die $msg;
 231       }
 232       $ftp->binary
 233         or die "can't set binary mode on $hostname\n";
 234
 235       $ftp->put($zipfile)
 236         or die "can't put $zipfile: ". $ftp->message. "\n";
 237
 238       $ftp->quit;
 239
 240     } else {
 241       die "unknown scheme in URL $url\n";
 242     }
 243
 244   }
 245   else { #not billco
 246
 247     my $targetnum = $opt{targetnum};
 248     my $upload_target = FS::upload_target->by_key($targetnum)
 249       or die "FTP target $targetnum not found\n";
 250
 251     $dir .= "/target$targetnum";
 252     chdir($dir);
 253
 254     my $file  = $agentnum ? "agentnum$agentnum" : 'spool'; #.csv
 255
 256     unless ( -f "$dir/$file.csv" ) {
 257       warn "$me $dir/$file.csv not found\n" if $DEBUG > 1;
 258       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 259       return;
 260     }
 261
 262     rename "$dir/$file.csv", "$dir/$file-$date.csv";
 263
 264     if ( $opt{'handling'} eq 'bridgestone' ) {
 265
 266       my $prefix = $conf->config('bridgestone-prefix', $agentnum);
 267       unless ( $prefix ) {
 268         warn "$me agent $agentnum has no bridgestone-prefix, skipped\n";
 269         $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 270         return;
 271       }
 272
 273       my $seq = $conf->config('bridgestone-batch_counter', $agentnum) || 1;
 274
 275       # extract zip code
 276       join(' ',$conf->config('company_address', $agentnum)) =~
 277         /(\d{5}(\-\d{4})?)\s*$/;
 278       my $ourzip = $1 || ''; #could be an explicit option if really needed
 279       $ourzip  =~ s/\D//;
 280       my $newfile = sprintf('%s_%s_%0.6d.dat',
 281                             $prefix,
 282                             time2str('%Y%m%d', time),
 283                             $seq);
 284       warn "copying spool to $newfile\n" if $DEBUG;
 285
 286       my ($in, $out);
 287       open $in, '<', "$dir/$file-$date.csv"
 288         or die "unable to read $file-$date.csv\n";
 289       open $out, '>', "$dir/$newfile" or die "unable to write $newfile\n";
 290       #header--not sure how much of this generalizes at all
 291       my $head = sprintf(
 292         "%-6s%-4s%-27s%-6s%0.6d%-5s%-9s%-9s%-7s%0.8d%-7s%0.6d\n",
 293         ' COMP:', 'VISP', '', ',SEQ#:', $seq, ',ZIP:', $ourzip, ',VERS:1.1',
 294         ',RUNDT:', time2str('%m%d%Y', $^T),
 295         ',RUNTM:', time2str('%H%M%S', $^T),
 296       );
 297       warn "HEADER: $head" if $DEBUG;
 298       print $out $head;
 299
 300       my $rows = 0;
 301       while( <$in> ) {
 302         print $out $_;
 303         $rows++;
 304       }
 305
 306       #trailer
 307       my $trail = sprintf(
 308         "%-6s%-4s%-27s%-6s%0.6d%-7s%0.9d%-9s%0.9d\n",
 309         ' COMP:', 'VISP', '', ',SEQ:', $seq,
 310         ',LINES:', $rows+2, ',LETTERS:', $rows,
 311       );
 312       warn "TRAILER: $trail" if $DEBUG;
 313       print $out $trail;
 314
 315       close $in;
 316       close $out;
 317
 318       my $zipfile = sprintf('%s_%0.6d.zip', $prefix, $seq);
 319       my $command = "cd $dir; zip $zipfile $newfile";
 320       warn "compressing to $zipfile\n$command\n" if $DEBUG;
 321       system($command) and die "$command failed\n";
 322
 323       my $error = $upload_target->put($zipfile);
 324       if ( $error ) {
 325         foreach ( qw ( header detail ) ) {
 326           rename "$dir/$file-$date-$_.csv",
 327                  "$dir/$file-$_.csv";
 328           die $error;
 329         }
 330       }
 331
 332       send_email(
 333         prepare_report('bridgestone-confirm_template',
 334           {
 335             agentnum=> $agentnum,
 336             zipfile => $zipfile,
 337             prefix  => $prefix,
 338             seq     => $seq,
 339             rows    => $rows,
 340           }
 341         )
 342       );
 343
 344       $seq++;
 345       warn "setting batch counter to $seq\n" if $DEBUG;
 346       $conf->set('bridgestone-batch_counter', $seq, $agentnum);
 347
 348     } elsif ( $opt{'handling'} eq 'ics' ) {
 349
 350       my ($basename, $regfile, $bigfile);
 351       $basename = sprintf('c%sc1', time2str('%m%d', time));
 352       $regfile = $basename . 'i.txt'; # for "regular" (short) invoices
 353       $bigfile = $basename . 'b.txt'; # for "big" invoices
 354
 355       warn "copying spool to $regfile, $bigfile\n" if $DEBUG;
 356
 357       my ($in, $reg, $big); #filehandles
 358       my %count = (B => 0, 1 => 0, 2 => 0); # number of invoices
 359       my %sum = (B => 0, R => 0); # total of charges field
 360       open $in, '<', "$dir/$file-$date.csv"
 361         or die "unable to read $file-$date.csv\n";
 362
 363       open $reg, '>', "$dir/$regfile" or die "unable to write $regfile\n";
 364       open $big, '>', "$dir/$bigfile" or die "unable to write $bigfile\n";
 365
 366       while (my $line = <$in>) {
 367         chomp($line);
 368         my $tag = substr($line, -1, 1, '');
 369         my $charge = substr($line, 252, 10);
 370         if ( $tag eq 'B' ) {
 371           print $big $line, "\n";
 372           $count{B}++;
 373           $sum{B} += $charge;
 374         } else {
 375           print $reg $line, "\n";
 376           $count{$tag}++;
 377           $sum{R} += $charge;
 378         }
 379       }
 380       close $in;
 381       close $reg;
 382       close $big;
 383
 384       # zip up all three files for transport
 385       my $zipfile = "$basename" . '.zip';
 386       my $command = "cd $dir; zip $zipfile $regfile $bigfile";
 387       system($command) and die "'$command' failed\n";
 388
 389       # upload them, unless we're using email, in which case
 390       # the zip file will ride along with the report.  yes, this
 391       # kind of defeats the purpose of the upload_target interface,
 392       # but at least we have a place to store the configuration.
 393       my $error = '';
 394       if ( $upload_target->protocol ne 'email' ) {
 395         $error = $upload_target->put("$dir/$zipfile");
 396       }
 397
 398       # create the report
 399       for (values %sum) {
 400         $_ = sprintf('%.2f', $_);
 401       }
 402
 403       my %report = prepare_report('ics-confirm_template',
 404         {
 405           agentnum  => $agentnum,
 406           count     => \%count,
 407           sum       => \%sum,
 408           error     => $error,
 409         }
 410       );
 411       if ( $upload_target->protocol eq 'email' ) {
 412         $report{'to'} =
 413           join('@', $upload_target->username, $upload_target->hostname);
 414         $report{'subject'} = $upload_target->subject;
 415         $report{'mimeparts'} = [
 416           { Path        => "$dir/$zipfile",
 417             Type        => 'application/zip',
 418             Encoding    => 'base64',
 419             Filename    => $zipfile,
 420             Disposition => 'attachment',
 421           }
 422         ];
 423       }
 424       $error = send_email(%report);
 425
 426       if ( $error ) {
 427         # put the original spool file back
 428         rename "$dir/$file-$date.csv", "$dir/$file.csv";
 429         die $error;
 430       }
 431
 432     } else { # not bridgestone or ics
 433
 434       # this is the usual case
 435
 436       my $error = $upload_target->put("$file-$date.csv");
 437       if ( $error ) {
 438         rename "$dir/$file-$date.csv", "$dir/$file.csv";
 439         die $error;
 440       }
 441
 442     }
 443
 444   } #opt{handling}
 445
 446   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 447   '';
 448
 449 }
 450
 451 =item send_report CONFIG PARAMS
 452
 453 Retrieves the config value named CONFIG, parses it as a Text::Template,
 454 extracts "to" and "subject" headers, and returns a hash that can be passed
 455 to L<FS::Misc::send_email>.
 456
 457 PARAMS is a hashref to be passed to C<fill_in>.  It must contain
 458 'agentnum' to look up the per-agent config.
 459
 460 =cut
 461
 462 # we used it twice, so it's now a subroutine
 463
 464 sub prepare_report {
 465
 466   my ($config, $params) = @_;
 467   my $agentnum = $params->{agentnum};
 468   my $conf = FS::Conf->new;
 469
 470   my $template = join("\n", $conf->config($config, $agentnum));
 471   if (!$template) {
 472     warn "$me agent $agentnum has no $config, no email report sent\n";
 473     return;
 474   }
 475
 476   my $tmpl_obj = Text::Template->new(
 477     TYPE => 'STRING', SOURCE => $template
 478   );
 479   my $content = $tmpl_obj->fill_in( HASH => $params );
 480   my ($head, $body) = split("\n\n", $content, 2);
 481   $head =~ /^subject:\s*(.*)$/im;
 482   my $subject = $1;
 483
 484   $head =~ /^to:\s*(.*)$/im;
 485   my $to = $1;
 486
 487   (
 488     to      => $to,
 489     from    => $conf->config('invoice_from', $agentnum),
 490     subject => $subject,
 491     body    => $body,
 492   );
 493
 494 }
 495
 496 1;