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 LWP::UserAgent;
  14 use HTTP::Request;
  15 use HTTP::Request::Common;
  16 use HTTP::Response;
  17 use Net::FTP;
  18
  19 @ISA = qw( Exporter );
  20 @EXPORT_OK = qw ( upload );
  21 $DEBUG = 0;
  22 $me = '[FS::Cron::upload]';
  23
  24 #freeside-daily %opt:
  25 #  -v: enable debugging
  26 #  -l: debugging level
  27 #  -m: Experimental multi-process mode uses the job queue for multi-process and/or multi-machine billing.
  28 #  -r: Multi-process mode dry run option
  29 #  -a: Only process customers with the specified agentnum
  30
  31
  32 sub upload {
  33   my %opt = @_;
  34   my $log = FS::Log->new('Cron::upload');
  35   $log->info('start');
  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   if ( $conf->exists('cust_bill-ftp_spool') ) {
  54     my $url = $conf->config('cust_bill-ftpdir');
  55     $url = "/$url" unless $url =~ m[^/];
  56     $url = 'ftp://' . $conf->config('cust_bill-ftpserver') . $url;
  57
  58     my $format = $conf->config('cust_bill-ftpformat');
  59     my $username = $conf->config('cust_bill-ftpusername');
  60     my $password = $conf->config('cust_bill-ftppassword');
  61
  62     my %task = (
  63       'date'      => $date,
  64       'l'         => $opt{'l'},
  65       'm'         => $opt{'m'},
  66       'v'         => $opt{'v'},
  67       'username'  => $username,
  68       'password'  => $password,
  69       'url'       => $url,
  70       'format'    => $format,
  71     );
  72
  73     if ( $conf->exists('cust_bill-spoolagent') ) {
  74       # then push each agent's spool separately
  75       foreach ( @agents ) {
  76         push @tasks, { %task, 'agentnum' => $_->agentnum };
  77       }
  78     }
  79     elsif ( $opt{'a'} ) {
  80       warn "Per-agent processing, but cust_bill-spoolagent is not enabled.\nSkipped invoice upload.\n";
  81     }
  82     else {
  83       push @tasks, \%task;
  84     }
  85   }
  86
  87   else { #check each agent for billco upload settings
  88
  89     my %task = (
  90       'date'      => $date,
  91       'l'         => $opt{'l'},
  92       'm'         => $opt{'m'},
  93       'v'         => $opt{'v'},
  94     );
  95
  96     foreach (@agents) {
  97       my $agentnum = $_->agentnum;
  98
  99       if ( $conf->config( 'billco-username', $agentnum, 1 ) ) {
 100         my $username = $conf->config('billco-username', $agentnum, 1);
 101         my $password = $conf->config('billco-password', $agentnum, 1);
 102         my $clicode  = $conf->config('billco-clicode',  $agentnum, 1);
 103         my $url      = $conf->config('billco-url',      $agentnum);
 104         push @tasks, {
 105           %task,
 106           'agentnum' => $agentnum,
 107           'username' => $username,
 108           'password' => $password,
 109           'url'      => $url,
 110           'clicode'  => $clicode,
 111           'format'   => 'billco',
 112         };
 113       }
 114     } # foreach @agents
 115
 116   } #!if cust_bill-ftp_spool
 117
 118   # if there's nothing to do, don't hold up the rest of the process
 119   if (!@tasks) {
 120     $log->info('finish (nothing to upload)');
 121     return '';
 122   }
 123
 124   # wait for any ongoing billing jobs to complete
 125   if ($opt{m}) {
 126     my $dbh = dbh;
 127     my $sql = "SELECT count(*) FROM queue LEFT JOIN cust_main USING(custnum) ".
 128     "WHERE queue.job='FS::cust_main::queued_bill' AND status != 'failed'";
 129     if (@agents) {
 130       $sql .= ' AND cust_main.agentnum IN('.
 131         join(',', map {$_->agentnum} @agents).
 132         ')';
 133     }
 134     my $sth = $dbh->prepare($sql) or die $dbh->errstr;
 135     while (1) {
 136       $sth->execute()
 137         or die "Unexpected error executing statement $sql: ". $sth->errstr;
 138       last if $sth->fetchrow_arrayref->[0] == 0;
 139       warn "Waiting 5min for billing to complete...\n" if $DEBUG;
 140       sleep 300;
 141     }
 142   }
 143
 144   foreach (@tasks) {
 145
 146     my $agentnum = $_->{agentnum};
 147
 148     if ( $opt{'m'} ) {
 149
 150       if ( $opt{'r'} ) {
 151         warn "DRY RUN: would add agent $agentnum for queued upload\n";
 152       } else {
 153         my $queue = new FS::queue {
 154           'job'      => 'FS::Cron::upload::spool_upload',
 155         };
 156         my $error = $queue->insert( %$_ );
 157       }
 158
 159     } else {
 160
 161       eval { spool_upload(%$_) };
 162       warn "spool_upload failed: $@\n"
 163         if $@;
 164
 165     }
 166
 167   }
 168   $log->info('finish');
 169
 170 }
 171
 172 sub spool_upload {
 173   my %opt = @_;
 174   my $log = FS::Log->new('spool_upload');
 175
 176   warn "$me spool_upload called\n" if $DEBUG;
 177   my $conf = new FS::Conf;
 178   my $dir = '%%%FREESIDE_EXPORT%%%/export.'. $FS::UID::datasrc. '/cust_bill';
 179
 180   my $agentnum = $opt{agentnum} || '';
 181   $log->debug('start', agentnum => $agentnum);
 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   die "no date provided\n" unless $opt{date};
 190
 191   local $SIG{HUP} = 'IGNORE';
 192   local $SIG{INT} = 'IGNORE';
 193   local $SIG{QUIT} = 'IGNORE';
 194   local $SIG{TERM} = 'IGNORE';
 195   local $SIG{TSTP} = 'IGNORE';
 196   local $SIG{PIPE} = 'IGNORE';
 197
 198   my $oldAutoCommit = $FS::UID::AutoCommit;
 199   local $FS::UID::AutoCommit = 0;
 200   my $dbh = dbh;
 201
 202   if ( $agentnum ) {
 203     my $agent = qsearchs( 'agent', { agentnum => $agentnum } )
 204       or die "no such agent: $agentnum";
 205     $agent->select_for_update; #mutex
 206   }
 207
 208   if ( $opt{'format'} eq 'billco' ) {
 209
 210     die "no agentnum provided\n" unless $agentnum;
 211
 212     my $zipfile  = "$dir/agentnum$agentnum-$opt{date}.zip";
 213
 214     unless ( -f "$dir/agentnum$agentnum-header.csv" ||
 215              -f "$dir/agentnum$agentnum-detail.csv" )
 216     {
 217       warn "$me neither $dir/agentnum$agentnum-header.csv nor ".
 218            "$dir/agentnum$agentnum-detail.csv found\n" if $DEBUG;
 219       $log->debug("finish (neither agentnum$agentnum-header.csv nor ".
 220                   "agentnum$agentnum-detail.csv found)");
 221       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 222       return;
 223     }
 224
 225     foreach ( qw ( header detail ) ) {
 226       rename "$dir/agentnum$agentnum-$_.csv",
 227              "$dir/agentnum$agentnum-$opt{date}-$_.csv";
 228     }
 229
 230     my $command = "cd $dir; zip $zipfile ".
 231                   "agentnum$agentnum-$opt{date}-header.csv ".
 232                   "agentnum$agentnum-$opt{date}-detail.csv";
 233
 234     system($command) and die "$command failed\n";
 235
 236     unlink "agentnum$agentnum-$opt{date}-header.csv",
 237            "agentnum$agentnum-$opt{date}-detail.csv";
 238
 239     if ( $url =~ /^http/i ) {
 240
 241       my $ua = new LWP::UserAgent;
 242       my $res = $ua->request( POST( $url,
 243                                     'Content_Type' => 'form-data',
 244                                     'Content' => [ 'username' => $username,
 245                                                    'pass'     => $password,
 246                                                    'custid'   => $username,
 247                                                    'clicode'  => $opt{clicode},
 248                                                    'file1'    => [ $zipfile ],
 249                                                  ],
 250                                   )
 251                             );
 252
 253       die "upload failed: ". $res->status_line. "\n"
 254         unless $res->is_success;
 255
 256     } elsif ( $url =~ /^ftp:\/\/([\w\.]+)(\/.*)$/i ) {
 257
 258       my($hostname, $path) = ($1, $2);
 259
 260       my $ftp = new Net::FTP($hostname, Passive=>1)
 261         or die "can't connect to $hostname: $@\n";
 262       $ftp->login($username, $password)
 263         or die "can't login to $hostname: ". $ftp->message."\n";
 264       unless ( $ftp->cwd($path) ) {
 265         my $msg = "can't cd $path on $hostname: ". $ftp->message. "\n";
 266         ( $path eq '/' ) ? warn $msg : die $msg;
 267       }
 268       $ftp->binary
 269         or die "can't set binary mode on $hostname\n";
 270
 271       $ftp->put($zipfile)
 272         or die "can't put $zipfile: ". $ftp->message. "\n";
 273
 274       $ftp->quit;
 275
 276     } else {
 277       die "unknown scheme in URL $url\n";
 278     }
 279
 280   } else { #$opt{format} ne 'billco'
 281
 282     my $date = $opt{date};
 283     my $file = $opt{agentnum} ? "agentnum$opt{agentnum}" : 'spool'; #.csv
 284     unless ( -f "$dir/$file.csv" ) {
 285       warn "$me $dir/$file.csv not found\n" if $DEBUG;
 286       $log->debug("finish ($dir/$file.csv not found)");
 287       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 288       return;
 289     }
 290     rename "$dir/$file.csv", "$dir/$file-$date.csv";
 291
 292     #ftp only for now
 293     if ( $url =~ m{^ftp://([\w\.]+)(/.*)$}i ) {
 294
 295       my ($hostname, $path) = ($1, $2);
 296       my $ftp = new Net::FTP ($hostname)
 297         or die "can't connect to $hostname: $@\n";
 298       $ftp->login($username, $password)
 299         or die "can't login to $hostname: ".$ftp->message."\n";
 300       unless ( $ftp->cwd($path) ) {
 301         my $msg = "can't cd $path on $hostname: ".$ftp->message."\n";
 302         ( $path eq '/' ) ? warn $msg : die $msg;
 303       }
 304       chdir($dir);
 305       $ftp->put("$file-$date.csv")
 306         or die "can't put $file-$date.csv: ".$ftp->message."\n";
 307       $ftp->quit;
 308
 309     } else {
 310       die "malformed FTP URL $url\n";
 311     }
 312   } #opt{format}
 313
 314   $log->debug('finish', agentnum => $agentnum);
 315
 316   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 317   '';
 318
 319 }
 320
 321 1;