FS/FS/cust_main.pm

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