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 Storable qw(thaw);
   9 use MIME::Base64;
  10 use FS::CurrentUser;
  11 use FS::Record qw( qsearchs );
  12 use FS::cust_main;
  13 use FS::Conf;
  14
  15 my $DEBUG = '';
  16
  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";
  24       next;
  25     };
  26     my $mod = $1;
  27     my $info = eval "use FS::cust_main::import_charges::$mod; ".
  28                     "\\%FS::cust_main::import_charges::$mod\::info;";
  29     if ( $@ ) {
  30       die "error using FS::cust_main::import_charges::$mod (skipping): $@\n" if $@;
  31       next;
  32     }
  33     unless ( keys %$info ) {
  34       warn "no %info hash found in FS::cust_main::import_charges::$mod, skipping\n";
  35       next;
  36     }
  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;
  40       next;
  41     }
  42     $import_charges_info{$mod} = $info;
  43   }
  44 }
  45
  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;
  51
  52 sub import_formats {
  53   %import_formats;
  54 }
  55
  56 =head1 NAME
  57
  58 FS::cust_main::Import_Charges - Batch charge importing
  59
  60 =head1 SYNOPSIS
  61
  62   use FS::cust_main::Import_Charges;
  63
  64   my $error =
  65     FS::cust_main::Import_charges::batch_charge( {
  66       filehandle => $fh,
  67       'agentnum' => scalar($cgi->param('agentnum')),
  68       'format'   => scalar($cgi->param('format')),
  69     } );
  70
  71 =head1 DESCRIPTION
  72
  73 Batch customer charging.
  74
  75
  76 =head1 SUBROUTINES
  77
  78 =over 4
  79
  80 =item batch_charge
  81
  82 =cut
  83
  84 sub batch_charge {
  85   my $job = shift;
  86   my $param = thaw(decode_base64(shift));
  87   #warn join('-',keys %$param);
  88   my $agentnum = $param->{agentnum};
  89   my $format = $param->{format};
  90
  91   my $files = $param->{'uploaded_files'}
  92     or die "No files provided.\n";
  93
  94   my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files;
  95
  96   my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
  97   my $filename = $dir. $files{'file'};
  98
  99   my $type;
 100   if ( $filename =~ /\.(\w+)$/i ) {
 101     $type = lc($1);
 102   } else {
 103     #or error out???
 104     warn "can't parse file type from filename $filename; defaulting to CSV";
 105     $type = 'csv';
 106   }
 107
 108   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
 109
 110   my @fields;
 111   my %charges;
 112
 113   if ( $import_charges_info{$format} ) {
 114     @fields = @{$import_charges_info{$format}->{'fields'}};
 115     %charges = %{$import_charges_info{$format}->{'charges'}};
 116   } else {
 117     die "unknown format $format";
 118   }
 119
 120   my $count;
 121   my $parser;
 122   my @buffer = ();
 123
 124   if ( $type eq 'csv' ) {
 125
 126     eval "use Text::CSV_XS;";
 127     eval "use File::Slurp qw( slurp );";
 128     die $@ if $@;
 129
 130     $parser = new Text::CSV_XS;
 131
 132     @buffer = split(/\r?\n/, slurp($filename) );
 133     $count = scalar(@buffer);
 134
 135   } elsif ( $type eq 'xls' ) {
 136     eval "use Spreadsheet::ParseExcel;";
 137     die $@ if $@;
 138
 139     my $excel = Spreadsheet::ParseExcel::Workbook->new->Parse($filename);
 140     $parser = $excel->{Worksheet}[0]; #first sheet
 141
 142     $count = $parser->{MaxRow} || $parser->{MinRow};
 143     $count++;
 144
 145   } else {
 146     die "Unknown file type $type\n";
 147   }
 148
 149   my $imported = 0;
 150   #my $columns;
 151
 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';
 158
 159   my $oldAutoCommit = $FS::UID::AutoCommit;
 160   local $FS::UID::AutoCommit = 0;
 161   my $dbh = dbh;
 162
 163   my $line;
 164   my $row = 0;
 165   my %data = ();
 166   my( $last, $min_sec ) = ( time, 5 ); #progressbar foo
 167   while (1) {
 168     my @columns = ();
 169
 170     if ( $type eq 'csv' ) {
 171
 172       last unless scalar(@buffer);
 173       $line = shift(@buffer);
 174
 175       $parser->parse($line) or do {
 176         $dbh->rollback if $oldAutoCommit;
 177         return "can't parse: ". $parser->error_input();
 178       };
 179       @columns = $parser->fields();
 180
 181     } elsif ( $type eq 'xls' ) {
 182       last if $row > ($parser->{MaxRow} || $parser->{MinRow})
 183            || ! $parser->{Cells}[$row];
 184
 185       my @row = @{ $parser->{Cells}[$row] };
 186       @columns = map $_->{Val}, @row;
 187
 188     } else {
 189       die "Unknown file type $type\n";
 190     }
 191
 192     #warn join('-',@columns);
 193
 194     my %row = ();
 195     foreach my $field ( @fields ) {
 196       $row{$field} = shift @columns;
 197     }
 198
 199     if ( $row{custnum} && $row{agent_custid} ) {
 200       dbh->rollback if $oldAutoCommit;
 201       return "can't specify custnum with agent_custid $row{agent_custid}";
 202     }
 203
 204     my $id;
 205     my %hash = ();
 206
 207     if ( $row{agent_custid} && $agentnum ) {
 208       $id = $row{agent_custid};
 209       $data{$id}{cust} = {
 210         'agent_custid' => $row{agent_custid},
 211         'agentnum'     => $agentnum,
 212       };
 213       %hash = ( 'agent_custid' => $row{agent_custid},
 214                 'agentnum'     => $agentnum,
 215               );
 216     }
 217
 218     if ( $row{custnum} ) {
 219       $id = $row{custnum};
 220       $data{$id}{cust} = {
 221         'custnum' => $row{custnum},
 222         'testnum' => 'test',
 223       };
 224       %hash = ( 'custnum' => $row{custnum} );
 225     }
 226
 227     unless ( scalar(keys %hash) ) {
 228       $dbh->rollback if $oldAutoCommit;
 229       return "can't find customer without custnum or agent_custid and agentnum";
 230     }
 231
 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'};
 234
 235     $row++;
 236
 237     if ( $job && time - $min_sec > $last ) { #progress bar
 238       $job->update_statustext( int(100 * $row / $count) );
 239       $last = time;
 240     }
 241
 242   }
 243
 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}};
 248
 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";
 254     }
 255
 256     foreach my $pkg_key (keys %pkg_hash) {
 257       my $pkg = $pkg_key;
 258       my $amount = $pkg_hash{$pkg_key};
 259
 260       if (%charges) { next unless $charges{$pkg}; }
 261
 262       if ( $amount > 0 ) {
 263         my $error = $cust_main->charge($amount, $pkg);
 264         if ( $error ) {
 265           $dbh->rollback if $oldAutoCommit;
 266           return $error;
 267         }
 268         $imported++;
 269       } elsif ( $amount < 0 ) {
 270         my $error = $cust_main->credit( sprintf( "%.2f", 0-$amount ), $pkg );
 271         if ( $error ) {
 272           $dbh->rollback if $oldAutoCommit;
 273           return $error;
 274         }
 275         $imported++;
 276       } else {
 277       #hmm?
 278       }
 279     }
 280
 281   }
 282
 283   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 284
 285   unlink $filename;
 286
 287   return "Empty file!" unless $imported;
 288
 289   ''; #no error
 290
 291 }
 292
 293 1;