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 );
sub upload {
my %opt = @_;
+ my $log = FS::Log->new('Cron::upload');
+ $log->info('start');
my $debug = 0;
$debug = 1 if $opt{'v'};
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;
+
+ 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,
+ };
+ }
+ }
+
+ # 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 my $agent ( @agent ) {
+ foreach (@tasks) {
- my $agentnum = $agent->agentnum;
+ 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 )
- 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';
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;
+ }
+
+ my $url = $opt{url} or die "no url for agent $agentnum\n";
+ $url =~ s/^\s+//; $url =~ s/\s+$//;
+
+ my $username = $opt{username} or die "no username for agent $agentnum\n";
+ my $password = $opt{password} or die "no password for agent $agentnum\n";
+
+ foreach ( qw ( header detail ) ) {
+ rename "$dir/$file-$_.csv",
+ "$dir/$file-$date-$_.csv";
+ }
+
+ my $command = "cd $dir; zip $zipfile ".
+ "$file-$date-header.csv ".
+ "$file-$date-detail.csv";
+
+ system($command) and die "$command failed\n";
+
+ unlink "$file-$date-header.csv",
+ "$file-$date-detail.csv";
+
+ if ( $url =~ /^http/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 ],
+ ],
+ )
+ );
+
+ die "upload failed: ". $res->status_line. "\n"
+ unless $res->is_success;
+
+ } 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->quit;
+
+ } else {
+ die "unknown scheme in URL $url\n";
}
- }
- foreach ( qw ( header detail ) ) {
- rename "$dir/agentnum$agentnum-$_.csv",
- "$dir/agentnum$agentnum-$opt{date}-$_.csv";
}
+ 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");
+ }
- my $command = "cd $dir; zip $zipfile ".
- "agentnum$agentnum-$opt{date}-header.csv ".
- "agentnum$agentnum-$opt{date}-detail.csv";
+ # create the report
+ for (values %sum) {
+ $_ = sprintf('%.2f', $_);
+ }
- system($command) and die "$command failed\n";
+ 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);
- unlink "agentnum$agentnum-$opt{date}-header.csv",
- "agentnum$agentnum-$opt{date}-detail.csv";
+ if ( $error ) {
+ # put the original spool file back
+ rename "$dir/$file-$date.csv", "$dir/$file.csv";
+ die $error;
+ }
+
+ } else { # not bridgestone or ics
- 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 ],
- ],
- )
- );
+ # this is the usual case
- die "upload failed: ". $res->status_line. "\n"
- unless $res->is_success;
+ 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;
projects / freeside.git / blobdiff