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
16 use HTTP::Request::Common;
20 @ISA = qw( Exporter );
21 @EXPORT_OK = qw ( upload );
23 $me = '[FS::Cron::upload]';
26 # -v: enable debugging
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
37 $debug = 1 if $opt{'v'};
38 $debug = $opt{'l'} if $opt{'l'};
40 local $DEBUG = $debug if $debug;
42 warn "$me upload called\n" if $DEBUG;
46 my $date = time2str('%Y%m%d%H%M%S', $^T); # more?
48 my $conf = new FS::Conf;
50 my @agents = $opt{'a'} ? FS::agent->by_key($opt{'a'}) : qsearch('agent', {});
59 my @agentnums = ('', map {$_->agentnum} @agents);
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) {
70 'targetnum' => $target->targetnum,
71 'handling' => $target->handling,
76 # deprecated billco method
78 my $agentnum = $_->agentnum;
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);
87 'agentnum' => $agentnum,
88 'username' => $username,
89 'password' => $password,
91 'clicode' => $clicode,
92 'handling' => 'billco',
99 my $agentnum = $_->{agentnum};
104 warn "DRY RUN: would add agent $agentnum for queued upload\n";
106 my $queue = new FS::queue {
107 'job' => 'FS::Cron::upload::spool_upload',
109 my $error = $queue->insert( %$_ );
114 eval { spool_upload(%$_) };
115 warn "spool_upload failed: $@\n"
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';
131 my $date = $opt{date} or die "no date provided\n";
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';
140 my $oldAutoCommit = $FS::UID::AutoCommit;
141 local $FS::UID::AutoCommit = 0;
144 my $agentnum = $opt{agentnum};
147 $agent = qsearchs( 'agent', { agentnum => $agentnum } )
148 or die "no such agent: $agentnum";
149 $agent->select_for_update; #mutex
152 if ( $opt{'handling'} eq 'billco' ) {
154 my $file = "agentnum$agentnum";
155 my $zipfile = "$dir/$file-$date.zip";
157 unless ( -f "$dir/$file-header.csv" ||
158 -f "$dir/$file-detail.csv" )
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;
166 my $url = $opt{url} or die "no url for agent $agentnum\n";
167 $url =~ s/^\s+//; $url =~ s/\s+$//;
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";
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;
178 $sth->execute( $agentnum )
179 or die "Unexpected error executing statement $sql: ". $sth->errstr;
180 last if $sth->fetchrow_arrayref->[0];
185 foreach ( qw ( header detail ) ) {
186 rename "$dir/$file-$_.csv",
187 "$dir/$file-$date-$_.csv";
190 my $command = "cd $dir; zip $zipfile ".
191 "$file-$date-header.csv ".
192 "$file-$date-detail.csv";
194 system($command) and die "$command failed\n";
196 unlink "$file-$date-header.csv",
197 "$file-$date-detail.csv";
199 if ( $url =~ /^http/i ) {
201 my $ua = new LWP::UserAgent;
202 my $res = $ua->request( POST( $url,
203 'Content_Type' => 'form-data',
204 'Content' => [ 'username' => $username,
206 'custid' => $username,
207 'clicode' => $opt{clicode},
208 'file1' => [ $zipfile ],
213 die "upload failed: ". $res->status_line. "\n"
214 unless $res->is_success;
216 } elsif ( $url =~ /^ftp:\/\/([\w\.]+)(\/.*)$/i ) {
218 my($hostname, $path) = ($1, $2);
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;
229 or die "can't set binary mode on $hostname\n";
232 or die "can't put $zipfile: ". $ftp->message. "\n";
237 die "unknown scheme in URL $url\n";
243 my $targetnum = $opt{targetnum};
244 my $ftp_target = FS::ftp_target->by_key($targetnum)
245 or die "FTP target $targetnum not found\n";
247 $dir .= "/target$targetnum";
250 my $file = $agentnum ? "agentnum$agentnum" : 'spool'; #.csv
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;
258 rename "$dir/$file.csv", "$dir/$file-$date.csv";
260 if ( $opt{'handling'} eq 'bridgestone' ) {
262 my $prefix = $conf->config('bridgestone-prefix', $agentnum);
264 warn "$me agent $agentnum has no bridgestone-prefix, skipped\n";
265 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
269 my $seq = $conf->config('bridgestone-batch_counter', $agentnum) || 1;
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
276 my $newfile = sprintf('%s_%s_%0.6d.dat',
278 time2str('%Y%m%d', time),
280 warn "copying spool to $newfile\n" if $DEBUG;
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
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),
293 warn "HEADER: $head" if $DEBUG;
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,
308 warn "TRAILER: $trail" if $DEBUG;
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";
319 my $connection = $ftp_target->connect; # dies on error
320 $connection->put($zipfile);
322 my $template = join("\n",$conf->config('bridgestone-confirm_template'));
324 my $tmpl_obj = Text::Template->new(
325 TYPE => 'STRING', SOURCE => $template
327 my $content = $tmpl_obj->fill_in( HASH =>
335 my ($head, $body) = split("\n\n", $content, 2);
336 $head =~ /^subject:\s*(.*)$/im;
339 $head =~ /^to:\s*(.*)$/im;
344 from => $conf->config('invoice_from', $agentnum),
349 warn "$me agent $agentnum has no bridgestone-confirm_template, no email sent\n";
353 warn "setting batch counter to $seq\n" if $DEBUG;
354 $conf->set('bridgestone-batch_counter', $seq, $agentnum);
356 } else { # not bridgestone
358 # this is the usual case
360 my $connection = $ftp_target->connect; # dies on error
361 $connection->put("$file-$date.csv");
367 $dbh->commit or die $dbh->errstr if $oldAutoCommit;