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 $conf = new FS::Conf;
  43   my @agent = grep { $conf->config( 'billco-username', $_->agentnum, 1 ) }
  44               grep { $conf->config( 'billco-password', $_->agentnum, 1 ) }
  45               qsearch( 'agent', {} );
  46
  47   my $date =  time2str('%Y%m%d%H%M%S', $^T); # more?
  48
  49   @agent = grep { $_ == $opt{'a'} } @agent if $opt{'a'};
  50
  51   foreach my $agent ( @agent ) {
  52
  53     my $agentnum = $agent->agentnum;
  54
  55     if ( $opt{'m'} ) {
  56
  57       if ( $opt{'r'} ) {
  58         warn "DRY RUN: would add agent $agentnum for queued upload\n";
  59       } else {
  60
  61         my $queue = new FS::queue {
  62           'job'      => 'FS::Cron::upload::billco_upload',
  63         };
  64         my $error = $queue->insert(
  65                                     'agentnum' => $agentnum,
  66                                     'date'     => $date,
  67                                     'l'        => $opt{'l'} || '',
  68                                     'm'        => $opt{'m'} || '',
  69                                     'v'        => $opt{'v'} || '',
  70                                   );
  71
  72       }
  73
  74     } else {
  75
  76       eval "&billco_upload( 'agentnum' => $agentnum, 'date' => $date );";
  77       warn "billco_upload failed: $@\n"
  78         if $@;
  79
  80     }
  81
  82   }
  83
  84 }
  85
  86 sub billco_upload {
  87   my %opt = @_;
  88
  89   warn "$me billco_upload called\n" if $DEBUG;
  90   my $conf = new FS::Conf;
  91   my $dir = '%%%FREESIDE_EXPORT%%%/export.'. $FS::UID::datasrc. '/cust_bill';
  92
  93   my $agentnum = $opt{agentnum} or die "no agentnum provided\n";
  94   my $url      = $conf->config( 'billco-url', $agentnum )
  95     or die "no url for agent $agentnum\n";
  96   $url =~ s/^\s+//; $url =~ s/\s+$//;
  97   my $username = $conf->config( 'billco-username', $agentnum, 1 )
  98     or die "no username for agent $agentnum\n";
  99   my $password = $conf->config( 'billco-password', $agentnum, 1 )
 100     or die "no password for agent $agentnum\n";
 101   my $clicode  = $conf->config( 'billco-clicode', $agentnum, 1 );
 102     #or die "no clicode for agent $agentnum\n";
 103
 104   die "no date provided\n" unless $opt{date};
 105   my $zipfile  = "$dir/agentnum$agentnum-$opt{date}.zip";
 106
 107   local $SIG{HUP} = 'IGNORE';
 108   local $SIG{INT} = 'IGNORE';
 109   local $SIG{QUIT} = 'IGNORE';
 110   local $SIG{TERM} = 'IGNORE';
 111   local $SIG{TSTP} = 'IGNORE';
 112   local $SIG{PIPE} = 'IGNORE';
 113
 114   my $oldAutoCommit = $FS::UID::AutoCommit;
 115   local $FS::UID::AutoCommit = 0;
 116   my $dbh = dbh;
 117
 118   my $agent = qsearchs( 'agent', { agentnum => $agentnum } )
 119     or die "no such agent: $agentnum";
 120   $agent->select_for_update; #mutex
 121
 122   unless ( -f "$dir/agentnum$agentnum-header.csv" ||
 123            -f "$dir/agentnum$agentnum-detail.csv" )
 124   {
 125     warn "$me neither $dir/agentnum$agentnum-header.csv nor ".
 126          "$dir/agentnum$agentnum-detail.csv found\n" if $DEBUG;
 127     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 128     return;
 129   }
 130
 131   # a better way?
 132   if ($opt{m}) {
 133     my $sql = "SELECT count(*) FROM queue LEFT JOIN cust_main USING(custnum) ".
 134       "WHERE queue.job='FS::cust_main::queued_bill' AND cust_main.agentnum = ?";
 135     my $sth = $dbh->prepare($sql) or die $dbh->errstr;
 136     while (1) {
 137       $sth->execute( $agentnum )
 138         or die "Unexpected error executing statement $sql: ". $sth->errstr;
 139       last if $sth->fetchow_arrayref->[0];
 140       sleep 300;
 141     }
 142   }
 143
 144   foreach ( qw ( header detail ) ) {
 145     rename "$dir/agentnum$agentnum-$_.csv",
 146            "$dir/agentnum$agentnum-$opt{date}-$_.csv";
 147   }
 148
 149   my $command = "cd $dir; zip $zipfile ".
 150                 "agentnum$agentnum-$opt{date}-header.csv ".
 151                 "agentnum$agentnum-$opt{date}-detail.csv";
 152
 153   system($command) and die "$command failed\n";
 154
 155   unlink "agentnum$agentnum-$opt{date}-header.csv",
 156          "agentnum$agentnum-$opt{date}-detail.csv";
 157
 158   if ( $url =~ /^http/i ) {
 159
 160     my $ua = new LWP::UserAgent;
 161     my $res = $ua->request( POST( $url,
 162                                   'Content_Type' => 'form-data',
 163                                   'Content' => [ 'username' => $username,
 164                                                  'pass'     => $password,
 165                                                  'custid'   => $username,
 166                                                  'clicode'  => $clicode,
 167                                                  'file1'    => [ $zipfile ],
 168                                                ],
 169                                 )
 170                           );
 171
 172     die "upload failed: ". $res->status_line. "\n"
 173       unless $res->is_success;
 174
 175   } elsif ( $url =~ /^ftp:\/\/([\w\.]+)(\/.*)$/i ) {
 176
 177     my($hostname, $path) = ($1, $2);
 178
 179     my $ftp = new Net::FTP($hostname) #, Passive=>1 )
 180       or die "can't connect to $hostname: $@\n";
 181     $ftp->login($username, $password)
 182       or die "can't login to $hostname: ". $ftp->message."\n";
 183     unless ( $ftp->cwd($path) ) {
 184       my $msg = "can't cd $path on $hostname: ". $ftp->message. "\n";
 185       ( $path eq '/' ) ? warn $msg : die $msg;
 186     }
 187     $ftp->binary
 188       or die "can't set binary mode on $hostname\n";
 189
 190     $ftp->put($zipfile)
 191       or die "can't put $zipfile: ". $ftp->message. "\n";
 192
 193     $ftp->quit;
 194
 195   } else {
 196     die "unknown scheme in URL $url\n";
 197   }
 198
 199   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 200   '';
 201
 202 }
 203
 204 1;