FS/FS/cust_main.pm

   1 package FS::cust_main;
   2
   3 use strict;
   4 use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields
   5              $import $skip_fuzzyfiles $ignore_expired_card );
   6 use vars qw( $realtime_bop_decline_quiet ); #ugh
   7 use Safe;
   8 use Carp;
   9 use Exporter;
  10 BEGIN {
  11   eval "use Time::Local;";
  12   die "Time::Local minimum version 1.05 required with Perl versions before 5.6"
  13     if $] < 5.006 && !defined($Time::Local::VERSION);
  14   #eval "use Time::Local qw(timelocal timelocal_nocheck);";
  15   eval "use Time::Local qw(timelocal_nocheck);";
  16 }
  17 use Digest::MD5 qw(md5_base64);
  18 use Date::Format;
  19 use Date::Parse;
  20 #use Date::Manip;
  21 use String::Approx qw(amatch);
  22 use Business::CreditCard 0.28;
  23 use FS::UID qw( getotaker dbh );
  24 use FS::Record qw( qsearchs qsearch dbdef );
  25 use FS::Misc qw( send_email );
  26 use FS::Msgcat qw(gettext);
  27 use FS::cust_pkg;
  28 use FS::cust_svc;
  29 use FS::cust_bill;
  30 use FS::cust_bill_pkg;
  31 use FS::cust_pay;
  32 use FS::cust_pay_void;
  33 use FS::cust_credit;
  34 use FS::cust_refund;
  35 use FS::part_referral;
  36 use FS::cust_main_county;
  37 use FS::agent;
  38 use FS::cust_main_invoice;
  39 use FS::cust_credit_bill;
  40 use FS::cust_bill_pay;
  41 use FS::prepay_credit;
  42 use FS::queue;
  43 use FS::part_pkg;
  44 use FS::part_bill_event;
  45 use FS::cust_bill_event;
  46 use FS::cust_tax_exempt;
  47 use FS::cust_tax_exempt_pkg;
  48 use FS::type_pkgs;
  49 use FS::payment_gateway;
  50 use FS::agent_payment_gateway;
  51 use FS::banned_pay;
  52
  53 @ISA = qw( FS::Record );
  54
  55 @EXPORT_OK = qw( smart_search );
  56
  57 $realtime_bop_decline_quiet = 0;
  58
  59 # 1 is mostly method/subroutine entry and options
  60 # 2 traces progress of some operations
  61 # 3 is even more information including possibly sensitive data
  62 $DEBUG = 0;
  63 $me = '[FS::cust_main]';
  64
  65 $import = 0;
  66 $skip_fuzzyfiles = 0;
  67 $ignore_expired_card = 0;
  68
  69 @encrypted_fields = ('payinfo', 'paycvv');
  70
  71 #ask FS::UID to run this stuff for us later
  72 #$FS::UID::callback{'FS::cust_main'} = sub {
  73 install_callback FS::UID sub {
  74   $conf = new FS::Conf;
  75   #yes, need it for stuff below (prolly should be cached)
  76 };
  77
  78 sub _cache {
  79   my $self = shift;
  80   my ( $hashref, $cache ) = @_;
  81   if ( exists $hashref->{'pkgnum'} ) {
  82 #    #@{ $self->{'_pkgnum'} } = ();
  83     my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
  84     $self->{'_pkgnum'} = $subcache;
  85     #push @{ $self->{'_pkgnum'} },
  86     FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
  87   }
  88 }
  89
  90 =head1 NAME
  91
  92 FS::cust_main - Object methods for cust_main records
  93
  94 =head1 SYNOPSIS
  95
  96   use FS::cust_main;
  97
  98   $record = new FS::cust_main \%hash;
  99   $record = new FS::cust_main { 'column' => 'value' };
 100
 101   $error = $record->insert;
 102
 103   $error = $new_record->replace($old_record);
 104
 105   $error = $record->delete;
 106
 107   $error = $record->check;
 108
 109   @cust_pkg = $record->all_pkgs;
 110
 111   @cust_pkg = $record->ncancelled_pkgs;
 112
 113   @cust_pkg = $record->suspended_pkgs;
 114
 115   $error = $record->bill;
 116   $error = $record->bill %options;
 117   $error = $record->bill 'time' => $time;
 118
 119   $error = $record->collect;
 120   $error = $record->collect %options;
 121   $error = $record->collect 'invoice_time'   => $time,
 122                           ;
 123
 124 =head1 DESCRIPTION
 125
 126 An FS::cust_main object represents a customer.  FS::cust_main inherits from
 127 FS::Record.  The following fields are currently supported:
 128
 129 =over 4
 130
 131 =item custnum - primary key (assigned automatically for new customers)
 132
 133 =item agentnum - agent (see L<FS::agent>)
 134
 135 =item refnum - Advertising source (see L<FS::part_referral>)
 136
 137 =item first - name
 138
 139 =item last - name
 140
 141 =item ss - social security number (optional)
 142
 143 =item company - (optional)
 144
 145 =item address1
 146
 147 =item address2 - (optional)
 148
 149 =item city
 150
 151 =item county - (optional, see L<FS::cust_main_county>)
 152
 153 =item state - (see L<FS::cust_main_county>)
 154
 155 =item zip
 156
 157 =item country - (see L<FS::cust_main_county>)
 158
 159 =item daytime - phone (optional)
 160
 161 =item night - phone (optional)
 162
 163 =item fax - phone (optional)
 164
 165 =item ship_first - name
 166
 167 =item ship_last - name
 168
 169 =item ship_company - (optional)
 170
 171 =item ship_address1
 172
 173 =item ship_address2 - (optional)
 174
 175 =item ship_city
 176
 177 =item ship_county - (optional, see L<FS::cust_main_county>)
 178
 179 =item ship_state - (see L<FS::cust_main_county>)
 180
 181 =item ship_zip
 182
 183 =item ship_country - (see L<FS::cust_main_county>)
 184
 185 =item ship_daytime - phone (optional)
 186
 187 =item ship_night - phone (optional)
 188
 189 =item ship_fax - phone (optional)
 190
 191 =item payby
 192
 193 I<CARD> (credit card - automatic), I<DCRD> (credit card - on-demand), I<CHEK> (electronic check - automatic), I<DCHK> (electronic check - on-demand), I<LECB> (Phone bill billing), I<BILL> (billing), I<COMP> (free), or I<PREPAY> (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to I<BILL>)
 194
 195 =item payinfo
 196
 197 Card Number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
 198
 199 =cut
 200
 201 sub payinfo {
 202   my($self,$payinfo) = @_;
 203   if ( defined($payinfo) ) {
 204     $self->paymask($payinfo);
 205     $self->setfield('payinfo', $payinfo); # This is okay since we are the 'setter'
 206   } else {
 207     $payinfo = $self->getfield('payinfo'); # This is okay since we are the 'getter'
 208     return $payinfo;
 209   }
 210 }
 211
 212
 213 =item paycvv
 214
 215 Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card
 216
 217 =cut
 218
 219 =item paymask - Masked payment type
 220
 221 =over 4
 222
 223 =item Credit Cards
 224
 225 Mask all but the last four characters.
 226
 227 =item Checks
 228
 229 Mask all but last 2 of account number and bank routing number.
 230
 231 =item Others
 232
 233 Do nothing, return the unmasked string.
 234
 235 =back
 236
 237 =cut
 238
 239 sub paymask {
 240   my($self,$value)=@_;
 241
 242   # If it doesn't exist then generate it
 243   my $paymask=$self->getfield('paymask');
 244   if (!defined($value) && (!defined($paymask) || $paymask eq '')) {
 245     $value = $self->payinfo;
 246   }
 247
 248   if ( defined($value) && !$self->is_encrypted($value)) {
 249     my $payinfo = $value;
 250     my $payby = $self->payby;
 251     if ($payby eq 'CARD' || $payby eq 'DCRD') { # Credit Cards (Show last four)
 252       $paymask = 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4));
 253     } elsif ($payby eq 'CHEK' ||
 254              $payby eq 'DCHK' ) { # Checks (Show last 2 @ bank)
 255       my( $account, $aba ) = split('@', $payinfo );
 256       $paymask = 'x'x(length($account)-2). substr($account,(length($account)-2))."@".$aba;
 257     } else { # Tie up loose ends
 258       $paymask = $payinfo;
 259     }
 260     $self->setfield('paymask', $paymask); # This is okay since we are the 'setter'
 261   } elsif (defined($value) && $self->is_encrypted($value)) {
 262     $paymask = 'N/A';
 263   }
 264   return $paymask;
 265 }
 266
 267 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
 268
 269 =item paystart_month - start date month (maestro/solo cards only)
 270
 271 =item paystart_year - start date year (maestro/solo cards only)
 272
 273 =item payissue - issue number (maestro/solo cards only)
 274
 275 =item payname - name on card or billing name
 276
 277 =item payip - IP address from which payment information was received
 278
 279 =item tax - tax exempt, empty or `Y'
 280
 281 =item otaker - order taker (assigned automatically, see L<FS::UID>)
 282
 283 =item comments - comments (optional)
 284
 285 =item referral_custnum - referring customer number
 286
 287 =item spool_cdr - Enable individual CDR spooling, empty or `Y'
 288
 289 =back
 290
 291 =head1 METHODS
 292
 293 =over 4
 294
 295 =item new HASHREF
 296
 297 Creates a new customer.  To add the customer to the database, see L<"insert">.
 298
 299 Note that this stores the hash reference, not a distinct copy of the hash it
 300 points to.  You can ask the object for a copy with the I<hash> method.
 301
 302 =cut
 303
 304 sub table { 'cust_main'; }
 305
 306 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
 307
 308 Adds this customer to the database.  If there is an error, returns the error,
 309 otherwise returns false.
 310
 311 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
 312 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
 313 are inserted atomicly, or the transaction is rolled back.  Passing an empty
 314 hash reference is equivalent to not supplying this parameter.  There should be
 315 a better explanation of this, but until then, here's an example:
 316
 317   use Tie::RefHash;
 318   tie %hash, 'Tie::RefHash'; #this part is important
 319   %hash = (
 320     $cust_pkg => [ $svc_acct ],
 321     ...
 322   );
 323   $cust_main->insert( \%hash );
 324
 325 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 326 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 327 expected and rollback the entire transaction; it is not necessary to call
 328 check_invoicing_list first.  The invoicing_list is set after the records in the
 329 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
 330 invoicing_list destination to the newly-created svc_acct.  Here's an example:
 331
 332   $cust_main->insert( {}, [ $email, 'POST' ] );
 333
 334 Currently available options are: I<depend_jobnum> and I<noexport>.
 335
 336 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 337 on the supplied jobnum (they will not run until the specific job completes).
 338 This can be used to defer provisioning until some action completes (such
 339 as running the customer's credit card successfully).
 340
 341 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 342 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 343 the B<reexport> method.)
 344
 345 =cut
 346
 347 sub insert {
 348   my $self = shift;
 349   my $cust_pkgs = @_ ? shift : {};
 350   my $invoicing_list = @_ ? shift : '';
 351   my %options = @_;
 352   warn "$me insert called with options ".
 353        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 354     if $DEBUG;
 355
 356   local $SIG{HUP} = 'IGNORE';
 357   local $SIG{INT} = 'IGNORE';
 358   local $SIG{QUIT} = 'IGNORE';
 359   local $SIG{TERM} = 'IGNORE';
 360   local $SIG{TSTP} = 'IGNORE';
 361   local $SIG{PIPE} = 'IGNORE';
 362
 363   my $oldAutoCommit = $FS::UID::AutoCommit;
 364   local $FS::UID::AutoCommit = 0;
 365   my $dbh = dbh;
 366
 367   my $prepay_identifier = '';
 368   my( $amount, $seconds ) = ( 0, 0 );
 369   my $payby = '';
 370   if ( $self->payby eq 'PREPAY' ) {
 371
 372     $self->payby('BILL');
 373     $prepay_identifier = $self->payinfo;
 374     $self->payinfo('');
 375
 376     warn "  looking up prepaid card $prepay_identifier\n"
 377       if $DEBUG > 1;
 378
 379     my $error = $self->get_prepay($prepay_identifier, \$amount, \$seconds);
 380     if ( $error ) {
 381       $dbh->rollback if $oldAutoCommit;
 382       #return "error applying prepaid card (transaction rolled back): $error";
 383       return $error;
 384     }
 385
 386     $payby = 'PREP' if $amount;
 387
 388   } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
 389
 390     $payby = $1;
 391     $self->payby('BILL');
 392     $amount = $self->paid;
 393
 394   }
 395
 396   warn "  inserting $self\n"
 397     if $DEBUG > 1;
 398
 399   my $error = $self->SUPER::insert;
 400   if ( $error ) {
 401     $dbh->rollback if $oldAutoCommit;
 402     #return "inserting cust_main record (transaction rolled back): $error";
 403     return $error;
 404   }
 405
 406   warn "  setting invoicing list\n"
 407     if $DEBUG > 1;
 408
 409   if ( $invoicing_list ) {
 410     $error = $self->check_invoicing_list( $invoicing_list );
 411     if ( $error ) {
 412       $dbh->rollback if $oldAutoCommit;
 413       return "checking invoicing_list (transaction rolled back): $error";
 414     }
 415     $self->invoicing_list( $invoicing_list );
 416   }
 417
 418   warn "  ordering packages\n"
 419     if $DEBUG > 1;
 420
 421   $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
 422   if ( $error ) {
 423     $dbh->rollback if $oldAutoCommit;
 424     return $error;
 425   }
 426
 427   if ( $seconds ) {
 428     $dbh->rollback if $oldAutoCommit;
 429     return "No svc_acct record to apply pre-paid time";
 430   }
 431
 432   if ( $amount ) {
 433     warn "  inserting initial $payby payment of $amount\n"
 434       if $DEBUG > 1;
 435     $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
 436     if ( $error ) {
 437       $dbh->rollback if $oldAutoCommit;
 438       return "inserting payment (transaction rolled back): $error";
 439     }
 440   }
 441
 442   unless ( $import || $skip_fuzzyfiles ) {
 443     warn "  queueing fuzzyfiles update\n"
 444       if $DEBUG > 1;
 445     $error = $self->queue_fuzzyfiles_update;
 446     if ( $error ) {
 447       $dbh->rollback if $oldAutoCommit;
 448       return "updating fuzzy search cache: $error";
 449     }
 450   }
 451
 452   warn "  insert complete; committing transaction\n"
 453     if $DEBUG > 1;
 454
 455   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 456   '';
 457
 458 }
 459
 460 =item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
 461
 462 Like the insert method on an existing record, this method orders a package
 463 and included services atomicaly.  Pass a Tie::RefHash data structure to this
 464 method containing FS::cust_pkg and FS::svc_I<tablename> objects.  There should
 465 be a better explanation of this, but until then, here's an example:
 466
 467   use Tie::RefHash;
 468   tie %hash, 'Tie::RefHash'; #this part is important
 469   %hash = (
 470     $cust_pkg => [ $svc_acct ],
 471     ...
 472   );
 473   $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
 474
 475 Services can be new, in which case they are inserted, or existing unaudited
 476 services, in which case they are linked to the newly-created package.
 477
 478 Currently available options are: I<depend_jobnum> and I<noexport>.
 479
 480 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 481 on the supplied jobnum (they will not run until the specific job completes).
 482 This can be used to defer provisioning until some action completes (such
 483 as running the customer's credit card successfully).
 484
 485 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 486 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 487 the B<reexport> method for each cust_pkg object.  Using the B<reexport> method
 488 on the cust_main object is not recommended, as existing services will also be
 489 reexported.)
 490
 491 =cut
 492
 493 sub order_pkgs {
 494   my $self = shift;
 495   my $cust_pkgs = shift;
 496   my $seconds = shift;
 497   my %options = @_;
 498   my %svc_options = ();
 499   $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
 500     if exists $options{'depend_jobnum'};
 501   warn "$me order_pkgs called with options ".
 502        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 503     if $DEBUG;
 504
 505   local $SIG{HUP} = 'IGNORE';
 506   local $SIG{INT} = 'IGNORE';
 507   local $SIG{QUIT} = 'IGNORE';
 508   local $SIG{TERM} = 'IGNORE';
 509   local $SIG{TSTP} = 'IGNORE';
 510   local $SIG{PIPE} = 'IGNORE';
 511
 512   my $oldAutoCommit = $FS::UID::AutoCommit;
 513   local $FS::UID::AutoCommit = 0;
 514   my $dbh = dbh;
 515
 516   local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
 517
 518   foreach my $cust_pkg ( keys %$cust_pkgs ) {
 519     $cust_pkg->custnum( $self->custnum );
 520     my $error = $cust_pkg->insert;
 521     if ( $error ) {
 522       $dbh->rollback if $oldAutoCommit;
 523       return "inserting cust_pkg (transaction rolled back): $error";
 524     }
 525     foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
 526       if ( $svc_something->svcnum ) {
 527         my $old_cust_svc = $svc_something->cust_svc;
 528         my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
 529         $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
 530         $error = $new_cust_svc->replace($old_cust_svc);
 531       } else {
 532         $svc_something->pkgnum( $cust_pkg->pkgnum );
 533         if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
 534           $svc_something->seconds( $svc_something->seconds + $$seconds );
 535           $$seconds = 0;
 536         }
 537         $error = $svc_something->insert(%svc_options);
 538       }
 539       if ( $error ) {
 540         $dbh->rollback if $oldAutoCommit;
 541         #return "inserting svc_ (transaction rolled back): $error";
 542         return $error;
 543       }
 544     }
 545   }
 546
 547   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 548   ''; #no error
 549 }
 550
 551 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF ]
 552
 553 Recharges this (existing) customer with the specified prepaid card (see
 554 L<FS::prepay_credit>), specified either by I<identifier> or as an
 555 FS::prepay_credit object.  If there is an error, returns the error, otherwise
 556 returns false.
 557
 558 Optionally, two scalar references can be passed as well.  They will have their
 559 values filled in with the amount and number of seconds applied by this prepaid
 560 card.
 561
 562 =cut
 563
 564 sub recharge_prepay {
 565   my( $self, $prepay_credit, $amountref, $secondsref ) = @_;
 566
 567   local $SIG{HUP} = 'IGNORE';
 568   local $SIG{INT} = 'IGNORE';
 569   local $SIG{QUIT} = 'IGNORE';
 570   local $SIG{TERM} = 'IGNORE';
 571   local $SIG{TSTP} = 'IGNORE';
 572   local $SIG{PIPE} = 'IGNORE';
 573
 574   my $oldAutoCommit = $FS::UID::AutoCommit;
 575   local $FS::UID::AutoCommit = 0;
 576   my $dbh = dbh;
 577
 578   my( $amount, $seconds ) = ( 0, 0 );
 579
 580   my $error = $self->get_prepay($prepay_credit, \$amount, \$seconds)
 581            || $self->increment_seconds($seconds)
 582            || $self->insert_cust_pay_prepay( $amount,
 583                                              ref($prepay_credit)
 584                                                ? $prepay_credit->identifier
 585                                                : $prepay_credit
 586                                            );
 587
 588   if ( $error ) {
 589     $dbh->rollback if $oldAutoCommit;
 590     return $error;
 591   }
 592
 593   if ( defined($amountref)  ) { $$amountref  = $amount;  }
 594   if ( defined($secondsref) ) { $$secondsref = $seconds; }
 595
 596   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 597   '';
 598
 599 }
 600
 601 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ , AMOUNTREF, SECONDSREF
 602
 603 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
 604 specified either by I<identifier> or as an FS::prepay_credit object.
 605
 606 References to I<amount> and I<seconds> scalars should be passed as arguments
 607 and will be incremented by the values of the prepaid card.
 608
 609 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
 610 check or set this customer's I<agentnum>.
 611
 612 If there is an error, returns the error, otherwise returns false.
 613
 614 =cut
 615
 616
 617 sub get_prepay {
 618   my( $self, $prepay_credit, $amountref, $secondsref ) = @_;
 619
 620   local $SIG{HUP} = 'IGNORE';
 621   local $SIG{INT} = 'IGNORE';
 622   local $SIG{QUIT} = 'IGNORE';
 623   local $SIG{TERM} = 'IGNORE';
 624   local $SIG{TSTP} = 'IGNORE';
 625   local $SIG{PIPE} = 'IGNORE';
 626
 627   my $oldAutoCommit = $FS::UID::AutoCommit;
 628   local $FS::UID::AutoCommit = 0;
 629   my $dbh = dbh;
 630
 631   unless ( ref($prepay_credit) ) {
 632
 633     my $identifier = $prepay_credit;
 634
 635     $prepay_credit = qsearchs(
 636       'prepay_credit',
 637       { 'identifier' => $prepay_credit },
 638       '',
 639       'FOR UPDATE'
 640     );
 641
 642     unless ( $prepay_credit ) {
 643       $dbh->rollback if $oldAutoCommit;
 644       return "Invalid prepaid card: ". $identifier;
 645     }
 646
 647   }
 648
 649   if ( $prepay_credit->agentnum ) {
 650     if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
 651       $dbh->rollback if $oldAutoCommit;
 652       return "prepaid card not valid for agent ". $self->agentnum;
 653     }
 654     $self->agentnum($prepay_credit->agentnum);
 655   }
 656
 657   my $error = $prepay_credit->delete;
 658   if ( $error ) {
 659     $dbh->rollback if $oldAutoCommit;
 660     return "removing prepay_credit (transaction rolled back): $error";
 661   }
 662
 663   $$amountref  += $prepay_credit->amount;
 664   $$secondsref += $prepay_credit->seconds;
 665
 666   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 667   '';
 668
 669 }
 670
 671 =item increment_seconds SECONDS
 672
 673 Updates this customer's single or primary account (see L<FS::svc_acct>) by
 674 the specified number of seconds.  If there is an error, returns the error,
 675 otherwise returns false.
 676
 677 =cut
 678
 679 sub increment_seconds {
 680   my( $self, $seconds ) = @_;
 681   warn "$me increment_seconds called: $seconds seconds\n"
 682     if $DEBUG;
 683
 684   my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
 685                       $self->ncancelled_pkgs;
 686
 687   if ( ! @cust_pkg ) {
 688     return 'No packages with primary or single services found'.
 689            ' to apply pre-paid time';
 690   } elsif ( scalar(@cust_pkg) > 1 ) {
 691     #maybe have a way to specify the package/account?
 692     return 'Multiple packages found to apply pre-paid time';
 693   }
 694
 695   my $cust_pkg = $cust_pkg[0];
 696   warn "  found package pkgnum ". $cust_pkg->pkgnum. "\n"
 697     if $DEBUG > 1;
 698
 699   my @cust_svc =
 700     $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
 701
 702   if ( ! @cust_svc ) {
 703     return 'No account found to apply pre-paid time';
 704   } elsif ( scalar(@cust_svc) > 1 ) {
 705     return 'Multiple accounts found to apply pre-paid time';
 706   }
 707
 708   my $svc_acct = $cust_svc[0]->svc_x;
 709   warn "  found service svcnum ". $svc_acct->pkgnum.
 710        ' ('. $svc_acct->email. ")\n"
 711     if $DEBUG > 1;
 712
 713   $svc_acct->increment_seconds($seconds);
 714
 715 }
 716
 717 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
 718
 719 Inserts a prepayment in the specified amount for this customer.  An optional
 720 second argument can specify the prepayment identifier for tracking purposes.
 721 If there is an error, returns the error, otherwise returns false.
 722
 723 =cut
 724
 725 sub insert_cust_pay_prepay {
 726   shift->insert_cust_pay('PREP', @_);
 727 }
 728
 729 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
 730
 731 Inserts a cash payment in the specified amount for this customer.  An optional
 732 second argument can specify the payment identifier for tracking purposes.
 733 If there is an error, returns the error, otherwise returns false.
 734
 735 =cut
 736
 737 sub insert_cust_pay_cash {
 738   shift->insert_cust_pay('CASH', @_);
 739 }
 740
 741 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
 742
 743 Inserts a Western Union payment in the specified amount for this customer.  An
 744 optional second argument can specify the prepayment identifier for tracking
 745 purposes.  If there is an error, returns the error, otherwise returns false.
 746
 747 =cut
 748
 749 sub insert_cust_pay_west {
 750   shift->insert_cust_pay('WEST', @_);
 751 }
 752
 753 sub insert_cust_pay {
 754   my( $self, $payby, $amount ) = splice(@_, 0, 3);
 755   my $payinfo = scalar(@_) ? shift : '';
 756
 757   my $cust_pay = new FS::cust_pay {
 758     'custnum' => $self->custnum,
 759     'paid'    => sprintf('%.2f', $amount),
 760     #'_date'   => #date the prepaid card was purchased???
 761     'payby'   => $payby,
 762     'payinfo' => $payinfo,
 763   };
 764   $cust_pay->insert;
 765
 766 }
 767
 768 =item reexport
 769
 770 This method is deprecated.  See the I<depend_jobnum> option to the insert and
 771 order_pkgs methods for a better way to defer provisioning.
 772
 773 Re-schedules all exports by calling the B<reexport> method of all associated
 774 packages (see L<FS::cust_pkg>).  If there is an error, returns the error;
 775 otherwise returns false.
 776
 777 =cut
 778
 779 sub reexport {
 780   my $self = shift;
 781
 782   carp "WARNING: FS::cust_main::reexport is deprectated; ".
 783        "use the depend_jobnum option to insert or order_pkgs to delay export";
 784
 785   local $SIG{HUP} = 'IGNORE';
 786   local $SIG{INT} = 'IGNORE';
 787   local $SIG{QUIT} = 'IGNORE';
 788   local $SIG{TERM} = 'IGNORE';
 789   local $SIG{TSTP} = 'IGNORE';
 790   local $SIG{PIPE} = 'IGNORE';
 791
 792   my $oldAutoCommit = $FS::UID::AutoCommit;
 793   local $FS::UID::AutoCommit = 0;
 794   my $dbh = dbh;
 795
 796   foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
 797     my $error = $cust_pkg->reexport;
 798     if ( $error ) {
 799       $dbh->rollback if $oldAutoCommit;
 800       return $error;
 801     }
 802   }
 803
 804   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 805   '';
 806
 807 }
 808
 809 =item delete NEW_CUSTNUM
 810
 811 This deletes the customer.  If there is an error, returns the error, otherwise
 812 returns false.
 813
 814 This will completely remove all traces of the customer record.  This is not
 815 what you want when a customer cancels service; for that, cancel all of the
 816 customer's packages (see L</cancel>).
 817
 818 If the customer has any uncancelled packages, you need to pass a new (valid)
 819 customer number for those packages to be transferred to.  Cancelled packages
 820 will be deleted.  Did I mention that this is NOT what you want when a customer
 821 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
 822
 823 You can't delete a customer with invoices (see L<FS::cust_bill>),
 824 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
 825 refunds (see L<FS::cust_refund>).
 826
 827 =cut
 828
 829 sub delete {
 830   my $self = shift;
 831
 832   local $SIG{HUP} = 'IGNORE';
 833   local $SIG{INT} = 'IGNORE';
 834   local $SIG{QUIT} = 'IGNORE';
 835   local $SIG{TERM} = 'IGNORE';
 836   local $SIG{TSTP} = 'IGNORE';
 837   local $SIG{PIPE} = 'IGNORE';
 838
 839   my $oldAutoCommit = $FS::UID::AutoCommit;
 840   local $FS::UID::AutoCommit = 0;
 841   my $dbh = dbh;
 842
 843   if ( $self->cust_bill ) {
 844     $dbh->rollback if $oldAutoCommit;
 845     return "Can't delete a customer with invoices";
 846   }
 847   if ( $self->cust_credit ) {
 848     $dbh->rollback if $oldAutoCommit;
 849     return "Can't delete a customer with credits";
 850   }
 851   if ( $self->cust_pay ) {
 852     $dbh->rollback if $oldAutoCommit;
 853     return "Can't delete a customer with payments";
 854   }
 855   if ( $self->cust_refund ) {
 856     $dbh->rollback if $oldAutoCommit;
 857     return "Can't delete a customer with refunds";
 858   }
 859
 860   my @cust_pkg = $self->ncancelled_pkgs;
 861   if ( @cust_pkg ) {
 862     my $new_custnum = shift;
 863     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
 864       $dbh->rollback if $oldAutoCommit;
 865       return "Invalid new customer number: $new_custnum";
 866     }
 867     foreach my $cust_pkg ( @cust_pkg ) {
 868       my %hash = $cust_pkg->hash;
 869       $hash{'custnum'} = $new_custnum;
 870       my $new_cust_pkg = new FS::cust_pkg ( \%hash );
 871       my $error = $new_cust_pkg->replace($cust_pkg);
 872       if ( $error ) {
 873         $dbh->rollback if $oldAutoCommit;
 874         return $error;
 875       }
 876     }
 877   }
 878   my @cancelled_cust_pkg = $self->all_pkgs;
 879   foreach my $cust_pkg ( @cancelled_cust_pkg ) {
 880     my $error = $cust_pkg->delete;
 881     if ( $error ) {
 882       $dbh->rollback if $oldAutoCommit;
 883       return $error;
 884     }
 885   }
 886
 887   foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
 888     qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
 889   ) {
 890     my $error = $cust_main_invoice->delete;
 891     if ( $error ) {
 892       $dbh->rollback if $oldAutoCommit;
 893       return $error;
 894     }
 895   }
 896
 897   my $error = $self->SUPER::delete;
 898   if ( $error ) {
 899     $dbh->rollback if $oldAutoCommit;
 900     return $error;
 901   }
 902
 903   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 904   '';
 905
 906 }
 907
 908 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
 909
 910 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 911 returns the error, otherwise returns false.
 912
 913 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 914 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 915 expected and rollback the entire transaction; it is not necessary to call
 916 check_invoicing_list first.  Here's an example:
 917
 918   $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
 919
 920 =cut
 921
 922 sub replace {
 923   my $self = shift;
 924   my $old = shift;
 925   my @param = @_;
 926   warn "$me replace called\n"
 927     if $DEBUG;
 928
 929   local $SIG{HUP} = 'IGNORE';
 930   local $SIG{INT} = 'IGNORE';
 931   local $SIG{QUIT} = 'IGNORE';
 932   local $SIG{TERM} = 'IGNORE';
 933   local $SIG{TSTP} = 'IGNORE';
 934   local $SIG{PIPE} = 'IGNORE';
 935
 936   # If the mask is blank then try to set it - if we can...
 937   if (!defined($self->getfield('paymask')) || $self->getfield('paymask') eq '') {
 938     $self->paymask($self->payinfo);
 939   }
 940
 941   # We absolutely have to have an old vs. new record to make this work.
 942   if (!defined($old)) {
 943     $old = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 944   }
 945
 946   if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
 947        && $conf->config('users-allow_comp')                  ) {
 948     return "You are not permitted to create complimentary accounts."
 949       unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
 950   }
 951
 952   local($ignore_expired_card) = 1
 953     if $old->payby  =~ /^(CARD|DCRD)$/
 954     && $self->payby =~ /^(CARD|DCRD)$/
 955     && $old->payinfo eq $self->payinfo;
 956
 957   my $oldAutoCommit = $FS::UID::AutoCommit;
 958   local $FS::UID::AutoCommit = 0;
 959   my $dbh = dbh;
 960
 961   my $error = $self->SUPER::replace($old);
 962
 963   if ( $error ) {
 964     $dbh->rollback if $oldAutoCommit;
 965     return $error;
 966   }
 967
 968   if ( @param ) { # INVOICING_LIST_ARYREF
 969     my $invoicing_list = shift @param;
 970     $error = $self->check_invoicing_list( $invoicing_list );
 971     if ( $error ) {
 972       $dbh->rollback if $oldAutoCommit;
 973       return $error;
 974     }
 975     $self->invoicing_list( $invoicing_list );
 976   }
 977
 978   if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
 979        grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
 980     # card/check/lec info has changed, want to retry realtime_ invoice events
 981     my $error = $self->retry_realtime;
 982     if ( $error ) {
 983       $dbh->rollback if $oldAutoCommit;
 984       return $error;
 985     }
 986   }
 987
 988   unless ( $import || $skip_fuzzyfiles ) {
 989     $error = $self->queue_fuzzyfiles_update;
 990     if ( $error ) {
 991       $dbh->rollback if $oldAutoCommit;
 992       return "updating fuzzy search cache: $error";
 993     }
 994   }
 995
 996   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 997   '';
 998
 999 }
1000
1001 =item queue_fuzzyfiles_update
1002
1003 Used by insert & replace to update the fuzzy search cache
1004
1005 =cut
1006
1007 sub queue_fuzzyfiles_update {
1008   my $self = shift;
1009
1010   local $SIG{HUP} = 'IGNORE';
1011   local $SIG{INT} = 'IGNORE';
1012   local $SIG{QUIT} = 'IGNORE';
1013   local $SIG{TERM} = 'IGNORE';
1014   local $SIG{TSTP} = 'IGNORE';
1015   local $SIG{PIPE} = 'IGNORE';
1016
1017   my $oldAutoCommit = $FS::UID::AutoCommit;
1018   local $FS::UID::AutoCommit = 0;
1019   my $dbh = dbh;
1020
1021   my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1022   my $error = $queue->insert($self->getfield('last'), $self->company);
1023   if ( $error ) {
1024     $dbh->rollback if $oldAutoCommit;
1025     return "queueing job (transaction rolled back): $error";
1026   }
1027
1028   if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
1029     $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1030     $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
1031     if ( $error ) {
1032       $dbh->rollback if $oldAutoCommit;
1033       return "queueing job (transaction rolled back): $error";
1034     }
1035   }
1036
1037   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1038   '';
1039
1040 }
1041
1042 =item check
1043
1044 Checks all fields to make sure this is a valid customer record.  If there is
1045 an error, returns the error, otherwise returns false.  Called by the insert
1046 and replace methods.
1047
1048 =cut
1049
1050 sub check {
1051   my $self = shift;
1052
1053   warn "$me check BEFORE: \n". $self->_dump
1054     if $DEBUG > 2;
1055
1056   my $error =
1057     $self->ut_numbern('custnum')
1058     || $self->ut_number('agentnum')
1059     || $self->ut_number('refnum')
1060     || $self->ut_name('last')
1061     || $self->ut_name('first')
1062     || $self->ut_textn('company')
1063     || $self->ut_text('address1')
1064     || $self->ut_textn('address2')
1065     || $self->ut_text('city')
1066     || $self->ut_textn('county')
1067     || $self->ut_textn('state')
1068     || $self->ut_country('country')
1069     || $self->ut_anything('comments')
1070     || $self->ut_numbern('referral_custnum')
1071   ;
1072   #barf.  need message catalogs.  i18n.  etc.
1073   $error .= "Please select an advertising source."
1074     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1075   return $error if $error;
1076
1077   return "Unknown agent"
1078     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1079
1080   return "Unknown refnum"
1081     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1082
1083   return "Unknown referring custnum: ". $self->referral_custnum
1084     unless ! $self->referral_custnum
1085            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1086
1087   if ( $self->ss eq '' ) {
1088     $self->ss('');
1089   } else {
1090     my $ss = $self->ss;
1091     $ss =~ s/\D//g;
1092     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1093       or return "Illegal social security number: ". $self->ss;
1094     $self->ss("$1-$2-$3");
1095   }
1096
1097
1098 # bad idea to disable, causes billing to fail because of no tax rates later
1099 #  unless ( $import ) {
1100     unless ( qsearch('cust_main_county', {
1101       'country' => $self->country,
1102       'state'   => '',
1103      } ) ) {
1104       return "Unknown state/county/country: ".
1105         $self->state. "/". $self->county. "/". $self->country
1106         unless qsearch('cust_main_county',{
1107           'state'   => $self->state,
1108           'county'  => $self->county,
1109           'country' => $self->country,
1110         } );
1111     }
1112 #  }
1113
1114   $error =
1115     $self->ut_phonen('daytime', $self->country)
1116     || $self->ut_phonen('night', $self->country)
1117     || $self->ut_phonen('fax', $self->country)
1118     || $self->ut_zip('zip', $self->country)
1119   ;
1120   return $error if $error;
1121
1122   my @addfields = qw(
1123     last first company address1 address2 city county state zip
1124     country daytime night fax
1125   );
1126
1127   if ( defined $self->dbdef_table->column('ship_last') ) {
1128     if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1129                        @addfields )
1130          && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
1131        )
1132     {
1133       my $error =
1134         $self->ut_name('ship_last')
1135         || $self->ut_name('ship_first')
1136         || $self->ut_textn('ship_company')
1137         || $self->ut_text('ship_address1')
1138         || $self->ut_textn('ship_address2')
1139         || $self->ut_text('ship_city')
1140         || $self->ut_textn('ship_county')
1141         || $self->ut_textn('ship_state')
1142         || $self->ut_country('ship_country')
1143       ;
1144       return $error if $error;
1145
1146       #false laziness with above
1147       unless ( qsearchs('cust_main_county', {
1148         'country' => $self->ship_country,
1149         'state'   => '',
1150        } ) ) {
1151         return "Unknown ship_state/ship_county/ship_country: ".
1152           $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1153           unless qsearch('cust_main_county',{
1154             'state'   => $self->ship_state,
1155             'county'  => $self->ship_county,
1156             'country' => $self->ship_country,
1157           } );
1158       }
1159       #eofalse
1160
1161       $error =
1162         $self->ut_phonen('ship_daytime', $self->ship_country)
1163         || $self->ut_phonen('ship_night', $self->ship_country)
1164         || $self->ut_phonen('ship_fax', $self->ship_country)
1165         || $self->ut_zip('ship_zip', $self->ship_country)
1166       ;
1167       return $error if $error;
1168
1169     } else { # ship_ info eq billing info, so don't store dup info in database
1170       $self->setfield("ship_$_", '')
1171         foreach qw( last first company address1 address2 city county state zip
1172                     country daytime night fax );
1173     }
1174   }
1175
1176   $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1177     or return "Illegal payby: ". $self->payby;
1178
1179   $error =    $self->ut_numbern('paystart_month')
1180            || $self->ut_numbern('paystart_year')
1181            || $self->ut_numbern('payissue')
1182   ;
1183   return $error if $error;
1184
1185   if ( $self->payip eq '' ) {
1186     $self->payip('');
1187   } else {
1188     $error = $self->ut_ip('payip');
1189     return $error if $error;
1190   }
1191
1192   # If it is encrypted and the private key is not availaible then we can't
1193   # check the credit card.
1194
1195   my $check_payinfo = 1;
1196
1197   if ($self->is_encrypted($self->payinfo)) {
1198     $check_payinfo = 0;
1199   }
1200
1201   $self->payby($1);
1202
1203   if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1204
1205     my $payinfo = $self->payinfo;
1206     $payinfo =~ s/\D//g;
1207     $payinfo =~ /^(\d{13,16})$/
1208       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1209     $payinfo = $1;
1210     $self->payinfo($payinfo);
1211     validate($payinfo)
1212       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1213
1214     return gettext('unknown_card_type')
1215       if cardtype($self->payinfo) eq "Unknown";
1216
1217     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1218     return "Banned credit card" if $ban;
1219
1220     if ( defined $self->dbdef_table->column('paycvv') ) {
1221       if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1222         if ( cardtype($self->payinfo) eq 'American Express card' ) {
1223           $self->paycvv =~ /^(\d{4})$/
1224             or return "CVV2 (CID) for American Express cards is four digits.";
1225           $self->paycvv($1);
1226         } else {
1227           $self->paycvv =~ /^(\d{3})$/
1228             or return "CVV2 (CVC2/CID) is three digits.";
1229           $self->paycvv($1);
1230         }
1231       } else {
1232         $self->paycvv('');
1233       }
1234     }
1235
1236     my $cardtype = cardtype($payinfo);
1237     if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1238
1239       return "Start date or issue number is required for $cardtype cards"
1240         unless $self->paystart_month && $self->paystart_year or $self->payissue;
1241
1242       return "Start month must be between 1 and 12"
1243         if $self->paystart_month
1244            and $self->paystart_month < 1 || $self->paystart_month > 12;
1245
1246       return "Start year must be 1990 or later"
1247         if $self->paystart_year
1248            and $self->paystart_year < 1990;
1249
1250       return "Issue number must be beween 1 and 99"
1251         if $self->payissue
1252           and $self->payissue < 1 || $self->payissue > 99;
1253
1254     } else {
1255       $self->paystart_month('');
1256       $self->paystart_year('');
1257       $self->payissue('');
1258     }
1259
1260   } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1261
1262     my $payinfo = $self->payinfo;
1263     $payinfo =~ s/[^\d\@]//g;
1264     if ( $conf->exists('echeck-nonus') ) {
1265       $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1266       $payinfo = "$1\@$2";
1267     } else {
1268       $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1269       $payinfo = "$1\@$2";
1270     }
1271     $self->payinfo($payinfo);
1272     $self->paycvv('') if $self->dbdef_table->column('paycvv');
1273
1274     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1275     return "Banned ACH account" if $ban;
1276
1277   } elsif ( $self->payby eq 'LECB' ) {
1278
1279     my $payinfo = $self->payinfo;
1280     $payinfo =~ s/\D//g;
1281     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1282     $payinfo = $1;
1283     $self->payinfo($payinfo);
1284     $self->paycvv('') if $self->dbdef_table->column('paycvv');
1285
1286   } elsif ( $self->payby eq 'BILL' ) {
1287
1288     $error = $self->ut_textn('payinfo');
1289     return "Illegal P.O. number: ". $self->payinfo if $error;
1290     $self->paycvv('') if $self->dbdef_table->column('paycvv');
1291
1292   } elsif ( $self->payby eq 'COMP' ) {
1293
1294     if ( !$self->custnum && $conf->config('users-allow_comp') ) {
1295       return "You are not permitted to create complimentary accounts."
1296         unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
1297     }
1298
1299     $error = $self->ut_textn('payinfo');
1300     return "Illegal comp account issuer: ". $self->payinfo if $error;
1301     $self->paycvv('') if $self->dbdef_table->column('paycvv');
1302
1303   } elsif ( $self->payby eq 'PREPAY' ) {
1304
1305     my $payinfo = $self->payinfo;
1306     $payinfo =~ s/\W//g; #anything else would just confuse things
1307     $self->payinfo($payinfo);
1308     $error = $self->ut_alpha('payinfo');
1309     return "Illegal prepayment identifier: ". $self->payinfo if $error;
1310     return "Unknown prepayment identifier"
1311       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1312     $self->paycvv('') if $self->dbdef_table->column('paycvv');
1313
1314   }
1315
1316   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1317     return "Expiration date required"
1318       unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1319     $self->paydate('');
1320   } else {
1321     my( $m, $y );
1322     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1323       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1324     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1325       ( $m, $y ) = ( $3, "20$2" );
1326     } else {
1327       return "Illegal expiration date: ". $self->paydate;
1328     }
1329     $self->paydate("$y-$m-01");
1330     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1331     return gettext('expired_card')
1332       if !$import
1333       && !$ignore_expired_card
1334       && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1335   }
1336
1337   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1338        ( ! $conf->exists('require_cardname')
1339          || $self->payby !~ /^(CARD|DCRD)$/  )
1340   ) {
1341     $self->payname( $self->first. " ". $self->getfield('last') );
1342   } else {
1343     $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1344       or return gettext('illegal_name'). " payname: ". $self->payname;
1345     $self->payname($1);
1346   }
1347
1348   foreach my $flag (qw( tax spool_cdr )) {
1349     $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1350     $self->$flag($1);
1351   }
1352
1353   $self->otaker(getotaker) unless $self->otaker;
1354
1355   warn "$me check AFTER: \n". $self->_dump
1356     if $DEBUG > 2;
1357
1358   $self->SUPER::check;
1359 }
1360
1361 =item all_pkgs
1362
1363 Returns all packages (see L<FS::cust_pkg>) for this customer.
1364
1365 =cut
1366
1367 sub all_pkgs {
1368   my $self = shift;
1369   if ( $self->{'_pkgnum'} ) {
1370     values %{ $self->{'_pkgnum'}->cache };
1371   } else {
1372     qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
1373   }
1374 }
1375
1376 =item ncancelled_pkgs
1377
1378 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1379
1380 =cut
1381
1382 sub ncancelled_pkgs {
1383   my $self = shift;
1384   if ( $self->{'_pkgnum'} ) {
1385     grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
1386   } else {
1387     @{ [ # force list context
1388       qsearch( 'cust_pkg', {
1389         'custnum' => $self->custnum,
1390         'cancel'  => '',
1391       }),
1392       qsearch( 'cust_pkg', {
1393         'custnum' => $self->custnum,
1394         'cancel'  => 0,
1395       }),
1396     ] };
1397   }
1398 }
1399
1400 =item suspended_pkgs
1401
1402 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1403
1404 =cut
1405
1406 sub suspended_pkgs {
1407   my $self = shift;
1408   grep { $_->susp } $self->ncancelled_pkgs;
1409 }
1410
1411 =item unflagged_suspended_pkgs
1412
1413 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1414 customer (thouse packages without the `manual_flag' set).
1415
1416 =cut
1417
1418 sub unflagged_suspended_pkgs {
1419   my $self = shift;
1420   return $self->suspended_pkgs
1421     unless dbdef->table('cust_pkg')->column('manual_flag');
1422   grep { ! $_->manual_flag } $self->suspended_pkgs;
1423 }
1424
1425 =item unsuspended_pkgs
1426
1427 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1428 this customer.
1429
1430 =cut
1431
1432 sub unsuspended_pkgs {
1433   my $self = shift;
1434   grep { ! $_->susp } $self->ncancelled_pkgs;
1435 }
1436
1437 =item num_cancelled_pkgs
1438
1439 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1440 customer.
1441
1442 =cut
1443
1444 sub num_cancelled_pkgs {
1445   my $self = shift;
1446   $self->num_pkgs("cancel IS NOT NULL AND cust_pkg.cancel != 0");
1447 }
1448
1449 sub num_pkgs {
1450   my( $self, $sql ) = @_;
1451   my $sth = dbh->prepare(
1452     "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? AND $sql"
1453   ) or die dbh->errstr;
1454   $sth->execute($self->custnum) or die $sth->errstr;
1455   $sth->fetchrow_arrayref->[0];
1456 }
1457
1458 =item unsuspend
1459
1460 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1461 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
1462 on success or a list of errors.
1463
1464 =cut
1465
1466 sub unsuspend {
1467   my $self = shift;
1468   grep { $_->unsuspend } $self->suspended_pkgs;
1469 }
1470
1471 =item suspend
1472
1473 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1474
1475 Returns a list: an empty list on success or a list of errors.
1476
1477 =cut
1478
1479 sub suspend {
1480   my $self = shift;
1481   grep { $_->suspend } $self->unsuspended_pkgs;
1482 }
1483
1484 =item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
1485
1486 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1487 PKGPARTs (see L<FS::part_pkg>).
1488
1489 Returns a list: an empty list on success or a list of errors.
1490
1491 =cut
1492
1493 sub suspend_if_pkgpart {
1494   my $self = shift;
1495   my @pkgparts = @_;
1496   grep { $_->suspend }
1497     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1498       $self->unsuspended_pkgs;
1499 }
1500
1501 =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
1502
1503 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1504 listed PKGPARTs (see L<FS::part_pkg>).
1505
1506 Returns a list: an empty list on success or a list of errors.
1507
1508 =cut
1509
1510 sub suspend_unless_pkgpart {
1511   my $self = shift;
1512   my @pkgparts = @_;
1513   grep { $_->suspend }
1514     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1515       $self->unsuspended_pkgs;
1516 }
1517
1518 =item cancel [ OPTION => VALUE ... ]
1519
1520 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1521
1522 Available options are: I<quiet>, I<reasonnum>, and I<ban>
1523
1524 I<quiet> can be set true to supress email cancellation notices.
1525
1526 # I<reasonnum> can be set to a cancellation reason (see L<FS::cancel_reason>)
1527
1528 I<ban> can be set true to ban this customer's credit card or ACH information,
1529 if present.
1530
1531 Always returns a list: an empty list on success or a list of errors.
1532
1533 =cut
1534
1535 sub cancel {
1536   my $self = shift;
1537   my %opt = @_;
1538
1539   if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
1540
1541     #should try decryption (we might have the private key)
1542     # and if not maybe queue a job for the server that does?
1543     return ( "Can't (yet) ban encrypted credit cards" )
1544       if $self->is_encrypted($self->payinfo);
1545
1546     my $ban = new FS::banned_pay $self->_banned_pay_hashref;
1547     my $error = $ban->insert;
1548     return ( $error ) if $error;
1549
1550   }
1551
1552   grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1553 }
1554
1555 sub _banned_pay_hashref {
1556   my $self = shift;
1557
1558   my %payby2ban = (
1559     'CARD' => 'CARD',
1560     'DCRD' => 'CARD',
1561     'CHEK' => 'CHEK',
1562     'DCHK' => 'CHEK'
1563   );
1564
1565   {
1566     'payby'   => $payby2ban{$self->payby},
1567     'payinfo' => md5_base64($self->payinfo),
1568     #'reason'  =>
1569   };
1570 }
1571
1572 =item agent
1573
1574 Returns the agent (see L<FS::agent>) for this customer.
1575
1576 =cut
1577
1578 sub agent {
1579   my $self = shift;
1580   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1581 }
1582
1583 =item bill OPTIONS
1584
1585 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
1586 conjunction with the collect method.
1587
1588 Options are passed as name-value pairs.
1589
1590 Currently available options are:
1591
1592 resetup - if set true, re-charges setup fees.
1593
1594 time - bills the customer as if it were that time.  Specified as a UNIX
1595 timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and
1596 L<Date::Parse> for conversion functions.  For example:
1597
1598  use Date::Parse;
1599  ...
1600  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1601
1602
1603 If there is an error, returns the error, otherwise returns false.
1604
1605 =cut
1606
1607 sub bill {
1608   my( $self, %options ) = @_;
1609   return '' if $self->payby eq 'COMP';
1610   warn "$me bill customer ". $self->custnum. "\n"
1611     if $DEBUG;
1612
1613   my $time = $options{'time'} || time;
1614
1615   my $error;
1616
1617   #put below somehow?
1618   local $SIG{HUP} = 'IGNORE';
1619   local $SIG{INT} = 'IGNORE';
1620   local $SIG{QUIT} = 'IGNORE';
1621   local $SIG{TERM} = 'IGNORE';
1622   local $SIG{TSTP} = 'IGNORE';
1623   local $SIG{PIPE} = 'IGNORE';
1624
1625   my $oldAutoCommit = $FS::UID::AutoCommit;
1626   local $FS::UID::AutoCommit = 0;
1627   my $dbh = dbh;
1628
1629   $self->select_for_update; #mutex
1630
1631   #create a new invoice
1632   #(we'll remove it later if it doesn't actually need to be generated [contains
1633   # no line items] and we're inside a transaciton so nothing else will see it)
1634   my $cust_bill = new FS::cust_bill ( {
1635     'custnum' => $self->custnum,
1636     '_date'   => $time,
1637     #'charged' => $charged,
1638     'charged' => 0,
1639   } );
1640   $error = $cust_bill->insert;
1641   if ( $error ) {
1642     $dbh->rollback if $oldAutoCommit;
1643     return "can't create invoice for customer #". $self->custnum. ": $error";
1644   }
1645   my $invnum = $cust_bill->invnum;
1646
1647   ###
1648   # find the packages which are due for billing, find out how much they are
1649   # & generate invoice database.
1650   ###
1651
1652   my( $total_setup, $total_recur ) = ( 0, 0 );
1653   my %tax;
1654   my @precommit_hooks = ();
1655
1656   foreach my $cust_pkg (
1657     qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1658   ) {
1659
1660     #NO!! next if $cust_pkg->cancel;
1661     next if $cust_pkg->getfield('cancel');
1662
1663     warn "  bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
1664
1665     #? to avoid use of uninitialized value errors... ?
1666     $cust_pkg->setfield('bill', '')
1667       unless defined($cust_pkg->bill);
1668
1669     my $part_pkg = $cust_pkg->part_pkg;
1670
1671     my %hash = $cust_pkg->hash;
1672     my $old_cust_pkg = new FS::cust_pkg \%hash;
1673
1674     my @details = ();
1675
1676     ###
1677     # bill setup
1678     ###
1679
1680     my $setup = 0;
1681     if ( !$cust_pkg->setup || $options{'resetup'} ) {
1682
1683       warn "    bill setup\n" if $DEBUG > 1;
1684
1685       $setup = eval { $cust_pkg->calc_setup( $time ) };
1686       if ( $@ ) {
1687         $dbh->rollback if $oldAutoCommit;
1688         return "$@ running calc_setup for $cust_pkg\n";
1689       }
1690
1691       $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1692     }
1693
1694     ###
1695     # bill recurring fee
1696     ###
1697
1698     my $recur = 0;
1699     my $sdate;
1700     if ( $part_pkg->getfield('freq') ne '0' &&
1701          ! $cust_pkg->getfield('susp') &&
1702          ( $cust_pkg->getfield('bill') || 0 ) <= $time
1703     ) {
1704
1705       warn "    bill recur\n" if $DEBUG > 1;
1706
1707       # XXX shared with $recur_prog
1708       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1709
1710       #over two params!  lets at least switch to a hashref for the rest...
1711       my %param = ( 'precommit_hooks' => \@precommit_hooks, );
1712
1713       $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
1714       if ( $@ ) {
1715         $dbh->rollback if $oldAutoCommit;
1716         return "$@ running calc_recur for $cust_pkg\n";
1717       }
1718
1719       #change this bit to use Date::Manip? CAREFUL with timezones (see
1720       # mailing list archive)
1721       my ($sec,$min,$hour,$mday,$mon,$year) =
1722         (localtime($sdate) )[0,1,2,3,4,5];
1723
1724       #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1725       # only for figuring next bill date, nothing else, so, reset $sdate again
1726       # here
1727       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1728       $cust_pkg->last_bill($sdate)
1729         if $cust_pkg->dbdef_table->column('last_bill');
1730
1731       if ( $part_pkg->freq =~ /^\d+$/ ) {
1732         $mon += $part_pkg->freq;
1733         until ( $mon < 12 ) { $mon -= 12; $year++; }
1734       } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1735         my $weeks = $1;
1736         $mday += $weeks * 7;
1737       } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1738         my $days = $1;
1739         $mday += $days;
1740       } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) {
1741         my $hours = $1;
1742         $hour += $hours;
1743       } else {
1744         $dbh->rollback if $oldAutoCommit;
1745         return "unparsable frequency: ". $part_pkg->freq;
1746       }
1747       $cust_pkg->setfield('bill',
1748         timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1749     }
1750
1751     warn "\$setup is undefined" unless defined($setup);
1752     warn "\$recur is undefined" unless defined($recur);
1753     warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1754
1755     ###
1756     # If $cust_pkg has been modified, update it and create cust_bill_pkg records
1757     ###
1758
1759     if ( $cust_pkg->modified ) {
1760
1761       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n"
1762         if $DEBUG >1;
1763
1764       $error=$cust_pkg->replace($old_cust_pkg);
1765       if ( $error ) { #just in case
1766         $dbh->rollback if $oldAutoCommit;
1767         return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1768       }
1769
1770       $setup = sprintf( "%.2f", $setup );
1771       $recur = sprintf( "%.2f", $recur );
1772       if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1773         $dbh->rollback if $oldAutoCommit;
1774         return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1775       }
1776       if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1777         $dbh->rollback if $oldAutoCommit;
1778         return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1779       }
1780
1781       if ( $setup != 0 || $recur != 0 ) {
1782
1783         warn "    charges (setup=$setup, recur=$recur); adding line items\n"
1784           if $DEBUG > 1;
1785         my $cust_bill_pkg = new FS::cust_bill_pkg ({
1786           'invnum'  => $invnum,
1787           'pkgnum'  => $cust_pkg->pkgnum,
1788           'setup'   => $setup,
1789           'recur'   => $recur,
1790           'sdate'   => $sdate,
1791           'edate'   => $cust_pkg->bill,
1792           'details' => \@details,
1793         });
1794         $error = $cust_bill_pkg->insert;
1795         if ( $error ) {
1796           $dbh->rollback if $oldAutoCommit;
1797           return "can't create invoice line item for invoice #$invnum: $error";
1798         }
1799         $total_setup += $setup;
1800         $total_recur += $recur;
1801
1802         ###
1803         # handle taxes
1804         ###
1805
1806         unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1807
1808           my $prefix =
1809             ( $conf->exists('tax-ship_address') && length($self->ship_last) )
1810             ? 'ship_'
1811             : '';
1812           my %taxhash = map { $_ => $self->get("$prefix$_") }
1813                             qw( state county country );
1814
1815           $taxhash{'taxclass'} = $part_pkg->taxclass;
1816
1817           my @taxes = qsearch( 'cust_main_county', \%taxhash );
1818
1819           unless ( @taxes ) {
1820             $taxhash{'taxclass'} = '';
1821             @taxes =  qsearch( 'cust_main_county', \%taxhash );
1822           }
1823
1824           #one more try at a whole-country tax rate
1825           unless ( @taxes ) {
1826             $taxhash{$_} = '' foreach qw( state county );
1827             @taxes =  qsearch( 'cust_main_county', \%taxhash );
1828           }
1829
1830           # maybe eliminate this entirely, along with all the 0% records
1831           unless ( @taxes ) {
1832             $dbh->rollback if $oldAutoCommit;
1833             return
1834               "fatal: can't find tax rate for state/county/country/taxclass ".
1835               join('/', ( map $self->get("$prefix$_"),
1836                               qw(state county country)
1837                         ),
1838                         $part_pkg->taxclass ). "\n";
1839           }
1840
1841           foreach my $tax ( @taxes ) {
1842
1843             my $taxable_charged = 0;
1844             $taxable_charged += $setup
1845               unless $part_pkg->setuptax =~ /^Y$/i
1846                   || $tax->setuptax =~ /^Y$/i;
1847             $taxable_charged += $recur
1848               unless $part_pkg->recurtax =~ /^Y$/i
1849                   || $tax->recurtax =~ /^Y$/i;
1850             next unless $taxable_charged;
1851
1852             if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) {
1853               #my ($mon,$year) = (localtime($sdate) )[4,5];
1854               my ($mon,$year) = (localtime( $sdate || $cust_bill->_date ) )[4,5];
1855               $mon++;
1856               my $freq = $part_pkg->freq || 1;
1857               if ( $freq !~ /(\d+)$/ ) {
1858                 $dbh->rollback if $oldAutoCommit;
1859                 return "daily/weekly package definitions not (yet?)".
1860                        " compatible with monthly tax exemptions";
1861               }
1862               my $taxable_per_month =
1863                 sprintf("%.2f", $taxable_charged / $freq );
1864
1865               #call the whole thing off if this customer has any old
1866               #exemption records...
1867               my @cust_tax_exempt =
1868                 qsearch( 'cust_tax_exempt' => { custnum=> $self->custnum } );
1869               if ( @cust_tax_exempt ) {
1870                 $dbh->rollback if $oldAutoCommit;
1871                 return
1872                   'this customer still has old-style tax exemption records; '.
1873                   'run bin/fs-migrate-cust_tax_exempt?';
1874               }
1875
1876               foreach my $which_month ( 1 .. $freq ) {
1877
1878                 #maintain the new exemption table now
1879                 my $sql = "
1880                   SELECT SUM(amount)
1881                     FROM cust_tax_exempt_pkg
1882                       LEFT JOIN cust_bill_pkg USING ( billpkgnum )
1883                       LEFT JOIN cust_bill     USING ( invnum     )
1884                     WHERE custnum = ?
1885                       AND taxnum  = ?
1886                       AND year    = ?
1887                       AND month   = ?
1888                 ";
1889                 my $sth = dbh->prepare($sql) or do {
1890                   $dbh->rollback if $oldAutoCommit;
1891                   return "fatal: can't lookup exising exemption: ". dbh->errstr;
1892                 };
1893                 $sth->execute(
1894                   $self->custnum,
1895                   $tax->taxnum,
1896                   1900+$year,
1897                   $mon,
1898                 ) or do {
1899                   $dbh->rollback if $oldAutoCommit;
1900                   return "fatal: can't lookup exising exemption: ". dbh->errstr;
1901                 };
1902                 my $existing_exemption = $sth->fetchrow_arrayref->[0] || 0;
1903
1904                 my $remaining_exemption =
1905                   $tax->exempt_amount - $existing_exemption;
1906                 if ( $remaining_exemption > 0 ) {
1907                   my $addl = $remaining_exemption > $taxable_per_month
1908                     ? $taxable_per_month
1909                     : $remaining_exemption;
1910                   $taxable_charged -= $addl;
1911
1912                   my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg ( {
1913                     'billpkgnum' => $cust_bill_pkg->billpkgnum,
1914                     'taxnum'     => $tax->taxnum,
1915                     'year'       => 1900+$year,
1916                     'month'      => $mon,
1917                     'amount'     => sprintf("%.2f", $addl ),
1918                   } );
1919                   $error = $cust_tax_exempt_pkg->insert;
1920                   if ( $error ) {
1921                     $dbh->rollback if $oldAutoCommit;
1922                     return "fatal: can't insert cust_tax_exempt_pkg: $error";
1923                   }
1924                 } # if $remaining_exemption > 0
1925
1926                 #++
1927                 $mon++;
1928                 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1929                 until ( $mon < 13 ) { $mon -= 12; $year++; }
1930
1931               } #foreach $which_month
1932
1933             } #if $tax->exempt_amount
1934
1935             $taxable_charged = sprintf( "%.2f", $taxable_charged);
1936
1937             #$tax += $taxable_charged * $cust_main_county->tax / 100
1938             $tax{ $tax->taxname || 'Tax' } +=
1939               $taxable_charged * $tax->tax / 100
1940
1941           } #foreach my $tax ( @taxes )
1942
1943         } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1944
1945       } #if $setup != 0 || $recur != 0
1946
1947     } #if $cust_pkg->modified
1948
1949   } #foreach my $cust_pkg
1950
1951   unless ( $cust_bill->cust_bill_pkg ) {
1952     $cust_bill->delete; #don't create an invoice w/o line items
1953     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1954     return '';
1955   }
1956
1957   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1958
1959   foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1960     my $tax = sprintf("%.2f", $tax{$taxname} );
1961     $charged = sprintf( "%.2f", $charged+$tax );
1962
1963     my $cust_bill_pkg = new FS::cust_bill_pkg ({
1964       'invnum'   => $invnum,
1965       'pkgnum'   => 0,
1966       'setup'    => $tax,
1967       'recur'    => 0,
1968       'sdate'    => '',
1969       'edate'    => '',
1970       'itemdesc' => $taxname,
1971     });
1972     $error = $cust_bill_pkg->insert;
1973     if ( $error ) {
1974       $dbh->rollback if $oldAutoCommit;
1975       return "can't create invoice line item for invoice #$invnum: $error";
1976     }
1977     $total_setup += $tax;
1978
1979   }
1980
1981   $cust_bill->charged( sprintf( "%.2f", $total_setup + $total_recur ) );
1982   $error = $cust_bill->replace;
1983   if ( $error ) {
1984     $dbh->rollback if $oldAutoCommit;
1985     return "can't update charged for invoice #$invnum: $error";
1986   }
1987
1988   foreach my $hook ( @precommit_hooks ) {
1989     eval {
1990       &{$hook}; #($self) ?
1991     };
1992     if ( $@ ) {
1993       $dbh->rollback if $oldAutoCommit;
1994       return "$@ running precommit hook $hook\n";
1995     }
1996   }
1997
1998   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1999   ''; #no error
2000 }
2001
2002 =item collect OPTIONS
2003
2004 (Attempt to) collect money for this customer's outstanding invoices (see
2005 L<FS::cust_bill>).  Usually used after the bill method.
2006
2007 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
2008 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
2009 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
2010
2011 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
2012 and the invoice events web interface.
2013
2014 If there is an error, returns the error, otherwise returns false.
2015
2016 Options are passed as name-value pairs.
2017
2018 Currently available options are:
2019
2020 invoice_time - Use this time when deciding when to print invoices and
2021 late notices on those invoices.  The default is now.  It is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse>
2022 for conversion functions.
2023
2024 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
2025 events.
2026
2027 quiet - set true to surpress email card/ACH decline notices.
2028
2029 freq - "1d" for the traditional, daily events (the default), or "1m" for the
2030 new monthly events
2031
2032 =cut
2033
2034 sub collect {
2035   my( $self, %options ) = @_;
2036   my $invoice_time = $options{'invoice_time'} || time;
2037
2038   #put below somehow?
2039   local $SIG{HUP} = 'IGNORE';
2040   local $SIG{INT} = 'IGNORE';
2041   local $SIG{QUIT} = 'IGNORE';
2042   local $SIG{TERM} = 'IGNORE';
2043   local $SIG{TSTP} = 'IGNORE';
2044   local $SIG{PIPE} = 'IGNORE';
2045
2046   my $oldAutoCommit = $FS::UID::AutoCommit;
2047   local $FS::UID::AutoCommit = 0;
2048   my $dbh = dbh;
2049
2050   $self->select_for_update; #mutex
2051
2052   my $balance = $self->balance;
2053   warn "$me collect customer ". $self->custnum. ": balance $balance\n"
2054     if $DEBUG;
2055   unless ( $balance > 0 ) { #redundant?????
2056     $dbh->rollback if $oldAutoCommit; #hmm
2057     return '';
2058   }
2059
2060   if ( exists($options{'retry_card'}) ) {
2061     carp 'retry_card option passed to collect is deprecated; use retry';
2062     $options{'retry'} ||= $options{'retry_card'};
2063   }
2064   if ( exists($options{'retry'}) && $options{'retry'} ) {
2065     my $error = $self->retry_realtime;
2066     if ( $error ) {
2067       $dbh->rollback if $oldAutoCommit;
2068       return $error;
2069     }
2070   }
2071
2072   my $extra_sql = '';
2073   if ( defined $options{'freq'} && $options{'freq'} eq '1m' ) {
2074     $extra_sql = " AND freq = '1m' ";
2075   } else {
2076     $extra_sql = " AND ( freq = '1d' OR freq IS NULL OR freq = '' ) ";
2077   }
2078
2079   foreach my $cust_bill ( $self->open_cust_bill ) {
2080
2081     # don't try to charge for the same invoice if it's already in a batch
2082     #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
2083
2084     last if $self->balance <= 0;
2085
2086     warn "  invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n"
2087       if $DEBUG > 1;
2088
2089     foreach my $part_bill_event (
2090       sort {    $a->seconds   <=> $b->seconds
2091              || $a->weight    <=> $b->weight
2092              || $a->eventpart <=> $b->eventpart }
2093         grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
2094                && ! qsearch( 'cust_bill_event', {
2095                                 'invnum'    => $cust_bill->invnum,
2096                                 'eventpart' => $_->eventpart,
2097                                 'status'    => 'done',
2098                                                                    } )
2099              }
2100           qsearch( {
2101             'table'     => 'part_bill_event',
2102             'hashref'   => { 'payby'    => $self->payby,
2103                              'disabled' => '',           },
2104             'extra_sql' => $extra_sql,
2105           } )
2106     ) {
2107
2108       last if $cust_bill->owed <= 0  # don't run subsequent events if owed<=0
2109            || $self->balance   <= 0; # or if balance<=0
2110
2111       warn "  calling invoice event (". $part_bill_event->eventcode. ")\n"
2112         if $DEBUG > 1;
2113       my $cust_main = $self; #for callback
2114
2115       my $error;
2116       {
2117         local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2118         local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
2119         $error = eval $part_bill_event->eventcode;
2120       }
2121
2122       my $status = '';
2123       my $statustext = '';
2124       if ( $@ ) {
2125         $status = 'failed';
2126         $statustext = $@;
2127       } elsif ( $error ) {
2128         $status = 'done';
2129         $statustext = $error;
2130       } else {
2131         $status = 'done'
2132       }
2133
2134       #add cust_bill_event
2135       my $cust_bill_event = new FS::cust_bill_event {
2136         'invnum'     => $cust_bill->invnum,
2137         'eventpart'  => $part_bill_event->eventpart,
2138         #'_date'      => $invoice_time,
2139         '_date'      => time,
2140         'status'     => $status,
2141         'statustext' => $statustext,
2142       };
2143       $error = $cust_bill_event->insert;
2144       if ( $error ) {
2145         #$dbh->rollback if $oldAutoCommit;
2146         #return "error: $error";
2147
2148         # gah, even with transactions.
2149         $dbh->commit if $oldAutoCommit; #well.
2150         my $e = 'WARNING: Event run but database not updated - '.
2151                 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
2152                 ', eventpart '. $part_bill_event->eventpart.
2153                 ": $error";
2154         warn $e;
2155         return $e;
2156       }
2157
2158
2159     }
2160
2161   }
2162
2163   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2164   '';
2165
2166 }
2167
2168 =item retry_realtime
2169
2170 Schedules realtime credit card / electronic check / LEC billing events for
2171 for retry.  Useful if card information has changed or manual retry is desired.
2172 The 'collect' method must be called to actually retry the transaction.
2173
2174 Implementation details: For each of this customer's open invoices, changes
2175 the status of the first "done" (with statustext error) realtime processing
2176 event to "failed".
2177
2178 =cut
2179
2180 sub retry_realtime {
2181   my $self = shift;
2182
2183   local $SIG{HUP} = 'IGNORE';
2184   local $SIG{INT} = 'IGNORE';
2185   local $SIG{QUIT} = 'IGNORE';
2186   local $SIG{TERM} = 'IGNORE';
2187   local $SIG{TSTP} = 'IGNORE';
2188   local $SIG{PIPE} = 'IGNORE';
2189
2190   my $oldAutoCommit = $FS::UID::AutoCommit;
2191   local $FS::UID::AutoCommit = 0;
2192   my $dbh = dbh;
2193
2194   foreach my $cust_bill (
2195     grep { $_->cust_bill_event }
2196       $self->open_cust_bill
2197   ) {
2198     my @cust_bill_event =
2199       sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
2200         grep {
2201                #$_->part_bill_event->plan eq 'realtime-card'
2202                $_->part_bill_event->eventcode =~
2203                    /\$cust_bill\->realtime_(card|ach|lec)/
2204                  && $_->status eq 'done'
2205                  && $_->statustext
2206              }
2207           $cust_bill->cust_bill_event;
2208     next unless @cust_bill_event;
2209     my $error = $cust_bill_event[0]->retry;
2210     if ( $error ) {
2211       $dbh->rollback if $oldAutoCommit;
2212       return "error scheduling invoice event for retry: $error";
2213     }
2214
2215   }
2216
2217   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2218   '';
2219
2220 }
2221
2222 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
2223
2224 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
2225 via a Business::OnlinePayment realtime gateway.  See
2226 L<http://420.am/business-onlinepayment> for supported gateways.
2227
2228 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2229
2230 Available options are: I<description>, I<invnum>, I<quiet>
2231
2232 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2233 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
2234 if set, will override the value from the customer record.
2235
2236 I<description> is a free-text field passed to the gateway.  It defaults to
2237 "Internet services".
2238
2239 If an I<invnum> is specified, this payment (if successful) is applied to the
2240 specified invoice.  If you don't specify an I<invnum> you might want to
2241 call the B<apply_payments> method.
2242
2243 I<quiet> can be set true to surpress email decline notices.
2244
2245 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
2246
2247 =cut
2248
2249 sub realtime_bop {
2250   my( $self, $method, $amount, %options ) = @_;
2251   if ( $DEBUG ) {
2252     warn "$me realtime_bop: $method $amount\n";
2253     warn "  $_ => $options{$_}\n" foreach keys %options;
2254   }
2255
2256   $options{'description'} ||= 'Internet services';
2257
2258   eval "use Business::OnlinePayment";
2259   die $@ if $@;
2260
2261   my $payinfo = exists($options{'payinfo'})
2262                   ? $options{'payinfo'}
2263                   : $self->payinfo;
2264
2265   ###
2266   # select a gateway
2267   ###
2268
2269   my $taxclass = '';
2270   if ( $options{'invnum'} ) {
2271     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
2272     die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
2273     my @taxclasses =
2274       map  { $_->part_pkg->taxclass }
2275       grep { $_ }
2276       map  { $_->cust_pkg }
2277       $cust_bill->cust_bill_pkg;
2278     unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are
2279                                                            #different taxclasses
2280       $taxclass = $taxclasses[0];
2281     }
2282   }
2283
2284   #look for an agent gateway override first
2285   my $cardtype;
2286   if ( $method eq 'CC' ) {
2287     $cardtype = cardtype($payinfo);
2288   } elsif ( $method eq 'ECHECK' ) {
2289     $cardtype = 'ACH';
2290   } else {
2291     $cardtype = $method;
2292   }
2293
2294   my $override =
2295        qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2296                                            cardtype => $cardtype,
2297                                            taxclass => $taxclass,       } )
2298     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2299                                            cardtype => '',
2300                                            taxclass => $taxclass,       } )
2301     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2302                                            cardtype => $cardtype,
2303                                            taxclass => '',              } )
2304     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2305                                            cardtype => '',
2306                                            taxclass => '',              } );
2307
2308   my $payment_gateway = '';
2309   my( $processor, $login, $password, $action, @bop_options );
2310   if ( $override ) { #use a payment gateway override
2311
2312     $payment_gateway = $override->payment_gateway;
2313
2314     $processor   = $payment_gateway->gateway_module;
2315     $login       = $payment_gateway->gateway_username;
2316     $password    = $payment_gateway->gateway_password;
2317     $action      = $payment_gateway->gateway_action;
2318     @bop_options = $payment_gateway->options;
2319
2320   } else { #use the standard settings from the config
2321
2322     ( $processor, $login, $password, $action, @bop_options ) =
2323       $self->default_payment_gateway($method);
2324
2325   }
2326
2327   ###
2328   # massage data
2329   ###
2330
2331   my $address = exists($options{'address1'})
2332                     ? $options{'address1'}
2333                     : $self->address1;
2334   my $address2 = exists($options{'address2'})
2335                     ? $options{'address2'}
2336                     : $self->address2;
2337   $address .= ", ". $address2 if length($address2);
2338
2339   my $o_payname = exists($options{'payname'})
2340                     ? $options{'payname'}
2341                     : $self->payname;
2342   my($payname, $payfirst, $paylast);
2343   if ( $o_payname && $method ne 'ECHECK' ) {
2344     ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2345       or return "Illegal payname $payname";
2346     ($payfirst, $paylast) = ($1, $2);
2347   } else {
2348     $payfirst = $self->getfield('first');
2349     $paylast = $self->getfield('last');
2350     $payname =  "$payfirst $paylast";
2351   }
2352
2353   my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
2354   if ( $conf->exists('emailinvoiceauto')
2355        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
2356     push @invoicing_list, $self->all_emails;
2357   }
2358
2359   my $email = ($conf->exists('business-onlinepayment-email-override'))
2360               ? $conf->config('business-onlinepayment-email-override')
2361               : $invoicing_list[0];
2362
2363   my %content = ();
2364
2365   my $payip = exists($options{'payip'})
2366                 ? $options{'payip'}
2367                 : $self->payip;
2368   $content{customer_ip} = $payip
2369     if length($payip);
2370
2371   if ( $method eq 'CC' ) {
2372
2373     $content{card_number} = $payinfo;
2374     my $paydate = exists($options{'paydate'})
2375                     ? $options{'paydate'}
2376                     : $self->paydate;
2377     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2378     $content{expiration} = "$2/$1";
2379
2380     my $paycvv = exists($options{'paycvv'})
2381                    ? $options{'paycvv'}
2382                    : $self->paycvv;
2383     $content{cvv2} = $self->paycvv
2384       if length($paycvv);
2385
2386     my $paystart_month = exists($options{'paystart_month'})
2387                            ? $options{'paystart_month'}
2388                            : $self->paystart_month;
2389
2390     my $paystart_year  = exists($options{'paystart_year'})
2391                            ? $options{'paystart_year'}
2392                            : $self->paystart_year;
2393
2394     $content{card_start} = "$paystart_month/$paystart_year"
2395       if $paystart_month && $paystart_year;
2396
2397     my $payissue       = exists($options{'payissue'})
2398                            ? $options{'payissue'}
2399                            : $self->payissue;
2400     $content{issue_number} = $payissue if $payissue;
2401
2402     $content{recurring_billing} = 'YES'
2403       if qsearch('cust_pay', { 'custnum' => $self->custnum,
2404                                'payby'   => 'CARD',
2405                                'payinfo' => $payinfo,
2406                              } );
2407
2408   } elsif ( $method eq 'ECHECK' ) {
2409     ( $content{account_number}, $content{routing_code} ) =
2410       split('@', $payinfo);
2411     $content{bank_name} = $o_payname;
2412     $content{account_type} = 'CHECKING';
2413     $content{account_name} = $payname;
2414     $content{customer_org} = $self->company ? 'B' : 'I';
2415     $content{customer_ssn} = exists($options{'ss'})
2416                                ? $options{'ss'}
2417                                : $self->ss;
2418   } elsif ( $method eq 'LEC' ) {
2419     $content{phone} = $payinfo;
2420   }
2421
2422   ###
2423   # run transaction(s)
2424   ###
2425
2426   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
2427
2428   my $transaction = new Business::OnlinePayment( $processor, @bop_options );
2429   $transaction->content(
2430     'type'           => $method,
2431     'login'          => $login,
2432     'password'       => $password,
2433     'action'         => $action1,
2434     'description'    => $options{'description'},
2435     'amount'         => $amount,
2436     'invoice_number' => $options{'invnum'},
2437     'customer_id'    => $self->custnum,
2438     'last_name'      => $paylast,
2439     'first_name'     => $payfirst,
2440     'name'           => $payname,
2441     'address'        => $address,
2442     'city'           => ( exists($options{'city'})
2443                             ? $options{'city'}
2444                             : $self->city          ),
2445     'state'          => ( exists($options{'state'})
2446                             ? $options{'state'}
2447                             : $self->state          ),
2448     'zip'            => ( exists($options{'zip'})
2449                             ? $options{'zip'}
2450                             : $self->zip          ),
2451     'country'        => ( exists($options{'country'})
2452                             ? $options{'country'}
2453                             : $self->country          ),
2454     'referer'        => 'http://cleanwhisker.420.am/',
2455     'email'          => $email,
2456     'phone'          => $self->daytime || $self->night,
2457     %content, #after
2458   );
2459   $transaction->submit();
2460
2461   if ( $transaction->is_success() && $action2 ) {
2462     my $auth = $transaction->authorization;
2463     my $ordernum = $transaction->can('order_number')
2464                    ? $transaction->order_number
2465                    : '';
2466
2467     my $capture =
2468       new Business::OnlinePayment( $processor, @bop_options );
2469
2470     my %capture = (
2471       %content,
2472       type           => $method,
2473       action         => $action2,
2474       login          => $login,
2475       password       => $password,
2476       order_number   => $ordernum,
2477       amount         => $amount,
2478       authorization  => $auth,
2479       description    => $options{'description'},
2480     );
2481
2482     foreach my $field (qw( authorization_source_code returned_ACI                                          transaction_identifier validation_code
2483                            transaction_sequence_num local_transaction_date
2484                            local_transaction_time AVS_result_code          )) {
2485       $capture{$field} = $transaction->$field() if $transaction->can($field);
2486     }
2487
2488     $capture->content( %capture );
2489
2490     $capture->submit();
2491
2492     unless ( $capture->is_success ) {
2493       my $e = "Authorization successful but capture failed, custnum #".
2494               $self->custnum. ': '.  $capture->result_code.
2495               ": ". $capture->error_message;
2496       warn $e;
2497       return $e;
2498     }
2499
2500   }
2501
2502   ###
2503   # remove paycvv after initial transaction
2504   ###
2505
2506   #false laziness w/misc/process/payment.cgi - check both to make sure working
2507   # correctly
2508   if ( defined $self->dbdef_table->column('paycvv')
2509        && length($self->paycvv)
2510        && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
2511   ) {
2512     my $error = $self->remove_cvv;
2513     if ( $error ) {
2514       warn "WARNING: error removing cvv: $error\n";
2515     }
2516   }
2517
2518   ###
2519   # result handling
2520   ###
2521
2522   if ( $transaction->is_success() ) {
2523
2524     my %method2payby = (
2525       'CC'     => 'CARD',
2526       'ECHECK' => 'CHEK',
2527       'LEC'    => 'LECB',
2528     );
2529
2530     my $paybatch = '';
2531     if ( $payment_gateway ) { # agent override
2532       $paybatch = $payment_gateway->gatewaynum. '-';
2533     }
2534
2535     $paybatch .= "$processor:". $transaction->authorization;
2536
2537     $paybatch .= ':'. $transaction->order_number
2538       if $transaction->can('order_number')
2539       && length($transaction->order_number);
2540
2541     my $cust_pay = new FS::cust_pay ( {
2542        'custnum'  => $self->custnum,
2543        'invnum'   => $options{'invnum'},
2544        'paid'     => $amount,
2545        '_date'     => '',
2546        'payby'    => $method2payby{$method},
2547        'payinfo'  => $payinfo,
2548        'paybatch' => $paybatch,
2549     } );
2550     my $error = $cust_pay->insert;
2551     if ( $error ) {
2552       $cust_pay->invnum(''); #try again with no specific invnum
2553       my $error2 = $cust_pay->insert;
2554       if ( $error2 ) {
2555         # gah, even with transactions.
2556         my $e = 'WARNING: Card/ACH debited but database not updated - '.
2557                 "error inserting payment ($processor): $error2".
2558                 " (previously tried insert with invnum #$options{'invnum'}" .
2559                 ": $error )";
2560         warn $e;
2561         return $e;
2562       }
2563     }
2564     return ''; #no error
2565
2566   } else {
2567
2568     my $perror = "$processor error: ". $transaction->error_message;
2569
2570     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
2571          && $conf->exists('emaildecline')
2572          && grep { $_ ne 'POST' } $self->invoicing_list
2573          && ! grep { $transaction->error_message =~ /$_/ }
2574                    $conf->config('emaildecline-exclude')
2575     ) {
2576       my @templ = $conf->config('declinetemplate');
2577       my $template = new Text::Template (
2578         TYPE   => 'ARRAY',
2579         SOURCE => [ map "$_\n", @templ ],
2580       ) or return "($perror) can't create template: $Text::Template::ERROR";
2581       $template->compile()
2582         or return "($perror) can't compile template: $Text::Template::ERROR";
2583
2584       my $templ_hash = { error => $transaction->error_message };
2585
2586       my $error = send_email(
2587         'from'    => $conf->config('invoice_from'),
2588         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
2589         'subject' => 'Your payment could not be processed',
2590         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
2591       );
2592
2593       $perror .= " (also received error sending decline notification: $error)"
2594         if $error;
2595
2596     }
2597
2598     return $perror;
2599   }
2600
2601 }
2602
2603 =item default_payment_gateway
2604
2605 =cut
2606
2607 sub default_payment_gateway {
2608   my( $self, $method ) = @_;
2609
2610   die "Real-time processing not enabled\n"
2611     unless $conf->exists('business-onlinepayment');
2612
2613   #load up config
2614   my $bop_config = 'business-onlinepayment';
2615   $bop_config .= '-ach'
2616     if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2617   my ( $processor, $login, $password, $action, @bop_options ) =
2618     $conf->config($bop_config);
2619   $action ||= 'normal authorization';
2620   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2621   die "No real-time processor is enabled - ".
2622       "did you set the business-onlinepayment configuration value?\n"
2623     unless $processor;
2624
2625   ( $processor, $login, $password, $action, @bop_options )
2626 }
2627
2628 =item remove_cvv
2629
2630 Removes the I<paycvv> field from the database directly.
2631
2632 If there is an error, returns the error, otherwise returns false.
2633
2634 =cut
2635
2636 sub remove_cvv {
2637   my $self = shift;
2638   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2639     or return dbh->errstr;
2640   $sth->execute($self->custnum)
2641     or return $sth->errstr;
2642   $self->paycvv('');
2643   '';
2644 }
2645
2646 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
2647
2648 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2649 via a Business::OnlinePayment realtime gateway.  See
2650 L<http://420.am/business-onlinepayment> for supported gateways.
2651
2652 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2653
2654 Available options are: I<amount>, I<reason>, I<paynum>
2655
2656 Most gateways require a reference to an original payment transaction to refund,
2657 so you probably need to specify a I<paynum>.
2658
2659 I<amount> defaults to the original amount of the payment if not specified.
2660
2661 I<reason> specifies a reason for the refund.
2662
2663 Implementation note: If I<amount> is unspecified or equal to the amount of the
2664 orignal payment, first an attempt is made to "void" the transaction via
2665 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2666 the normal attempt is made to "refund" ("credit") the transaction via the
2667 gateway is attempted.
2668
2669 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2670 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
2671 #if set, will override the value from the customer record.
2672
2673 #If an I<invnum> is specified, this payment (if successful) is applied to the
2674 #specified invoice.  If you don't specify an I<invnum> you might want to
2675 #call the B<apply_payments> method.
2676
2677 =cut
2678
2679 #some false laziness w/realtime_bop, not enough to make it worth merging
2680 #but some useful small subs should be pulled out
2681 sub realtime_refund_bop {
2682   my( $self, $method, %options ) = @_;
2683   if ( $DEBUG ) {
2684     warn "$me realtime_refund_bop: $method refund\n";
2685     warn "  $_ => $options{$_}\n" foreach keys %options;
2686   }
2687
2688   eval "use Business::OnlinePayment";
2689   die $@ if $@;
2690
2691   ###
2692   # look up the original payment and optionally a gateway for that payment
2693   ###
2694
2695   my $cust_pay = '';
2696   my $amount = $options{'amount'};
2697
2698   my( $processor, $login, $password, @bop_options ) ;
2699   my( $auth, $order_number ) = ( '', '', '' );
2700
2701   if ( $options{'paynum'} ) {
2702
2703     warn "  paynum: $options{paynum}\n" if $DEBUG > 1;
2704     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2705       or return "Unknown paynum $options{'paynum'}";
2706     $amount ||= $cust_pay->paid;
2707
2708     $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-]*)(:([\w\-]+))?$/
2709       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2710                 $cust_pay->paybatch;
2711     my $gatewaynum = '';
2712     ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
2713
2714     if ( $gatewaynum ) { #gateway for the payment to be refunded
2715
2716       my $payment_gateway =
2717         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
2718       die "payment gateway $gatewaynum not found"
2719         unless $payment_gateway;
2720
2721       $processor   = $payment_gateway->gateway_module;
2722       $login       = $payment_gateway->gateway_username;
2723       $password    = $payment_gateway->gateway_password;
2724       @bop_options = $payment_gateway->options;
2725
2726     } else { #try the default gateway
2727
2728       my( $conf_processor, $unused_action );
2729       ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
2730         $self->default_payment_gateway($method);
2731
2732       return "processor of payment $options{'paynum'} $processor does not".
2733              " match default processor $conf_processor"
2734         unless $processor eq $conf_processor;
2735
2736     }
2737
2738
2739   } else { # didn't specify a paynum, so look for agent gateway overrides
2740            # like a normal transaction
2741
2742     my $cardtype;
2743     if ( $method eq 'CC' ) {
2744       $cardtype = cardtype($self->payinfo);
2745     } elsif ( $method eq 'ECHECK' ) {
2746       $cardtype = 'ACH';
2747     } else {
2748       $cardtype = $method;
2749     }
2750     my $override =
2751            qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2752                                                cardtype => $cardtype,
2753                                                taxclass => '',              } )
2754         || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2755                                                cardtype => '',
2756                                                taxclass => '',              } );
2757
2758     if ( $override ) { #use a payment gateway override
2759
2760       my $payment_gateway = $override->payment_gateway;
2761
2762       $processor   = $payment_gateway->gateway_module;
2763       $login       = $payment_gateway->gateway_username;
2764       $password    = $payment_gateway->gateway_password;
2765       #$action      = $payment_gateway->gateway_action;
2766       @bop_options = $payment_gateway->options;
2767
2768     } else { #use the standard settings from the config
2769
2770       my $unused_action;
2771       ( $processor, $login, $password, $unused_action, @bop_options ) =
2772         $self->default_payment_gateway($method);
2773
2774     }
2775
2776   }
2777   return "neither amount nor paynum specified" unless $amount;
2778
2779   my %content = (
2780     'type'           => $method,
2781     'login'          => $login,
2782     'password'       => $password,
2783     'order_number'   => $order_number,
2784     'amount'         => $amount,
2785     'referer'        => 'http://cleanwhisker.420.am/',
2786   );
2787   $content{authorization} = $auth
2788     if length($auth); #echeck/ACH transactions have an order # but no auth
2789                       #(at least with authorize.net)
2790
2791   #first try void if applicable
2792   if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2793     warn "  attempting void\n" if $DEBUG > 1;
2794     my $void = new Business::OnlinePayment( $processor, @bop_options );
2795     $void->content( 'action' => 'void', %content );
2796     $void->submit();
2797     if ( $void->is_success ) {
2798       my $error = $cust_pay->void($options{'reason'});
2799       if ( $error ) {
2800         # gah, even with transactions.
2801         my $e = 'WARNING: Card/ACH voided but database not updated - '.
2802                 "error voiding payment: $error";
2803         warn $e;
2804         return $e;
2805       }
2806       warn "  void successful\n" if $DEBUG > 1;
2807       return '';
2808     }
2809   }
2810
2811   warn "  void unsuccessful, trying refund\n"
2812     if $DEBUG > 1;
2813
2814   #massage data
2815   my $address = $self->address1;
2816   $address .= ", ". $self->address2 if $self->address2;
2817
2818   my($payname, $payfirst, $paylast);
2819   if ( $self->payname && $method ne 'ECHECK' ) {
2820     $payname = $self->payname;
2821     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2822       or return "Illegal payname $payname";
2823     ($payfirst, $paylast) = ($1, $2);
2824   } else {
2825     $payfirst = $self->getfield('first');
2826     $paylast = $self->getfield('last');
2827     $payname =  "$payfirst $paylast";
2828   }
2829
2830   my $payinfo = '';
2831   if ( $method eq 'CC' ) {
2832
2833     if ( $cust_pay ) {
2834       $content{card_number} = $payinfo = $cust_pay->payinfo;
2835       #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2836       #$content{expiration} = "$2/$1";
2837     } else {
2838       $content{card_number} = $payinfo = $self->payinfo;
2839       $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2840       $content{expiration} = "$2/$1";
2841     }
2842
2843   } elsif ( $method eq 'ECHECK' ) {
2844     ( $content{account_number}, $content{routing_code} ) =
2845       split('@', $payinfo = $self->payinfo);
2846     $content{bank_name} = $self->payname;
2847     $content{account_type} = 'CHECKING';
2848     $content{account_name} = $payname;
2849     $content{customer_org} = $self->company ? 'B' : 'I';
2850     $content{customer_ssn} = $self->ss;
2851   } elsif ( $method eq 'LEC' ) {
2852     $content{phone} = $payinfo = $self->payinfo;
2853   }
2854
2855   #then try refund
2856   my $refund = new Business::OnlinePayment( $processor, @bop_options );
2857   my %sub_content = $refund->content(
2858     'action'         => 'credit',
2859     'customer_id'    => $self->custnum,
2860     'last_name'      => $paylast,
2861     'first_name'     => $payfirst,
2862     'name'           => $payname,
2863     'address'        => $address,
2864     'city'           => $self->city,
2865     'state'          => $self->state,
2866     'zip'            => $self->zip,
2867     'country'        => $self->country,
2868     %content, #after
2869   );
2870   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
2871     if $DEBUG > 1;
2872   $refund->submit();
2873
2874   return "$processor error: ". $refund->error_message
2875     unless $refund->is_success();
2876
2877   my %method2payby = (
2878     'CC'     => 'CARD',
2879     'ECHECK' => 'CHEK',
2880     'LEC'    => 'LECB',
2881   );
2882
2883   my $paybatch = "$processor:". $refund->authorization;
2884   $paybatch .= ':'. $refund->order_number
2885     if $refund->can('order_number') && $refund->order_number;
2886
2887   while ( $cust_pay && $cust_pay->unappled < $amount ) {
2888     my @cust_bill_pay = $cust_pay->cust_bill_pay;
2889     last unless @cust_bill_pay;
2890     my $cust_bill_pay = pop @cust_bill_pay;
2891     my $error = $cust_bill_pay->delete;
2892     last if $error;
2893   }
2894
2895   my $cust_refund = new FS::cust_refund ( {
2896     'custnum'  => $self->custnum,
2897     'paynum'   => $options{'paynum'},
2898     'refund'   => $amount,
2899     '_date'    => '',
2900     'payby'    => $method2payby{$method},
2901     'payinfo'  => $payinfo,
2902     'paybatch' => $paybatch,
2903     'reason'   => $options{'reason'} || 'card or ACH refund',
2904   } );
2905   my $error = $cust_refund->insert;
2906   if ( $error ) {
2907     $cust_refund->paynum(''); #try again with no specific paynum
2908     my $error2 = $cust_refund->insert;
2909     if ( $error2 ) {
2910       # gah, even with transactions.
2911       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
2912               "error inserting refund ($processor): $error2".
2913               " (previously tried insert with paynum #$options{'paynum'}" .
2914               ": $error )";
2915       warn $e;
2916       return $e;
2917     }
2918   }
2919
2920   ''; #no error
2921
2922 }
2923
2924 =item total_owed
2925
2926 Returns the total owed for this customer on all invoices
2927 (see L<FS::cust_bill/owed>).
2928
2929 =cut
2930
2931 sub total_owed {
2932   my $self = shift;
2933   $self->total_owed_date(2145859200); #12/31/2037
2934 }
2935
2936 =item total_owed_date TIME
2937
2938 Returns the total owed for this customer on all invoices with date earlier than
2939 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2940 see L<Time::Local> and L<Date::Parse> for conversion functions.
2941
2942 =cut
2943
2944 sub total_owed_date {
2945   my $self = shift;
2946   my $time = shift;
2947   my $total_bill = 0;
2948   foreach my $cust_bill (
2949     grep { $_->_date <= $time }
2950       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2951   ) {
2952     $total_bill += $cust_bill->owed;
2953   }
2954   sprintf( "%.2f", $total_bill );
2955 }
2956
2957 =item apply_credits OPTION => VALUE ...
2958
2959 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2960 to outstanding invoice balances in chronological order (or reverse
2961 chronological order if the I<order> option is set to B<newest>) and returns the
2962 value of any remaining unapplied credits available for refund (see
2963 L<FS::cust_refund>).
2964
2965 =cut
2966
2967 sub apply_credits {
2968   my $self = shift;
2969   my %opt = @_;
2970
2971   return 0 unless $self->total_credited;
2972
2973   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2974       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2975
2976   my @invoices = $self->open_cust_bill;
2977   @invoices = sort { $b->_date <=> $a->_date } @invoices
2978     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2979
2980   my $credit;
2981   foreach my $cust_bill ( @invoices ) {
2982     my $amount;
2983
2984     if ( !defined($credit) || $credit->credited == 0) {
2985       $credit = pop @credits or last;
2986     }
2987
2988     if ($cust_bill->owed >= $credit->credited) {
2989       $amount=$credit->credited;
2990     }else{
2991       $amount=$cust_bill->owed;
2992     }
2993
2994     my $cust_credit_bill = new FS::cust_credit_bill ( {
2995       'crednum' => $credit->crednum,
2996       'invnum'  => $cust_bill->invnum,
2997       'amount'  => $amount,
2998     } );
2999     my $error = $cust_credit_bill->insert;
3000     die $error if $error;
3001
3002     redo if ($cust_bill->owed > 0);
3003
3004   }
3005
3006   return $self->total_credited;
3007 }
3008
3009 =item apply_payments
3010
3011 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
3012 to outstanding invoice balances in chronological order.
3013
3014  #and returns the value of any remaining unapplied payments.
3015
3016 =cut
3017
3018 sub apply_payments {
3019   my $self = shift;
3020
3021   #return 0 unless
3022
3023   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
3024       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
3025
3026   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
3027       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
3028
3029   my $payment;
3030
3031   foreach my $cust_bill ( @invoices ) {
3032     my $amount;
3033
3034     if ( !defined($payment) || $payment->unapplied == 0 ) {
3035       $payment = pop @payments or last;
3036     }
3037
3038     if ( $cust_bill->owed >= $payment->unapplied ) {
3039       $amount = $payment->unapplied;
3040     } else {
3041       $amount = $cust_bill->owed;
3042     }
3043
3044     my $cust_bill_pay = new FS::cust_bill_pay ( {
3045       'paynum' => $payment->paynum,
3046       'invnum' => $cust_bill->invnum,
3047       'amount' => $amount,
3048     } );
3049     my $error = $cust_bill_pay->insert;
3050     die $error if $error;
3051
3052     redo if ( $cust_bill->owed > 0);
3053
3054   }
3055
3056   return $self->total_unapplied_payments;
3057 }
3058
3059 =item total_credited
3060
3061 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3062 customer.  See L<FS::cust_credit/credited>.
3063
3064 =cut
3065
3066 sub total_credited {
3067   my $self = shift;
3068   my $total_credit = 0;
3069   foreach my $cust_credit ( qsearch('cust_credit', {
3070     'custnum' => $self->custnum,
3071   } ) ) {
3072     $total_credit += $cust_credit->credited;
3073   }
3074   sprintf( "%.2f", $total_credit );
3075 }
3076
3077 =item total_unapplied_payments
3078
3079 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
3080 See L<FS::cust_pay/unapplied>.
3081
3082 =cut
3083
3084 sub total_unapplied_payments {
3085   my $self = shift;
3086   my $total_unapplied = 0;
3087   foreach my $cust_pay ( qsearch('cust_pay', {
3088     'custnum' => $self->custnum,
3089   } ) ) {
3090     $total_unapplied += $cust_pay->unapplied;
3091   }
3092   sprintf( "%.2f", $total_unapplied );
3093 }
3094
3095 =item balance
3096
3097 Returns the balance for this customer (total_owed minus total_credited
3098 minus total_unapplied_payments).
3099
3100 =cut
3101
3102 sub balance {
3103   my $self = shift;
3104   sprintf( "%.2f",
3105     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
3106   );
3107 }
3108
3109 =item balance_date TIME
3110
3111 Returns the balance for this customer, only considering invoices with date
3112 earlier than TIME (total_owed_date minus total_credited minus
3113 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
3114 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
3115 functions.
3116
3117 =cut
3118
3119 sub balance_date {
3120   my $self = shift;
3121   my $time = shift;
3122   sprintf( "%.2f",
3123     $self->total_owed_date($time)
3124       - $self->total_credited
3125       - $self->total_unapplied_payments
3126   );
3127 }
3128
3129 =item paydate_monthyear
3130
3131 Returns a two-element list consisting of the month and year of this customer's
3132 paydate (credit card expiration date for CARD customers)
3133
3134 =cut
3135
3136 sub paydate_monthyear {
3137   my $self = shift;
3138   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3139     ( $2, $1 );
3140   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3141     ( $1, $3 );
3142   } else {
3143     ('', '');
3144   }
3145 }
3146
3147 =item payinfo_masked
3148
3149 Returns a "masked" payinfo field appropriate to the payment type.  Masked characters are replaced by 'x'es.  Use this to display publicly accessable account Information.
3150
3151 Credit Cards - Mask all but the last four characters.
3152 Checks - Mask all but last 2 of account number and bank routing number.
3153 Others - Do nothing, return the unmasked string.
3154
3155 =cut
3156
3157 sub payinfo_masked {
3158   my $self = shift;
3159   return $self->paymask;
3160 }
3161
3162 =item invoicing_list [ ARRAYREF ]
3163
3164 If an arguement is given, sets these email addresses as invoice recipients
3165 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
3166 (except as warnings), so use check_invoicing_list first.
3167
3168 Returns a list of email addresses (with svcnum entries expanded).
3169
3170 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
3171 check it without disturbing anything by passing nothing.
3172
3173 This interface may change in the future.
3174
3175 =cut
3176
3177 sub invoicing_list {
3178   my( $self, $arrayref ) = @_;
3179   if ( $arrayref ) {
3180     my @cust_main_invoice;
3181     if ( $self->custnum ) {
3182       @cust_main_invoice =
3183         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3184     } else {
3185       @cust_main_invoice = ();
3186     }
3187     foreach my $cust_main_invoice ( @cust_main_invoice ) {
3188       #warn $cust_main_invoice->destnum;
3189       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3190         #warn $cust_main_invoice->destnum;
3191         my $error = $cust_main_invoice->delete;
3192         warn $error if $error;
3193       }
3194     }
3195     if ( $self->custnum ) {
3196       @cust_main_invoice =
3197         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3198     } else {
3199       @cust_main_invoice = ();
3200     }
3201     my %seen = map { $_->address => 1 } @cust_main_invoice;
3202     foreach my $address ( @{$arrayref} ) {
3203       next if exists $seen{$address} && $seen{$address};
3204       $seen{$address} = 1;
3205       my $cust_main_invoice = new FS::cust_main_invoice ( {
3206         'custnum' => $self->custnum,
3207         'dest'    => $address,
3208       } );
3209       my $error = $cust_main_invoice->insert;
3210       warn $error if $error;
3211     }
3212   }
3213   if ( $self->custnum ) {
3214     map { $_->address }
3215       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3216   } else {
3217     ();
3218   }
3219 }
3220
3221 =item check_invoicing_list ARRAYREF
3222
3223 Checks these arguements as valid input for the invoicing_list method.  If there
3224 is an error, returns the error, otherwise returns false.
3225
3226 =cut
3227
3228 sub check_invoicing_list {
3229   my( $self, $arrayref ) = @_;
3230   foreach my $address ( @{$arrayref} ) {
3231
3232     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3233       return 'Can\'t add FAX invoice destination with a blank FAX number.';
3234     }
3235
3236     my $cust_main_invoice = new FS::cust_main_invoice ( {
3237       'custnum' => $self->custnum,
3238       'dest'    => $address,
3239     } );
3240     my $error = $self->custnum
3241                 ? $cust_main_invoice->check
3242                 : $cust_main_invoice->checkdest
3243     ;
3244     return $error if $error;
3245   }
3246   '';
3247 }
3248
3249 =item set_default_invoicing_list
3250
3251 Sets the invoicing list to all accounts associated with this customer,
3252 overwriting any previous invoicing list.
3253
3254 =cut
3255
3256 sub set_default_invoicing_list {
3257   my $self = shift;
3258   $self->invoicing_list($self->all_emails);
3259 }
3260
3261 =item all_emails
3262
3263 Returns the email addresses of all accounts provisioned for this customer.
3264
3265 =cut
3266
3267 sub all_emails {
3268   my $self = shift;
3269   my %list;
3270   foreach my $cust_pkg ( $self->all_pkgs ) {
3271     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3272     my @svc_acct =
3273       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3274         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3275           @cust_svc;
3276     $list{$_}=1 foreach map { $_->email } @svc_acct;
3277   }
3278   keys %list;
3279 }
3280
3281 =item invoicing_list_addpost
3282
3283 Adds postal invoicing to this customer.  If this customer is already configured
3284 to receive postal invoices, does nothing.
3285
3286 =cut
3287
3288 sub invoicing_list_addpost {
3289   my $self = shift;
3290   return if grep { $_ eq 'POST' } $self->invoicing_list;
3291   my @invoicing_list = $self->invoicing_list;
3292   push @invoicing_list, 'POST';
3293   $self->invoicing_list(\@invoicing_list);
3294 }
3295
3296 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3297
3298 Returns an array of customers referred by this customer (referral_custnum set
3299 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
3300 customers referred by customers referred by this customer and so on, inclusive.
3301 The default behavior is DEPTH 1 (no recursion).
3302
3303 =cut
3304
3305 sub referral_cust_main {
3306   my $self = shift;
3307   my $depth = @_ ? shift : 1;
3308   my $exclude = @_ ? shift : {};
3309
3310   my @cust_main =
3311     map { $exclude->{$_->custnum}++; $_; }
3312       grep { ! $exclude->{ $_->custnum } }
3313         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3314
3315   if ( $depth > 1 ) {
3316     push @cust_main,
3317       map { $_->referral_cust_main($depth-1, $exclude) }
3318         @cust_main;
3319   }
3320
3321   @cust_main;
3322 }
3323
3324 =item referral_cust_main_ncancelled
3325
3326 Same as referral_cust_main, except only returns customers with uncancelled
3327 packages.
3328
3329 =cut
3330
3331 sub referral_cust_main_ncancelled {
3332   my $self = shift;
3333   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3334 }
3335
3336 =item referral_cust_pkg [ DEPTH ]
3337
3338 Like referral_cust_main, except returns a flat list of all unsuspended (and
3339 uncancelled) packages for each customer.  The number of items in this list may
3340 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3341
3342 =cut
3343
3344 sub referral_cust_pkg {
3345   my $self = shift;
3346   my $depth = @_ ? shift : 1;
3347
3348   map { $_->unsuspended_pkgs }
3349     grep { $_->unsuspended_pkgs }
3350       $self->referral_cust_main($depth);
3351 }
3352
3353 =item referring_cust_main
3354
3355 Returns the single cust_main record for the customer who referred this customer
3356 (referral_custnum), or false.
3357
3358 =cut
3359
3360 sub referring_cust_main {
3361   my $self = shift;
3362   return '' unless $self->referral_custnum;
3363   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3364 }
3365
3366 =item credit AMOUNT, REASON
3367
3368 Applies a credit to this customer.  If there is an error, returns the error,
3369 otherwise returns false.
3370
3371 =cut
3372
3373 sub credit {
3374   my( $self, $amount, $reason ) = @_;
3375   my $cust_credit = new FS::cust_credit {
3376     'custnum' => $self->custnum,
3377     'amount'  => $amount,
3378     'reason'  => $reason,
3379   };
3380   $cust_credit->insert;
3381 }
3382
3383 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3384
3385 Creates a one-time charge for this customer.  If there is an error, returns
3386 the error, otherwise returns false.
3387
3388 =cut
3389
3390 sub charge {
3391   my ( $self, $amount ) = ( shift, shift );
3392   my $pkg      = @_ ? shift : 'One-time charge';
3393   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
3394   my $taxclass = @_ ? shift : '';
3395
3396   local $SIG{HUP} = 'IGNORE';
3397   local $SIG{INT} = 'IGNORE';
3398   local $SIG{QUIT} = 'IGNORE';
3399   local $SIG{TERM} = 'IGNORE';
3400   local $SIG{TSTP} = 'IGNORE';
3401   local $SIG{PIPE} = 'IGNORE';
3402
3403   my $oldAutoCommit = $FS::UID::AutoCommit;
3404   local $FS::UID::AutoCommit = 0;
3405   my $dbh = dbh;
3406
3407   my $part_pkg = new FS::part_pkg ( {
3408     'pkg'      => $pkg,
3409     'comment'  => $comment,
3410     #'setup'    => $amount,
3411     #'recur'    => '0',
3412     'plan'     => 'flat',
3413     'plandata' => "setup_fee=$amount",
3414     'freq'     => 0,
3415     'disabled' => 'Y',
3416     'taxclass' => $taxclass,
3417   } );
3418
3419   my $error = $part_pkg->insert;
3420   if ( $error ) {
3421     $dbh->rollback if $oldAutoCommit;
3422     return $error;
3423   }
3424
3425   my $pkgpart = $part_pkg->pkgpart;
3426   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3427   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3428     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3429     $error = $type_pkgs->insert;
3430     if ( $error ) {
3431       $dbh->rollback if $oldAutoCommit;
3432       return $error;
3433     }
3434   }
3435
3436   my $cust_pkg = new FS::cust_pkg ( {
3437     'custnum' => $self->custnum,
3438     'pkgpart' => $pkgpart,
3439   } );
3440
3441   $error = $cust_pkg->insert;
3442   if ( $error ) {
3443     $dbh->rollback if $oldAutoCommit;
3444     return $error;
3445   }
3446
3447   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3448   '';
3449
3450 }
3451
3452 =item cust_bill
3453
3454 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3455
3456 =cut
3457
3458 sub cust_bill {
3459   my $self = shift;
3460   sort { $a->_date <=> $b->_date }
3461     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3462 }
3463
3464 =item open_cust_bill
3465
3466 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3467 customer.
3468
3469 =cut
3470
3471 sub open_cust_bill {
3472   my $self = shift;
3473   grep { $_->owed > 0 } $self->cust_bill;
3474 }
3475
3476 =item cust_credit
3477
3478 Returns all the credits (see L<FS::cust_credit>) for this customer.
3479
3480 =cut
3481
3482 sub cust_credit {
3483   my $self = shift;
3484   sort { $a->_date <=> $b->_date }
3485     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3486 }
3487
3488 =item cust_pay
3489
3490 Returns all the payments (see L<FS::cust_pay>) for this customer.
3491
3492 =cut
3493
3494 sub cust_pay {
3495   my $self = shift;
3496   sort { $a->_date <=> $b->_date }
3497     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3498 }
3499
3500 =item cust_pay_void
3501
3502 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3503
3504 =cut
3505
3506 sub cust_pay_void {
3507   my $self = shift;
3508   sort { $a->_date <=> $b->_date }
3509     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3510 }
3511
3512
3513 =item cust_refund
3514
3515 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3516
3517 =cut
3518
3519 sub cust_refund {
3520   my $self = shift;
3521   sort { $a->_date <=> $b->_date }
3522     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3523 }
3524
3525 =item select_for_update
3526
3527 Selects this record with the SQL "FOR UPDATE" command.  This can be useful as
3528 a mutex.
3529
3530 =cut
3531
3532 sub select_for_update {
3533   my $self = shift;
3534   qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
3535 }
3536
3537 =item name
3538
3539 Returns a name string for this customer, either "Company (Last, First)" or
3540 "Last, First".
3541
3542 =cut
3543
3544 sub name {
3545   my $self = shift;
3546   my $name = $self->contact;
3547   $name = $self->company. " ($name)" if $self->company;
3548   $name;
3549 }
3550
3551 =item ship_name
3552
3553 Returns a name string for this (service/shipping) contact, either
3554 "Company (Last, First)" or "Last, First".
3555
3556 =cut
3557
3558 sub ship_name {
3559   my $self = shift;
3560   if ( $self->get('ship_last') ) {
3561     my $name = $self->ship_contact;
3562     $name = $self->ship_company. " ($name)" if $self->ship_company;
3563     $name;
3564   } else {
3565     $self->name;
3566   }
3567 }
3568
3569 =item contact
3570
3571 Returns this customer's full (billing) contact name only, "Last, First"
3572
3573 =cut
3574
3575 sub contact {
3576   my $self = shift;
3577   $self->get('last'). ', '. $self->first;
3578 }
3579
3580 =item ship_contact
3581
3582 Returns this customer's full (shipping) contact name only, "Last, First"
3583
3584 =cut
3585
3586 sub ship_contact {
3587   my $self = shift;
3588   $self->get('ship_last')
3589     ? $self->get('ship_last'). ', '. $self->ship_first
3590     : $self->contact;
3591 }
3592
3593 =item status
3594
3595 Returns a status string for this customer, currently:
3596
3597 =over 4
3598
3599 =item prospect - No packages have ever been ordered
3600
3601 =item active - One or more recurring packages is active
3602
3603 =item suspended - All non-cancelled recurring packages are suspended
3604
3605 =item cancelled - All recurring packages are cancelled
3606
3607 =back
3608
3609 =cut
3610
3611 sub status {
3612   my $self = shift;
3613   for my $status (qw( prospect active suspended cancelled )) {
3614     my $method = $status.'_sql';
3615     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3616     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3617     $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
3618     return $status if $sth->fetchrow_arrayref->[0];
3619   }
3620 }
3621
3622 =item statuscolor
3623
3624 Returns a hex triplet color string for this customer's status.
3625
3626 =cut
3627
3628 my %statuscolor = (
3629   'prospect'  => '000000',
3630   'active'    => '00CC00',
3631   'suspended' => 'FF9900',
3632   'cancelled' => 'FF0000',
3633 );
3634 sub statuscolor {
3635   my $self = shift;
3636   $statuscolor{$self->status};
3637 }
3638
3639 =back
3640
3641 =head1 CLASS METHODS
3642
3643 =over 4
3644
3645 =item prospect_sql
3646
3647 Returns an SQL expression identifying prospective cust_main records (customers
3648 with no packages ever ordered)
3649
3650 =cut
3651
3652 sub prospect_sql { "
3653   0 = ( SELECT COUNT(*) FROM cust_pkg
3654           WHERE cust_pkg.custnum = cust_main.custnum
3655       )
3656 "; }
3657
3658 =item active_sql
3659
3660 Returns an SQL expression identifying active cust_main records.
3661
3662 =cut
3663
3664 sub active_sql { "
3665   0 < ( SELECT COUNT(*) FROM cust_pkg
3666           WHERE cust_pkg.custnum = cust_main.custnum
3667             AND ". FS::cust_pkg->active_sql. "
3668       )
3669 "; }
3670
3671 =item susp_sql
3672 =item suspended_sql
3673
3674 Returns an SQL expression identifying suspended cust_main records.
3675
3676 =cut
3677
3678 #my $recurring_sql = FS::cust_pkg->recurring_sql;
3679 my $recurring_sql = "
3680   '0' != ( select freq from part_pkg
3681              where cust_pkg.pkgpart = part_pkg.pkgpart )
3682 ";
3683
3684 sub suspended_sql { susp_sql(@_); }
3685 sub susp_sql { "
3686     0 < ( SELECT COUNT(*) FROM cust_pkg
3687             WHERE cust_pkg.custnum = cust_main.custnum
3688               AND $recurring_sql
3689               AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3690         )
3691     AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3692                 WHERE cust_pkg.custnum = cust_main.custnum
3693                   AND ". FS::cust_pkg->active_sql. "
3694             )
3695 "; }
3696
3697 =item cancel_sql
3698 =item cancelled_sql
3699
3700 Returns an SQL expression identifying cancelled cust_main records.
3701
3702 =cut
3703
3704 sub cancelled_sql { cancel_sql(@_); }
3705 sub cancel_sql { "
3706   0 < ( SELECT COUNT(*) FROM cust_pkg
3707           WHERE cust_pkg.custnum = cust_main.custnum
3708       )
3709   AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3710               WHERE cust_pkg.custnum = cust_main.custnum
3711                 AND $recurring_sql
3712                 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3713           )
3714 "; }
3715
3716 =item uncancel_sql
3717 =item uncancelled_sql
3718
3719 Returns an SQL expression identifying un-cancelled cust_main records.
3720
3721 =cut
3722
3723 sub uncancelled_sql { uncancel_sql(@_); }
3724 sub uncancel_sql { "
3725   ( 0 < ( SELECT COUNT(*) FROM cust_pkg
3726                  WHERE cust_pkg.custnum = cust_main.custnum
3727                    AND ( cust_pkg.cancel IS NULL
3728                          OR cust_pkg.cancel = 0
3729                        )
3730         )
3731     OR 0 = ( SELECT COUNT(*) FROM cust_pkg
3732                WHERE cust_pkg.custnum = cust_main.custnum
3733            )
3734   )
3735 "; }
3736
3737 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
3738
3739 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
3740 records.  Currently, only I<last> or I<company> may be specified (the
3741 appropriate ship_ field is also searched if applicable).
3742
3743 Additional options are the same as FS::Record::qsearch
3744
3745 =cut
3746
3747 sub fuzzy_search {
3748   my( $self, $fuzzy, $hash, @opt) = @_;
3749   #$self
3750   $hash ||= {};
3751   my @cust_main = ();
3752
3753   check_and_rebuild_fuzzyfiles();
3754   foreach my $field ( keys %$fuzzy ) {
3755     my $sub = \&{"all_$field"};
3756     my %match = ();
3757     $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) );
3758
3759     foreach ( keys %match ) {
3760       push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
3761       push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt)
3762         if defined dbdef->table('cust_main')->column('ship_last');
3763     }
3764   }
3765
3766   my %saw = ();
3767   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
3768
3769   @cust_main;
3770
3771 }
3772
3773 =back
3774
3775 =head1 SUBROUTINES
3776
3777 =over 4
3778
3779 =item smart_search OPTION => VALUE ...
3780
3781 Accepts the following options: I<search>, the string to search for.  The string
3782 will be searched for as a customer number, last name or company name, first
3783 searching for an exact match then fuzzy and substring matches.
3784
3785 Any additional options treated as an additional qualifier on the search
3786 (i.e. I<agentnum>).
3787
3788 Returns a (possibly empty) array of FS::cust_main objects.
3789
3790 =cut
3791
3792 sub smart_search {
3793   my %options = @_;
3794   my $search = delete $options{'search'};
3795   my @cust_main = ();
3796
3797   if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
3798
3799     push @cust_main, qsearch('cust_main', { 'custnum' => $1, %options } );
3800
3801   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search
3802
3803     my $value = lc($1);
3804     my $q_value = dbh->quote($value);
3805
3806     #exact
3807     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
3808     $sql .= " ( LOWER(last) = $q_value OR LOWER(company) = $q_value";
3809     $sql .= " OR LOWER(ship_last) = $q_value OR LOWER(ship_company) = $q_value"
3810       if defined dbdef->table('cust_main')->column('ship_last');
3811     $sql .= ' )';
3812
3813     push @cust_main, qsearch( 'cust_main', \%options, '', $sql );
3814
3815     unless ( @cust_main ) {  #no exact match, trying substring/fuzzy
3816
3817       #still some false laziness w/ search/cust_main.cgi
3818
3819       #substring
3820       push @cust_main, qsearch( 'cust_main',
3821                                 { 'last'     => { 'op'    => 'ILIKE',
3822                                                   'value' => "%$q_value%" },
3823                                   %options,
3824                                 }
3825                               );
3826       push @cust_main, qsearch( 'cust_main',
3827                                 { 'ship_last' => { 'op'    => 'ILIKE',
3828                                                    'value' => "%$q_value%" },
3829                                   %options,
3830
3831                                 }
3832                               )
3833         if defined dbdef->table('cust_main')->column('ship_last');
3834
3835       push @cust_main, qsearch( 'cust_main',
3836                                 { 'company'  => { 'op'    => 'ILIKE',
3837                                                   'value' => "%$q_value%" },
3838                                   %options,
3839                                 }
3840                               );
3841       push @cust_main, qsearch( 'cust_main',
3842                                 { 'ship_company' => { 'op' => 'ILIKE',
3843                                                    'value' => "%$q_value%" },
3844                                   %options,
3845                                 }
3846                               )
3847         if defined dbdef->table('cust_main')->column('ship_last');
3848
3849       #fuzzy
3850       push @cust_main, FS::cust_main->fuzzy_search(
3851         { 'last'     => $value },
3852         \%options,
3853       );
3854       push @cust_main, FS::cust_main->fuzzy_search(
3855         { 'company'  => $value },
3856         \%options,
3857       );
3858
3859     }
3860
3861   }
3862
3863   @cust_main;
3864
3865 }
3866
3867 =item check_and_rebuild_fuzzyfiles
3868
3869 =cut
3870
3871 sub check_and_rebuild_fuzzyfiles {
3872   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3873   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
3874     or &rebuild_fuzzyfiles;
3875 }
3876
3877 =item rebuild_fuzzyfiles
3878
3879 =cut
3880
3881 sub rebuild_fuzzyfiles {
3882
3883   use Fcntl qw(:flock);
3884
3885   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3886   mkdir $dir, 0700 unless -d $dir;
3887
3888   #last
3889
3890   open(LASTLOCK,">>$dir/cust_main.last")
3891     or die "can't open $dir/cust_main.last: $!";
3892   flock(LASTLOCK,LOCK_EX)
3893     or die "can't lock $dir/cust_main.last: $!";
3894
3895   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
3896   push @all_last,
3897                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
3898     if defined dbdef->table('cust_main')->column('ship_last');
3899
3900   open (LASTCACHE,">$dir/cust_main.last.tmp")
3901     or die "can't open $dir/cust_main.last.tmp: $!";
3902   print LASTCACHE join("\n", @all_last), "\n";
3903   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
3904
3905   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
3906   close LASTLOCK;
3907
3908   #company
3909
3910   open(COMPANYLOCK,">>$dir/cust_main.company")
3911     or die "can't open $dir/cust_main.company: $!";
3912   flock(COMPANYLOCK,LOCK_EX)
3913     or die "can't lock $dir/cust_main.company: $!";
3914
3915   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
3916   push @all_company,
3917        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
3918     if defined dbdef->table('cust_main')->column('ship_last');
3919
3920   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
3921     or die "can't open $dir/cust_main.company.tmp: $!";
3922   print COMPANYCACHE join("\n", @all_company), "\n";
3923   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
3924
3925   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
3926   close COMPANYLOCK;
3927
3928 }
3929
3930 =item all_last
3931
3932 =cut
3933
3934 sub all_last {
3935   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3936   open(LASTCACHE,"<$dir/cust_main.last")
3937     or die "can't open $dir/cust_main.last: $!";
3938   my @array = map { chomp; $_; } <LASTCACHE>;
3939   close LASTCACHE;
3940   \@array;
3941 }
3942
3943 =item all_company
3944
3945 =cut
3946
3947 sub all_company {
3948   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3949   open(COMPANYCACHE,"<$dir/cust_main.company")
3950     or die "can't open $dir/cust_main.last: $!";
3951   my @array = map { chomp; $_; } <COMPANYCACHE>;
3952   close COMPANYCACHE;
3953   \@array;
3954 }
3955
3956 =item append_fuzzyfiles LASTNAME COMPANY
3957
3958 =cut
3959
3960 sub append_fuzzyfiles {
3961   my( $last, $company ) = @_;
3962
3963   &check_and_rebuild_fuzzyfiles;
3964
3965   use Fcntl qw(:flock);
3966
3967   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3968
3969   if ( $last ) {
3970
3971     open(LAST,">>$dir/cust_main.last")
3972       or die "can't open $dir/cust_main.last: $!";
3973     flock(LAST,LOCK_EX)
3974       or die "can't lock $dir/cust_main.last: $!";
3975
3976     print LAST "$last\n";
3977
3978     flock(LAST,LOCK_UN)
3979       or die "can't unlock $dir/cust_main.last: $!";
3980     close LAST;
3981   }
3982
3983   if ( $company ) {
3984
3985     open(COMPANY,">>$dir/cust_main.company")
3986       or die "can't open $dir/cust_main.company: $!";
3987     flock(COMPANY,LOCK_EX)
3988       or die "can't lock $dir/cust_main.company: $!";
3989
3990     print COMPANY "$company\n";
3991
3992     flock(COMPANY,LOCK_UN)
3993       or die "can't unlock $dir/cust_main.company: $!";
3994
3995     close COMPANY;
3996   }
3997
3998   1;
3999 }
4000
4001 =item batch_import
4002
4003 =cut
4004
4005 sub batch_import {
4006   my $param = shift;
4007   #warn join('-',keys %$param);
4008   my $fh = $param->{filehandle};
4009   my $agentnum = $param->{agentnum};
4010   my $refnum = $param->{refnum};
4011   my $pkgpart = $param->{pkgpart};
4012   my @fields = @{$param->{fields}};
4013
4014   eval "use Text::CSV_XS;";
4015   die $@ if $@;
4016
4017   my $csv = new Text::CSV_XS;
4018   #warn $csv;
4019   #warn $fh;
4020
4021   my $imported = 0;
4022   #my $columns;
4023
4024   local $SIG{HUP} = 'IGNORE';
4025   local $SIG{INT} = 'IGNORE';
4026   local $SIG{QUIT} = 'IGNORE';
4027   local $SIG{TERM} = 'IGNORE';
4028   local $SIG{TSTP} = 'IGNORE';
4029   local $SIG{PIPE} = 'IGNORE';
4030
4031   my $oldAutoCommit = $FS::UID::AutoCommit;
4032   local $FS::UID::AutoCommit = 0;
4033   my $dbh = dbh;
4034
4035   #while ( $columns = $csv->getline($fh) ) {
4036   my $line;
4037   while ( defined($line=<$fh>) ) {
4038
4039     $csv->parse($line) or do {
4040       $dbh->rollback if $oldAutoCommit;
4041       return "can't parse: ". $csv->error_input();
4042     };
4043
4044     my @columns = $csv->fields();
4045     #warn join('-',@columns);
4046
4047     my %cust_main = (
4048       agentnum => $agentnum,
4049       refnum   => $refnum,
4050       country  => $conf->config('countrydefault') || 'US',
4051       payby    => 'BILL', #default
4052       paydate  => '12/2037', #default
4053     );
4054     my $billtime = time;
4055     my %cust_pkg = ( pkgpart => $pkgpart );
4056     foreach my $field ( @fields ) {
4057       if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
4058         #$cust_pkg{$1} = str2time( shift @$columns );
4059         if ( $1 eq 'setup' ) {
4060           $billtime = str2time(shift @columns);
4061         } else {
4062           $cust_pkg{$1} = str2time( shift @columns );
4063         }
4064       } else {
4065         #$cust_main{$field} = shift @$columns;
4066         $cust_main{$field} = shift @columns;
4067       }
4068     }
4069
4070     my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
4071     my $cust_main = new FS::cust_main ( \%cust_main );
4072     use Tie::RefHash;
4073     tie my %hash, 'Tie::RefHash'; #this part is important
4074     $hash{$cust_pkg} = [] if $pkgpart;
4075     my $error = $cust_main->insert( \%hash );
4076
4077     if ( $error ) {
4078       $dbh->rollback if $oldAutoCommit;
4079       return "can't insert customer for $line: $error";
4080     }
4081
4082     #false laziness w/bill.cgi
4083     $error = $cust_main->bill( 'time' => $billtime );
4084     if ( $error ) {
4085       $dbh->rollback if $oldAutoCommit;
4086       return "can't bill customer for $line: $error";
4087     }
4088
4089     $cust_main->apply_payments;
4090     $cust_main->apply_credits;
4091
4092     $error = $cust_main->collect();
4093     if ( $error ) {
4094       $dbh->rollback if $oldAutoCommit;
4095       return "can't collect customer for $line: $error";
4096     }
4097
4098     $imported++;
4099   }
4100
4101   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4102
4103   return "Empty file!" unless $imported;
4104
4105   ''; #no error
4106
4107 }
4108
4109 =item batch_charge
4110
4111 =cut
4112
4113 sub batch_charge {
4114   my $param = shift;
4115   #warn join('-',keys %$param);
4116   my $fh = $param->{filehandle};
4117   my @fields = @{$param->{fields}};
4118
4119   eval "use Text::CSV_XS;";
4120   die $@ if $@;
4121
4122   my $csv = new Text::CSV_XS;
4123   #warn $csv;
4124   #warn $fh;
4125
4126   my $imported = 0;
4127   #my $columns;
4128
4129   local $SIG{HUP} = 'IGNORE';
4130   local $SIG{INT} = 'IGNORE';
4131   local $SIG{QUIT} = 'IGNORE';
4132   local $SIG{TERM} = 'IGNORE';
4133   local $SIG{TSTP} = 'IGNORE';
4134   local $SIG{PIPE} = 'IGNORE';
4135
4136   my $oldAutoCommit = $FS::UID::AutoCommit;
4137   local $FS::UID::AutoCommit = 0;
4138   my $dbh = dbh;
4139
4140   #while ( $columns = $csv->getline($fh) ) {
4141   my $line;
4142   while ( defined($line=<$fh>) ) {
4143
4144     $csv->parse($line) or do {
4145       $dbh->rollback if $oldAutoCommit;
4146       return "can't parse: ". $csv->error_input();
4147     };
4148
4149     my @columns = $csv->fields();
4150     #warn join('-',@columns);
4151
4152     my %row = ();
4153     foreach my $field ( @fields ) {
4154       $row{$field} = shift @columns;
4155     }
4156
4157     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
4158     unless ( $cust_main ) {
4159       $dbh->rollback if $oldAutoCommit;
4160       return "unknown custnum $row{'custnum'}";
4161     }
4162
4163     if ( $row{'amount'} > 0 ) {
4164       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4165       if ( $error ) {
4166         $dbh->rollback if $oldAutoCommit;
4167         return $error;
4168       }
4169       $imported++;
4170     } elsif ( $row{'amount'} < 0 ) {
4171       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4172                                       $row{'pkg'}                         );
4173       if ( $error ) {
4174         $dbh->rollback if $oldAutoCommit;
4175         return $error;
4176       }
4177       $imported++;
4178     } else {
4179       #hmm?
4180     }
4181
4182   }
4183
4184   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4185
4186   return "Empty file!" unless $imported;
4187
4188   ''; #no error
4189
4190 }
4191
4192 =back
4193
4194 =head1 BUGS
4195
4196 The delete method.
4197
4198 The delete method should possibly take an FS::cust_main object reference
4199 instead of a scalar customer number.
4200
4201 Bill and collect options should probably be passed as references instead of a
4202 list.
4203
4204 There should probably be a configuration file with a list of allowed credit
4205 card types.
4206
4207 No multiple currency support (probably a larger project than just this module).
4208
4209 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4210
4211 =head1 SEE ALSO
4212
4213 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4214 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4215 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
4216
4217 =cut
4218
4219 1;
4220