1 package FS::Cron::upload;
4 use vars qw( @ISA @EXPORT_OK $me $DEBUG );
8 use FS::Record qw( qsearch qsearchs );
12 use FS::Misc qw( send_email ); #for bridgestone
13 use FS::upload_target;
16 use HTTP::Request::Common;
19 use List::Util qw( sum );
21 @ISA = qw( Exporter );
22 @EXPORT_OK = qw ( upload );
24 $me = '[FS::Cron::upload]';
27 # -v: enable debugging
29 # -m: Experimental multi-process mode uses the job queue for multi-process and/or multi-machine billing.
30 # -r: Multi-process mode dry run option
31 # -a: Only process customers with the specified agentnum
38 $debug = 1 if $opt{'v'};
39 $debug = $opt{'l'} if $opt{'l'};
41 local $DEBUG = $debug if $debug;
43 warn "$me upload called\n" if $DEBUG;
47 my $date = time2str('%Y%m%d%H%M%S', $^T); # more?
49 my $conf = new FS::Conf;
51 my @agents = $opt{'a'} ? FS::agent->by_key($opt{'a'}) : qsearch('agent', {});
60 my @agentnums = ('', map {$_->agentnum} @agents);
62 foreach my $target (qsearch('upload_target', {})) {
63 # We don't know here if it's spooled on a per-agent basis or not.
64 # (It could even be both, via different events.) So queue up an
65 # upload for each agent, plus one with null agentnum, and we'll
66 # upload as many files as we find.
67 foreach my $a (@agentnums) {
71 'targetnum' => $target->targetnum,
72 'handling' => $target->handling,
77 # deprecated billco method
79 my $agentnum = $_->agentnum;
81 if ( $conf->config( 'billco-username', $agentnum, 1 ) ) {
82 my $username = $conf->config('billco-username', $agentnum, 1);
83 my $password = $conf->config('billco-password', $agentnum, 1);
84 my $clicode = $conf->config('billco-clicode', $agentnum, 1);
85 my $url = $conf->config('billco-url', $agentnum);
88 'agentnum' => $agentnum,
89 'username' => $username,
90 'password' => $password,
92 'clicode' => $clicode,
93 'handling' => 'billco',
100 my $agentnum = $_->{agentnum};
105 warn "DRY RUN: would add agent $agentnum for queued upload\n";
107 my $queue = new FS::queue {
108 'job' => 'FS::Cron::upload::spool_upload',
110 my $error = $queue->insert( %$_ );
115 eval { spool_upload(%$_) };
116 warn "spool_upload failed: $@\n"
128 warn "$me spool_upload called\n" if $DEBUG;
129 my $conf = new FS::Conf;
130 my $dir = '%%%FREESIDE_EXPORT%%%/export.'. $FS::UID::datasrc. '/cust_bill';
132 my $date = $opt{date} or die "no date provided\n";
134 local $SIG{HUP} = 'IGNORE';
135 local $SIG{INT} = 'IGNORE';
136 local $SIG{QUIT} = 'IGNORE';
137 local $SIG{TERM} = 'IGNORE';
138 local $SIG{TSTP} = 'IGNORE';
139 local $SIG{PIPE} = 'IGNORE';
141 my $oldAutoCommit = $FS::UID::AutoCommit;
142 local $FS::UID::AutoCommit = 0;
145 my $agentnum = $opt{agentnum};
148 $agent = qsearchs( 'agent', { agentnum => $agentnum } )
149 or die "no such agent: $agentnum";
150 $agent->select_for_update; #mutex
153 if ( $opt{'handling'} eq 'billco' ) {
155 my $file = "agentnum$agentnum";
156 my $zipfile = "$dir/$file-$date.zip";
158 unless ( -f "$dir/$file-header.csv" ||
159 -f "$dir/$file-detail.csv" )
161 warn "$me neither $dir/$file-header.csv nor ".
162 "$dir/$file-detail.csv found\n" if $DEBUG > 1;
163 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
167 my $url = $opt{url} or die "no url for agent $agentnum\n";
168 $url =~ s/^\s+//; $url =~ s/\s+$//;
170 my $username = $opt{username} or die "no username for agent $agentnum\n";
171 my $password = $opt{password} or die "no password for agent $agentnum\n";
175 my $sql = "SELECT count(*) FROM queue LEFT JOIN cust_main USING(custnum) ".
176 "WHERE queue.job='FS::cust_main::queued_bill' AND cust_main.agentnum = ?";
177 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
179 $sth->execute( $agentnum )
180 or die "Unexpected error executing statement $sql: ". $sth->errstr;
181 last if $sth->fetchrow_arrayref->[0];
186 foreach ( qw ( header detail ) ) {
187 rename "$dir/$file-$_.csv",
188 "$dir/$file-$date-$_.csv";
191 my $command = "cd $dir; zip $zipfile ".
192 "$file-$date-header.csv ".
193 "$file-$date-detail.csv";
195 system($command) and die "$command failed\n";
197 unlink "$file-$date-header.csv",
198 "$file-$date-detail.csv";
200 if ( $url =~ /^http/i ) {
202 my $ua = new LWP::UserAgent;
203 my $res = $ua->request( POST( $url,
204 'Content_Type' => 'form-data',
205 'Content' => [ 'username' => $username,
207 'custid' => $username,
208 'clicode' => $opt{clicode},
209 'file1' => [ $zipfile ],
214 die "upload failed: ". $res->status_line. "\n"
215 unless $res->is_success;
217 } elsif ( $url =~ /^ftp:\/\/([\w\.]+)(\/.*)$/i ) {
219 my($hostname, $path) = ($1, $2);
221 my $ftp = new Net::FTP($hostname, Passive=>1)
222 or die "can't connect to $hostname: $@\n";
223 $ftp->login($username, $password)
224 or die "can't login to $hostname: ". $ftp->message."\n";
225 unless ( $ftp->cwd($path) ) {
226 my $msg = "can't cd $path on $hostname: ". $ftp->message. "\n";
227 ( $path eq '/' ) ? warn $msg : die $msg;
230 or die "can't set binary mode on $hostname\n";
233 or die "can't put $zipfile: ". $ftp->message. "\n";
238 die "unknown scheme in URL $url\n";
244 my $targetnum = $opt{targetnum};
245 my $upload_target = FS::upload_target->by_key($targetnum)
246 or die "FTP target $targetnum not found\n";
248 $dir .= "/target$targetnum";
251 my $file = $agentnum ? "agentnum$agentnum" : 'spool'; #.csv
253 unless ( -f "$dir/$file.csv" ) {
254 warn "$me $dir/$file.csv not found\n" if $DEBUG > 1;
255 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
259 rename "$dir/$file.csv", "$dir/$file-$date.csv";
261 if ( $opt{'handling'} eq 'bridgestone' ) {
263 my $prefix = $conf->config('bridgestone-prefix', $agentnum);
265 warn "$me agent $agentnum has no bridgestone-prefix, skipped\n";
266 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
270 my $seq = $conf->config('bridgestone-batch_counter', $agentnum) || 1;
273 join(' ',$conf->config('company_address', $agentnum)) =~
274 /(\d{5}(\-\d{4})?)\s*$/;
275 my $ourzip = $1 || ''; #could be an explicit option if really needed
277 my $newfile = sprintf('%s_%s_%0.6d.dat',
279 time2str('%Y%m%d', time),
281 warn "copying spool to $newfile\n" if $DEBUG;
284 open $in, '<', "$dir/$file-$date.csv"
285 or die "unable to read $file-$date.csv\n";
286 open $out, '>', "$dir/$newfile" or die "unable to write $newfile\n";
287 #header--not sure how much of this generalizes at all
289 "%-6s%-4s%-27s%-6s%0.6d%-5s%-9s%-9s%-7s%0.8d%-7s%0.6d\n",
290 ' COMP:', 'VISP', '', ',SEQ#:', $seq, ',ZIP:', $ourzip, ',VERS:1.1',
291 ',RUNDT:', time2str('%m%d%Y', $^T),
292 ',RUNTM:', time2str('%H%M%S', $^T),
294 warn "HEADER: $head" if $DEBUG;
305 "%-6s%-4s%-27s%-6s%0.6d%-7s%0.9d%-9s%0.9d\n",
306 ' COMP:', 'VISP', '', ',SEQ:', $seq,
307 ',LINES:', $rows+2, ',LETTERS:', $rows,
309 warn "TRAILER: $trail" if $DEBUG;
315 my $zipfile = sprintf('%s_%0.6d.zip', $prefix, $seq);
316 my $command = "cd $dir; zip $zipfile $newfile";
317 warn "compressing to $zipfile\n$command\n" if $DEBUG;
318 system($command) and die "$command failed\n";
320 my $error = $upload_target->put($zipfile);
321 die $error if $error;
323 send_report('bridgestone-confirm_template',
325 agentnum=> $agentnum,
334 warn "setting batch counter to $seq\n" if $DEBUG;
335 $conf->set('bridgestone-batch_counter', $seq, $agentnum);
337 } elsif ( $opt{'handling'} eq 'ics' ) {
339 my ($basename, $regfile, $bigfile);
340 $basename = sprintf('c%sc1', time2str('%m%d', time));
341 $regfile = $basename . 'i.txt'; # for "regular" (short) invoices
342 $bigfile = $basename . 'b.txt'; # for "big" invoices
344 warn "copying spool to $regfile, $bigfile\n" if $DEBUG;
346 my ($in, $reg, $big); #filehandles
347 my %count = (B => 0, 1 => 0, 2 => 0); # number of invoices
348 my %sum = (B => 0, R => 0); # total of charges field
349 open $in, '<', "$dir/$file-$date.csv"
350 or die "unable to read $file-$date.csv\n";
352 open $reg, '>', "$dir/$regfile" or die "unable to write $regfile\n";
353 open $big, '>', "$dir/$bigfile" or die "unable to write $bigfile\n";
355 while (my $line = <$in>) {
357 my $tag = substr($line, -1, 1, '');
358 my $charge = substr($line, 252, 10);
360 print $big $line, "\n";
364 print $reg $line, "\n";
373 my $zipfile = "$basename" . '.zip';
374 my $command = "cd $dir; zip $zipfile $regfile $bigfile";
375 system($command) and die "'$command' failed\n";
376 $upload_target->put("$dir/$zipfile");
379 $_ = sprintf('%.2f', $_);
382 send_report('ics-confirm_template',
384 agentnum => $agentnum,
390 } else { # not bridgestone or ics
392 # this is the usual case
394 my $error = $upload_target->put("$file-$date.csv");
395 die $error if $error;
401 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
406 =item send_report CONFIG PARAMS
408 Retrieves the config value named CONFIG, parses it as a Text::Template,
409 extracts "to" and "subject" headers, and sends it by email.
411 PARAMS is a hashref to be passed to C<fill_in>. It must contain
412 'agentnum' to look up the per-agent config.
416 # we used it twice, so it's now a subroutine
419 my ($config, $params) = @_;
420 my $agentnum = $params->{agentnum};
421 my $conf = FS::Conf->new;
423 my $template = join("\n", $conf->config($config, $agentnum));
425 warn "$me agent $agentnum has no $config, no email report sent\n";
429 my $tmpl_obj = Text::Template->new(
430 TYPE => 'STRING', SOURCE => $template
432 my $content = $tmpl_obj->fill_in( HASH => $params );
433 my ($head, $body) = split("\n\n", $content, 2);
434 $head =~ /^subject:\s*(.*)$/im;
437 $head =~ /^to:\s*(.*)$/im;
442 from => $conf->config('invoice_from', $agentnum),