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
9 use FS::Record qw( qsearchs );
15 my %import_charges_info;
16 foreach my $INC ( @INC ) {
17 warn "globbing $INC/FS/cust_main/import_charges/[a-z]*.pm\n" if $DEBUG;
18 foreach my $file ( glob("$INC/FS/cust_main/import_charges/[a-z]*.pm") ) {
19 warn "attempting to load import charges format info from $file\n" if $DEBUG;
20 $file =~ /\/(\w+)\.pm$/ or do {
21 warn "unrecognized file in $INC/FS/cust_main/import_charges/: $file\n";
25 my $info = eval "use FS::cust_main::import_charges::$mod; ".
26 "\\%FS::cust_main::import_charges::$mod\::info;";
28 die "error using FS::cust_main::import_charges::$mod (skipping): $@\n" if $@;
31 unless ( keys %$info ) {
32 warn "no %info hash found in FS::cust_main::import_charges::$mod, skipping\n";
35 warn "got import charges format info from FS::cust_main::import_charges::$mod: $info\n" if $DEBUG;
36 if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
37 warn "skipping disabled import charges format FS::cust_main::import_charges::$mod" if $DEBUG;
40 $import_charges_info{$mod} = $info;
44 tie my %import_formats, 'Tie::IxHash',
45 map { $_ => $import_charges_info{$_}->{'name'} }
46 sort { $import_charges_info{$a}->{'weight'} <=> $import_charges_info{$b}->{'weight'} }
47 grep { exists($import_charges_info{$_}->{'fields'}) }
48 keys %import_charges_info;
56 FS::cust_main::Import_Charges - Batch charge importing
60 use FS::cust_main::Import_Charges;
63 FS::cust_main::Import_charges::batch_charge( {
65 'agentnum' => scalar($cgi->param('agentnum')),
66 'format' => scalar($cgi->param('format')),
71 Batch customer charging.
85 #warn join('-',keys %$param);
86 my $agentnum = $param->{agentnum};
87 my $format = $param->{format};
89 my $files = $param->{'uploaded_files'}
90 or die "No files provided.\n";
92 my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files;
94 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
95 my $filename = $dir. $files{'file'};
98 if ( $filename =~ /\.(\w+)$/i ) {
102 warn "can't parse file type from filename $filename; defaulting to CSV";
106 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
111 if ( $import_charges_info{$format} ) {
112 @fields = @{$import_charges_info{$format}->{'fields'}};
113 %charges = %{$import_charges_info{$format}->{'charges'}};
115 die "unknown format $format";
122 if ( $type eq 'csv' ) {
124 eval "use Text::CSV_XS;";
125 eval "use File::Slurp qw( slurp );";
128 $parser = new Text::CSV_XS;
130 @buffer = split(/\r?\n/, slurp($filename) );
131 $count = scalar(@buffer);
133 } elsif ( $type eq 'xls' ) {
134 eval "use Spreadsheet::ParseExcel;";
137 my $excel = Spreadsheet::ParseExcel::Workbook->new->Parse($filename);
138 $parser = $excel->{Worksheet}[0]; #first sheet
140 $count = $parser->{MaxRow} || $parser->{MinRow};
144 die "Unknown file type $type\n";
150 local $SIG{HUP} = 'IGNORE';
151 local $SIG{INT} = 'IGNORE';
152 local $SIG{QUIT} = 'IGNORE';
153 local $SIG{TERM} = 'IGNORE';
154 local $SIG{TSTP} = 'IGNORE';
155 local $SIG{PIPE} = 'IGNORE';
157 my $oldAutoCommit = $FS::UID::AutoCommit;
158 local $FS::UID::AutoCommit = 0;
164 my( $last, $min_sec ) = ( time, 5 ); #progressbar foo
168 if ( $type eq 'csv' ) {
170 last unless scalar(@buffer);
171 $line = shift(@buffer);
173 $parser->parse($line) or do {
174 $dbh->rollback if $oldAutoCommit;
175 return "can't parse: ". $parser->error_input();
177 @columns = $parser->fields();
179 } elsif ( $type eq 'xls' ) {
180 last if $row > ($parser->{MaxRow} || $parser->{MinRow})
181 || ! $parser->{Cells}[$row];
183 my @row = @{ $parser->{Cells}[$row] };
184 @columns = map $_->{Val}, @row;
187 die "Unknown file type $type\n";
190 #warn join('-',@columns);
193 foreach my $field ( @fields ) {
194 $row{$field} = shift @columns;
197 if ( $row{custnum} && $row{agent_custid} ) {
198 dbh->rollback if $oldAutoCommit;
199 return "can't specify custnum with agent_custid $row{agent_custid}";
205 if ( $row{agent_custid} && $agentnum ) {
206 $id = $row{agent_custid};
208 'agent_custid' => $row{agent_custid},
209 'agentnum' => $agentnum,
211 %hash = ( 'agent_custid' => $row{agent_custid},
212 'agentnum' => $agentnum,
216 if ( $row{custnum} ) {
219 'custnum' => $row{custnum},
222 %hash = ( 'custnum' => $row{custnum} );
225 unless ( scalar(keys %hash) ) {
226 $dbh->rollback if $oldAutoCommit;
227 return "can't find customer without custnum or agent_custid and agentnum";
230 ## add new pkg data or upate existing by adding new amount for custnum
231 $data{$id}{pkg}{$row{pkg}} = $data{$id}{pkg}{$row{pkg}} ? $data{$id}{pkg}{$row{pkg}} + $row{'amount'} : $row{'amount'};
235 if ( $job && time - $min_sec > $last ) { #progress bar
236 $job->update_statustext( int(100 * $row / $count) );
242 ### run through data hash to post all charges.
243 foreach my $k (keys %data) {
244 my %pkg_hash = %{$data{$k}{pkg}};
245 my %cust_hash = %{$data{$k}{cust}};
247 my $cust_main = qsearchs('cust_main', { %cust_hash } );
248 unless ( $cust_main ) {
249 $dbh->rollback if $oldAutoCommit;
250 my $custnum = $cust_hash{custnum} || $cust_hash{agent_custid};
251 return "unknown custnum $custnum";
254 foreach my $pkg_key (keys %pkg_hash) {
256 my $amount = $pkg_hash{$pkg_key};
258 if (%charges) { next unless $charges{$pkg}; }
261 my $error = $cust_main->charge($amount, $pkg);
263 $dbh->rollback if $oldAutoCommit;
267 } elsif ( $amount < 0 ) {
268 my $error = $cust_main->credit( sprintf( "%.2f", 0-$amount ), $pkg );
270 $dbh->rollback if $oldAutoCommit;
281 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
285 return "Empty file!" unless $imported;