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