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   ##should charges to charge be a config option?
  73     %charges = (
  74       'DISABILITY ACCESS/ENHANCED 911 SERVICES SURCHARGE' => '1',
  75       'FEDERAL TRS FUND'                                  => '1',
  76       'FEDERAL UNIVERSAL SERVICE FUND'                    => '1',
  77       'STATE SALES TAX'                                   => '1',
  78     );
  79   } else {
  80     die "unknown format $format";
  81   }
  82
  83   my $count;
  84   my $parser;
  85   my @buffer = ();
  86
  87   if ( $type eq 'csv' ) {
  88
  89     eval "use Text::CSV_XS;";
  90     eval "use File::Slurp qw( slurp );";
  91     die $@ if $@;
  92
  93     $parser = new Text::CSV_XS;
  94
  95     @buffer = split(/\r?\n/, slurp($filename) );
  96     $count = scalar(@buffer);
  97
  98   } elsif ( $type eq 'xls' ) {
  99     eval "use Spreadsheet::ParseExcel;";
 100     die $@ if $@;
 101
 102     my $excel = Spreadsheet::ParseExcel::Workbook->new->Parse($filename);
 103     $parser = $excel->{Worksheet}[0]; #first sheet
 104
 105     $count = $parser->{MaxRow} || $parser->{MinRow};
 106     $count++;
 107
 108   } else {
 109     die "Unknown file type $type\n";
 110   }
 111
 112   my $imported = 0;
 113   #my $columns;
 114
 115   local $SIG{HUP} = 'IGNORE';
 116   local $SIG{INT} = 'IGNORE';
 117   local $SIG{QUIT} = 'IGNORE';
 118   local $SIG{TERM} = 'IGNORE';
 119   local $SIG{TSTP} = 'IGNORE';
 120   local $SIG{PIPE} = 'IGNORE';
 121
 122   my $oldAutoCommit = $FS::UID::AutoCommit;
 123   local $FS::UID::AutoCommit = 0;
 124   my $dbh = dbh;
 125
 126   my $line;
 127   my $row = 0;
 128   my %data = ();
 129   my( $last, $min_sec ) = ( time, 5 ); #progressbar foo
 130   while (1) {
 131     my @columns = ();
 132
 133     if ( $type eq 'csv' ) {
 134
 135       last unless scalar(@buffer);
 136       $line = shift(@buffer);
 137
 138       $parser->parse($line) or do {
 139         $dbh->rollback if $oldAutoCommit;
 140         return "can't parse: ". $parser->error_input();
 141       };
 142       @columns = $parser->fields();
 143
 144     } elsif ( $type eq 'xls' ) {
 145       last if $row > ($parser->{MaxRow} || $parser->{MinRow})
 146            || ! $parser->{Cells}[$row];
 147
 148       my @row = @{ $parser->{Cells}[$row] };
 149       @columns = map $_->{Val}, @row;
 150
 151     } else {
 152       die "Unknown file type $type\n";
 153     }
 154
 155     #warn join('-',@columns);
 156
 157     my %row = ();
 158     foreach my $field ( @fields ) {
 159       $row{$field} = shift @columns;
 160     }
 161
 162     if ( $row{custnum} && $row{agent_custid} ) {
 163       dbh->rollback if $oldAutoCommit;
 164       return "can't specify custnum with agent_custid $row{agent_custid}";
 165     }
 166
 167     my $id;
 168     my %hash = ();
 169
 170     if ( $row{agent_custid} && $agentnum ) {
 171       $id = $row{agent_custid};
 172       $data{$id}{cust} = (
 173         'agent_custid' => $row{agent_custid},
 174         'agentnum'     => $agentnum,
 175       );
 176       %hash = ( 'agent_custid' => $row{agent_custid},
 177                 'agentnum'     => $agentnum,
 178               );
 179     }
 180
 181     if ( $row{custnum} ) {
 182       $id = $row{custnum};
 183       $data{$id}{cust} = {
 184         'custnum' => $row{custnum},
 185         'testnum' => 'test',
 186       };
 187       %hash = ( 'custnum' => $row{custnum} );
 188     }
 189
 190     unless ( scalar(keys %hash) ) {
 191       $dbh->rollback if $oldAutoCommit;
 192       return "can't find customer without custnum or agent_custid and agentnum";
 193     }
 194
 195     ## add new pkg data or upate existing by adding new amount for custnum
 196     $data{$id}{pkg}{$row{pkg}} = $data{$id}{pkg}{$row{pkg}} ? $data{$id}{pkg}{$row{pkg}} + $row{'amount'} : $row{'amount'};
 197
 198     $row++;
 199
 200     if ( $job && time - $min_sec > $last ) { #progress bar
 201       $job->update_statustext( int(100 * $row / $count) );
 202       $last = time;
 203     }
 204
 205   }
 206
 207   ### run through data hash to post all charges.
 208   foreach my $k (keys %data) {
 209     my %pkg_hash  = %{$data{$k}{pkg}};
 210     my %cust_hash = %{$data{$k}{cust}};
 211
 212     my $cust_main = qsearchs('cust_main', { %cust_hash } );
 213     unless ( $cust_main ) {
 214       $dbh->rollback if $oldAutoCommit;
 215       my $custnum = $cust_hash{custnum} || $cust_hash{agent_custid};
 216       return "unknown custnum $custnum";
 217     }
 218
 219     foreach my $pkg_key (keys %pkg_hash) {
 220       my $pkg = $pkg_key;
 221       my $amount = $pkg_hash{$pkg_key};
 222
 223       if (%charges) { next unless $charges{$pkg}; }
 224
 225       if ( $amount > 0 ) {
 226         my $error = $cust_main->charge($amount, $pkg);
 227         if ( $error ) {
 228           $dbh->rollback if $oldAutoCommit;
 229           return $error;
 230         }
 231         $imported++;
 232       } elsif ( $amount < 0 ) {
 233         my $error = $cust_main->credit( sprintf( "%.2f", 0-$amount ), $pkg );
 234         if ( $error ) {
 235           $dbh->rollback if $oldAutoCommit;
 236           return $error;
 237         }
 238         $imported++;
 239       } else {
 240       #hmm?
 241       }
 242     }
 243
 244   }
 245
 246   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 247
 248   unlink $filename;
 249
 250   return "Empty file!" unless $imported;
 251
 252   ''; #no error
 253
 254 }
 255
 256 1;