FS/FS/cust_main.pm

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