FS/FS/cust_main.pm

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