1 package FS::cust_main::Import_Charges;
2 #actually no specific reason it lives under FS::cust_main:: othan than it calls
3 # a thing on cust_main objects. not part of the inheritence, just providess a
4 # subroutine for misc/process/cust_main-import_charges.cgi
11 use FS::Record qw( qsearchs );
17 my %import_charges_info;
18 foreach my $INC ( @INC ) {
19 warn "globbing $INC/FS/cust_main/import_charges/[a-z]*.pm\n" if $DEBUG;
20 foreach my $file ( glob("$INC/FS/cust_main/import_charges/[a-z]*.pm") ) {
21 warn "attempting to load import charges format info from $file\n" if $DEBUG;
22 $file =~ /\/(\w+)\.pm$/ or do {
23 warn "unrecognized file in $INC/FS/cust_main/import_charges/: $file\n";
27 my $info = eval "use FS::cust_main::import_charges::$mod; ".
28 "\\%FS::cust_main::import_charges::$mod\::info;";
30 die "error using FS::cust_main::import_charges::$mod (skipping): $@\n" if $@;
33 unless ( keys %$info ) {
34 warn "no %info hash found in FS::cust_main::import_charges::$mod, skipping\n";
37 warn "got import charges format info from FS::cust_main::import_charges::$mod: $info\n" if $DEBUG;
38 if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
39 warn "skipping disabled import charges format FS::cust_main::import_charges::$mod" if $DEBUG;
42 $import_charges_info{$mod} = $info;
46 tie my %import_formats, 'Tie::IxHash',
47 map { $_ => $import_charges_info{$_}->{'name'} }
48 sort { $import_charges_info{$a}->{'weight'} <=> $import_charges_info{$b}->{'weight'} }
49 grep { exists($import_charges_info{$_}->{'fields'}) }
50 keys %import_charges_info;
58 FS::cust_main::Import_Charges - Batch charge importing
62 use FS::cust_main::Import_Charges;
65 FS::cust_main::Import_charges::batch_charge( {
67 'agentnum' => scalar($cgi->param('agentnum')),
68 'format' => scalar($cgi->param('format')),
73 Batch customer charging.
86 my $param = thaw(decode_base64(shift));
87 #warn join('-',keys %$param);
88 my $agentnum = $param->{agentnum};
89 my $format = $param->{format};
91 my $files = $param->{'uploaded_files'}
92 or die "No files provided.\n";
94 my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files;
96 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
97 my $filename = $dir. $files{'file'};
100 if ( $filename =~ /\.(\w+)$/i ) {
104 warn "can't parse file type from filename $filename; defaulting to CSV";
108 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
113 if ( $import_charges_info{$format} ) {
114 @fields = @{$import_charges_info{$format}->{'fields'}};
115 %charges = %{$import_charges_info{$format}->{'charges'}};
117 die "unknown format $format";
124 if ( $type eq 'csv' ) {
126 eval "use Text::CSV_XS;";
127 eval "use File::Slurp qw( slurp );";
130 $parser = new Text::CSV_XS;
132 @buffer = split(/\r?\n/, slurp($filename) );
133 $count = scalar(@buffer);
135 } elsif ( $type eq 'xls' ) {
136 eval "use Spreadsheet::ParseExcel;";
139 my $excel = Spreadsheet::ParseExcel::Workbook->new->Parse($filename);
140 $parser = $excel->{Worksheet}[0]; #first sheet
142 $count = $parser->{MaxRow} || $parser->{MinRow};
146 die "Unknown file type $type\n";
152 local $SIG{HUP} = 'IGNORE';
153 local $SIG{INT} = 'IGNORE';
154 local $SIG{QUIT} = 'IGNORE';
155 local $SIG{TERM} = 'IGNORE';
156 local $SIG{TSTP} = 'IGNORE';
157 local $SIG{PIPE} = 'IGNORE';
159 my $oldAutoCommit = $FS::UID::AutoCommit;
160 local $FS::UID::AutoCommit = 0;
166 my( $last, $min_sec ) = ( time, 5 ); #progressbar foo
170 if ( $type eq 'csv' ) {
172 last unless scalar(@buffer);
173 $line = shift(@buffer);
175 $parser->parse($line) or do {
176 $dbh->rollback if $oldAutoCommit;
177 return "can't parse: ". $parser->error_input();
179 @columns = $parser->fields();
181 } elsif ( $type eq 'xls' ) {
182 last if $row > ($parser->{MaxRow} || $parser->{MinRow})
183 || ! $parser->{Cells}[$row];
185 my @row = @{ $parser->{Cells}[$row] };
186 @columns = map $_->{Val}, @row;
189 die "Unknown file type $type\n";
192 #warn join('-',@columns);
195 foreach my $field ( @fields ) {
196 $row{$field} = shift @columns;
199 if ( $row{custnum} && $row{agent_custid} ) {
200 dbh->rollback if $oldAutoCommit;
201 return "can't specify custnum with agent_custid $row{agent_custid}";
207 if ( $row{agent_custid} && $agentnum ) {
208 $id = $row{agent_custid};
210 'agent_custid' => $row{agent_custid},
211 'agentnum' => $agentnum,
213 %hash = ( 'agent_custid' => $row{agent_custid},
214 'agentnum' => $agentnum,
218 if ( $row{custnum} ) {
221 'custnum' => $row{custnum},
224 %hash = ( 'custnum' => $row{custnum} );
227 unless ( scalar(keys %hash) ) {
228 $dbh->rollback if $oldAutoCommit;
229 return "can't find customer without custnum or agent_custid and agentnum";
232 ## add new pkg data or upate existing by adding new amount for custnum
233 $data{$id}{pkg}{$row{pkg}} = $data{$id}{pkg}{$row{pkg}} ? $data{$id}{pkg}{$row{pkg}} + $row{'amount'} : $row{'amount'};
237 if ( $job && time - $min_sec > $last ) { #progress bar
238 $job->update_statustext( int(100 * $row / $count) );
244 ### run through data hash to post all charges.
245 foreach my $k (keys %data) {
246 my %pkg_hash = %{$data{$k}{pkg}};
247 my %cust_hash = %{$data{$k}{cust}};
249 my $cust_main = qsearchs('cust_main', { %cust_hash } );
250 unless ( $cust_main ) {
251 $dbh->rollback if $oldAutoCommit;
252 my $custnum = $cust_hash{custnum} || $cust_hash{agent_custid};
253 return "unknown custnum $custnum";
256 foreach my $pkg_key (keys %pkg_hash) {
258 my $amount = $pkg_hash{$pkg_key};
260 if (%charges) { next unless $charges{$pkg}; }
263 my $error = $cust_main->charge($amount, $pkg);
265 $dbh->rollback if $oldAutoCommit;
269 } elsif ( $amount < 0 ) {
270 my $error = $cust_main->credit( sprintf( "%.2f", 0-$amount ), $pkg );
272 $dbh->rollback if $oldAutoCommit;
283 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
287 return "Empty file!" unless $imported;