FS/FS/cust_main.pm

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