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