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   my $agent;
 147   if ( $agentnum ) {
 148     $agent = qsearchs( 'agent', { agentnum => $agentnum } )
 149       or die "no such agent: $agentnum";
 150     $agent->select_for_update; #mutex
 151   }
 152
 153   if ( $opt{'handling'} eq 'billco' ) {
 154
 155     my $file = "agentnum$agentnum";
 156     my $zipfile  = "$dir/$file-$date.zip";
 157
 158     unless ( -f "$dir/$file-header.csv" ||
 159              -f "$dir/$file-detail.csv" )
 160     {
 161       warn "$me neither $dir/$file-header.csv nor ".
 162            "$dir/$file-detail.csv found\n" if $DEBUG > 1;
 163       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 164       return;
 165     }
 166
 167     my $url      = $opt{url} or die "no url for agent $agentnum\n";
 168     $url =~ s/^\s+//; $url =~ s/\s+$//;
 169
 170     my $username = $opt{username} or die "no username for agent $agentnum\n";
 171     my $password = $opt{password} or die "no password for agent $agentnum\n";
 172
 173     # a better way?
 174     if ($opt{m}) {
 175       my $sql = "SELECT count(*) FROM queue LEFT JOIN cust_main USING(custnum) ".
 176         "WHERE queue.job='FS::cust_main::queued_bill' AND cust_main.agentnum = ?";
 177       my $sth = $dbh->prepare($sql) or die $dbh->errstr;
 178       while (1) {
 179         $sth->execute( $agentnum )
 180           or die "Unexpected error executing statement $sql: ". $sth->errstr;
 181         last if $sth->fetchrow_arrayref->[0];
 182         sleep 300;
 183       }
 184     }
 185
 186     foreach ( qw ( header detail ) ) {
 187       rename "$dir/$file-$_.csv",
 188              "$dir/$file-$date-$_.csv";
 189     }
 190
 191     my $command = "cd $dir; zip $zipfile ".
 192                   "$file-$date-header.csv ".
 193                   "$file-$date-detail.csv";
 194
 195     system($command) and die "$command failed\n";
 196
 197     unlink "$file-$date-header.csv",
 198            "$file-$date-detail.csv";
 199
 200     if ( $url =~ /^http/i ) {
 201
 202       my $ua = new LWP::UserAgent;
 203       my $res = $ua->request( POST( $url,
 204                                     'Content_Type' => 'form-data',
 205                                     'Content' => [ 'username' => $username,
 206                                                    'pass'     => $password,
 207                                                    'custid'   => $username,
 208                                                    'clicode'  => $opt{clicode},
 209                                                    'file1'    => [ $zipfile ],
 210                                                  ],
 211                                   )
 212                             );
 213
 214       die "upload failed: ". $res->status_line. "\n"
 215         unless $res->is_success;
 216
 217     } elsif ( $url =~ /^ftp:\/\/([\w\.]+)(\/.*)$/i ) {
 218
 219       my($hostname, $path) = ($1, $2);
 220
 221       my $ftp = new Net::FTP($hostname, Passive=>1)
 222         or die "can't connect to $hostname: $@\n";
 223       $ftp->login($username, $password)
 224         or die "can't login to $hostname: ". $ftp->message."\n";
 225       unless ( $ftp->cwd($path) ) {
 226         my $msg = "can't cd $path on $hostname: ". $ftp->message. "\n";
 227         ( $path eq '/' ) ? warn $msg : die $msg;
 228       }
 229       $ftp->binary
 230         or die "can't set binary mode on $hostname\n";
 231
 232       $ftp->put($zipfile)
 233         or die "can't put $zipfile: ". $ftp->message. "\n";
 234
 235       $ftp->quit;
 236
 237     } else {
 238       die "unknown scheme in URL $url\n";
 239     }
 240
 241   }
 242   else { #not billco
 243
 244     my $targetnum = $opt{targetnum};
 245     my $upload_target = FS::upload_target->by_key($targetnum)
 246       or die "FTP target $targetnum not found\n";
 247
 248     $dir .= "/target$targetnum";
 249     chdir($dir);
 250
 251     my $file  = $agentnum ? "agentnum$agentnum" : 'spool'; #.csv
 252
 253     unless ( -f "$dir/$file.csv" ) {
 254       warn "$me $dir/$file.csv not found\n" if $DEBUG > 1;
 255       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 256       return;
 257     }
 258
 259     rename "$dir/$file.csv", "$dir/$file-$date.csv";
 260
 261     if ( $opt{'handling'} eq 'bridgestone' ) {
 262
 263       my $prefix = $conf->config('bridgestone-prefix', $agentnum);
 264       unless ( $prefix ) {
 265         warn "$me agent $agentnum has no bridgestone-prefix, skipped\n";
 266         $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 267         return;
 268       }
 269
 270       my $seq = $conf->config('bridgestone-batch_counter', $agentnum) || 1;
 271
 272       # extract zip code
 273       join(' ',$conf->config('company_address', $agentnum)) =~
 274         /(\d{5}(\-\d{4})?)\s*$/;
 275       my $ourzip = $1 || ''; #could be an explicit option if really needed
 276       $ourzip  =~ s/\D//;
 277       my $newfile = sprintf('%s_%s_%0.6d.dat',
 278                             $prefix,
 279                             time2str('%Y%m%d', time),
 280                             $seq);
 281       warn "copying spool to $newfile\n" if $DEBUG;
 282
 283       my ($in, $out);
 284       open $in, '<', "$dir/$file-$date.csv"
 285         or die "unable to read $file-$date.csv\n";
 286       open $out, '>', "$dir/$newfile" or die "unable to write $newfile\n";
 287       #header--not sure how much of this generalizes at all
 288       my $head = sprintf(
 289         "%-6s%-4s%-27s%-6s%0.6d%-5s%-9s%-9s%-7s%0.8d%-7s%0.6d\n",
 290         ' COMP:', 'VISP', '', ',SEQ#:', $seq, ',ZIP:', $ourzip, ',VERS:1.1',
 291         ',RUNDT:', time2str('%m%d%Y', $^T),
 292         ',RUNTM:', time2str('%H%M%S', $^T),
 293       );
 294       warn "HEADER: $head" if $DEBUG;
 295       print $out $head;
 296
 297       my $rows = 0;
 298       while( <$in> ) {
 299         print $out $_;
 300         $rows++;
 301       }
 302
 303       #trailer
 304       my $trail = sprintf(
 305         "%-6s%-4s%-27s%-6s%0.6d%-7s%0.9d%-9s%0.9d\n",
 306         ' COMP:', 'VISP', '', ',SEQ:', $seq,
 307         ',LINES:', $rows+2, ',LETTERS:', $rows,
 308       );
 309       warn "TRAILER: $trail" if $DEBUG;
 310       print $out $trail;
 311
 312       close $in;
 313       close $out;
 314
 315       my $zipfile = sprintf('%s_%0.6d.zip', $prefix, $seq);
 316       my $command = "cd $dir; zip $zipfile $newfile";
 317       warn "compressing to $zipfile\n$command\n" if $DEBUG;
 318       system($command) and die "$command failed\n";
 319
 320       my $error = $upload_target->put($zipfile);
 321       if ( $error ) {
 322         foreach ( qw ( header detail ) ) {
 323           rename "$dir/$file-$date-$_.csv",
 324                  "$dir/$file-$_.csv";
 325           die $error;
 326         }
 327       }
 328
 329       send_report('bridgestone-confirm_template',
 330         {
 331           agentnum=> $agentnum,
 332           zipfile => $zipfile,
 333           prefix  => $prefix,
 334           seq     => $seq,
 335           rows    => $rows,
 336         }
 337       );
 338
 339       $seq++;
 340       warn "setting batch counter to $seq\n" if $DEBUG;
 341       $conf->set('bridgestone-batch_counter', $seq, $agentnum);
 342
 343     } elsif ( $opt{'handling'} eq 'ics' ) {
 344
 345       my ($basename, $regfile, $bigfile);
 346       $basename = sprintf('c%sc1', time2str('%m%d', time));
 347       $regfile = $basename . 'i.txt'; # for "regular" (short) invoices
 348       $bigfile = $basename . 'b.txt'; # for "big" invoices
 349
 350       warn "copying spool to $regfile, $bigfile\n" if $DEBUG;
 351
 352       my ($in, $reg, $big); #filehandles
 353       my %count = (B => 0, 1 => 0, 2 => 0); # number of invoices
 354       my %sum = (B => 0, R => 0); # total of charges field
 355       open $in, '<', "$dir/$file-$date.csv"
 356         or die "unable to read $file-$date.csv\n";
 357
 358       open $reg, '>', "$dir/$regfile" or die "unable to write $regfile\n";
 359       open $big, '>', "$dir/$bigfile" or die "unable to write $bigfile\n";
 360
 361       while (my $line = <$in>) {
 362         chomp($line);
 363         my $tag = substr($line, -1, 1, '');
 364         my $charge = substr($line, 252, 10);
 365         if ( $tag eq 'B' ) {
 366           print $big $line, "\n";
 367           $count{B}++;
 368           $sum{B} += $charge;
 369         } else {
 370           print $reg $line, "\n";
 371           $count{$tag}++;
 372           $sum{R} += $charge;
 373         }
 374       }
 375       close $in;
 376       close $reg;
 377       close $big;
 378
 379       my $zipfile = "$basename" . '.zip';
 380       my $command = "cd $dir; zip $zipfile $regfile $bigfile";
 381       system($command) and die "'$command' failed\n";
 382       my $error = $upload_target->put("$dir/$zipfile");
 383
 384       for (values %sum) {
 385         $_ = sprintf('%.2f', $_);
 386       }
 387
 388       send_report('ics-confirm_template',
 389         {
 390           agentnum  => $agentnum,
 391           count     => \%count,
 392           sum       => \%sum,
 393           error     => $error,
 394         }
 395       );
 396
 397       if ( $error ) {
 398         rename "$dir/$file-$date.csv", "$dir/$file.csv";
 399         die $error;
 400       }
 401
 402     } else { # not bridgestone or ics
 403
 404       # this is the usual case
 405
 406       my $error = $upload_target->put("$file-$date.csv");
 407       if ( $error ) {
 408         rename "$dir/$file-$date.csv", "$dir/$file.csv";
 409         die $error;
 410       }
 411
 412     }
 413
 414   } #opt{handling}
 415
 416   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 417   '';
 418
 419 }
 420
 421 =item send_report CONFIG PARAMS
 422
 423 Retrieves the config value named CONFIG, parses it as a Text::Template,
 424 extracts "to" and "subject" headers, and sends it by email.
 425
 426 PARAMS is a hashref to be passed to C<fill_in>.  It must contain
 427 'agentnum' to look up the per-agent config.
 428
 429 =cut
 430
 431 # we used it twice, so it's now a subroutine
 432 sub send_report {
 433
 434   my ($config, $params) = @_;
 435   my $agentnum = $params->{agentnum};
 436   my $conf = FS::Conf->new;
 437
 438   my $template = join("\n", $conf->config($config, $agentnum));
 439   if (!$template) {
 440     warn "$me agent $agentnum has no $config, no email report sent\n";
 441     return;
 442   }
 443
 444   my $tmpl_obj = Text::Template->new(
 445     TYPE => 'STRING', SOURCE => $template
 446   );
 447   my $content = $tmpl_obj->fill_in( HASH => $params );
 448   my ($head, $body) = split("\n\n", $content, 2);
 449   $head =~ /^subject:\s*(.*)$/im;
 450   my $subject = $1;
 451
 452   $head =~ /^to:\s*(.*)$/im;
 453   my $to = $1;
 454
 455   send_email(
 456     to      => $to,
 457     from    => $conf->config('invoice_from', $agentnum),
 458     subject => $subject,
 459     body    => $body,
 460   );
 461
 462 }
 463
 464 1;