FS/FS/cust_main.pm

   1 package FS::cust_main;
   2
   3 use strict;
   4 use vars qw( @ISA $conf $lpr $processor $xaction $E_NoErr $invoice_from
   5              $smtpmachine $Debug $bop_processor $bop_login $bop_password
   6              $bop_action @bop_options);
   7 use Safe;
   8 use Carp;
   9 use Time::Local;
  10 use Date::Format;
  11 #use Date::Manip;
  12 use Mail::Internet;
  13 use Mail::Header;
  14 use Business::CreditCard;
  15 use FS::UID qw( getotaker dbh );
  16 use FS::Record qw( qsearchs qsearch dbdef );
  17 use FS::cust_pkg;
  18 use FS::cust_bill;
  19 use FS::cust_bill_pkg;
  20 use FS::cust_pay;
  21 use FS::cust_credit;
  22 use FS::cust_pay_batch;
  23 use FS::part_referral;
  24 use FS::cust_main_county;
  25 use FS::agent;
  26 use FS::cust_main_invoice;
  27 use FS::cust_credit_bill;
  28 use FS::cust_bill_pay;
  29 use FS::prepay_credit;
  30 use FS::queue;
  31
  32 @ISA = qw( FS::Record );
  33
  34 $Debug = 0;
  35 #$Debug = 1;
  36
  37 #ask FS::UID to run this stuff for us later
  38 $FS::UID::callback{'FS::cust_main'} = sub {
  39   $conf = new FS::Conf;
  40   $lpr = $conf->config('lpr');
  41   $invoice_from = $conf->config('invoice_from');
  42   $smtpmachine = $conf->config('smtpmachine');
  43
  44   if ( $conf->exists('cybercash3.2') ) {
  45     require CCMckLib3_2;
  46       #qw($MCKversion %Config InitConfig CCError CCDebug CCDebug2);
  47     require CCMckDirectLib3_2;
  48       #qw(SendCC2_1Server);
  49     require CCMckErrno3_2;
  50       #qw(MCKGetErrorMessage $E_NoErr);
  51     import CCMckErrno3_2 qw($E_NoErr);
  52
  53     my $merchant_conf;
  54     ($merchant_conf,$xaction)= $conf->config('cybercash3.2');
  55     my $status = &CCMckLib3_2::InitConfig($merchant_conf);
  56     if ( $status != $E_NoErr ) {
  57       warn "CCMckLib3_2::InitConfig error:\n";
  58       foreach my $key (keys %CCMckLib3_2::Config) {
  59         warn "  $key => $CCMckLib3_2::Config{$key}\n"
  60       }
  61       my($errmsg) = &CCMckErrno3_2::MCKGetErrorMessage($status);
  62       die "CCMckLib3_2::InitConfig fatal error: $errmsg\n";
  63     }
  64     $processor='cybercash3.2';
  65   } elsif ( $conf->exists('business-onlinepayment') ) {
  66     ( $bop_processor,
  67       $bop_login,
  68       $bop_password,
  69       $bop_action,
  70       @bop_options
  71     ) = $conf->config('business-onlinepayment');
  72     $bop_action ||= 'normal authorization';
  73     eval "use Business::OnlinePayment";
  74     $processor="Business::OnlinePayment::$bop_processor";
  75   }
  76 };
  77
  78 =head1 NAME
  79
  80 FS::cust_main - Object methods for cust_main records
  81
  82 =head1 SYNOPSIS
  83
  84   use FS::cust_main;
  85
  86   $record = new FS::cust_main \%hash;
  87   $record = new FS::cust_main { 'column' => 'value' };
  88
  89   $error = $record->insert;
  90
  91   $error = $new_record->replace($old_record);
  92
  93   $error = $record->delete;
  94
  95   $error = $record->check;
  96
  97   @cust_pkg = $record->all_pkgs;
  98
  99   @cust_pkg = $record->ncancelled_pkgs;
 100
 101   @cust_pkg = $record->suspended_pkgs;
 102
 103   $error = $record->bill;
 104   $error = $record->bill %options;
 105   $error = $record->bill 'time' => $time;
 106
 107   $error = $record->collect;
 108   $error = $record->collect %options;
 109   $error = $record->collect 'invoice_time'   => $time,
 110                             'batch_card'     => 'yes',
 111                             'report_badcard' => 'yes',
 112                           ;
 113
 114 =head1 DESCRIPTION
 115
 116 An FS::cust_main object represents a customer.  FS::cust_main inherits from
 117 FS::Record.  The following fields are currently supported:
 118
 119 =over 4
 120
 121 =item custnum - primary key (assigned automatically for new customers)
 122
 123 =item agentnum - agent (see L<FS::agent>)
 124
 125 =item refnum - referral (see L<FS::part_referral>)
 126
 127 =item first - name
 128
 129 =item last - name
 130
 131 =item ss - social security number (optional)
 132
 133 =item company - (optional)
 134
 135 =item address1
 136
 137 =item address2 - (optional)
 138
 139 =item city
 140
 141 =item county - (optional, see L<FS::cust_main_county>)
 142
 143 =item state - (see L<FS::cust_main_county>)
 144
 145 =item zip
 146
 147 =item country - (see L<FS::cust_main_county>)
 148
 149 =item daytime - phone (optional)
 150
 151 =item night - phone (optional)
 152
 153 =item fax - phone (optional)
 154
 155 =item ship_first - name
 156
 157 =item ship_last - name
 158
 159 =item ship_company - (optional)
 160
 161 =item ship_address1
 162
 163 =item ship_address2 - (optional)
 164
 165 =item ship_city
 166
 167 =item ship_county - (optional, see L<FS::cust_main_county>)
 168
 169 =item ship_state - (see L<FS::cust_main_county>)
 170
 171 =item ship_zip
 172
 173 =item ship_country - (see L<FS::cust_main_county>)
 174
 175 =item ship_daytime - phone (optional)
 176
 177 =item ship_night - phone (optional)
 178
 179 =item ship_fax - phone (optional)
 180
 181 =item payby - `CARD' (credit cards), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to BILL)
 182
 183 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
 184
 185 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
 186
 187 =item payname - name on card or billing name
 188
 189 =item tax - tax exempt, empty or `Y'
 190
 191 =item otaker - order taker (assigned automatically, see L<FS::UID>)
 192
 193 =item comments - comments (optional)
 194
 195 =back
 196
 197 =head1 METHODS
 198
 199 =over 4
 200
 201 =item new HASHREF
 202
 203 Creates a new customer.  To add the customer to the database, see L<"insert">.
 204
 205 Note that this stores the hash reference, not a distinct copy of the hash it
 206 points to.  You can ask the object for a copy with the I<hash> method.
 207
 208 =cut
 209
 210 sub table { 'cust_main'; }
 211
 212 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
 213
 214 Adds this customer to the database.  If there is an error, returns the error,
 215 otherwise returns false.
 216
 217 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
 218 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
 219 are inserted atomicly, or the transaction is rolled back.  Passing an empty
 220 hash reference is equivalent to not supplying this parameter.  There should be
 221 a better explanation of this, but until then, here's an example:
 222
 223   use Tie::RefHash;
 224   tie %hash, 'Tie::RefHash'; #this part is important
 225   %hash = (
 226     $cust_pkg => [ $svc_acct ],
 227     ...
 228   );
 229   $cust_main->insert( \%hash );
 230
 231 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 232 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 233 expected and rollback the entire transaction; it is not necessary to call
 234 check_invoicing_list first.  The invoicing_list is set after the records in the
 235 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
 236 invoicing_list destination to the newly-created svc_acct.  Here's an example:
 237
 238   $cust_main->insert( {}, [ $email, 'POST' ] );
 239
 240 =cut
 241
 242 sub insert {
 243   my $self = shift;
 244   my @param = @_;
 245
 246   local $SIG{HUP} = 'IGNORE';
 247   local $SIG{INT} = 'IGNORE';
 248   local $SIG{QUIT} = 'IGNORE';
 249   local $SIG{TERM} = 'IGNORE';
 250   local $SIG{TSTP} = 'IGNORE';
 251   local $SIG{PIPE} = 'IGNORE';
 252
 253   my $oldAutoCommit = $FS::UID::AutoCommit;
 254   local $FS::UID::AutoCommit = 0;
 255   my $dbh = dbh;
 256
 257   my $amount = 0;
 258   my $seconds = 0;
 259   if ( $self->payby eq 'PREPAY' ) {
 260     $self->payby('BILL');
 261     my $prepay_credit = qsearchs(
 262       'prepay_credit',
 263       { 'identifier' => $self->payinfo },
 264       '',
 265       'FOR UPDATE'
 266     );
 267     warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
 268       unless $prepay_credit;
 269     $amount = $prepay_credit->amount;
 270     $seconds = $prepay_credit->seconds;
 271     my $error = $prepay_credit->delete;
 272     if ( $error ) {
 273       $dbh->rollback if $oldAutoCommit;
 274       return "removing prepay_credit (transaction rolled back): $error";
 275     }
 276   }
 277
 278   my $error = $self->SUPER::insert;
 279   if ( $error ) {
 280     $dbh->rollback if $oldAutoCommit;
 281     return "inserting cust_main record (transaction rolled back): $error";
 282   }
 283
 284   if ( @param ) { # CUST_PKG_HASHREF
 285     my $cust_pkgs = shift @param;
 286     foreach my $cust_pkg ( keys %$cust_pkgs ) {
 287       $cust_pkg->custnum( $self->custnum );
 288       $error = $cust_pkg->insert;
 289       if ( $error ) {
 290         $dbh->rollback if $oldAutoCommit;
 291         return "inserting cust_pkg (transaction rolled back): $error";
 292       }
 293       foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
 294         $svc_something->pkgnum( $cust_pkg->pkgnum );
 295         if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
 296           $svc_something->seconds( $svc_something->seconds + $seconds );
 297           $seconds = 0;
 298         }
 299         $error = $svc_something->insert;
 300         if ( $error ) {
 301           $dbh->rollback if $oldAutoCommit;
 302           return "inserting svc_ (transaction rolled back): $error";
 303         }
 304       }
 305     }
 306   }
 307
 308   if ( $seconds ) {
 309     $dbh->rollback if $oldAutoCommit;
 310     return "No svc_acct record to apply pre-paid time";
 311   }
 312
 313   if ( @param ) { # INVOICING_LIST_ARYREF
 314     my $invoicing_list = shift @param;
 315     $error = $self->check_invoicing_list( $invoicing_list );
 316     if ( $error ) {
 317       $dbh->rollback if $oldAutoCommit;
 318       return "checking invoicing_list (transaction rolled back): $error";
 319     }
 320     $self->invoicing_list( $invoicing_list );
 321   }
 322
 323   if ( $amount ) {
 324     my $cust_credit = new FS::cust_credit {
 325       'custnum' => $self->custnum,
 326       'amount'  => $amount,
 327     };
 328     $error = $cust_credit->insert;
 329     if ( $error ) {
 330       $dbh->rollback if $oldAutoCommit;
 331       return "inserting credit (transaction rolled back): $error";
 332     }
 333   }
 334
 335   my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
 336   $error = $queue->insert($self->getfield('last'), $self->company);
 337   if ( $error ) {
 338     $dbh->rollback if $oldAutoCommit;
 339     return "queueing job (transaction rolled back): $error";
 340   }
 341
 342   if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
 343     $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
 344     $error = $queue->insert($self->getfield('last'), $self->company);
 345     if ( $error ) {
 346       $dbh->rollback if $oldAutoCommit;
 347       return "queueing job (transaction rolled back): $error";
 348     }
 349   }
 350
 351   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 352   '';
 353
 354 }
 355
 356 =item delete NEW_CUSTNUM
 357
 358 This deletes the customer.  If there is an error, returns the error, otherwise
 359 returns false.
 360
 361 This will completely remove all traces of the customer record.  This is not
 362 what you want when a customer cancels service; for that, cancel all of the
 363 customer's packages (see L<FS::cust_pkg/cancel>).
 364
 365 If the customer has any uncancelled packages, you need to pass a new (valid)
 366 customer number for those packages to be transferred to.  Cancelled packages
 367 will be deleted.  Did I mention that this is NOT what you want when a customer
 368 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
 369
 370 You can't delete a customer with invoices (see L<FS::cust_bill>),
 371 or credits (see L<FS::cust_credit>) or payments (see L<FS::cust_pay>).
 372
 373 =cut
 374
 375 sub delete {
 376   my $self = shift;
 377
 378   local $SIG{HUP} = 'IGNORE';
 379   local $SIG{INT} = 'IGNORE';
 380   local $SIG{QUIT} = 'IGNORE';
 381   local $SIG{TERM} = 'IGNORE';
 382   local $SIG{TSTP} = 'IGNORE';
 383   local $SIG{PIPE} = 'IGNORE';
 384
 385   my $oldAutoCommit = $FS::UID::AutoCommit;
 386   local $FS::UID::AutoCommit = 0;
 387   my $dbh = dbh;
 388
 389   if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
 390     $dbh->rollback if $oldAutoCommit;
 391     return "Can't delete a customer with invoices";
 392   }
 393   if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
 394     $dbh->rollback if $oldAutoCommit;
 395     return "Can't delete a customer with credits";
 396   }
 397   if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
 398     $dbh->rollback if $oldAutoCommit;
 399     return "Can't delete a customer with payments";
 400   }
 401
 402   my @cust_pkg = $self->ncancelled_pkgs;
 403   if ( @cust_pkg ) {
 404     my $new_custnum = shift;
 405     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
 406       $dbh->rollback if $oldAutoCommit;
 407       return "Invalid new customer number: $new_custnum";
 408     }
 409     foreach my $cust_pkg ( @cust_pkg ) {
 410       my %hash = $cust_pkg->hash;
 411       $hash{'custnum'} = $new_custnum;
 412       my $new_cust_pkg = new FS::cust_pkg ( \%hash );
 413       my $error = $new_cust_pkg->replace($cust_pkg);
 414       if ( $error ) {
 415         $dbh->rollback if $oldAutoCommit;
 416         return $error;
 417       }
 418     }
 419   }
 420   my @cancelled_cust_pkg = $self->all_pkgs;
 421   foreach my $cust_pkg ( @cancelled_cust_pkg ) {
 422     my $error = $cust_pkg->delete;
 423     if ( $error ) {
 424       $dbh->rollback if $oldAutoCommit;
 425       return $error;
 426     }
 427   }
 428
 429   foreach my $cust_main_invoice (
 430     qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
 431   ) {
 432     my $error = $cust_main_invoice->delete;
 433     if ( $error ) {
 434       $dbh->rollback if $oldAutoCommit;
 435       return $error;
 436     }
 437   }
 438
 439   my $error = $self->SUPER::delete;
 440   if ( $error ) {
 441     $dbh->rollback if $oldAutoCommit;
 442     return $error;
 443   }
 444
 445   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 446   '';
 447
 448 }
 449
 450 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
 451
 452 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 453 returns the error, otherwise returns false.
 454
 455 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 456 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 457 expected and rollback the entire transaction; it is not necessary to call
 458 check_invoicing_list first.  Here's an example:
 459
 460   $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
 461
 462 =cut
 463
 464 sub replace {
 465   my $self = shift;
 466   my $old = shift;
 467   my @param = @_;
 468
 469   local $SIG{HUP} = 'IGNORE';
 470   local $SIG{INT} = 'IGNORE';
 471   local $SIG{QUIT} = 'IGNORE';
 472   local $SIG{TERM} = 'IGNORE';
 473   local $SIG{TSTP} = 'IGNORE';
 474   local $SIG{PIPE} = 'IGNORE';
 475
 476   my $oldAutoCommit = $FS::UID::AutoCommit;
 477   local $FS::UID::AutoCommit = 0;
 478   my $dbh = dbh;
 479
 480   my $error = $self->SUPER::replace($old);
 481
 482   if ( $error ) {
 483     $dbh->rollback if $oldAutoCommit;
 484     return $error;
 485   }
 486
 487   if ( @param ) { # INVOICING_LIST_ARYREF
 488     my $invoicing_list = shift @param;
 489     $error = $self->check_invoicing_list( $invoicing_list );
 490     if ( $error ) {
 491       $dbh->rollback if $oldAutoCommit;
 492       return $error;
 493     }
 494     $self->invoicing_list( $invoicing_list );
 495   }
 496
 497   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 498   '';
 499
 500 }
 501
 502 =item check
 503
 504 Checks all fields to make sure this is a valid customer record.  If there is
 505 an error, returns the error, otherwise returns false.  Called by the insert
 506 and repalce methods.
 507
 508 =cut
 509
 510 sub check {
 511   my $self = shift;
 512
 513   my $error =
 514     $self->ut_numbern('custnum')
 515     || $self->ut_number('agentnum')
 516     || $self->ut_number('refnum')
 517     || $self->ut_name('last')
 518     || $self->ut_name('first')
 519     || $self->ut_textn('company')
 520     || $self->ut_text('address1')
 521     || $self->ut_textn('address2')
 522     || $self->ut_text('city')
 523     || $self->ut_textn('county')
 524     || $self->ut_textn('state')
 525     || $self->ut_country('country')
 526     || $self->ut_anything('comments')
 527     || $self->ut_numbern('referral_custnum')
 528   ;
 529   #barf.  need message catalogs.  i18n.  etc.
 530   $error .= "Please select a referral."
 531     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
 532   return $error if $error;
 533
 534   return "Unknown agent"
 535     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
 536
 537   return "Unknown referral"
 538     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
 539
 540   return "Unknown referring custnum ". $self->referral_custnum
 541     unless ! $self->referral_custnum
 542            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
 543
 544   if ( $self->ss eq '' ) {
 545     $self->ss('');
 546   } else {
 547     my $ss = $self->ss;
 548     $ss =~ s/\D//g;
 549     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
 550       or return "Illegal social security number: ". $self->ss;
 551     $self->ss("$1-$2-$3");
 552   }
 553
 554   unless ( qsearchs('cust_main_county', {
 555     'country' => $self->country,
 556     'state'   => '',
 557    } ) ) {
 558     return "Unknown state/county/country: ".
 559       $self->state. "/". $self->county. "/". $self->country
 560       unless qsearchs('cust_main_county',{
 561         'state'   => $self->state,
 562         'county'  => $self->county,
 563         'country' => $self->country,
 564       } );
 565   }
 566
 567   $error =
 568     $self->ut_phonen('daytime', $self->country)
 569     || $self->ut_phonen('night', $self->country)
 570     || $self->ut_phonen('fax', $self->country)
 571     || $self->ut_zip('zip', $self->country)
 572   ;
 573   return $error if $error;
 574
 575   my @addfields = qw(
 576     last first company address1 address2 city county state zip
 577     country daytime night fax
 578   );
 579
 580   if ( defined $self->dbdef_table->column('ship_last') ) {
 581     if ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } @addfields
 582          && grep $self->getfield("ship_$_"), grep $_ ne 'state', @addfields
 583        )
 584     {
 585       my $error =
 586         $self->ut_name('ship_last')
 587         || $self->ut_name('ship_first')
 588         || $self->ut_textn('ship_company')
 589         || $self->ut_text('ship_address1')
 590         || $self->ut_textn('ship_address2')
 591         || $self->ut_text('ship_city')
 592         || $self->ut_textn('ship_county')
 593         || $self->ut_textn('ship_state')
 594         || $self->ut_country('ship_country')
 595       ;
 596       return $error if $error;
 597
 598       #false laziness with above
 599       unless ( qsearchs('cust_main_county', {
 600         'country' => $self->ship_country,
 601         'state'   => '',
 602        } ) ) {
 603         return "Unknown ship_state/ship_county/ship_country: ".
 604           $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
 605           unless qsearchs('cust_main_county',{
 606             'state'   => $self->ship_state,
 607             'county'  => $self->ship_county,
 608             'country' => $self->ship_country,
 609           } );
 610       }
 611       #eofalse
 612
 613       $error =
 614         $self->ut_phonen('ship_daytime', $self->ship_country)
 615         || $self->ut_phonen('ship_night', $self->ship_country)
 616         || $self->ut_phonen('ship_fax', $self->ship_country)
 617         || $self->ut_zip('ship_zip', $self->ship_country)
 618       ;
 619       return $error if $error;
 620
 621     } else { # ship_ info eq billing info, so don't store dup info in database
 622       $self->setfield("ship_$_", '')
 623         foreach qw( last first company address1 address2 city county state zip
 624                     country daytime night fax );
 625     }
 626   }
 627
 628   $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
 629     or return "Illegal payby: ". $self->payby;
 630   $self->payby($1);
 631
 632   if ( $self->payby eq 'CARD' ) {
 633
 634     my $payinfo = $self->payinfo;
 635     $payinfo =~ s/\D//g;
 636     $payinfo =~ /^(\d{13,16})$/
 637       or return "Illegal credit card number: ". $self->payinfo;
 638     $payinfo = $1;
 639     $self->payinfo($payinfo);
 640     validate($payinfo)
 641       or return "Illegal credit card number: ". $self->payinfo;
 642     return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
 643
 644   } elsif ( $self->payby eq 'BILL' ) {
 645
 646     $error = $self->ut_textn('payinfo');
 647     return "Illegal P.O. number: ". $self->payinfo if $error;
 648
 649   } elsif ( $self->payby eq 'COMP' ) {
 650
 651     $error = $self->ut_textn('payinfo');
 652     return "Illegal comp account issuer: ". $self->payinfo if $error;
 653
 654   } elsif ( $self->payby eq 'PREPAY' ) {
 655
 656     my $payinfo = $self->payinfo;
 657     $payinfo =~ s/\W//g; #anything else would just confuse things
 658     $self->payinfo($payinfo);
 659     $error = $self->ut_alpha('payinfo');
 660     return "Illegal prepayment identifier: ". $self->payinfo if $error;
 661     return "Unknown prepayment identifier"
 662       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
 663
 664   }
 665
 666   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
 667     return "Expriation date required"
 668       unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY';
 669     $self->paydate('');
 670   } else {
 671     $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
 672       or return "Illegal expiration date: ". $self->paydate;
 673     if ( length($2) == 4 ) {
 674       $self->paydate("$2-$1-01");
 675     } else {
 676       $self->paydate("20$2-$1-01");
 677     }
 678   }
 679
 680   if ( $self->payname eq '' ) {
 681     $self->payname( $self->first. " ". $self->getfield('last') );
 682   } else {
 683     $self->payname =~ /^([\w \,\.\-\']+)$/
 684       or return "Illegal billing name: ". $self->payname;
 685     $self->payname($1);
 686   }
 687
 688   $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
 689   $self->tax($1);
 690
 691   $self->otaker(getotaker);
 692
 693   ''; #no error
 694 }
 695
 696 =item all_pkgs
 697
 698 Returns all packages (see L<FS::cust_pkg>) for this customer.
 699
 700 =cut
 701
 702 sub all_pkgs {
 703   my $self = shift;
 704   qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
 705 }
 706
 707 =item ncancelled_pkgs
 708
 709 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
 710
 711 =cut
 712
 713 sub ncancelled_pkgs {
 714   my $self = shift;
 715   @{ [ # force list context
 716     qsearch( 'cust_pkg', {
 717       'custnum' => $self->custnum,
 718       'cancel'  => '',
 719     }),
 720     qsearch( 'cust_pkg', {
 721       'custnum' => $self->custnum,
 722       'cancel'  => 0,
 723     }),
 724   ] };
 725 }
 726
 727 =item suspended_pkgs
 728
 729 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
 730
 731 =cut
 732
 733 sub suspended_pkgs {
 734   my $self = shift;
 735   grep { $_->susp } $self->ncancelled_pkgs;
 736 }
 737
 738 =item unflagged_suspended_pkgs
 739
 740 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
 741 customer (thouse packages without the `manual_flag' set).
 742
 743 =cut
 744
 745 sub unflagged_suspended_pkgs {
 746   my $self = shift;
 747   return $self->suspended_pkgs
 748     unless dbdef->table('cust_pkg')->column('manual_flag');
 749   grep { ! $_->manual_flag } $self->suspended_pkgs;
 750 }
 751
 752 =item unsuspended_pkgs
 753
 754 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
 755 this customer.
 756
 757 =cut
 758
 759 sub unsuspended_pkgs {
 760   my $self = shift;
 761   grep { ! $_->susp } $self->ncancelled_pkgs;
 762 }
 763
 764 =item unsuspend
 765
 766 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
 767 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
 768 on success or a list of errors.
 769
 770 =cut
 771
 772 sub unsuspend {
 773   my $self = shift;
 774   grep { $_->unsuspend } $self->suspended_pkgs;
 775 }
 776
 777 =item suspend
 778
 779 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
 780 Always returns a list: an empty list on success or a list of errors.
 781
 782 =cut
 783
 784 sub suspend {
 785   my $self = shift;
 786   grep { $_->suspend } $self->unsuspended_pkgs;
 787 }
 788
 789 =item bill OPTIONS
 790
 791 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
 792 conjunction with the collect method.
 793
 794 Options are passed as name-value pairs.
 795
 796 The only currently available option is `time', which bills the customer as if
 797 it were that time.  It is specified as a UNIX timestamp; see
 798 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
 799 functions.  For example:
 800
 801  use Date::Parse;
 802  ...
 803  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
 804
 805 If there is an error, returns the error, otherwise returns false.
 806
 807 =cut
 808
 809 sub bill {
 810   my( $self, %options ) = @_;
 811   my $time = $options{'time'} || time;
 812
 813   my $error;
 814
 815   #put below somehow?
 816   local $SIG{HUP} = 'IGNORE';
 817   local $SIG{INT} = 'IGNORE';
 818   local $SIG{QUIT} = 'IGNORE';
 819   local $SIG{TERM} = 'IGNORE';
 820   local $SIG{TSTP} = 'IGNORE';
 821   local $SIG{PIPE} = 'IGNORE';
 822
 823   my $oldAutoCommit = $FS::UID::AutoCommit;
 824   local $FS::UID::AutoCommit = 0;
 825   my $dbh = dbh;
 826
 827   # find the packages which are due for billing, find out how much they are
 828   # & generate invoice database.
 829
 830   my( $total_setup, $total_recur ) = ( 0, 0 );
 831   my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
 832   my @cust_bill_pkg = ();
 833
 834   foreach my $cust_pkg (
 835     qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } )
 836   ) {
 837
 838     next if $cust_pkg->getfield('cancel');
 839
 840     #? to avoid use of uninitialized value errors... ?
 841     $cust_pkg->setfield('bill', '')
 842       unless defined($cust_pkg->bill);
 843
 844     my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
 845
 846     #so we don't modify cust_pkg record unnecessarily
 847     my $cust_pkg_mod_flag = 0;
 848     my %hash = $cust_pkg->hash;
 849     my $old_cust_pkg = new FS::cust_pkg \%hash;
 850
 851     # bill setup
 852     my $setup = 0;
 853     unless ( $cust_pkg->setup ) {
 854       my $setup_prog = $part_pkg->getfield('setup');
 855       $setup_prog =~ /^(.*)$/ or do {
 856         $dbh->rollback if $oldAutoCommit;
 857         return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
 858                ": $setup_prog";
 859       };
 860       $setup_prog = $1;
 861
 862         #my $cpt = new Safe;
 863         ##$cpt->permit(); #what is necessary?
 864         #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
 865         #$setup = $cpt->reval($setup_prog);
 866       $setup = eval $setup_prog;
 867       unless ( defined($setup) ) {
 868         $dbh->rollback if $oldAutoCommit;
 869         return "Error reval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
 870                ": $@";
 871       }
 872       $cust_pkg->setfield('setup',$time);
 873       $cust_pkg_mod_flag=1;
 874     }
 875
 876     #bill recurring fee
 877     my $recur = 0;
 878     my $sdate;
 879     if ( $part_pkg->getfield('freq') > 0 &&
 880          ! $cust_pkg->getfield('susp') &&
 881          ( $cust_pkg->getfield('bill') || 0 ) < $time
 882     ) {
 883       my $recur_prog = $part_pkg->getfield('recur');
 884       $recur_prog =~ /^(.*)$/ or do {
 885         $dbh->rollback if $oldAutoCommit;
 886         return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
 887                ": $recur_prog";
 888       };
 889       $recur_prog = $1;
 890
 891         #my $cpt = new Safe;
 892         ##$cpt->permit(); #what is necessary?
 893         #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
 894         #$recur = $cpt->reval($recur_prog);
 895       $recur = eval $recur_prog;
 896       unless ( defined($recur) ) {
 897         $dbh->rollback if $oldAutoCommit;
 898         return "Error reval-ing part_pkg->recur pkgpart ".
 899                $part_pkg->pkgpart. ": $@";
 900       }
 901       #change this bit to use Date::Manip? CAREFUL with timezones (see
 902       # mailing list archive)
 903       #$sdate=$cust_pkg->bill || time;
 904       #$sdate=$cust_pkg->bill || $time;
 905       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
 906       my ($sec,$min,$hour,$mday,$mon,$year) =
 907         (localtime($sdate) )[0,1,2,3,4,5];
 908       $mon += $part_pkg->getfield('freq');
 909       until ( $mon < 12 ) { $mon -= 12; $year++; }
 910       $cust_pkg->setfield('bill',
 911         timelocal($sec,$min,$hour,$mday,$mon,$year));
 912       $cust_pkg_mod_flag = 1;
 913     }
 914
 915     warn "\$setup is undefined" unless defined($setup);
 916     warn "\$recur is undefined" unless defined($recur);
 917     warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
 918
 919     if ( $cust_pkg_mod_flag ) {
 920       $error=$cust_pkg->replace($old_cust_pkg);
 921       if ( $error ) { #just in case
 922         $dbh->rollback if $oldAutoCommit;
 923         return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
 924       }
 925       $setup = sprintf( "%.2f", $setup );
 926       $recur = sprintf( "%.2f", $recur );
 927       if ( $setup < 0 ) {
 928         $dbh->rollback if $oldAutoCommit;
 929         return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
 930       }
 931       if ( $recur < 0 ) {
 932         $dbh->rollback if $oldAutoCommit;
 933         return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
 934       }
 935       if ( $setup > 0 || $recur > 0 ) {
 936         my $cust_bill_pkg = new FS::cust_bill_pkg ({
 937           'pkgnum' => $cust_pkg->pkgnum,
 938           'setup'  => $setup,
 939           'recur'  => $recur,
 940           'sdate'  => $sdate,
 941           'edate'  => $cust_pkg->bill,
 942         });
 943         push @cust_bill_pkg, $cust_bill_pkg;
 944         $total_setup += $setup;
 945         $total_recur += $recur;
 946         $taxable_setup += $setup
 947           unless $part_pkg->dbdef_table->column('setuptax')
 948                  || $part_pkg->setuptax =~ /^Y$/i;
 949         $taxable_recur += $recur
 950           unless $part_pkg->dbdef_table->column('recurtax')
 951                  || $part_pkg->recurtax =~ /^Y$/i;
 952       }
 953     }
 954
 955   }
 956
 957   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
 958   my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
 959
 960   unless ( @cust_bill_pkg ) {
 961     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 962     return '';
 963   }
 964
 965   unless ( $self->tax =~ /Y/i
 966            || $self->payby eq 'COMP'
 967            || $taxable_charged == 0 ) {
 968     my $cust_main_county = qsearchs('cust_main_county',{
 969         'state'   => $self->state,
 970         'county'  => $self->county,
 971         'country' => $self->country,
 972     } );
 973     my $tax = sprintf( "%.2f",
 974       $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
 975     );
 976
 977     if ( $tax > 0 ) {
 978       $charged = sprintf( "%.2f", $charged+$tax );
 979
 980       my $cust_bill_pkg = new FS::cust_bill_pkg ({
 981         'pkgnum' => 0,
 982         'setup'  => $tax,
 983         'recur'  => 0,
 984         'sdate'  => '',
 985         'edate'  => '',
 986       });
 987       push @cust_bill_pkg, $cust_bill_pkg;
 988     }
 989   }
 990
 991   my $cust_bill = new FS::cust_bill ( {
 992     'custnum' => $self->custnum,
 993     '_date'   => $time,
 994     'charged' => $charged,
 995   } );
 996   $error = $cust_bill->insert;
 997   if ( $error ) {
 998     $dbh->rollback if $oldAutoCommit;
 999     return "can't create invoice for customer #". $self->custnum. ": $error";
1000   }
1001
1002   my $invnum = $cust_bill->invnum;
1003   my $cust_bill_pkg;
1004   foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1005     warn $cust_bill_pkg->invnum($invnum);
1006     $error = $cust_bill_pkg->insert;
1007     if ( $error ) {
1008       $dbh->rollback if $oldAutoCommit;
1009       return "can't create invoice line item for customer #". $self->custnum.
1010              ": $error";
1011     }
1012   }
1013
1014   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1015   ''; #no error
1016 }
1017
1018 =item collect OPTIONS
1019
1020 (Attempt to) collect money for this customer's outstanding invoices (see
1021 L<FS::cust_bill>).  Usually used after the bill method.
1022
1023 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1024 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1025
1026 If there is an error, returns the error, otherwise returns false.
1027
1028 Options are passed as name-value pairs.
1029
1030 Currently available options are:
1031
1032 invoice_time - Use this time when deciding when to print invoices and
1033 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>
1034 for conversion functions.
1035
1036 batch_card - Set this true to batch cards (see L<FS::cust_pay_batch>).  By
1037 default, cards are processed immediately, which will generate an error if
1038 CyberCash is not installed.
1039
1040 report_badcard - Set this true if you want bad card transactions to
1041 return an error.  By default, they don't.
1042
1043 =cut
1044
1045 sub collect {
1046   my( $self, %options ) = @_;
1047   my $invoice_time = $options{'invoice_time'} || time;
1048
1049   #put below somehow?
1050   local $SIG{HUP} = 'IGNORE';
1051   local $SIG{INT} = 'IGNORE';
1052   local $SIG{QUIT} = 'IGNORE';
1053   local $SIG{TERM} = 'IGNORE';
1054   local $SIG{TSTP} = 'IGNORE';
1055   local $SIG{PIPE} = 'IGNORE';
1056
1057   my $oldAutoCommit = $FS::UID::AutoCommit;
1058   local $FS::UID::AutoCommit = 0;
1059   my $dbh = dbh;
1060
1061   my $balance = $self->balance;
1062   warn "collect: balance $balance" if $Debug;
1063   unless ( $balance > 0 ) { #redundant?????
1064     $dbh->rollback if $oldAutoCommit; #hmm
1065     return '';
1066   }
1067
1068   foreach my $cust_bill (
1069     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1070   ) {
1071
1072     #this has to be before next's
1073     my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1074                                   ? $balance
1075                                   : $cust_bill->owed
1076     );
1077     $balance = sprintf( "%.2f", $balance - $amount );
1078
1079     next unless $cust_bill->owed > 0;
1080
1081     # don't try to charge for the same invoice if it's already in a batch
1082     next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1083
1084     warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1085
1086     next unless $amount > 0;
1087
1088     if ( $self->payby eq 'BILL' ) {
1089
1090       #30 days 2592000
1091       my $since = $invoice_time - ( $cust_bill->_date || 0 );
1092       #warn "$invoice_time ", $cust_bill->_date, " $since";
1093       if ( $since >= 0 #don't print future invoices
1094            && ( $cust_bill->printed * 2592000 ) <= $since
1095       ) {
1096
1097         #my @print_text = $cust_bill->print_text; #( date )
1098         my @invoicing_list = $self->invoicing_list;
1099         if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
1100           $ENV{SMTPHOSTS} = $smtpmachine;
1101           $ENV{MAILADDRESS} = $invoice_from;
1102           my $header = new Mail::Header ( [
1103             "From: $invoice_from",
1104             "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
1105             "Sender: $invoice_from",
1106             "Reply-To: $invoice_from",
1107             "Date: ". time2str("%a, %d %b %Y %X %z", time),
1108             "Subject: Invoice",
1109           ] );
1110           my $message = new Mail::Internet (
1111             'Header' => $header,
1112             'Body' => [ $cust_bill->print_text ], #( date)
1113           );
1114           $message->smtpsend or die "Can't send invoice email!"; #die?  warn?
1115
1116         } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
1117           open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
1118           print LPR $cust_bill->print_text; #( date )
1119           close LPR
1120             or die $! ? "Error closing $lpr: $!"
1121                          : "Exit status $? from $lpr";
1122         }
1123
1124         my %hash = $cust_bill->hash;
1125         $hash{'printed'}++;
1126         my $new_cust_bill = new FS::cust_bill(\%hash);
1127         my $error = $new_cust_bill->replace($cust_bill);
1128         warn "Error updating $cust_bill->printed: $error" if $error;
1129
1130       }
1131
1132     } elsif ( $self->payby eq 'COMP' ) {
1133       my $cust_pay = new FS::cust_pay ( {
1134          'invnum' => $cust_bill->invnum,
1135          'paid' => $amount,
1136          '_date' => '',
1137          'payby' => 'COMP',
1138          'payinfo' => $self->payinfo,
1139          'paybatch' => ''
1140       } );
1141       my $error = $cust_pay->insert;
1142       if ( $error ) {
1143         $dbh->rollback if $oldAutoCommit;
1144         return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error";
1145       }
1146
1147
1148     } elsif ( $self->payby eq 'CARD' ) {
1149
1150       if ( $options{'batch_card'} ne 'yes' ) {
1151
1152         unless ( $processor ) {
1153           $dbh->rollback if $oldAutoCommit;
1154           return "Real time card processing not enabled!";
1155         }
1156
1157         my $address = $self->address1;
1158         $address .= ", ". $self->address2 if $self->address2;
1159
1160         #fix exp. date
1161         #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1162         $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1163         my $exp = "$2/$1";
1164
1165         if ( $processor eq 'cybercash3.2' ) {
1166
1167           #fix exp. date for cybercash
1168           #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1169           $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1170           my $exp = "$2/$1";
1171
1172           my $paybatch = $cust_bill->invnum.
1173                          '-' . time2str("%y%m%d%H%M%S", time);
1174
1175           my $payname = $self->payname ||
1176                         $self->getfield('first'). ' '. $self->getfield('last');
1177
1178
1179           my $country = $self->country eq 'US' ? 'USA' : $self->country;
1180
1181           my @full_xaction = ( $xaction,
1182             'Order-ID'     => $paybatch,
1183             'Amount'       => "usd $amount",
1184             'Card-Number'  => $self->getfield('payinfo'),
1185             'Card-Name'    => $payname,
1186             'Card-Address' => $address,
1187             'Card-City'    => $self->getfield('city'),
1188             'Card-State'   => $self->getfield('state'),
1189             'Card-Zip'     => $self->getfield('zip'),
1190             'Card-Country' => $country,
1191             'Card-Exp'     => $exp,
1192           );
1193
1194           my %result;
1195           %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
1196
1197           #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
1198           #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
1199           if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
1200             my $cust_pay = new FS::cust_pay ( {
1201                'invnum'   => $cust_bill->invnum,
1202                'paid'     => $amount,
1203                '_date'     => '',
1204                'payby'    => 'CARD',
1205                'payinfo'  => $self->payinfo,
1206                'paybatch' => "$processor:$paybatch",
1207             } );
1208             my $error = $cust_pay->insert;
1209             if ( $error ) {
1210               # gah, even with transactions.
1211               $dbh->commit if $oldAutoCommit; #well.
1212               my $e = 'WARNING: Card debited but database not updated - '.
1213                       'error applying payment, invnum #' . $cust_bill->invnum.
1214                       " (CyberCash Order-ID $paybatch): $error";
1215               warn $e;
1216               return $e;
1217             }
1218           } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
1219                  || $options{'report_badcard'} ) {
1220              $dbh->commit if $oldAutoCommit;
1221              return 'Cybercash error, invnum #' .
1222                $cust_bill->invnum. ':'. $result{'MErrMsg'};
1223           } else {
1224             $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1225             return '';
1226           }
1227
1228         } elsif ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) {
1229
1230           my $bop_processor = $1;
1231
1232           my($payname, $payfirst, $paylast);
1233           if ( $self->payname ) {
1234             $payname = $self->payname;
1235             $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/
1236               or do {
1237                       $dbh->rollback if $oldAutoCommit;
1238                       return "Illegal payname $payname";
1239                     };
1240             ($payfirst, $paylast) = ($1, $2);
1241           } else {
1242             $payfirst = $self->getfield('first');
1243             $paylast = $self->getfield('first');
1244             $payname =  "$payfirst $paylast";
1245           }
1246
1247           my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1248           if ( $conf->exists('emailinvoiceauto')
1249                || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1250             push @invoicing_list, $self->default_invoicing_list;
1251           }
1252           my $email = $invoicing_list[0];
1253
1254           my( $action1, $action2 ) = split(/\s*\,\s*/, $bop_action );
1255
1256           my $transaction =
1257             new Business::OnlinePayment( $bop_processor, @bop_options );
1258           $transaction->content(
1259             'type'           => 'CC',
1260             'login'          => $bop_login,
1261             'password'       => $bop_password,
1262             'action'         => $action1,
1263             'description'    => 'Internet Services',
1264             'amount'         => $amount,
1265             'invoice_number' => $cust_bill->invnum,
1266             'customer_id'    => $self->custnum,
1267             'last_name'      => $paylast,
1268             'first_name'     => $payfirst,
1269             'name'           => $payname,
1270             'address'        => $address,
1271             'city'           => $self->city,
1272             'state'          => $self->state,
1273             'zip'            => $self->zip,
1274             'country'        => $self->country,
1275             'card_number'    => $self->payinfo,
1276             'expiration'     => $exp,
1277             'referer'        => 'http://cleanwhisker.420.am/',
1278             'email'          => $email,
1279           );
1280           $transaction->submit();
1281
1282           if ( $transaction->is_success() && $action2 ) {
1283             my $auth = $transaction->authorization;
1284             my $ordernum = $transaction->order_number;
1285             #warn "********* $auth ***********\n";
1286             #warn "********* $ordernum ***********\n";
1287             my $capture =
1288               new Business::OnlinePayment( $bop_processor, @bop_options );
1289
1290             $capture->content(
1291               action         => $action2,
1292               login          => $bop_login,
1293               password       => $bop_password,
1294               order_number   => $ordernum,
1295               amount         => $amount,
1296               authorization  => $auth,
1297               description    => 'Internet Services',
1298             );
1299
1300             $capture->submit();
1301
1302             unless ( $capture->is_success ) {
1303               my $e = "Authorization sucessful but capture failed, invnum #".
1304                       $cust_bill->invnum. ': '.  $capture->result_code.
1305                       ": ". $capture->error_message;
1306               warn $e;
1307               return $e;
1308             }
1309
1310           }
1311
1312           if ( $transaction->is_success() ) {
1313
1314             my $cust_pay = new FS::cust_pay ( {
1315                'invnum'   => $cust_bill->invnum,
1316                'paid'     => $amount,
1317                '_date'     => '',
1318                'payby'    => 'CARD',
1319                'payinfo'  => $self->payinfo,
1320                'paybatch' => "$processor:". $transaction->authorization,
1321             } );
1322             my $error = $cust_pay->insert;
1323             if ( $error ) {
1324               # gah, even with transactions.
1325               $dbh->commit if $oldAutoCommit; #well.
1326               my $e = 'WARNING: Card debited but database not updated - '.
1327                       'error applying payment, invnum #' . $cust_bill->invnum.
1328                       " ($processor): $error";
1329               warn $e;
1330               return $e;
1331             }
1332           } elsif ( $options{'report_badcard'} ) {
1333             $dbh->commit if $oldAutoCommit;
1334             return "$processor error, invnum #". $cust_bill->invnum. ': '.
1335                    $transaction->result_code. ": ". $transaction->error_message;
1336           } else {
1337             $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1338             #return '';
1339           }
1340
1341         } else {
1342           $dbh->rollback if $oldAutoCommit;
1343           return "Unknown real-time processor $processor\n";
1344         }
1345
1346       } else { #batch card
1347
1348        my $cust_pay_batch = new FS::cust_pay_batch ( {
1349          'invnum'   => $cust_bill->getfield('invnum'),
1350          'custnum'  => $self->getfield('custnum'),
1351          'last'     => $self->getfield('last'),
1352          'first'    => $self->getfield('first'),
1353          'address1' => $self->getfield('address1'),
1354          'address2' => $self->getfield('address2'),
1355          'city'     => $self->getfield('city'),
1356          'state'    => $self->getfield('state'),
1357          'zip'      => $self->getfield('zip'),
1358          'country'  => $self->getfield('country'),
1359          'trancode' => 77,
1360          'cardnum'  => $self->getfield('payinfo'),
1361          'exp'      => $self->getfield('paydate'),
1362          'payname'  => $self->getfield('payname'),
1363          'amount'   => $amount,
1364        } );
1365        my $error = $cust_pay_batch->insert;
1366        if ( $error ) {
1367          $dbh->rollback if $oldAutoCommit;
1368          return "Error adding to cust_pay_batch: $error";
1369        }
1370
1371       }
1372
1373     } else {
1374       $dbh->rollback if $oldAutoCommit;
1375       return "Unknown payment type ". $self->payby;
1376     }
1377
1378   }
1379   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1380   '';
1381
1382 }
1383
1384 =item total_owed
1385
1386 Returns the total owed for this customer on all invoices
1387 (see L<FS::cust_bill/owed>).
1388
1389 =cut
1390
1391 sub total_owed {
1392   my $self = shift;
1393   my $total_bill = 0;
1394   foreach my $cust_bill ( qsearch('cust_bill', {
1395     'custnum' => $self->custnum,
1396   } ) ) {
1397     $total_bill += $cust_bill->owed;
1398   }
1399   sprintf( "%.2f", $total_bill );
1400 }
1401
1402 =item apply_credits
1403
1404 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1405 to outstanding invoice balances in chronological order and returns the value
1406 of any remaining unapplied credits available for refund
1407 (see L<FS::cust_refund>).
1408
1409 =cut
1410
1411 sub apply_credits {
1412   my $self = shift;
1413
1414   return 0 unless $self->total_credited;
1415
1416   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1417       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1418
1419   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1420       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1421
1422   my $credit;
1423
1424   foreach my $cust_bill ( @invoices ) {
1425     my $amount;
1426
1427     if ( !defined($credit) || $credit->credited == 0) {
1428       $credit = pop @credits or last;
1429     }
1430
1431     if ($cust_bill->owed >= $credit->credited) {
1432       $amount=$credit->credited;
1433     }else{
1434       $amount=$cust_bill->owed;
1435     }
1436
1437     my $cust_credit_bill = new FS::cust_credit_bill ( {
1438       'crednum' => $credit->crednum,
1439       'invnum'  => $cust_bill->invnum,
1440       'amount'  => $amount,
1441     } );
1442     my $error = $cust_credit_bill->insert;
1443     die $error if $error;
1444
1445     redo if ($cust_bill->owed > 0);
1446
1447   }
1448
1449   return $self->total_credited;
1450 }
1451
1452 =item apply_payments
1453
1454 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1455 to outstanding invoice balances in chronological order.
1456
1457  #and returns the value of any remaining unapplied payments.
1458
1459 =cut
1460
1461 sub apply_payments {
1462   my $self = shift;
1463
1464   #return 0 unless
1465
1466   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1467       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1468
1469   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1470       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1471
1472   my $payment;
1473
1474   foreach my $cust_bill ( @invoices ) {
1475     my $amount;
1476
1477     if ( !defined($payment) || $payment->unapplied == 0 ) {
1478       $payment = pop @payments or last;
1479     }
1480
1481     if ( $cust_bill->owed >= $payment->unapplied ) {
1482       $amount = $payment->unapplied;
1483     } else {
1484       $amount = $cust_bill->owed;
1485     }
1486
1487     my $cust_bill_pay = new FS::cust_bill_pay ( {
1488       'paynum' => $payment->paynum,
1489       'invnum' => $cust_bill->invnum,
1490       'amount' => $amount,
1491     } );
1492     my $error = $cust_bill_pay->insert;
1493     die $error if $error;
1494
1495     redo if ( $cust_bill->owed > 0);
1496
1497   }
1498
1499   return $self->total_unapplied_payments;
1500 }
1501
1502 =item total_credited
1503
1504 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1505 customer.  See L<FS::cust_credit/credited>.
1506
1507 =cut
1508
1509 sub total_credited {
1510   my $self = shift;
1511   my $total_credit = 0;
1512   foreach my $cust_credit ( qsearch('cust_credit', {
1513     'custnum' => $self->custnum,
1514   } ) ) {
1515     $total_credit += $cust_credit->credited;
1516   }
1517   sprintf( "%.2f", $total_credit );
1518 }
1519
1520 =item total_unapplied_payments
1521
1522 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1523 See L<FS::cust_pay/unapplied>.
1524
1525 =cut
1526
1527 sub total_unapplied_payments {
1528   my $self = shift;
1529   my $total_unapplied = 0;
1530   foreach my $cust_pay ( qsearch('cust_pay', {
1531     'custnum' => $self->custnum,
1532   } ) ) {
1533     $total_unapplied += $cust_pay->unapplied;
1534   }
1535   sprintf( "%.2f", $total_unapplied );
1536 }
1537
1538 =item balance
1539
1540 Returns the balance for this customer (total_owed minus total_credited
1541 minus total_unapplied_payments).
1542
1543 =cut
1544
1545 sub balance {
1546   my $self = shift;
1547   sprintf( "%.2f",
1548     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1549   );
1550 }
1551
1552 =item invoicing_list [ ARRAYREF ]
1553
1554 If an arguement is given, sets these email addresses as invoice recipients
1555 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
1556 (except as warnings), so use check_invoicing_list first.
1557
1558 Returns a list of email addresses (with svcnum entries expanded).
1559
1560 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
1561 check it without disturbing anything by passing nothing.
1562
1563 This interface may change in the future.
1564
1565 =cut
1566
1567 sub invoicing_list {
1568   my( $self, $arrayref ) = @_;
1569   if ( $arrayref ) {
1570     my @cust_main_invoice;
1571     if ( $self->custnum ) {
1572       @cust_main_invoice =
1573         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1574     } else {
1575       @cust_main_invoice = ();
1576     }
1577     foreach my $cust_main_invoice ( @cust_main_invoice ) {
1578       #warn $cust_main_invoice->destnum;
1579       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1580         #warn $cust_main_invoice->destnum;
1581         my $error = $cust_main_invoice->delete;
1582         warn $error if $error;
1583       }
1584     }
1585     if ( $self->custnum ) {
1586       @cust_main_invoice =
1587         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1588     } else {
1589       @cust_main_invoice = ();
1590     }
1591     my %seen = map { $_->address => 1 } @cust_main_invoice;
1592     foreach my $address ( @{$arrayref} ) {
1593       #unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1594       next if exists $seen{$address} && $seen{$address};
1595       $seen{$address} = 1;
1596       my $cust_main_invoice = new FS::cust_main_invoice ( {
1597         'custnum' => $self->custnum,
1598         'dest'    => $address,
1599       } );
1600       my $error = $cust_main_invoice->insert;
1601       warn $error if $error;
1602     }
1603   }
1604   if ( $self->custnum ) {
1605     map { $_->address }
1606       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1607   } else {
1608     ();
1609   }
1610 }
1611
1612 =item check_invoicing_list ARRAYREF
1613
1614 Checks these arguements as valid input for the invoicing_list method.  If there
1615 is an error, returns the error, otherwise returns false.
1616
1617 =cut
1618
1619 sub check_invoicing_list {
1620   my( $self, $arrayref ) = @_;
1621   foreach my $address ( @{$arrayref} ) {
1622     my $cust_main_invoice = new FS::cust_main_invoice ( {
1623       'custnum' => $self->custnum,
1624       'dest'    => $address,
1625     } );
1626     my $error = $self->custnum
1627                 ? $cust_main_invoice->check
1628                 : $cust_main_invoice->checkdest
1629     ;
1630     return $error if $error;
1631   }
1632   '';
1633 }
1634
1635 =item default_invoicing_list
1636
1637 Returns the email addresses of any
1638
1639 =cut
1640
1641 sub default_invoicing_list {
1642   my $self = shift;
1643   my @list = ();
1644   foreach my $cust_pkg ( $self->all_pkgs ) {
1645     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1646     my @svc_acct =
1647       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1648         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1649           @cust_svc;
1650     push @list, map { $_->email } @svc_acct;
1651   }
1652   $self->invoicing_list(\@list);
1653 }
1654
1655 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1656
1657 Returns an array of customers referred by this customer (referral_custnum set
1658 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
1659 customers referred by customers referred by this customer and so on, inclusive.
1660 The default behavior is DEPTH 1 (no recursion).
1661
1662 =cut
1663
1664 sub referral_cust_main {
1665   my $self = shift;
1666   my $depth = @_ ? shift : 1;
1667   my $exclude = @_ ? shift : {};
1668
1669   my @cust_main =
1670     map { $exclude->{$_->custnum}++; $_; }
1671       grep { ! $exclude->{ $_->custnum } }
1672         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1673
1674   if ( $depth > 1 ) {
1675     push @cust_main,
1676       map { $_->referral_cust_main($depth-1, $exclude) }
1677         @cust_main;
1678   }
1679
1680   @cust_main;
1681 }
1682
1683 =item referral_cust_pkg [ DEPTH ]
1684
1685 Like referral_cust_main, except returns a flat list of all unsuspended packages
1686 for each customer.  The number of items in this list may be useful for
1687 comission calculations (perhaps after a grep).
1688
1689 =cut
1690
1691 sub referral_cust_pkg {
1692   my $self = shift;
1693   my $depth = @_ ? shift : 1;
1694
1695   map { $_->unsuspended_pkgs }
1696     grep { $_->unsuspended_pkgs }
1697       $self->referral_cust_main($depth);
1698 }
1699
1700 =item credit AMOUNT, REASON
1701
1702 Applies a credit to this customer.  If there is an error, returns the error,
1703 otherwise returns false.
1704
1705 =cut
1706
1707 sub credit {
1708   my( $self, $amount, $reason ) = @_;
1709   my $cust_credit = new FS::cust_credit {
1710     'custnum' => $self->custnum,
1711     'amount'  => $amount,
1712     'reason'  => $reason,
1713   };
1714   $cust_credit->insert;
1715 }
1716
1717 =back
1718
1719 =head1 SUBROUTINES
1720
1721 =over 4
1722
1723 =item check_and_rebuild_fuzzyfiles
1724
1725 =cut
1726
1727 sub check_and_rebuild_fuzzyfiles {
1728   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1729   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1730     or &rebuild_fuzzyfiles;
1731 }
1732
1733 =item rebuild_fuzzyfiles
1734
1735 =cut
1736
1737 sub rebuild_fuzzyfiles {
1738
1739   use Fcntl qw(:flock);
1740
1741   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1742
1743   #last
1744
1745   open(LASTLOCK,">>$dir/cust_main.last")
1746     or die "can't open $dir/cust_main.last: $!";
1747   flock(LASTLOCK,LOCK_EX)
1748     or die "can't lock $dir/cust_main.last: $!";
1749
1750   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1751   push @all_last,
1752                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1753     if defined dbdef->table('cust_main')->column('ship_last');
1754
1755   open (LASTCACHE,">$dir/cust_main.last.tmp")
1756     or die "can't open $dir/cust_main.last.tmp: $!";
1757   print LASTCACHE join("\n", @all_last), "\n";
1758   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1759
1760   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1761   close LASTLOCK;
1762
1763   #company
1764
1765   open(COMPANYLOCK,">>$dir/cust_main.company")
1766     or die "can't open $dir/cust_main.company: $!";
1767   flock(COMPANYLOCK,LOCK_EX)
1768     or die "can't lock $dir/cust_main.company: $!";
1769
1770   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1771   push @all_company,
1772        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1773     if defined dbdef->table('cust_main')->column('ship_last');
1774
1775   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1776     or die "can't open $dir/cust_main.company.tmp: $!";
1777   print COMPANYCACHE join("\n", @all_company), "\n";
1778   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1779
1780   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1781   close COMPANYLOCK;
1782
1783 }
1784
1785 =item all_last
1786
1787 =cut
1788
1789 sub all_last {
1790   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1791   open(LASTCACHE,"<$dir/cust_main.last")
1792     or die "can't open $dir/cust_main.last: $!";
1793   my @array = map { chomp; $_; } <LASTCACHE>;
1794   close LASTCACHE;
1795   \@array;
1796 }
1797
1798 =item all_company
1799
1800 =cut
1801
1802 sub all_company {
1803   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1804   open(COMPANYCACHE,"<$dir/cust_main.company")
1805     or die "can't open $dir/cust_main.last: $!";
1806   my @array = map { chomp; $_; } <COMPANYCACHE>;
1807   close COMPANYCACHE;
1808   \@array;
1809 }
1810
1811 =item append_fuzzyfiles LASTNAME COMPANY
1812
1813 =cut
1814
1815 sub append_fuzzyfiles {
1816   my( $last, $company ) = @_;
1817
1818   &check_and_rebuild_fuzzyfiles;
1819
1820   use Fcntl qw(:flock);
1821
1822   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1823
1824   if ( $last ) {
1825
1826     open(LAST,">>$dir/cust_main.last")
1827       or die "can't open $dir/cust_main.last: $!";
1828     flock(LAST,LOCK_EX)
1829       or die "can't lock $dir/cust_main.last: $!";
1830
1831     print LAST "$last\n";
1832
1833     flock(LAST,LOCK_UN)
1834       or die "can't unlock $dir/cust_main.last: $!";
1835     close LAST;
1836   }
1837
1838   if ( $company ) {
1839
1840     open(COMPANY,">>$dir/cust_main.company")
1841       or die "can't open $dir/cust_main.company: $!";
1842     flock(COMPANY,LOCK_EX)
1843       or die "can't lock $dir/cust_main.company: $!";
1844
1845     print COMPANY "$company\n";
1846
1847     flock(COMPANY,LOCK_UN)
1848       or die "can't unlock $dir/cust_main.company: $!";
1849
1850     close COMPANY;
1851   }
1852
1853   1;
1854 }
1855
1856 =head1 VERSION
1857
1858 $Id: cust_main.pm,v 1.44 2001-10-22 08:31:25 ivan Exp $
1859
1860 =head1 BUGS
1861
1862 The delete method.
1863
1864 The delete method should possibly take an FS::cust_main object reference
1865 instead of a scalar customer number.
1866
1867 Bill and collect options should probably be passed as references instead of a
1868 list.
1869
1870 CyberCash v2 forces us to define some variables in package main.
1871
1872 There should probably be a configuration file with a list of allowed credit
1873 card types.
1874
1875 No multiple currency support (probably a larger project than just this module).
1876
1877 =head1 SEE ALSO
1878
1879 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1880 L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
1881 L<FS::cust_main_county>, L<FS::cust_main_invoice>,
1882 L<FS::UID>, schema.html from the base documentation.
1883
1884 =cut
1885
1886 1;
1887
1888