FS/FS/cust_pay.pm

   1 package FS::cust_pay;
   2
   3 use strict;
   4 use vars qw( @ISA $DEBUG $me $conf @encrypted_fields
   5              $unsuspendauto $ignore_noapply
   6            );
   7 use Date::Format;
   8 use Business::CreditCard;
   9 use Text::Template;
  10 use FS::UID qw( getotaker );
  11 use FS::Misc qw( send_email );
  12 use FS::Record qw( dbh qsearch qsearchs );
  13 use FS::payby;
  14 use FS::cust_main_Mixin;
  15 use FS::payinfo_Mixin;
  16 use FS::cust_bill;
  17 use FS::cust_bill_pay;
  18 use FS::cust_pay_refund;
  19 use FS::cust_main;
  20 use FS::cust_pay_void;
  21
  22 @ISA = qw( FS::Record FS::cust_main_Mixin FS::payinfo_Mixin );
  23
  24 $DEBUG = 0;
  25
  26 $me = '[FS::cust_pay]';
  27
  28 $ignore_noapply = 0;
  29
  30 #ask FS::UID to run this stuff for us later
  31 FS::UID->install_callback( sub {
  32   $conf = new FS::Conf;
  33   $unsuspendauto = $conf->exists('unsuspendauto');
  34 } );
  35
  36 @encrypted_fields = ('payinfo');
  37
  38 =head1 NAME
  39
  40 FS::cust_pay - Object methods for cust_pay objects
  41
  42 =head1 SYNOPSIS
  43
  44   use FS::cust_pay;
  45
  46   $record = new FS::cust_pay \%hash;
  47   $record = new FS::cust_pay { 'column' => 'value' };
  48
  49   $error = $record->insert;
  50
  51   $error = $new_record->replace($old_record);
  52
  53   $error = $record->delete;
  54
  55   $error = $record->check;
  56
  57 =head1 DESCRIPTION
  58
  59 An FS::cust_pay object represents a payment; the transfer of money from a
  60 customer.  FS::cust_pay inherits from FS::Record.  The following fields are
  61 currently supported:
  62
  63 =over 4
  64
  65 =item paynum - primary key (assigned automatically for new payments)
  66
  67 =item custnum - customer (see L<FS::cust_main>)
  68
  69 =item _date - specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
  70 L<Time::Local> and L<Date::Parse> for conversion functions.
  71
  72 =item paid - Amount of this payment
  73
  74 =item otaker - order taker (assigned automatically, see L<FS::UID>)
  75
  76 =item payby - Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
  77
  78 =item payinfo - Payment Information (See L<FS::payinfo_Mixin> for data format)
  79
  80 =item paymask - Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
  81
  82 =item paybatch - text field for tracking card processing or other batch grouping
  83
  84 =item payunique - Optional unique identifer to prevent duplicate transactions.
  85
  86 =item closed - books closed flag, empty or `Y'
  87
  88 =back
  89
  90 =head1 METHODS
  91
  92 =over 4
  93
  94 =item new HASHREF
  95
  96 Creates a new payment.  To add the payment to the databse, see L<"insert">.
  97
  98 =cut
  99
 100 sub table { 'cust_pay'; }
 101 sub cust_linked { $_[0]->cust_main_custnum; }
 102 sub cust_unlinked_msg {
 103   my $self = shift;
 104   "WARNING: can't find cust_main.custnum ". $self->custnum.
 105   ' (cust_pay.paynum '. $self->paynum. ')';
 106 }
 107
 108 =item insert
 109
 110 Adds this payment to the database.
 111
 112 For backwards-compatibility and convenience, if the additional field invnum
 113 is defined, an FS::cust_bill_pay record for the full amount of the payment
 114 will be created.  In this case, custnum is optional.  An hash of optional
 115 arguments may be passed.  Currently "manual" is supported.  If true, a
 116 payment receipt is sent instead of a statement when 'payment_receipt_email'
 117 configuration option is set.
 118
 119 =cut
 120
 121 sub insert {
 122   my ($self, %options) = @_;
 123
 124   local $SIG{HUP} = 'IGNORE';
 125   local $SIG{INT} = 'IGNORE';
 126   local $SIG{QUIT} = 'IGNORE';
 127   local $SIG{TERM} = 'IGNORE';
 128   local $SIG{TSTP} = 'IGNORE';
 129   local $SIG{PIPE} = 'IGNORE';
 130
 131   my $oldAutoCommit = $FS::UID::AutoCommit;
 132   local $FS::UID::AutoCommit = 0;
 133   my $dbh = dbh;
 134
 135   my $cust_bill;
 136   if ( $self->invnum ) {
 137     $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
 138       or do {
 139         $dbh->rollback if $oldAutoCommit;
 140         return "Unknown cust_bill.invnum: ". $self->invnum;
 141       };
 142     $self->custnum($cust_bill->custnum );
 143   }
 144
 145
 146   my $error = $self->check;
 147   return $error if $error;
 148
 149   my $cust_main = $self->cust_main;
 150   my $old_balance = $cust_main->balance;
 151
 152   $error = $self->SUPER::insert;
 153   if ( $error ) {
 154     $dbh->rollback if $oldAutoCommit;
 155     return "error inserting $self: $error";
 156   }
 157
 158   if ( $self->invnum ) {
 159     my $cust_bill_pay = new FS::cust_bill_pay {
 160       'invnum' => $self->invnum,
 161       'paynum' => $self->paynum,
 162       'amount' => $self->paid,
 163       '_date'  => $self->_date,
 164     };
 165     $error = $cust_bill_pay->insert;
 166     if ( $error ) {
 167       if ( $ignore_noapply ) {
 168         warn "warning: error inserting $cust_bill_pay: $error ".
 169              "(ignore_noapply flag set; inserting cust_pay record anyway)\n";
 170       } else {
 171         $dbh->rollback if $oldAutoCommit;
 172         return "error inserting $cust_bill_pay: $error";
 173       }
 174     }
 175   }
 176
 177   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 178
 179   #false laziness w/ cust_credit::insert
 180   if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) {
 181     my @errors = $cust_main->unsuspend;
 182     #return
 183     # side-fx with nested transactions?  upstack rolls back?
 184     warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ".
 185          join(' / ', @errors)
 186       if @errors;
 187   }
 188   #eslaf
 189
 190   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 191
 192   #my $cust_main = $self->cust_main;
 193   if ( $conf->exists('payment_receipt_email')
 194        && grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list
 195   ) {
 196
 197     $cust_bill ||= ($cust_main->cust_bill)[-1]; #rather inefficient though?
 198
 199     my $error;
 200     if (    ( exists($options{'manual'}) && $options{'manual'} )
 201          || ! $conf->exists('invoice_html_statement')
 202          || ! $cust_bill
 203        ) {
 204
 205       my $receipt_template = new Text::Template (
 206         TYPE   => 'ARRAY',
 207         SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ],
 208       ) or do {
 209         warn "can't create payment receipt template: $Text::Template::ERROR";
 210         return '';
 211       };
 212
 213       my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ }
 214                              $cust_main->invoicing_list;
 215
 216       my $payby = $self->payby;
 217       my $payinfo = $self->payinfo;
 218       $payby =~ s/^BILL$/Check/ if $payinfo;
 219       $payinfo = $self->paymask if $payby eq 'CARD' || $payby eq 'CHEK';
 220       $payby =~ s/^CHEK$/Electronic check/;
 221
 222       $error = send_email(
 223         'from'    => $conf->config('invoice_from'), #??? well as good as any
 224         'to'      => \@invoicing_list,
 225         'subject' => 'Payment receipt',
 226         'body'    => [ $receipt_template->fill_in( HASH => {
 227                        'date'    => time2str("%a %B %o, %Y", $self->_date),
 228                        'name'    => $cust_main->name,
 229                        'paynum'  => $self->paynum,
 230                        'paid'    => sprintf("%.2f", $self->paid),
 231                        'payby'   => ucfirst(lc($payby)),
 232                        'payinfo' => $payinfo,
 233                        'balance' => $cust_main->balance,
 234                      } ) ],
 235       );
 236
 237     } else {
 238
 239       my $queue = new FS::queue {
 240          'paynum' => $self->paynum,
 241          'job'    => 'FS::cust_bill::queueable_email',
 242       };
 243       $error = $queue->insert(
 244         'invnum' => $cust_bill->invnum,
 245         'template' => 'statement',
 246       );
 247
 248     }
 249
 250     if ( $error ) {
 251       warn "can't send payment receipt/statement: $error";
 252     }
 253
 254   }
 255
 256   '';
 257
 258 }
 259
 260 =item void [ REASON ]
 261
 262 Voids this payment: deletes the payment and all associated applications and
 263 adds a record of the voided payment to the FS::cust_pay_void table.
 264
 265 =cut
 266
 267 sub void {
 268   my $self = shift;
 269
 270   local $SIG{HUP} = 'IGNORE';
 271   local $SIG{INT} = 'IGNORE';
 272   local $SIG{QUIT} = 'IGNORE';
 273   local $SIG{TERM} = 'IGNORE';
 274   local $SIG{TSTP} = 'IGNORE';
 275   local $SIG{PIPE} = 'IGNORE';
 276
 277   my $oldAutoCommit = $FS::UID::AutoCommit;
 278   local $FS::UID::AutoCommit = 0;
 279   my $dbh = dbh;
 280
 281   my $cust_pay_void = new FS::cust_pay_void ( {
 282     map { $_ => $self->get($_) } $self->fields
 283   } );
 284   $cust_pay_void->reason(shift) if scalar(@_);
 285   my $error = $cust_pay_void->insert;
 286   if ( $error ) {
 287     $dbh->rollback if $oldAutoCommit;
 288     return $error;
 289   }
 290
 291   $error = $self->delete;
 292   if ( $error ) {
 293     $dbh->rollback if $oldAutoCommit;
 294     return $error;
 295   }
 296
 297   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 298
 299   '';
 300
 301 }
 302
 303 =item delete
 304
 305 Unless the closed flag is set, deletes this payment and all associated
 306 applications (see L<FS::cust_bill_pay> and L<FS::cust_pay_refund>).  In most
 307 cases, you want to use the void method instead to leave a record of the
 308 deleted payment.
 309
 310 =cut
 311
 312 # very similar to FS::cust_credit::delete
 313 sub delete {
 314   my $self = shift;
 315   return "Can't delete closed payment" if $self->closed =~ /^Y/i;
 316
 317   local $SIG{HUP} = 'IGNORE';
 318   local $SIG{INT} = 'IGNORE';
 319   local $SIG{QUIT} = 'IGNORE';
 320   local $SIG{TERM} = 'IGNORE';
 321   local $SIG{TSTP} = 'IGNORE';
 322   local $SIG{PIPE} = 'IGNORE';
 323
 324   my $oldAutoCommit = $FS::UID::AutoCommit;
 325   local $FS::UID::AutoCommit = 0;
 326   my $dbh = dbh;
 327
 328   foreach my $app ( $self->cust_bill_pay, $self->cust_pay_refund ) {
 329     my $error = $app->delete;
 330     if ( $error ) {
 331       $dbh->rollback if $oldAutoCommit;
 332       return $error;
 333     }
 334   }
 335
 336   my $error = $self->SUPER::delete(@_);
 337   if ( $error ) {
 338     $dbh->rollback if $oldAutoCommit;
 339     return $error;
 340   }
 341
 342   if ( $conf->config('deletepayments') ne '' ) {
 343
 344     my $cust_main = $self->cust_main;
 345
 346     my $error = send_email(
 347       'from'    => $conf->config('invoice_from'), #??? well as good as any
 348       'to'      => $conf->config('deletepayments'),
 349       'subject' => 'FREESIDE NOTIFICATION: Payment deleted',
 350       'body'    => [
 351         "This is an automatic message from your Freeside installation\n",
 352         "informing you that the following payment has been deleted:\n",
 353         "\n",
 354         'paynum: '. $self->paynum. "\n",
 355         'custnum: '. $self->custnum.
 356           " (". $cust_main->last. ", ". $cust_main->first. ")\n",
 357         'paid: $'. sprintf("%.2f", $self->paid). "\n",
 358         'date: '. time2str("%a %b %e %T %Y", $self->_date). "\n",
 359         'payby: '. $self->payby. "\n",
 360         'payinfo: '. $self->paymask. "\n",
 361         'paybatch: '. $self->paybatch. "\n",
 362       ],
 363     );
 364
 365     if ( $error ) {
 366       $dbh->rollback if $oldAutoCommit;
 367       return "can't send payment deletion notification: $error";
 368     }
 369
 370   }
 371
 372   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 373
 374   '';
 375
 376 }
 377
 378 =item replace OLD_RECORD
 379
 380 You can, but probably shouldn't modify payments...
 381
 382 =cut
 383
 384 sub replace {
 385   #return "Can't modify payment!"
 386   my $self = shift;
 387   return "Can't modify closed payment" if $self->closed =~ /^Y/i;
 388   $self->SUPER::replace(@_);
 389 }
 390
 391 =item check
 392
 393 Checks all fields to make sure this is a valid payment.  If there is an error,
 394 returns the error, otherwise returns false.  Called by the insert method.
 395
 396 =cut
 397
 398 sub check {
 399   my $self = shift;
 400
 401   $self->otaker(getotaker) unless ($self->otaker);
 402
 403   my $error =
 404     $self->ut_numbern('paynum')
 405     || $self->ut_numbern('custnum')
 406     || $self->ut_numbern('_date')
 407     || $self->ut_money('paid')
 408     || $self->ut_alpha('otaker')
 409     || $self->ut_textn('paybatch')
 410     || $self->ut_textn('payunique')
 411     || $self->ut_enum('closed', [ '', 'Y' ])
 412     || $self->payinfo_check()
 413   ;
 414   return $error if $error;
 415
 416   return "paid must be > 0 " if $self->paid <= 0;
 417
 418   return "unknown cust_main.custnum: ". $self->custnum
 419     unless $self->invnum
 420            || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 421
 422   $self->_date(time) unless $self->_date;
 423
 424 #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it
 425 #  # UNIQUE index should catch this too, without race conditions, but this
 426 #  # should give a better error message the other 99.9% of the time...
 427 #  if ( length($self->payunique)
 428 #       && qsearchs('cust_pay', { 'payunique' => $self->payunique } ) ) {
 429 #    #well, it *could* be a better error message
 430 #    return "duplicate transaction".
 431 #           " - a payment with unique identifer ". $self->payunique.
 432 #           " already exists";
 433 #  }
 434
 435   $self->SUPER::check;
 436 }
 437
 438 =item batch_insert CUST_PAY_OBJECT, ...
 439
 440 Class method which inserts multiple payments.  Takes a list of FS::cust_pay
 441 objects.  Returns a list, each element representing the status of inserting the
 442 corresponding payment - empty.  If there is an error inserting any payment, the
 443 entire transaction is rolled back, i.e. all payments are inserted or none are.
 444
 445 For example:
 446
 447   my @errors = FS::cust_pay->batch_insert(@cust_pay);
 448   my $num_errors = scalar(grep $_, @errors);
 449   if ( $num_errors == 0 ) {
 450     #success; all payments were inserted
 451   } else {
 452     #failure; no payments were inserted.
 453   }
 454
 455 =cut
 456
 457 sub batch_insert {
 458   my $self = shift; #class method
 459
 460   local $SIG{HUP} = 'IGNORE';
 461   local $SIG{INT} = 'IGNORE';
 462   local $SIG{QUIT} = 'IGNORE';
 463   local $SIG{TERM} = 'IGNORE';
 464   local $SIG{TSTP} = 'IGNORE';
 465   local $SIG{PIPE} = 'IGNORE';
 466
 467   my $oldAutoCommit = $FS::UID::AutoCommit;
 468   local $FS::UID::AutoCommit = 0;
 469   my $dbh = dbh;
 470
 471   my $errors = 0;
 472
 473   my @errors = map {
 474     my $error = $_->insert( 'manual' => 1 );
 475     if ( $error ) {
 476       $errors++;
 477     } else {
 478       $_->cust_main->apply_payments;
 479     }
 480     $error;
 481   } @_;
 482
 483   if ( $errors ) {
 484     $dbh->rollback if $oldAutoCommit;
 485   } else {
 486     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 487   }
 488
 489   @errors;
 490
 491 }
 492
 493 =item cust_bill_pay
 494
 495 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
 496 payment.
 497
 498 =cut
 499
 500 sub cust_bill_pay {
 501   my $self = shift;
 502   sort {    $a->_date  <=> $b->_date
 503          || $a->invnum <=> $b->invnum }
 504     qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
 505   ;
 506 }
 507
 508 =item cust_pay_refund
 509
 510 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
 511 payment.
 512
 513 =cut
 514
 515 sub cust_pay_refund {
 516   my $self = shift;
 517   sort { $a->_date <=> $b->_date }
 518     qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
 519   ;
 520 }
 521
 522
 523 =item unapplied
 524
 525 Returns the amount of this payment that is still unapplied; which is
 526 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
 527 applications (see L<FS::cust_pay_refund>).
 528
 529 =cut
 530
 531 sub unapplied {
 532   my $self = shift;
 533   my $amount = $self->paid;
 534   $amount -= $_->amount foreach ( $self->cust_bill_pay );
 535   $amount -= $_->amount foreach ( $self->cust_pay_refund );
 536   sprintf("%.2f", $amount );
 537 }
 538
 539 =item unrefunded
 540
 541 Returns the amount of this payment that has not been refuned; which is
 542 paid minus all  refund applications (see L<FS::cust_pay_refund>).
 543
 544 =cut
 545
 546 sub unrefunded {
 547   my $self = shift;
 548   my $amount = $self->paid;
 549   $amount -= $_->amount foreach ( $self->cust_pay_refund );
 550   sprintf("%.2f", $amount );
 551 }
 552
 553
 554 =item cust_main
 555
 556 Returns the parent customer object (see L<FS::cust_main>).
 557
 558 =cut
 559
 560 sub cust_main {
 561   my $self = shift;
 562   qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 563 }
 564
 565 =item payby_name
 566
 567 Returns a name for the payby field.
 568
 569 =cut
 570
 571 sub payby_name {
 572   my $self = shift;
 573   if ( $self->payby eq 'BILL' ) { #kludge
 574     'Check';
 575   } else {
 576     FS::payby->shortname( $self->payby );
 577   }
 578 }
 579
 580 =item gatewaynum
 581
 582 Returns a gatewaynum for the processing gateway.
 583
 584 =item processor
 585
 586 Returns a name for the processing gateway.
 587
 588 =item authorization
 589
 590 Returns a name for the processing gateway.
 591
 592 =item order_number
 593
 594 Returns a name for the processing gateway.
 595
 596 =cut
 597
 598 sub gatewaynum    { shift->_parse_paybatch->{'gatewaynum'}; }
 599 sub processor     { shift->_parse_paybatch->{'processor'}; }
 600 sub authorization { shift->_parse_paybatch->{'authorization'}; }
 601 sub order_number  { shift->_parse_paybatch->{'order_number'}; }
 602
 603 #sucks that this stuff is in paybatch like this in the first place,
 604 #but at least other code can start to use new field names
 605 #(code nicked from FS::cust_main::realtime_refund_bop)
 606 sub _parse_paybatch {
 607   my $self = shift;
 608
 609   $self->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
 610     or return {};
 611               #"Can't parse paybatch for paynum $options{'paynum'}: ".
 612               #  $cust_pay->paybatch;
 613
 614   my( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
 615
 616   if ( $gatewaynum ) { #gateway for the payment to be refunded
 617
 618     my $payment_gateway =
 619       qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
 620
 621     die "payment gateway $gatewaynum not found" #?
 622       unless $payment_gateway;
 623
 624     $processor = $payment_gateway->gateway_module;
 625
 626   }
 627
 628   {
 629     'gatewaynum'    => $gatewaynum,
 630     'processor'     => $processor,
 631     'authorization' => $auth,
 632     'order_number'  => $order_number,
 633   };
 634
 635 }
 636
 637 =back
 638
 639 =head1 CLASS METHODS
 640
 641 =over 4
 642
 643 =item unapplied_sql
 644
 645 Returns an SQL fragment to retreive the unapplied amount.
 646
 647 =cut
 648
 649 sub unapplied_sql {
 650   #my $class = shift;
 651
 652   "paid
 653         - COALESCE(
 654                     ( SELECT SUM(amount) FROM cust_bill_pay
 655                         WHERE cust_pay.paynum = cust_bill_pay.paynum )
 656                     ,0
 657                   )
 658         - COALESCE(
 659                     ( SELECT SUM(amount) FROM cust_pay_refund
 660                         WHERE cust_pay.paynum = cust_pay_refund.paynum )
 661                     ,0
 662                   )
 663   ";
 664
 665 }
 666
 667 # _upgrade_data
 668 #
 669 # Used by FS::Upgrade to migrate to a new database.
 670
 671 use FS::h_cust_pay;
 672
 673 sub _upgrade_data {  #class method
 674   my ($class, %opts) = @_;
 675
 676   warn "$me upgrading $class\n" if $DEBUG;
 677
 678   #not the most efficient, but hey, it only has to run once
 679
 680   my $where = "WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' ) ".
 681               "  AND 0 < ( SELECT COUNT(*) FROM cust_main                 ".
 682               "              WHERE cust_main.custnum = cust_pay.custnum ) ";
 683
 684   my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
 685
 686   my $sth = dbh->prepare($count_sql) or die dbh->errstr;
 687   $sth->execute or die $sth->errstr;
 688   my $total = $sth->fetchrow_arrayref->[0];
 689
 690   local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
 691
 692   my $count = 0;
 693   my $lastprog = 0;
 694
 695   my @cust_pay = qsearch( {
 696       'table'     => 'cust_pay',
 697       'hashref'   => {},
 698       'extra_sql' => $where,
 699       'order_by'  => 'ORDER BY paynum',
 700   } );
 701
 702   foreach my $cust_pay (@cust_pay) {
 703
 704     my $h_cust_pay = $cust_pay->h_search('insert');
 705     if ( $h_cust_pay ) {
 706       next if $cust_pay->otaker eq $h_cust_pay->history_user;
 707       $cust_pay->otaker($h_cust_pay->history_user);
 708     } else {
 709       $cust_pay->otaker('legacy');
 710     }
 711
 712     delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
 713     my $error = $cust_pay->replace;
 714
 715     if ( $error ) {
 716       warn " *** WARNING: Error updaating order taker for payment paynum".
 717            $cust_pay->paynun. ": $error\n";
 718       next;
 719     }
 720
 721     $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
 722
 723     $count++;
 724     if ( $DEBUG > 1 && $lastprog + 30 < time ) {
 725       warn "$me $count/$total (". sprintf('%.2f',100*$count/$total). '%)'. "\n";
 726       $lastprog = time;
 727     }
 728
 729   }
 730
 731 }
 732
 733 =back
 734
 735 =head1 SUBROUTINES
 736
 737 =over 4
 738
 739 =item batch_import HASHREF
 740
 741 Inserts new payments.
 742
 743 =cut
 744
 745 sub batch_import {
 746   my $param = shift;
 747
 748   my $fh = $param->{filehandle};
 749   my $agentnum = $param->{agentnum};
 750   my $format = $param->{'format'};
 751   my $paybatch = $param->{'paybatch'};
 752
 753   # here is the agent virtualization
 754   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
 755
 756   my @fields;
 757   my $payby;
 758   if ( $format eq 'simple' ) {
 759     @fields = qw( custnum agent_custid paid payinfo );
 760     $payby = 'BILL';
 761   } elsif ( $format eq 'extended' ) {
 762     die "unimplemented\n";
 763     @fields = qw( );
 764     $payby = 'BILL';
 765   } else {
 766     die "unknown format $format";
 767   }
 768
 769   eval "use Text::CSV_XS;";
 770   die $@ if $@;
 771
 772   my $csv = new Text::CSV_XS;
 773
 774   my $imported = 0;
 775
 776   local $SIG{HUP} = 'IGNORE';
 777   local $SIG{INT} = 'IGNORE';
 778   local $SIG{QUIT} = 'IGNORE';
 779   local $SIG{TERM} = 'IGNORE';
 780   local $SIG{TSTP} = 'IGNORE';
 781   local $SIG{PIPE} = 'IGNORE';
 782
 783   my $oldAutoCommit = $FS::UID::AutoCommit;
 784   local $FS::UID::AutoCommit = 0;
 785   my $dbh = dbh;
 786
 787   my $line;
 788   while ( defined($line=<$fh>) ) {
 789
 790     $csv->parse($line) or do {
 791       $dbh->rollback if $oldAutoCommit;
 792       return "can't parse: ". $csv->error_input();
 793     };
 794
 795     my @columns = $csv->fields();
 796
 797     my %cust_pay = (
 798       payby    => $payby,
 799       paybatch => $paybatch,
 800     );
 801
 802     my $cust_main;
 803     foreach my $field ( @fields ) {
 804
 805       if ( $field eq 'agent_custid'
 806         && $agentnum
 807         && $columns[0] =~ /\S+/ )
 808       {
 809
 810         my $agent_custid = $columns[0];
 811         my %hash = ( 'agent_custid' => $agent_custid,
 812                      'agentnum'     => $agentnum,
 813                    );
 814
 815         if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
 816           $dbh->rollback if $oldAutoCommit;
 817           return "can't specify custnum with agent_custid $agent_custid";
 818         }
 819
 820         $cust_main = qsearchs({
 821                                 'table'     => 'cust_main',
 822                                 'hashref'   => \%hash,
 823                                 'extra_sql' => $extra_sql,
 824                              });
 825
 826         unless ( $cust_main ) {
 827           $dbh->rollback if $oldAutoCommit;
 828           return "can't find customer with agent_custid $agent_custid";
 829         }
 830
 831         $field = 'custnum';
 832         $columns[0] = $cust_main->custnum;
 833       }
 834
 835       $cust_pay{$field} = shift @columns;
 836     }
 837
 838     my $cust_pay = new FS::cust_pay( \%cust_pay );
 839     my $error = $cust_pay->insert;
 840
 841     if ( $error ) {
 842       $dbh->rollback if $oldAutoCommit;
 843       return "can't insert payment for $line: $error";
 844     }
 845
 846     if ( $format eq 'simple' ) {
 847       # include agentnum for less surprise?
 848       $cust_main = qsearchs({
 849                              'table'     => 'cust_main',
 850                              'hashref'   => { 'custnum' => $cust_pay->custnum },
 851                              'extra_sql' => $extra_sql,
 852                            })
 853         unless $cust_main;
 854
 855       unless ( $cust_main ) {
 856         $dbh->rollback if $oldAutoCommit;
 857         return "can't find customer to which payments apply at line: $line";
 858       }
 859
 860       $error = $cust_main->apply_payments_and_credits;
 861       if ( $error ) {
 862         $dbh->rollback if $oldAutoCommit;
 863         return "can't apply payments to customer for $line: $error";
 864       }
 865
 866     }
 867
 868     $imported++;
 869   }
 870
 871   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 872
 873   return "Empty file!" unless $imported;
 874
 875   ''; #no error
 876
 877 }
 878
 879 =back
 880
 881 =head1 BUGS
 882
 883 Delete and replace methods.
 884
 885 =head1 SEE ALSO
 886
 887 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
 888 schema.html from the base documentation.
 889
 890 =cut
 891
 892 1;
 893