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 Text::CSV_XS;
   8 use FS::UID qw( dbh );
   9 use FS::CurrentUser;
  10 use FS::Record qw( qsearchs );
  11 use FS::cust_main;
  12
  13 =head1 NAME
  14
  15 FS::cust_main::Import_Charges - Batch charge importing
  16
  17 =head1 SYNOPSIS
  18
  19   use FS::cust_main::Import_Charges;
  20
  21   my $error =
  22     FS::cust_main::Import_charges::batch_charge( {
  23       filehandle => $fh,
  24       'agentnum' => scalar($cgi->param('agentnum')),
  25       'format'   => scalar($cgi->param('format')),
  26     } );
  27
  28 =head1 DESCRIPTION
  29
  30 Batch customer charging.
  31
  32
  33 =head1 SUBROUTINES
  34
  35 =over 4
  36
  37 =item batch_charge
  38
  39 =cut
  40
  41 sub batch_charge {
  42   my $param = shift;
  43   #warn join('-',keys %$param);
  44   my $fh = $param->{filehandle};
  45   my $agentnum = $param->{agentnum};
  46   my $format = $param->{format};
  47
  48   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
  49
  50   my @fields;
  51   if ( $format eq 'simple' ) {
  52     @fields = qw( custnum agent_custid amount pkg );
  53   } else {
  54     die "unknown format $format";
  55   }
  56
  57   my $csv = new Text::CSV_XS;
  58   #warn $csv;
  59   #warn $fh;
  60
  61   my $imported = 0;
  62   #my $columns;
  63
  64   local $SIG{HUP} = 'IGNORE';
  65   local $SIG{INT} = 'IGNORE';
  66   local $SIG{QUIT} = 'IGNORE';
  67   local $SIG{TERM} = 'IGNORE';
  68   local $SIG{TSTP} = 'IGNORE';
  69   local $SIG{PIPE} = 'IGNORE';
  70
  71   my $oldAutoCommit = $FS::UID::AutoCommit;
  72   local $FS::UID::AutoCommit = 0;
  73   my $dbh = dbh;
  74
  75   #while ( $columns = $csv->getline($fh) ) {
  76   my $line;
  77   while ( defined($line=<$fh>) ) {
  78
  79     $csv->parse($line) or do {
  80       $dbh->rollback if $oldAutoCommit;
  81       return "can't parse: ". $csv->error_input();
  82     };
  83
  84     my @columns = $csv->fields();
  85     #warn join('-',@columns);
  86
  87     my %row = ();
  88     foreach my $field ( @fields ) {
  89       $row{$field} = shift @columns;
  90     }
  91
  92     if ( $row{custnum} && $row{agent_custid} ) {
  93       dbh->rollback if $oldAutoCommit;
  94       return "can't specify custnum with agent_custid $row{agent_custid}";
  95     }
  96
  97     my %hash = ();
  98     if ( $row{agent_custid} && $agentnum ) {
  99       %hash = ( 'agent_custid' => $row{agent_custid},
 100                 'agentnum'     => $agentnum,
 101               );
 102     }
 103
 104     if ( $row{custnum} ) {
 105       %hash = ( 'custnum' => $row{custnum} );
 106     }
 107
 108     unless ( scalar(keys %hash) ) {
 109       $dbh->rollback if $oldAutoCommit;
 110       return "can't find customer without custnum or agent_custid and agentnum";
 111     }
 112
 113     my $cust_main = qsearchs('cust_main', { %hash } );
 114     unless ( $cust_main ) {
 115       $dbh->rollback if $oldAutoCommit;
 116       my $custnum = $row{custnum} || $row{agent_custid};
 117       return "unknown custnum $custnum";
 118     }
 119
 120     if ( $row{'amount'} > 0 ) {
 121       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
 122       if ( $error ) {
 123         $dbh->rollback if $oldAutoCommit;
 124         return $error;
 125       }
 126       $imported++;
 127     } elsif ( $row{'amount'} < 0 ) {
 128       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
 129                                       $row{'pkg'}                         );
 130       if ( $error ) {
 131         $dbh->rollback if $oldAutoCommit;
 132         return $error;
 133       }
 134       $imported++;
 135     } else {
 136       #hmm?
 137     }
 138
 139   }
 140
 141   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 142
 143   return "Empty file!" unless $imported;
 144
 145   ''; #no error
 146
 147 }
 148
 149 1;