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