FS/FS/cust_main/Import_Charges.pm

   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
   5
   6 use strict;
   7 use FS::UID qw( dbh );
   8 use FS::CurrentUser;
   9 use FS::Record qw( qsearchs );
  10 use FS::cust_main;
  11
  12 =head1 NAME
  13
  14 FS::cust_main::Import_Charges - Batch charge importing
  15
  16 =head1 SYNOPSIS
  17
  18   use FS::cust_main::Import_Charges;
  19
  20   my $error =
  21     FS::cust_main::Import_charges::batch_charge( {
  22       filehandle => $fh,
  23       'agentnum' => scalar($cgi->param('agentnum')),
  24       'format'   => scalar($cgi->param('format')),
  25     } );
  26
  27 =head1 DESCRIPTION
  28
  29 Batch customer charging.
  30
  31
  32 =head1 SUBROUTINES
  33
  34 =over 4
  35
  36 =item batch_charge
  37
  38 =cut
  39
  40 sub batch_charge {
  41   my $job = shift;
  42   my $param = shift;
  43   #warn join('-',keys %$param);
  44   my $agentnum = $param->{agentnum};
  45   my $format = $param->{format};
  46
  47   my $files = $param->{'uploaded_files'}
  48     or die "No files provided.\n";
  49
  50   my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files;
  51
  52   my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
  53   my $filename = $dir. $files{'file'};
  54
  55   my $type;
  56   if ( $filename =~ /\.(\w+)$/i ) {
  57     $type = lc($1);
  58   } else {
  59     #or error out???
  60     warn "can't parse file type from filename $filename; defaulting to CSV";
  61     $type = 'csv';
  62   }
  63
  64   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
  65
  66   my @fields;
  67   my %charges;
  68   if ( $format eq 'simple' ) {
  69     @fields = qw( custnum agent_custid amount pkg );
  70   } elsif ( $format eq 'ooma' ) {
  71     #@fields = ( 'userfield1', 'userfield2', 'userfield3', 'userfield4', 'userfield5', 'userfield6', 'userfield7', 'userfield8', 'userfield9', 'userfield10', 'amount', 'userfield12', 'userfield13', 'userfield14', 'userfield15', 'userfield16', 'userfield17', 'userfield18', 'pkg', 'userfield20', 'custnum', 'userfield22', 'userfield23', 'userfield24', 'userfield25', );
  72     @fields = ( 'userfield1', 'userfield2', 'userfield3', 'userfield4', 'userfield5', 'userfield6', 'userfield7', 'userfield8', 'amount', 'userfield10', 'userfield11', 'userfield12', 'userfield13', 'userfield14', 'userfield15', 'userfield16', 'pkg', 'userfield18', 'custnum', 'userfield20', 'userfield21', 'userfield22', 'userfield23', 'userfield24', 'userfield25', );
  73
  74   ##should charges to charge be a config option?
  75     %charges = (
  76       'DISABILITY ACCESS/ENHANCED 911 SERVICES SURCHARGE' => '1',
  77       'FEDERAL TRS FUND'                                  => '1',
  78       'FEDERAL UNIVERSAL SERVICE FUND'                    => '1',
  79       'STATE SALES TAX'                                   => '1',
  80     );
  81   } else {
  82     die "unknown format $format";
  83   }
  84
  85   my $count;
  86   my $parser;
  87   my @buffer = ();
  88
  89   if ( $type eq 'csv' ) {
  90
  91     eval "use Text::CSV_XS;";
  92     eval "use File::Slurp qw( slurp );";
  93     die $@ if $@;
  94
  95     $parser = new Text::CSV_XS;
  96
  97     @buffer = split(/\r?\n/, slurp($filename) );
  98     $count = scalar(@buffer);
  99
 100   } elsif ( $type eq 'xls' ) {
 101     eval "use Spreadsheet::ParseExcel;";
 102     die $@ if $@;
 103
 104     my $excel = Spreadsheet::ParseExcel::Workbook->new->Parse($filename);
 105     $parser = $excel->{Worksheet}[0]; #first sheet
 106
 107     $count = $parser->{MaxRow} || $parser->{MinRow};
 108     $count++;
 109
 110   } else {
 111     die "Unknown file type $type\n";
 112   }
 113
 114   my $imported = 0;
 115   #my $columns;
 116
 117   local $SIG{HUP} = 'IGNORE';
 118   local $SIG{INT} = 'IGNORE';
 119   local $SIG{QUIT} = 'IGNORE';
 120   local $SIG{TERM} = 'IGNORE';
 121   local $SIG{TSTP} = 'IGNORE';
 122   local $SIG{PIPE} = 'IGNORE';
 123
 124   my $oldAutoCommit = $FS::UID::AutoCommit;
 125   local $FS::UID::AutoCommit = 0;
 126   my $dbh = dbh;
 127
 128   my $line;
 129   my $row = 0;
 130   my %data = ();
 131   my( $last, $min_sec ) = ( time, 5 ); #progressbar foo
 132   while (1) {
 133     my @columns = ();
 134
 135     if ( $type eq 'csv' ) {
 136
 137       last unless scalar(@buffer);
 138       $line = shift(@buffer);
 139
 140       $parser->parse($line) or do {
 141         $dbh->rollback if $oldAutoCommit;
 142         return "can't parse: ". $parser->error_input();
 143       };
 144       @columns = $parser->fields();
 145
 146     } elsif ( $type eq 'xls' ) {
 147       last if $row > ($parser->{MaxRow} || $parser->{MinRow})
 148            || ! $parser->{Cells}[$row];
 149
 150       my @row = @{ $parser->{Cells}[$row] };
 151       @columns = map $_->{Val}, @row;
 152
 153     } else {
 154       die "Unknown file type $type\n";
 155     }
 156
 157     #warn join('-',@columns);
 158
 159     my %row = ();
 160     foreach my $field ( @fields ) {
 161       $row{$field} = shift @columns;
 162     }
 163
 164     if ( $row{custnum} && $row{agent_custid} ) {
 165       dbh->rollback if $oldAutoCommit;
 166       return "can't specify custnum with agent_custid $row{agent_custid}";
 167     }
 168
 169     my $id;
 170     my %hash = ();
 171
 172     if ( $row{agent_custid} && $agentnum ) {
 173       $id = $row{agent_custid};
 174       $data{$id}{cust} = {
 175         'agent_custid' => $row{agent_custid},
 176         'agentnum'     => $agentnum,
 177       };
 178       %hash = ( 'agent_custid' => $row{agent_custid},
 179                 'agentnum'     => $agentnum,
 180               );
 181     }
 182
 183     if ( $row{custnum} ) {
 184       $id = $row{custnum};
 185       $data{$id}{cust} = {
 186         'custnum' => $row{custnum},
 187         'testnum' => 'test',
 188       };
 189       %hash = ( 'custnum' => $row{custnum} );
 190     }
 191
 192     unless ( scalar(keys %hash) ) {
 193       $dbh->rollback if $oldAutoCommit;
 194       return "can't find customer without custnum or agent_custid and agentnum";
 195     }
 196
 197     ## add new pkg data or upate existing by adding new amount for custnum
 198     $data{$id}{pkg}{$row{pkg}} = $data{$id}{pkg}{$row{pkg}} ? $data{$id}{pkg}{$row{pkg}} + $row{'amount'} : $row{'amount'};
 199
 200     $row++;
 201
 202     if ( $job && time - $min_sec > $last ) { #progress bar
 203       $job->update_statustext( int(100 * $row / $count) );
 204       $last = time;
 205     }
 206
 207   }
 208
 209   ### run through data hash to post all charges.
 210   foreach my $k (keys %data) {
 211     my %pkg_hash  = %{$data{$k}{pkg}};
 212     my %cust_hash = %{$data{$k}{cust}};
 213
 214     my $cust_main = qsearchs('cust_main', { %cust_hash } );
 215     unless ( $cust_main ) {
 216       $dbh->rollback if $oldAutoCommit;
 217       my $custnum = $cust_hash{custnum} || $cust_hash{agent_custid};
 218       return "unknown custnum $custnum";
 219     }
 220
 221     foreach my $pkg_key (keys %pkg_hash) {
 222       my $pkg = $pkg_key;
 223       my $amount = $pkg_hash{$pkg_key};
 224
 225       if (%charges) { next unless $charges{$pkg}; }
 226
 227       if ( $amount > 0 ) {
 228         my $error = $cust_main->charge($amount, $pkg);
 229         if ( $error ) {
 230           $dbh->rollback if $oldAutoCommit;
 231           return $error;
 232         }
 233         $imported++;
 234       } elsif ( $amount < 0 ) {
 235         my $error = $cust_main->credit( sprintf( "%.2f", 0-$amount ), $pkg );
 236         if ( $error ) {
 237           $dbh->rollback if $oldAutoCommit;
 238           return $error;
 239         }
 240         $imported++;
 241       } else {
 242       #hmm?
 243       }
 244     }
 245
 246   }
 247
 248   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 249
 250   unlink $filename;
 251
 252   return "Empty file!" unless $imported;
 253
 254   ''; #no error
 255
 256 }
 257
 258 1;