FS/FS/cust_main.pm

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