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