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::ftp_target;
  14 use LWP::UserAgent;
  15 use HTTP::Request;
  16 use HTTP::Request::Common;
  17 use HTTP::Response;
  18 use Net::FTP;
  19
  20 @ISA = qw( Exporter );
  21 @EXPORT_OK = qw ( upload );
  22 $DEBUG = 0;
  23 $me = '[FS::Cron::upload]';
  24
  25 #freeside-daily %opt:
  26 #  -v: enable debugging
  27 #  -l: debugging level
  28 #  -m: Experimental multi-process mode uses the job queue for multi-process and/or multi-machine billing.
  29 #  -r: Multi-process mode dry run option
  30 #  -a: Only process customers with the specified agentnum
  31
  32
  33 sub upload {
  34   my %opt = @_;
  35
  36   my $debug = 0;
  37   $debug = 1 if $opt{'v'};
  38   $debug = $opt{'l'} if $opt{'l'};
  39
  40   local $DEBUG = $debug if $debug;
  41
  42   warn "$me upload called\n" if $DEBUG;
  43
  44   my @tasks;
  45
  46   my $date =  time2str('%Y%m%d%H%M%S', $^T); # more?
  47
  48   my $conf = new FS::Conf;
  49
  50   my @agents = $opt{'a'} ? FS::agent->by_key($opt{'a'}) : qsearch('agent', {});
  51
  52   my %task = (
  53     'date'      => $date,
  54     'l'         => $opt{'l'},
  55     'm'         => $opt{'m'},
  56     'v'         => $opt{'v'},
  57   );
  58
  59   my @agentnums = ('', map {$_->agentnum} @agents);
  60
  61   foreach my $target (qsearch('ftp_target', {})) {
  62     # We don't know here if it's spooled on a per-agent basis or not.
  63     # (It could even be both, via different events.)  So queue up an
  64     # upload for each agent, plus one with null agentnum, and we'll
  65     # upload as many files as we find.
  66     foreach my $a (@agentnums) {
  67       push @tasks, {
  68         %task,
  69         'agentnum'  => $a,
  70         'targetnum' => $target->targetnum,
  71         'handling'  => $target->handling,
  72       };
  73     }
  74   }
  75
  76   # deprecated billco method
  77   foreach (@agents) {
  78     my $agentnum = $_->agentnum;
  79
  80     if ( $conf->config( 'billco-username', $agentnum, 1 ) ) {
  81       my $username = $conf->config('billco-username', $agentnum, 1);
  82       my $password = $conf->config('billco-password', $agentnum, 1);
  83       my $clicode  = $conf->config('billco-clicode',  $agentnum, 1);
  84       my $url      = $conf->config('billco-url',      $agentnum);
  85       push @tasks, {
  86         %task,
  87         'agentnum' => $agentnum,
  88         'username' => $username,
  89         'password' => $password,
  90         'url'      => $url,
  91         'clicode'  => $clicode,
  92         'handling' => 'billco',
  93       };
  94     }
  95   } # foreach @agents
  96
  97   foreach (@tasks) {
  98
  99     my $agentnum = $_->{agentnum};
 100
 101     if ( $opt{'m'} ) {
 102
 103       if ( $opt{'r'} ) {
 104         warn "DRY RUN: would add agent $agentnum for queued upload\n";
 105       } else {
 106         my $queue = new FS::queue {
 107           'job'      => 'FS::Cron::upload::spool_upload',
 108         };
 109         my $error = $queue->insert( %$_ );
 110       }
 111
 112     } else {
 113
 114       eval { spool_upload(%$_) };
 115       warn "spool_upload failed: $@\n"
 116         if $@;
 117
 118     }
 119
 120   }
 121
 122 }
 123
 124 sub spool_upload {
 125   my %opt = @_;
 126
 127   warn "$me spool_upload called\n" if $DEBUG;
 128   my $conf = new FS::Conf;
 129   my $dir = '%%%FREESIDE_EXPORT%%%/export.'. $FS::UID::datasrc. '/cust_bill';
 130
 131   my $date = $opt{date} or die "no date provided\n";
 132
 133   local $SIG{HUP} = 'IGNORE';
 134   local $SIG{INT} = 'IGNORE';
 135   local $SIG{QUIT} = 'IGNORE';
 136   local $SIG{TERM} = 'IGNORE';
 137   local $SIG{TSTP} = 'IGNORE';
 138   local $SIG{PIPE} = 'IGNORE';
 139
 140   my $oldAutoCommit = $FS::UID::AutoCommit;
 141   local $FS::UID::AutoCommit = 0;
 142   my $dbh = dbh;
 143
 144   my $agentnum = $opt{agentnum};
 145   my $agent;
 146   if ( $agentnum ) {
 147     $agent = qsearchs( 'agent', { agentnum => $agentnum } )
 148       or die "no such agent: $agentnum";
 149     $agent->select_for_update; #mutex
 150   }
 151
 152   if ( $opt{'handling'} eq 'billco' ) {
 153
 154     my $file = "agentnum$agentnum";
 155     my $zipfile  = "$dir/$file-$date.zip";
 156
 157     unless ( -f "$dir/$file-header.csv" ||
 158              -f "$dir/$file-detail.csv" )
 159     {
 160       warn "$me neither $dir/$file-header.csv nor ".
 161            "$dir/$file-detail.csv found\n" if $DEBUG > 1;
 162       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 163       return;
 164     }
 165
 166     my $url      = $opt{url} or die "no url for agent $agentnum\n";
 167     $url =~ s/^\s+//; $url =~ s/\s+$//;
 168
 169     my $username = $opt{username} or die "no username for agent $agentnum\n";
 170     my $password = $opt{password} or die "no password for agent $agentnum\n";
 171
 172     # a better way?
 173     if ($opt{m}) {
 174       my $sql = "SELECT count(*) FROM queue LEFT JOIN cust_main USING(custnum) ".
 175         "WHERE queue.job='FS::cust_main::queued_bill' AND cust_main.agentnum = ?";
 176       my $sth = $dbh->prepare($sql) or die $dbh->errstr;
 177       while (1) {
 178         $sth->execute( $agentnum )
 179           or die "Unexpected error executing statement $sql: ". $sth->errstr;
 180         last if $sth->fetchrow_arrayref->[0];
 181         sleep 300;
 182       }
 183     }
 184
 185     foreach ( qw ( header detail ) ) {
 186       rename "$dir/$file-$_.csv",
 187              "$dir/$file-$date-$_.csv";
 188     }
 189
 190     my $command = "cd $dir; zip $zipfile ".
 191                   "$file-$date-header.csv ".
 192                   "$file-$date-detail.csv";
 193
 194     system($command) and die "$command failed\n";
 195
 196     unlink "$file-$date-header.csv",
 197            "$file-$date-detail.csv";
 198
 199     if ( $url =~ /^http/i ) {
 200
 201       my $ua = new LWP::UserAgent;
 202       my $res = $ua->request( POST( $url,
 203                                     'Content_Type' => 'form-data',
 204                                     'Content' => [ 'username' => $username,
 205                                                    'pass'     => $password,
 206                                                    'custid'   => $username,
 207                                                    'clicode'  => $opt{clicode},
 208                                                    'file1'    => [ $zipfile ],
 209                                                  ],
 210                                   )
 211                             );
 212
 213       die "upload failed: ". $res->status_line. "\n"
 214         unless $res->is_success;
 215
 216     } elsif ( $url =~ /^ftp:\/\/([\w\.]+)(\/.*)$/i ) {
 217
 218       my($hostname, $path) = ($1, $2);
 219
 220       my $ftp = new Net::FTP($hostname, Passive=>1)
 221         or die "can't connect to $hostname: $@\n";
 222       $ftp->login($username, $password)
 223         or die "can't login to $hostname: ". $ftp->message."\n";
 224       unless ( $ftp->cwd($path) ) {
 225         my $msg = "can't cd $path on $hostname: ". $ftp->message. "\n";
 226         ( $path eq '/' ) ? warn $msg : die $msg;
 227       }
 228       $ftp->binary
 229         or die "can't set binary mode on $hostname\n";
 230
 231       $ftp->put($zipfile)
 232         or die "can't put $zipfile: ". $ftp->message. "\n";
 233
 234       $ftp->quit;
 235
 236     } else {
 237       die "unknown scheme in URL $url\n";
 238     }
 239
 240   }
 241   else { #not billco
 242
 243     my $targetnum = $opt{targetnum};
 244     my $ftp_target = FS::ftp_target->by_key($targetnum)
 245       or die "FTP target $targetnum not found\n";
 246
 247     $dir .= "/target$targetnum";
 248     chdir($dir);
 249
 250     my $file  = $agentnum ? "agentnum$agentnum" : 'spool'; #.csv
 251
 252     unless ( -f "$dir/$file.csv" ) {
 253       warn "$me $dir/$file.csv not found\n" if $DEBUG > 1;
 254       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 255       return;
 256     }
 257
 258     rename "$dir/$file.csv", "$dir/$file-$date.csv";
 259
 260     if ( $opt{'handling'} eq 'bridgestone' ) {
 261
 262       my $prefix = $conf->config('bridgestone-prefix', $agentnum);
 263       unless ( $prefix ) {
 264         warn "$me agent $agentnum has no bridgestone-prefix, skipped\n";
 265         $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 266         return;
 267       }
 268
 269       my $seq = $conf->config('bridgestone-batch_counter', $agentnum) || 1;
 270
 271       # extract zip code
 272       join(' ',$conf->config('company_address', $agentnum)) =~
 273         /(\d{5}(\-\d{4})?)\s*$/;
 274       my $ourzip = $1 || ''; #could be an explicit option if really needed
 275       $ourzip  =~ s/\D//;
 276       my $newfile = sprintf('%s_%s_%0.6d.dat',
 277                             $prefix,
 278                             time2str('%Y%m%d', time),
 279                             $seq);
 280       warn "copying spool to $newfile\n" if $DEBUG;
 281
 282       my ($in, $out);
 283       open $in, '<', "$dir/$file-$date.csv"
 284         or die "unable to read $file-$date.csv\n";
 285       open $out, '>', "$dir/$newfile" or die "unable to write $newfile\n";
 286       #header--not sure how much of this generalizes at all
 287       my $head = sprintf(
 288         "%-6s%-4s%-27s%-6s%0.6d%-5s%-9s%-9s%-7s%0.8d%-7s%0.6d\n",
 289         ' COMP:', 'VISP', '', ',SEQ#:', $seq, ',ZIP:', $ourzip, ',VERS:1.1',
 290         ',RUNDT:', time2str('%m%d%Y', $^T),
 291         ',RUNTM:', time2str('%H%M%S', $^T),
 292       );
 293       warn "HEADER: $head" if $DEBUG;
 294       print $out $head;
 295
 296       my $rows = 0;
 297       while( <$in> ) {
 298         print $out $_;
 299         $rows++;
 300       }
 301
 302       #trailer
 303       my $trail = sprintf(
 304         "%-6s%-4s%-27s%-6s%0.6d%-7s%0.9d%-9s%0.9d\n",
 305         ' COMP:', 'VISP', '', ',SEQ:', $seq,
 306         ',LINES:', $rows+2, ',LETTERS:', $rows,
 307       );
 308       warn "TRAILER: $trail" if $DEBUG;
 309       print $out $trail;
 310
 311       close $in;
 312       close $out;
 313
 314       my $zipfile = sprintf('%s_%0.6d.zip', $prefix, $seq);
 315       my $command = "cd $dir; zip $zipfile $newfile";
 316       warn "compressing to $zipfile\n$command\n" if $DEBUG;
 317       system($command) and die "$command failed\n";
 318
 319       my $connection = $ftp_target->connect; # dies on error
 320       $connection->put($zipfile);
 321
 322       my $template = join("\n",$conf->config('bridgestone-confirm_template'));
 323       if ( $template ) {
 324         my $tmpl_obj = Text::Template->new(
 325           TYPE => 'STRING', SOURCE => $template
 326         );
 327         my $content = $tmpl_obj->fill_in( HASH =>
 328           {
 329             zipfile => $zipfile,
 330             prefix  => $prefix,
 331             seq     => $seq,
 332             rows    => $rows,
 333           }
 334         );
 335         my ($head, $body) = split("\n\n", $content, 2);
 336         $head =~ /^subject:\s*(.*)$/im;
 337         my $subject = $1;
 338
 339         $head =~ /^to:\s*(.*)$/im;
 340         my $to = $1;
 341
 342         send_email(
 343           to      => $to,
 344           from    => $conf->config('invoice_from', $agentnum),
 345           subject => $subject,
 346           body    => $body,
 347         );
 348       } else { #!$template
 349         warn "$me agent $agentnum has no bridgestone-confirm_template, no email sent\n";
 350       }
 351
 352       $seq++;
 353       warn "setting batch counter to $seq\n" if $DEBUG;
 354       $conf->set('bridgestone-batch_counter', $seq, $agentnum);
 355
 356     } else { # not bridgestone
 357
 358       # this is the usual case
 359
 360       my $connection = $ftp_target->connect; # dies on error
 361       $connection->put("$file-$date.csv");
 362
 363     }
 364
 365   } #opt{handling}
 366
 367   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 368   '';
 369
 370 }
 371
 372 1;