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