X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2FCron%2Fupload.pm;h=691170af90c427b75f5bbac089e4f103a56b4d3c;hp=877b07fd8afce19d89673d50e22ae062fc7210e4;hb=17a8b72b78ba455b58d53731fe557a471e0f2947;hpb=c64541e0cb6307925480669203ff76554f4663fe

diff --git a/FS/FS/Cron/upload.pm b/FS/FS/Cron/upload.pm
index 877b07fd8..691170af9 100644
--- a/FS/FS/Cron/upload.pm
+++ b/FS/FS/Cron/upload.pm
@@ -9,11 +9,15 @@ use FS::Record qw( qsearch qsearchs );
 use FS::Conf;
 use FS::queue;
 use FS::agent;
+use FS::Log;
+use FS::Misc qw( send_email ); #for bridgestone
+use FS::upload_target;
 use LWP::UserAgent;
 use HTTP::Request;
 use HTTP::Request::Common;
 use HTTP::Response;
 use Net::FTP;
+use List::Util qw( sum );
 
 @ISA = qw( Exporter );
 @EXPORT_OK = qw ( upload );
@@ -30,6 +34,8 @@ $me = '[FS::Cron::upload]';
 
 sub upload {
   my %opt = @_;
+  my $log = FS::Log->new('Cron::upload');
+  $log->info('start');
 
   my $debug = 0;
   $debug = 1 if $opt{'v'};
@@ -39,69 +45,122 @@ sub upload {
 
   warn "$me upload called\n" if $DEBUG;
 
-  my $conf = new FS::Conf;
-  my @agent = grep { $conf->config( 'billco-username', $_->agentnum, 1 ) }
-              grep { $conf->config( 'billco-password', $_->agentnum, 1 ) }
-              qsearch( 'agent', {} );
+  my @tasks;
 
   my $date =  time2str('%Y%m%d%H%M%S', $^T); # more?
 
-  @agent = grep { $_ == $opt{'a'} } @agent if $opt{'a'};
+  my $conf = new FS::Conf;
 
-  foreach my $agent ( @agent ) {
+  my @agents = $opt{'a'} ? FS::agent->by_key($opt{'a'}) : qsearch('agent', {});
+
+  my %task = (
+    'date'      => $date,
+    'l'         => $opt{'l'},
+    'm'         => $opt{'m'},
+    'v'         => $opt{'v'},
+  );
+
+  my @agentnums = ('', map {$_->agentnum} @agents);
+
+  foreach my $target (qsearch('upload_target', {})) {
+    # We don't know here if it's spooled on a per-agent basis or not.
+    # (It could even be both, via different events.)  So queue up an 
+    # upload for each agent, plus one with null agentnum, and we'll 
+    # upload as many files as we find.
+    foreach my $a (@agentnums) {
+      push @tasks, {
+        %task,
+        'agentnum'  => $a,
+        'targetnum' => $target->targetnum,
+        'handling'  => $target->handling,
+      };
+    }
+  }
 
-    my $agentnum = $agent->agentnum;
+  # deprecated billco method
+  foreach (@agents) {
+    my $agentnum = $_->agentnum;
+
+    if ( $conf->config( 'billco-username', $agentnum, 1 ) ) {
+      my $username = $conf->config('billco-username', $agentnum, 1);
+      my $password = $conf->config('billco-password', $agentnum, 1);
+      my $clicode  = $conf->config('billco-clicode',  $agentnum, 1);
+      my $url      = $conf->config('billco-url',      $agentnum);
+      push @tasks, {
+        %task,
+        'agentnum' => $agentnum,
+        'username' => $username,
+        'password' => $password,
+        'url'      => $url,
+        'clicode'  => $clicode,
+        'handling' => 'billco',
+      };
+    }
+  } # foreach @agents
+
+  # if there's nothing to do, don't hold up the rest of the process
+  if (!@tasks) {
+    $log->info('finish (nothing to upload)');
+    return '';
+  }
+
+  # wait for any ongoing billing jobs to complete
+  if ($opt{m}) {
+    my $dbh = dbh;
+    my $sql = "SELECT count(*) FROM queue LEFT JOIN cust_main USING(custnum) ".
+    "WHERE queue.job='FS::cust_main::queued_bill' AND status != 'failed'";
+    if (@agents) {
+      $sql .= ' AND cust_main.agentnum IN('.
+        join(',', map {$_->agentnum} @agents).
+        ')';
+    }
+    my $sth = $dbh->prepare($sql) or die $dbh->errstr;
+    while (1) {
+      $sth->execute()
+        or die "Unexpected error executing statement $sql: ". $sth->errstr;
+      last if $sth->fetchrow_arrayref->[0] == 0;
+      warn "Waiting 5min for billing to complete...\n" if $DEBUG;
+      sleep 300;
+    }
+  }
+
+  foreach (@tasks) {
+
+    my $agentnum = $_->{agentnum};
 
     if ( $opt{'m'} ) {
 
       if ( $opt{'r'} ) {
         warn "DRY RUN: would add agent $agentnum for queued upload\n";
       } else {
-
         my $queue = new FS::queue {
-          'job'      => 'FS::Cron::upload::billco_upload',
+          'job'      => 'FS::Cron::upload::spool_upload',
         };
-        my $error = $queue->insert(
-                                    'agentnum' => $agentnum,
-                                    'date'     => $date,
-                                    'l'        => $opt{'l'} || '',
-                                    'm'        => $opt{'m'} || '',
-                                    'v'        => $opt{'v'} || '',
-                                  );
-
+        my $error = $queue->insert( %$_ );
       }
 
     } else {
 
-      eval "&billco_upload( 'agentnum' => $agentnum, 'date' => $date );";
-      warn "billco_upload failed: $@\n"
-        if ( $@ );
+      eval { spool_upload(%$_) };
+      warn "spool_upload failed: $@\n"
+        if $@;
 
     }
 
   }
+  $log->info('finish');
 
 }
 
-sub billco_upload {
+sub spool_upload {
   my %opt = @_;
+  my $log = FS::Log->new('spool_upload');
 
-  warn "$me billco_upload called\n" if $DEBUG;
+  warn "$me spool_upload called\n" if $DEBUG;
   my $conf = new FS::Conf;
   my $dir = '%%%FREESIDE_EXPORT%%%/export.'. $FS::UID::datasrc. '/cust_bill';
 
-  my $agentnum = $opt{agentnum} or die "no agentnum provided\n";
-  my $url      = $conf->config( 'billco-url', $agentnum )
-    or die "no url for agent $agentnum\n";
-  my $username = $conf->config( 'billco-username', $agentnum, 1 )
-    or die "no username for agent $agentnum\n";
-  my $password = $conf->config( 'billco-password', $agentnum, 1 )
-    or die "no password for agent $agentnum\n";
-  my $clicode  = $conf->config( 'billco-clicode', $agentnum, 1 );
-    #or die "no clicode for agent $agentnum\n";
-
-  die "no date provided\n" unless $opt{date};
-  my $zipfile  = "$dir/agentnum$agentnum-$opt{date}.zip";
+  my $date = $opt{date} or die "no date provided\n";
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
@@ -114,90 +173,346 @@ sub billco_upload {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
-  my $agent = qsearchs( 'agent', { agentnum => $agentnum } )
-    or die "no such agent: $agentnum";
-  $agent->select_for_update; #mutex 
+  my $agentnum = $opt{agentnum};
+  $log->debug('start', agentnum => $agentnum);
 
-  unless ( -f "$dir/agentnum$agentnum-header.csv" ||
-           -f "$dir/agentnum$agentnum-detail.csv" )
-  {
-    warn "$me neither $dir/agentnum$agentnum-header.csv nor ".
-         "$dir/agentnum$agentnum-detail.csv found\n" if $DEBUG;
-    $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-    return;
+  my $agent;
+  if ( $agentnum ) {
+    $agent = qsearchs( 'agent', { agentnum => $agentnum } )
+      or die "no such agent: $agentnum";
+    $agent->select_for_update; #mutex 
   }
 
-  # a better way?
-  if ($opt{m}) {
-    my $sql = "SELECT count(*) FROM queue LEFT JOIN cust_main USING(custnum) ".
-      "WHERE queue.job='FS::cust_main::queued_bill' AND cust_main.agentnum = ?";
-    my $sth = $dbh->prepare($sql) or die $dbh->errstr;
-    while (1) {
-      $sth->execute( $agentnum )
-        or die "Unexpected error executing statement $sql: ". $sth->errstr;
-      last if $sth->fetchow_arrayref->[0];
-      sleep 300;
+  if ( $opt{'handling'} eq 'billco' ) {
+
+    my $file = "agentnum$agentnum";
+    my $zipfile  = "$dir/$file-$date.zip";
+
+    unless ( -f "$dir/$file-header.csv" ||
+             -f "$dir/$file-detail.csv" )
+    {
+      warn "$me neither $dir/$file-header.csv nor ".
+           "$dir/$file-detail.csv found\n" if $DEBUG > 1;
+      $log->debug("finish (neither $file-header.csv nor ".
+           "$file-detail.csv found)");
+      $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+      return;
     }
-  }
 
-  foreach ( qw ( header detail ) ) {
-    rename "$dir/agentnum$agentnum-$_.csv",
-           "$dir/agentnum$agentnum-$opt{date}-$_.csv";
-  }
+    my $url      = $opt{url} or die "no url for agent $agentnum\n";
+    $url =~ s/^\s+//; $url =~ s/\s+$//;
 
-  my $command = "cd $dir; zip $zipfile ".
-                "agentnum$agentnum-$opt{date}-header.csv ".
-                "agentnum$agentnum-$opt{date}-detail.csv";
+    my $username = $opt{username} or die "no username for agent $agentnum\n";
+    my $password = $opt{password} or die "no password for agent $agentnum\n";
 
-  system($command) and die "$command failed\n";
+    foreach ( qw ( header detail ) ) {
+      rename "$dir/$file-$_.csv",
+             "$dir/$file-$date-$_.csv";
+    }
 
-  unlink "agentnum$agentnum-$opt{date}-header.csv",
-         "agentnum$agentnum-$opt{date}-detail.csv";
+    my $command = "cd $dir; zip $zipfile ".
+                  "$file-$date-header.csv ".
+                  "$file-$date-detail.csv";
 
-  if ( $url =~ /^http/i ) {
+    system($command) and die "$command failed\n";
 
-    my $ua = new LWP::UserAgent;
-    my $res = $ua->request( POST( $url,
-                                  'Content_Type' => 'form-data',
-                                  'Content' => [ 'username' => $username,
-                                                 'pass'     => $password,
-                                                 'custid'   => $username,
-                                                 'clicode'  => $clicode,
-                                                 'file1'    => [ $zipfile ],
-                                               ],
-                                )
-                          );
+    unlink "$file-$date-header.csv",
+           "$file-$date-detail.csv";
 
-    die "upload failed: ". $res->status_line. "\n"
-      unless $res->is_success;
+    if ( $url =~ /^http/i ) {
 
-  } elsif ( $url =~ /^ftp:\/\/([\w\.]+)(\/.*)$/i ) {
+      my $ua = new LWP::UserAgent;
+      my $res = $ua->request( POST( $url,
+                                    'Content_Type' => 'form-data',
+                                    'Content' => [ 'username' => $username,
+                                                   'pass'     => $password,
+                                                   'custid'   => $username,
+                                                   'clicode'  => $opt{clicode},
+                                                   'file1'    => [ $zipfile ],
+                                                 ],
+                                  )
+                            );
 
-    my($hostname, $path) = ($1, $2);
+      die "upload failed: ". $res->status_line. "\n"
+        unless $res->is_success;
 
-    my $ftp = new Net::FTP($hostname)
-      or die "can't connect to $hostname: $@\n";
-    $ftp->login($username, $password)
-      or die "can't login to $hostname: ". $ftp->message."\n";
-    unless ( $ftp->cwd($path) ) {
-      my $msg = "can't cd $path on $hostname: ". $ftp->message. "\n";
-      ( $path eq '/' ) ? warn $msg : die $msg;
-    }
-    $ftp->binary
-      or die "can't set binary mode on $hostname\n";
+    } elsif ( $url =~ /^ftp:\/\/([\w\.]+)(\/.*)$/i ) {
+
+      my($hostname, $path) = ($1, $2);
+
+      my $ftp = new Net::FTP($hostname, Passive=>1)
+        or die "can't connect to $hostname: $@\n";
+      $ftp->login($username, $password)
+        or die "can't login to $hostname: ". $ftp->message."\n";
+      unless ( $ftp->cwd($path) ) {
+        my $msg = "can't cd $path on $hostname: ". $ftp->message. "\n";
+        ( $path eq '/' ) ? warn $msg : die $msg;
+      }
+      $ftp->binary
+        or die "can't set binary mode on $hostname\n";
 
-    $ftp->put($zipfile)
-      or die "can't put $zipfile: ". $ftp->message. "\n";
+      $ftp->put($zipfile)
+        or die "can't put $zipfile: ". $ftp->message. "\n";
 
-    $ftp->quit;
+      $ftp->quit;
+
+    } else {
+      die "unknown scheme in URL $url\n";
+    }
 
-  } else {
-    die "unknown scheme in URL $url\n";
   }
+  else { #not billco
+
+    my $targetnum = $opt{targetnum};
+    my $upload_target = FS::upload_target->by_key($targetnum)
+      or die "FTP target $targetnum not found\n";
+
+    $dir .= "/target$targetnum";
+    chdir($dir);
+
+    my $file  = $agentnum ? "agentnum$agentnum" : 'spool'; #.csv
+
+    unless ( -f "$dir/$file.csv" ) {
+      warn "$me $dir/$file.csv not found\n" if $DEBUG > 1;
+      $log->debug("finish ($dir/$file.csv not found)");
+      $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+      return;
+    }
+
+    rename "$dir/$file.csv", "$dir/$file-$date.csv";
+
+    if ( $opt{'handling'} eq 'bridgestone' ) {
+
+      my $prefix = $conf->config('bridgestone-prefix', $agentnum);
+      unless ( $prefix ) {
+        warn "$me agent $agentnum has no bridgestone-prefix, skipped\n";
+        $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+        return;
+      }
+
+      my $seq = $conf->config('bridgestone-batch_counter', $agentnum) || 1;
+
+      # extract zip code
+      join(' ',$conf->config('company_address', $agentnum)) =~ 
+        /(\d{5}(\-\d{4})?)\s*$/;
+      my $ourzip = $1 || ''; #could be an explicit option if really needed
+      $ourzip  =~ s/\D//;
+      my $newfile = sprintf('%s_%s_%0.6d.dat', 
+                            $prefix,
+                            time2str('%Y%m%d', time),
+                            $seq);
+      warn "copying spool to $newfile\n" if $DEBUG;
+
+      my ($in, $out);
+      open $in, '<', "$dir/$file-$date.csv" 
+        or die "unable to read $file-$date.csv\n";
+      open $out, '>', "$dir/$newfile" or die "unable to write $newfile\n";
+      #header--not sure how much of this generalizes at all
+      my $head = sprintf(
+        "%-6s%-4s%-27s%-6s%0.6d%-5s%-9s%-9s%-7s%0.8d%-7s%0.6d\n",
+        ' COMP:', 'VISP', '', ',SEQ#:', $seq, ',ZIP:', $ourzip, ',VERS:1.1',
+        ',RUNDT:', time2str('%m%d%Y', $^T),
+        ',RUNTM:', time2str('%H%M%S', $^T),
+      );
+      warn "HEADER: $head" if $DEBUG;
+      print $out $head;
+
+      my $rows = 0;
+      while( <$in> ) {
+        print $out $_;
+        $rows++;
+      }
+
+      #trailer
+      my $trail = sprintf(
+        "%-6s%-4s%-27s%-6s%0.6d%-7s%0.9d%-9s%0.9d\n",
+        ' COMP:', 'VISP', '', ',SEQ:', $seq,
+        ',LINES:', $rows+2, ',LETTERS:', $rows,
+      );
+      warn "TRAILER: $trail" if $DEBUG;
+      print $out $trail;
+
+      close $in;
+      close $out;
+
+      my $zipfile = sprintf('%s_%0.6d.zip', $prefix, $seq);
+      my $command = "cd $dir; zip $zipfile $newfile";
+      warn "compressing to $zipfile\n$command\n" if $DEBUG;
+      system($command) and die "$command failed\n";
+
+      my $error = $upload_target->put($zipfile);
+      if ( $error ) {
+        foreach ( qw ( header detail ) ) {
+          rename "$dir/$file-$date-$_.csv",
+                 "$dir/$file-$_.csv";
+          die $error;
+        }
+      }
+
+      send_email(
+        prepare_report('bridgestone-confirm_template',
+          {
+            agentnum=> $agentnum,
+            zipfile => $zipfile,
+            prefix  => $prefix,
+            seq     => $seq,
+            rows    => $rows,
+          }
+        )
+      );
+
+      $seq++;
+      warn "setting batch counter to $seq\n" if $DEBUG;
+      $conf->set('bridgestone-batch_counter', $seq, $agentnum);
+
+    } elsif ( $opt{'handling'} eq 'ics' ) {
+
+      my ($basename, $regfile, $bigfile);
+      $basename = sprintf('c%sc1', time2str('%m%d', time));
+      $regfile = $basename . 'i.txt'; # for "regular" (short) invoices
+      $bigfile = $basename . 'b.txt'; # for "big" invoices
+
+      warn "copying spool to $regfile, $bigfile\n" if $DEBUG;
+
+      my ($in, $reg, $big); #filehandles
+      my %count = (B => 0, 1 => 0, 2 => 0); # number of invoices
+      my %sum = (B => 0, R => 0); # total of charges field
+      open $in, '<', "$dir/$file-$date.csv" 
+        or die "unable to read $file-$date.csv\n";
+
+      open $reg, '>', "$dir/$regfile" or die "unable to write $regfile\n";
+      open $big, '>', "$dir/$bigfile" or die "unable to write $bigfile\n";
+
+      while (my $line = <$in>) {
+        chomp($line);
+        my $tag = substr($line, -1, 1, '');
+        my $charge = substr($line, 252, 10);
+        if ( $tag eq 'B' ) {
+          print $big $line, "\n";
+          $count{B}++;
+          $sum{B} += $charge;
+        } else {
+          print $reg $line, "\n";
+          $count{$tag}++;
+          $sum{R} += $charge;
+        }
+      }
+      close $in;
+      close $reg;
+      close $big;
+
+      # zip up all three files for transport
+      my $zipfile = "$basename" . '.zip';
+      my $command = "cd $dir; zip $zipfile $regfile $bigfile";
+      system($command) and die "'$command' failed\n";
+
+      # upload them, unless we're using email, in which case 
+      # the zip file will ride along with the report.  yes, this 
+      # kind of defeats the purpose of the upload_target interface,
+      # but at least we have a place to store the configuration.
+      my $error = '';
+      if ( $upload_target->protocol ne 'email' ) {
+        $error = $upload_target->put("$dir/$zipfile");
+      }
+
+      # create the report
+      for (values %sum) {
+        $_ = sprintf('%.2f', $_);
+      }
+
+      my %report = prepare_report('ics-confirm_template',
+        {
+          agentnum  => $agentnum,
+          count     => \%count,
+          sum       => \%sum,
+          error     => $error,
+        }
+      );
+      if ( $upload_target->protocol eq 'email' ) {
+        $report{'to'} =
+          join('@', $upload_target->username, $upload_target->hostname);
+        $report{'subject'} = $upload_target->subject;
+        $report{'mimeparts'} = [
+          { Path        => "$dir/$zipfile",
+            Type        => 'application/zip',
+            Encoding    => 'base64',
+            Filename    => $zipfile,
+            Disposition => 'attachment',
+          }
+        ];
+      }
+      $error = send_email(%report);
+
+      if ( $error ) {
+        # put the original spool file back
+        rename "$dir/$file-$date.csv", "$dir/$file.csv";
+        die $error;
+      }
+ 
+    } else { # not bridgestone or ics
+
+      # this is the usual case
+
+      my $error = $upload_target->put("$file-$date.csv");
+      if ( $error ) {
+        rename "$dir/$file-$date.csv", "$dir/$file.csv";
+        die $error;
+      }
+
+    }
+
+  } #opt{handling}
+
+  $log->debug('finish', agentnum => $agentnum);
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   '';
 
 }
 
+=item prepare_report CONFIG PARAMS
+
+Retrieves the config value named CONFIG, parses it as a Text::Template,
+extracts "to" and "subject" headers, and returns a hash that can be passed
+to L<FS::Misc/send_email>.
+
+PARAMS is a hashref to be passed to C<fill_in>.  It must contain 
+'agentnum' to look up the per-agent config.
+
+=cut
+
+# we used it twice, so it's now a subroutine
+
+sub prepare_report {
+
+  my ($config, $params) = @_;
+  my $agentnum = $params->{agentnum};
+  my $conf = FS::Conf->new;
+
+  my $template = join("\n", $conf->config($config, $agentnum));
+  if (!$template) {
+    warn "$me agent $agentnum has no $config, no email report sent\n";
+    return;
+  }
+
+  my $tmpl_obj = Text::Template->new(
+    TYPE => 'STRING', SOURCE => $template
+  );
+  my $content = $tmpl_obj->fill_in( HASH => $params );
+  my ($head, $body) = split("\n\n", $content, 2);
+  $head =~ /^subject:\s*(.*)$/im;
+  my $subject = $1;
+
+  $head =~ /^to:\s*(.*)$/im;
+  my $to = $1;
+
+  (
+    to      => $to,
+    from    => $conf->invoice_from_full($agentnum),
+    subject => $subject,
+    body    => $body,
+  );
+
+}
+
 1;