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{1,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   $self->select_for_update; #mutex
1102
1103   # find the packages which are due for billing, find out how much they are
1104   # & generate invoice database.
1105
1106   my( $total_setup, $total_recur ) = ( 0, 0 );
1107   #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1108   my @cust_bill_pkg = ();
1109   #my $tax = 0;##
1110   #my $taxable_charged = 0;##
1111   #my $charged = 0;##
1112
1113   my %tax;
1114
1115   foreach my $cust_pkg (
1116     qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1117   ) {
1118
1119     #NO!! next if $cust_pkg->cancel;
1120     next if $cust_pkg->getfield('cancel');
1121
1122     #? to avoid use of uninitialized value errors... ?
1123     $cust_pkg->setfield('bill', '')
1124       unless defined($cust_pkg->bill);
1125
1126     my $part_pkg = $cust_pkg->part_pkg;
1127
1128     #so we don't modify cust_pkg record unnecessarily
1129     my $cust_pkg_mod_flag = 0;
1130     my %hash = $cust_pkg->hash;
1131     my $old_cust_pkg = new FS::cust_pkg \%hash;
1132
1133     my @details = ();
1134
1135     # bill setup
1136     my $setup = 0;
1137     if ( !$cust_pkg->setup || $options{'resetup'} ) {
1138       my $setup_prog = $part_pkg->getfield('setup');
1139       $setup_prog =~ /^(.*)$/ or do {
1140         $dbh->rollback if $oldAutoCommit;
1141         return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
1142                ": $setup_prog";
1143       };
1144       $setup_prog = $1;
1145       $setup_prog = '0' if $setup_prog =~ /^\s*$/;
1146
1147         #my $cpt = new Safe;
1148         ##$cpt->permit(); #what is necessary?
1149         #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1150         #$setup = $cpt->reval($setup_prog);
1151       $setup = eval $setup_prog;
1152       unless ( defined($setup) ) {
1153         $dbh->rollback if $oldAutoCommit;
1154         return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
1155                "(expression $setup_prog): $@";
1156       }
1157       $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1158       $cust_pkg_mod_flag=1;
1159     }
1160
1161     #bill recurring fee
1162     my $recur = 0;
1163     my $sdate;
1164     if ( $part_pkg->getfield('freq') ne '0' &&
1165          ! $cust_pkg->getfield('susp') &&
1166          ( $cust_pkg->getfield('bill') || 0 ) <= $time
1167     ) {
1168       my $recur_prog = $part_pkg->getfield('recur');
1169       $recur_prog =~ /^(.*)$/ or do {
1170         $dbh->rollback if $oldAutoCommit;
1171         return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1172                ": $recur_prog";
1173       };
1174       $recur_prog = $1;
1175       $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1176
1177       # shared with $recur_prog
1178       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1179
1180         #my $cpt = new Safe;
1181         ##$cpt->permit(); #what is necessary?
1182         #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1183         #$recur = $cpt->reval($recur_prog);
1184       $recur = eval $recur_prog;
1185       unless ( defined($recur) ) {
1186         $dbh->rollback if $oldAutoCommit;
1187         return "Error eval-ing part_pkg->recur pkgpart ".  $part_pkg->pkgpart.
1188                "(expression $recur_prog): $@";
1189       }
1190       #change this bit to use Date::Manip? CAREFUL with timezones (see
1191       # mailing list archive)
1192       my ($sec,$min,$hour,$mday,$mon,$year) =
1193         (localtime($sdate) )[0,1,2,3,4,5];
1194
1195       #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1196       # only for figuring next bill date, nothing else, so, reset $sdate again
1197       # here
1198       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1199       $cust_pkg->last_bill($sdate)
1200         if $cust_pkg->dbdef_table->column('last_bill');
1201
1202       if ( $part_pkg->freq =~ /^\d+$/ ) {
1203         $mon += $part_pkg->freq;
1204         until ( $mon < 12 ) { $mon -= 12; $year++; }
1205       } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1206         my $weeks = $1;
1207         $mday += $weeks * 7;
1208       } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1209         my $days = $1;
1210         $mday += $days;
1211       } else {
1212         $dbh->rollback if $oldAutoCommit;
1213         return "unparsable frequency: ". $part_pkg->freq;
1214       }
1215       $cust_pkg->setfield('bill',
1216         timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1217       $cust_pkg_mod_flag = 1;
1218     }
1219
1220     warn "\$setup is undefined" unless defined($setup);
1221     warn "\$recur is undefined" unless defined($recur);
1222     warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1223
1224     if ( $cust_pkg_mod_flag ) {
1225       $error=$cust_pkg->replace($old_cust_pkg);
1226       if ( $error ) { #just in case
1227         $dbh->rollback if $oldAutoCommit;
1228         return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1229       }
1230       $setup = sprintf( "%.2f", $setup );
1231       $recur = sprintf( "%.2f", $recur );
1232       if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1233         $dbh->rollback if $oldAutoCommit;
1234         return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1235       }
1236       if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1237         $dbh->rollback if $oldAutoCommit;
1238         return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1239       }
1240       if ( $setup != 0 || $recur != 0 ) {
1241         my $cust_bill_pkg = new FS::cust_bill_pkg ({
1242           'pkgnum'  => $cust_pkg->pkgnum,
1243           'setup'   => $setup,
1244           'recur'   => $recur,
1245           'sdate'   => $sdate,
1246           'edate'   => $cust_pkg->bill,
1247           'details' => \@details,
1248         });
1249         push @cust_bill_pkg, $cust_bill_pkg;
1250         $total_setup += $setup;
1251         $total_recur += $recur;
1252
1253         unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1254
1255           my @taxes = qsearch( 'cust_main_county', {
1256                                  'state'    => $self->state,
1257                                  'county'   => $self->county,
1258                                  'country'  => $self->country,
1259                                  'taxclass' => $part_pkg->taxclass,
1260                                                                       } );
1261           unless ( @taxes ) {
1262             @taxes =  qsearch( 'cust_main_county', {
1263                                   'state'    => $self->state,
1264                                   'county'   => $self->county,
1265                                   'country'  => $self->country,
1266                                   'taxclass' => '',
1267                                                                       } );
1268           }
1269
1270           #one more try at a whole-country tax rate
1271           unless ( @taxes ) {
1272             @taxes =  qsearch( 'cust_main_county', {
1273                                   'state'    => '',
1274                                   'county'   => '',
1275                                   'country'  => $self->country,
1276                                   'taxclass' => '',
1277                                                                       } );
1278           }
1279
1280           # maybe eliminate this entirely, along with all the 0% records
1281           unless ( @taxes ) {
1282             $dbh->rollback if $oldAutoCommit;
1283             return
1284               "fatal: can't find tax rate for state/county/country/taxclass ".
1285               join('/', ( map $self->$_(), qw(state county country) ),
1286                         $part_pkg->taxclass ).  "\n";
1287           }
1288
1289           foreach my $tax ( @taxes ) {
1290
1291             my $taxable_charged = 0;
1292             $taxable_charged += $setup
1293               unless $part_pkg->setuptax =~ /^Y$/i
1294                   || $tax->setuptax =~ /^Y$/i;
1295             $taxable_charged += $recur
1296               unless $part_pkg->recurtax =~ /^Y$/i
1297                   || $tax->recurtax =~ /^Y$/i;
1298             next unless $taxable_charged;
1299
1300             if ( $tax->exempt_amount > 0 ) {
1301               my ($mon,$year) = (localtime($sdate) )[4,5];
1302               $mon++;
1303               my $freq = $part_pkg->freq || 1;
1304               if ( $freq !~ /(\d+)$/ ) {
1305                 $dbh->rollback if $oldAutoCommit;
1306                 return "daily/weekly package definitions not (yet?)".
1307                        " compatible with monthly tax exemptions";
1308               }
1309               my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1310               foreach my $which_month ( 1 .. $freq ) {
1311                 my %hash = (
1312                   'custnum' => $self->custnum,
1313                   'taxnum'  => $tax->taxnum,
1314                   'year'    => 1900+$year,
1315                   'month'   => $mon++,
1316                 );
1317                 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1318                 until ( $mon < 13 ) { $mon -= 12; $year++; }
1319                 my $cust_tax_exempt =
1320                   qsearchs('cust_tax_exempt', \%hash)
1321                   || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1322                 my $remaining_exemption = sprintf("%.2f",
1323                   $tax->exempt_amount - $cust_tax_exempt->amount );
1324                 if ( $remaining_exemption > 0 ) {
1325                   my $addl = $remaining_exemption > $taxable_per_month
1326                     ? $taxable_per_month
1327                     : $remaining_exemption;
1328                   $taxable_charged -= $addl;
1329                   my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1330                     $cust_tax_exempt->hash,
1331                     'amount' =>
1332                       sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1333                   } );
1334                   $error = $new_cust_tax_exempt->exemptnum
1335                     ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1336                     : $new_cust_tax_exempt->insert;
1337                   if ( $error ) {
1338                     $dbh->rollback if $oldAutoCommit;
1339                     return "fatal: can't update cust_tax_exempt: $error";
1340                   }
1341
1342                 } # if $remaining_exemption > 0
1343
1344               } #foreach $which_month
1345
1346             } #if $tax->exempt_amount
1347
1348             $taxable_charged = sprintf( "%.2f", $taxable_charged);
1349
1350             #$tax += $taxable_charged * $cust_main_county->tax / 100
1351             $tax{ $tax->taxname || 'Tax' } +=
1352               $taxable_charged * $tax->tax / 100
1353
1354           } #foreach my $tax ( @taxes )
1355
1356         } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1357
1358       } #if $setup != 0 || $recur != 0
1359
1360     } #if $cust_pkg_mod_flag
1361
1362   } #foreach my $cust_pkg
1363
1364   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1365 #  my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1366
1367   unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1368     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1369     return '';
1370   }
1371
1372 #  unless ( $self->tax =~ /Y/i
1373 #           || $self->payby eq 'COMP'
1374 #           || $taxable_charged == 0 ) {
1375 #    my $cust_main_county = qsearchs('cust_main_county',{
1376 #        'state'   => $self->state,
1377 #        'county'  => $self->county,
1378 #        'country' => $self->country,
1379 #    } ) or die "fatal: can't find tax rate for state/county/country ".
1380 #               $self->state. "/". $self->county. "/". $self->country. "\n";
1381 #    my $tax = sprintf( "%.2f",
1382 #      $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1383 #    );
1384
1385   if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1386
1387     foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1388       my $tax = sprintf("%.2f", $tax{$taxname} );
1389       $charged = sprintf( "%.2f", $charged+$tax );
1390
1391       my $cust_bill_pkg = new FS::cust_bill_pkg ({
1392         'pkgnum'   => 0,
1393         'setup'    => $tax,
1394         'recur'    => 0,
1395         'sdate'    => '',
1396         'edate'    => '',
1397         'itemdesc' => $taxname,
1398       });
1399       push @cust_bill_pkg, $cust_bill_pkg;
1400     }
1401
1402   } else { #1.4 schema
1403
1404     my $tax = 0;
1405     foreach ( values %tax ) { $tax += $_ };
1406     $tax = sprintf("%.2f", $tax);
1407     if ( $tax > 0 ) {
1408       $charged = sprintf( "%.2f", $charged+$tax );
1409
1410       my $cust_bill_pkg = new FS::cust_bill_pkg ({
1411         'pkgnum' => 0,
1412         'setup'  => $tax,
1413         'recur'  => 0,
1414         'sdate'  => '',
1415         'edate'  => '',
1416       });
1417       push @cust_bill_pkg, $cust_bill_pkg;
1418     }
1419
1420   }
1421
1422   my $cust_bill = new FS::cust_bill ( {
1423     'custnum' => $self->custnum,
1424     '_date'   => $time,
1425     'charged' => $charged,
1426   } );
1427   $error = $cust_bill->insert;
1428   if ( $error ) {
1429     $dbh->rollback if $oldAutoCommit;
1430     return "can't create invoice for customer #". $self->custnum. ": $error";
1431   }
1432
1433   my $invnum = $cust_bill->invnum;
1434   my $cust_bill_pkg;
1435   foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1436     #warn $invnum;
1437     $cust_bill_pkg->invnum($invnum);
1438     $error = $cust_bill_pkg->insert;
1439     if ( $error ) {
1440       $dbh->rollback if $oldAutoCommit;
1441       return "can't create invoice line item for customer #". $self->custnum.
1442              ": $error";
1443     }
1444   }
1445
1446   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1447   ''; #no error
1448 }
1449
1450 =item collect OPTIONS
1451
1452 (Attempt to) collect money for this customer's outstanding invoices (see
1453 L<FS::cust_bill>).  Usually used after the bill method.
1454
1455 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1456 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1457 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1458
1459 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1460 and the invoice events web interface.
1461
1462 If there is an error, returns the error, otherwise returns false.
1463
1464 Options are passed as name-value pairs.
1465
1466 Currently available options are:
1467
1468 invoice_time - Use this time when deciding when to print invoices and
1469 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>
1470 for conversion functions.
1471
1472 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1473 events.
1474
1475 retry_card - Deprecated alias for 'retry'
1476
1477 batch_card - This option is deprecated.  See the invoice events web interface
1478 to control whether cards are batched or run against a realtime gateway.
1479
1480 report_badcard - This option is deprecated.
1481
1482 force_print - This option is deprecated; see the invoice events web interface.
1483
1484 quiet - set true to surpress email card/ACH decline notices.
1485
1486 =cut
1487
1488 sub collect {
1489   my( $self, %options ) = @_;
1490   my $invoice_time = $options{'invoice_time'} || time;
1491
1492   #put below somehow?
1493   local $SIG{HUP} = 'IGNORE';
1494   local $SIG{INT} = 'IGNORE';
1495   local $SIG{QUIT} = 'IGNORE';
1496   local $SIG{TERM} = 'IGNORE';
1497   local $SIG{TSTP} = 'IGNORE';
1498   local $SIG{PIPE} = 'IGNORE';
1499
1500   my $oldAutoCommit = $FS::UID::AutoCommit;
1501   local $FS::UID::AutoCommit = 0;
1502   my $dbh = dbh;
1503
1504   $self->select_for_update; #mutex
1505
1506   my $balance = $self->balance;
1507   warn "collect customer". $self->custnum. ": balance $balance" if $DEBUG;
1508   unless ( $balance > 0 ) { #redundant?????
1509     $dbh->rollback if $oldAutoCommit; #hmm
1510     return '';
1511   }
1512
1513   if ( exists($options{'retry_card'}) ) {
1514     carp 'retry_card option passed to collect is deprecated; use retry';
1515     $options{'retry'} ||= $options{'retry_card'};
1516   }
1517   if ( exists($options{'retry'}) && $options{'retry'} ) {
1518     my $error = $self->retry_realtime;
1519     if ( $error ) {
1520       $dbh->rollback if $oldAutoCommit;
1521       return $error;
1522     }
1523   }
1524
1525   foreach my $cust_bill ( $self->open_cust_bill ) {
1526
1527     # don't try to charge for the same invoice if it's already in a batch
1528     #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1529
1530     last if $self->balance <= 0;
1531
1532     warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")"
1533       if $DEBUG;
1534
1535     foreach my $part_bill_event (
1536       sort {    $a->seconds   <=> $b->seconds
1537              || $a->weight    <=> $b->weight
1538              || $a->eventpart <=> $b->eventpart }
1539         grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1540                && ! qsearchs( 'cust_bill_event', {
1541                                 'invnum'    => $cust_bill->invnum,
1542                                 'eventpart' => $_->eventpart,
1543                                 'status'    => 'done',
1544                                                                    } )
1545              }
1546           qsearch('part_bill_event', { 'payby'    => $self->payby,
1547                                        'disabled' => '',           } )
1548     ) {
1549
1550       last if $cust_bill->owed <= 0  # don't run subsequent events if owed<=0
1551            || $self->balance   <= 0; # or if balance<=0
1552
1553       warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1554         if $DEBUG;
1555       my $cust_main = $self; #for callback
1556
1557       my $error;
1558       {
1559         local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
1560         $error = eval $part_bill_event->eventcode;
1561       }
1562
1563       my $status = '';
1564       my $statustext = '';
1565       if ( $@ ) {
1566         $status = 'failed';
1567         $statustext = $@;
1568       } elsif ( $error ) {
1569         $status = 'done';
1570         $statustext = $error;
1571       } else {
1572         $status = 'done'
1573       }
1574
1575       #add cust_bill_event
1576       my $cust_bill_event = new FS::cust_bill_event {
1577         'invnum'     => $cust_bill->invnum,
1578         'eventpart'  => $part_bill_event->eventpart,
1579         #'_date'      => $invoice_time,
1580         '_date'      => time,
1581         'status'     => $status,
1582         'statustext' => $statustext,
1583       };
1584       $error = $cust_bill_event->insert;
1585       if ( $error ) {
1586         #$dbh->rollback if $oldAutoCommit;
1587         #return "error: $error";
1588
1589         # gah, even with transactions.
1590         $dbh->commit if $oldAutoCommit; #well.
1591         my $e = 'WARNING: Event run but database not updated - '.
1592                 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1593                 ', eventpart '. $part_bill_event->eventpart.
1594                 ": $error";
1595         warn $e;
1596         return $e;
1597       }
1598
1599
1600     }
1601
1602   }
1603
1604   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1605   '';
1606
1607 }
1608
1609 =item retry_realtime
1610
1611 Schedules realtime credit card / electronic check / LEC billing events for
1612 for retry.  Useful if card information has changed or manual retry is desired.
1613 The 'collect' method must be called to actually retry the transaction.
1614
1615 Implementation details: For each of this customer's open invoices, changes
1616 the status of the first "done" (with statustext error) realtime processing
1617 event to "failed".
1618
1619 =cut
1620
1621 sub retry_realtime {
1622   my $self = shift;
1623
1624   local $SIG{HUP} = 'IGNORE';
1625   local $SIG{INT} = 'IGNORE';
1626   local $SIG{QUIT} = 'IGNORE';
1627   local $SIG{TERM} = 'IGNORE';
1628   local $SIG{TSTP} = 'IGNORE';
1629   local $SIG{PIPE} = 'IGNORE';
1630
1631   my $oldAutoCommit = $FS::UID::AutoCommit;
1632   local $FS::UID::AutoCommit = 0;
1633   my $dbh = dbh;
1634
1635   foreach my $cust_bill (
1636     grep { $_->cust_bill_event }
1637       $self->open_cust_bill
1638   ) {
1639     my @cust_bill_event =
1640       sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1641         grep {
1642                #$_->part_bill_event->plan eq 'realtime-card'
1643                $_->part_bill_event->eventcode =~
1644                    /\$cust_bill\->realtime_(card|ach|lec)/
1645                  && $_->status eq 'done'
1646                  && $_->statustext
1647              }
1648           $cust_bill->cust_bill_event;
1649     next unless @cust_bill_event;
1650     my $error = $cust_bill_event[0]->retry;
1651     if ( $error ) {
1652       $dbh->rollback if $oldAutoCommit;
1653       return "error scheduling invoice event for retry: $error";
1654     }
1655
1656   }
1657
1658   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1659   '';
1660
1661 }
1662
1663 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1664
1665 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1666 via a Business::OnlinePayment realtime gateway.  See
1667 L<http://420.am/business-onlinepayment> for supported gateways.
1668
1669 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1670
1671 Available options are: I<description>, I<invnum>, I<quiet>
1672
1673 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1674 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
1675 if set, will override the value from the customer record.
1676
1677 I<description> is a free-text field passed to the gateway.  It defaults to
1678 "Internet services".
1679
1680 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1681 specified invoice.  If you don't specify an I<invnum> you might want to
1682 call the B<apply_payments> method.
1683
1684 I<quiet> can be set true to surpress email decline notices.
1685
1686 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1687
1688 =cut
1689
1690 sub realtime_bop {
1691   my( $self, $method, $amount, %options ) = @_;
1692   if ( $DEBUG ) {
1693     warn "$self $method $amount\n";
1694     warn "  $_ => $options{$_}\n" foreach keys %options;
1695   }
1696
1697   $options{'description'} ||= 'Internet services';
1698
1699   #pre-requisites
1700   die "Real-time processing not enabled\n"
1701     unless $conf->exists('business-onlinepayment');
1702   eval "use Business::OnlinePayment";
1703   die $@ if $@;
1704
1705   #overrides
1706   $self->set( $_ => $options{$_} )
1707     foreach grep { exists($options{$_}) }
1708             qw( payname address1 address2 city state zip payinfo paydate paycvv);
1709
1710   #load up config
1711   my $bop_config = 'business-onlinepayment';
1712   $bop_config .= '-ach'
1713     if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1714   my ( $processor, $login, $password, $action, @bop_options ) =
1715     $conf->config($bop_config);
1716   $action ||= 'normal authorization';
1717   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1718   die "No real-time processor is enabled - ".
1719       "did you set the business-onlinepayment configuration value?\n"
1720     unless $processor;
1721
1722   #massage data
1723
1724   my $address = $self->address1;
1725   $address .= ", ". $self->address2 if $self->address2;
1726
1727   my($payname, $payfirst, $paylast);
1728   if ( $self->payname && $method ne 'ECHECK' ) {
1729     $payname = $self->payname;
1730     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1731       or return "Illegal payname $payname";
1732     ($payfirst, $paylast) = ($1, $2);
1733   } else {
1734     $payfirst = $self->getfield('first');
1735     $paylast = $self->getfield('last');
1736     $payname =  "$payfirst $paylast";
1737   }
1738
1739   my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1740   if ( $conf->exists('emailinvoiceauto')
1741        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1742     push @invoicing_list, $self->all_emails;
1743   }
1744   my $email = $invoicing_list[0];
1745
1746   my %content;
1747   if ( $method eq 'CC' ) {
1748
1749     $content{card_number} = $self->payinfo;
1750     $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1751     $content{expiration} = "$2/$1";
1752
1753     $content{cvv2} = $self->paycvv
1754       if defined $self->dbdef_table->column('paycvv')
1755          && length($self->paycvv);
1756
1757     $content{recurring_billing} = 'YES'
1758       if qsearch('cust_pay', { 'custnum' => $self->custnum,
1759                                'payby'   => 'CARD',
1760                                'payinfo' => $self->payinfo, } );
1761
1762   } elsif ( $method eq 'ECHECK' ) {
1763     my($account_number,$routing_code) = $self->payinfo;
1764     ( $content{account_number}, $content{routing_code} ) =
1765       split('@', $self->payinfo);
1766     $content{bank_name} = $self->payname;
1767     $content{account_type} = 'CHECKING';
1768     $content{account_name} = $payname;
1769     $content{customer_org} = $self->company ? 'B' : 'I';
1770     $content{customer_ssn} = $self->ss;
1771   } elsif ( $method eq 'LEC' ) {
1772     $content{phone} = $self->payinfo;
1773   }
1774
1775   #transaction(s)
1776
1777   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1778
1779   my $transaction =
1780     new Business::OnlinePayment( $processor, @bop_options );
1781   $transaction->content(
1782     'type'           => $method,
1783     'login'          => $login,
1784     'password'       => $password,
1785     'action'         => $action1,
1786     'description'    => $options{'description'},
1787     'amount'         => $amount,
1788     'invoice_number' => $options{'invnum'},
1789     'customer_id'    => $self->custnum,
1790     'last_name'      => $paylast,
1791     'first_name'     => $payfirst,
1792     'name'           => $payname,
1793     'address'        => $address,
1794     'city'           => $self->city,
1795     'state'          => $self->state,
1796     'zip'            => $self->zip,
1797     'country'        => $self->country,
1798     'referer'        => 'http://cleanwhisker.420.am/',
1799     'email'          => $email,
1800     'phone'          => $self->daytime || $self->night,
1801     %content, #after
1802   );
1803   $transaction->submit();
1804
1805   if ( $transaction->is_success() && $action2 ) {
1806     my $auth = $transaction->authorization;
1807     my $ordernum = $transaction->can('order_number')
1808                    ? $transaction->order_number
1809                    : '';
1810
1811     my $capture =
1812       new Business::OnlinePayment( $processor, @bop_options );
1813
1814     my %capture = (
1815       %content,
1816       type           => $method,
1817       action         => $action2,
1818       login          => $login,
1819       password       => $password,
1820       order_number   => $ordernum,
1821       amount         => $amount,
1822       authorization  => $auth,
1823       description    => $options{'description'},
1824     );
1825
1826     foreach my $field (qw( authorization_source_code returned_ACI                                          transaction_identifier validation_code
1827                            transaction_sequence_num local_transaction_date
1828                            local_transaction_time AVS_result_code          )) {
1829       $capture{$field} = $transaction->$field() if $transaction->can($field);
1830     }
1831
1832     $capture->content( %capture );
1833
1834     $capture->submit();
1835
1836     unless ( $capture->is_success ) {
1837       my $e = "Authorization sucessful but capture failed, custnum #".
1838               $self->custnum. ': '.  $capture->result_code.
1839               ": ". $capture->error_message;
1840       warn $e;
1841       return $e;
1842     }
1843
1844   }
1845
1846   #remove paycvv after initial transaction
1847   #false laziness w/misc/process/payment.cgi - check both to make sure working
1848   # correctly
1849   if ( defined $self->dbdef_table->column('paycvv')
1850        && length($self->paycvv)
1851        && ! grep { $_ eq cardtype($self->payinfo) } $conf->config('cvv-save')
1852        && ! length($options{'paycvv'})
1853   ) {
1854     my $new = new FS::cust_main { $self->hash };
1855     $new->paycvv('');
1856     my $error = $new->replace($self);
1857     if ( $error ) {
1858       warn "error removing cvv: $error\n";
1859     }
1860   }
1861
1862   #result handling
1863   if ( $transaction->is_success() ) {
1864
1865     my %method2payby = (
1866       'CC'     => 'CARD',
1867       'ECHECK' => 'CHEK',
1868       'LEC'    => 'LECB',
1869     );
1870
1871     my $cust_pay = new FS::cust_pay ( {
1872        'custnum'  => $self->custnum,
1873        'invnum'   => $options{'invnum'},
1874        'paid'     => $amount,
1875        '_date'     => '',
1876        'payby'    => $method2payby{$method},
1877        'payinfo'  => $self->payinfo,
1878        'paybatch' => "$processor:". $transaction->authorization,
1879     } );
1880     my $error = $cust_pay->insert;
1881     if ( $error ) {
1882       $cust_pay->invnum(''); #try again with no specific invnum
1883       my $error2 = $cust_pay->insert;
1884       if ( $error2 ) {
1885         # gah, even with transactions.
1886         my $e = 'WARNING: Card/ACH debited but database not updated - '.
1887                 "error inserting payment ($processor): $error2".
1888                 " (previously tried insert with invnum #$options{'invnum'}" .
1889                 ": $error )";
1890         warn $e;
1891         return $e;
1892       }
1893     }
1894     return ''; #no error
1895
1896   } else {
1897
1898     my $perror = "$processor error: ". $transaction->error_message;
1899
1900     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
1901          && $conf->exists('emaildecline')
1902          && grep { $_ ne 'POST' } $self->invoicing_list
1903          && ! grep { $transaction->error_message =~ /$_/ }
1904                    $conf->config('emaildecline-exclude')
1905     ) {
1906       my @templ = $conf->config('declinetemplate');
1907       my $template = new Text::Template (
1908         TYPE   => 'ARRAY',
1909         SOURCE => [ map "$_\n", @templ ],
1910       ) or return "($perror) can't create template: $Text::Template::ERROR";
1911       $template->compile()
1912         or return "($perror) can't compile template: $Text::Template::ERROR";
1913
1914       my $templ_hash = { error => $transaction->error_message };
1915
1916       my $error = send_email(
1917         'from'    => $conf->config('invoice_from'),
1918         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1919         'subject' => 'Your payment could not be processed',
1920         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
1921       );
1922
1923       $perror .= " (also received error sending decline notification: $error)"
1924         if $error;
1925
1926     }
1927
1928     return $perror;
1929   }
1930
1931 }
1932
1933 =item total_owed
1934
1935 Returns the total owed for this customer on all invoices
1936 (see L<FS::cust_bill/owed>).
1937
1938 =cut
1939
1940 sub total_owed {
1941   my $self = shift;
1942   $self->total_owed_date(2145859200); #12/31/2037
1943 }
1944
1945 =item total_owed_date TIME
1946
1947 Returns the total owed for this customer on all invoices with date earlier than
1948 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
1949 see L<Time::Local> and L<Date::Parse> for conversion functions.
1950
1951 =cut
1952
1953 sub total_owed_date {
1954   my $self = shift;
1955   my $time = shift;
1956   my $total_bill = 0;
1957   foreach my $cust_bill (
1958     grep { $_->_date <= $time }
1959       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1960   ) {
1961     $total_bill += $cust_bill->owed;
1962   }
1963   sprintf( "%.2f", $total_bill );
1964 }
1965
1966 =item apply_credits
1967
1968 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1969 to outstanding invoice balances in chronological order and returns the value
1970 of any remaining unapplied credits available for refund
1971 (see L<FS::cust_refund>).
1972
1973 =cut
1974
1975 sub apply_credits {
1976   my $self = shift;
1977
1978   return 0 unless $self->total_credited;
1979
1980   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1981       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1982
1983   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1984       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1985
1986   my $credit;
1987
1988   foreach my $cust_bill ( @invoices ) {
1989     my $amount;
1990
1991     if ( !defined($credit) || $credit->credited == 0) {
1992       $credit = pop @credits or last;
1993     }
1994
1995     if ($cust_bill->owed >= $credit->credited) {
1996       $amount=$credit->credited;
1997     }else{
1998       $amount=$cust_bill->owed;
1999     }
2000
2001     my $cust_credit_bill = new FS::cust_credit_bill ( {
2002       'crednum' => $credit->crednum,
2003       'invnum'  => $cust_bill->invnum,
2004       'amount'  => $amount,
2005     } );
2006     my $error = $cust_credit_bill->insert;
2007     die $error if $error;
2008
2009     redo if ($cust_bill->owed > 0);
2010
2011   }
2012
2013   return $self->total_credited;
2014 }
2015
2016 =item apply_payments
2017
2018 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2019 to outstanding invoice balances in chronological order.
2020
2021  #and returns the value of any remaining unapplied payments.
2022
2023 =cut
2024
2025 sub apply_payments {
2026   my $self = shift;
2027
2028   #return 0 unless
2029
2030   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
2031       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
2032
2033   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
2034       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
2035
2036   my $payment;
2037
2038   foreach my $cust_bill ( @invoices ) {
2039     my $amount;
2040
2041     if ( !defined($payment) || $payment->unapplied == 0 ) {
2042       $payment = pop @payments or last;
2043     }
2044
2045     if ( $cust_bill->owed >= $payment->unapplied ) {
2046       $amount = $payment->unapplied;
2047     } else {
2048       $amount = $cust_bill->owed;
2049     }
2050
2051     my $cust_bill_pay = new FS::cust_bill_pay ( {
2052       'paynum' => $payment->paynum,
2053       'invnum' => $cust_bill->invnum,
2054       'amount' => $amount,
2055     } );
2056     my $error = $cust_bill_pay->insert;
2057     die $error if $error;
2058
2059     redo if ( $cust_bill->owed > 0);
2060
2061   }
2062
2063   return $self->total_unapplied_payments;
2064 }
2065
2066 =item total_credited
2067
2068 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2069 customer.  See L<FS::cust_credit/credited>.
2070
2071 =cut
2072
2073 sub total_credited {
2074   my $self = shift;
2075   my $total_credit = 0;
2076   foreach my $cust_credit ( qsearch('cust_credit', {
2077     'custnum' => $self->custnum,
2078   } ) ) {
2079     $total_credit += $cust_credit->credited;
2080   }
2081   sprintf( "%.2f", $total_credit );
2082 }
2083
2084 =item total_unapplied_payments
2085
2086 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2087 See L<FS::cust_pay/unapplied>.
2088
2089 =cut
2090
2091 sub total_unapplied_payments {
2092   my $self = shift;
2093   my $total_unapplied = 0;
2094   foreach my $cust_pay ( qsearch('cust_pay', {
2095     'custnum' => $self->custnum,
2096   } ) ) {
2097     $total_unapplied += $cust_pay->unapplied;
2098   }
2099   sprintf( "%.2f", $total_unapplied );
2100 }
2101
2102 =item balance
2103
2104 Returns the balance for this customer (total_owed minus total_credited
2105 minus total_unapplied_payments).
2106
2107 =cut
2108
2109 sub balance {
2110   my $self = shift;
2111   sprintf( "%.2f",
2112     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2113   );
2114 }
2115
2116 =item balance_date TIME
2117
2118 Returns the balance for this customer, only considering invoices with date
2119 earlier than TIME (total_owed_date minus total_credited minus
2120 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
2121 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
2122 functions.
2123
2124 =cut
2125
2126 sub balance_date {
2127   my $self = shift;
2128   my $time = shift;
2129   sprintf( "%.2f",
2130     $self->total_owed_date($time)
2131       - $self->total_credited
2132       - $self->total_unapplied_payments
2133   );
2134 }
2135
2136 =item paydate_monthyear
2137
2138 Returns a two-element list consisting of the month and year of this customer's
2139 paydate (credit card expiration date for CARD customers)
2140
2141 =cut
2142
2143 sub paydate_monthyear {
2144   my $self = shift;
2145   if ( $self->paydate  =~ /^(\d{4})-(\d{2})-\d{2}$/ ) { #Pg date format
2146     ( $2, $1 );
2147   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2148     ( $1, $3 );
2149   } else {
2150     ('', '');
2151   }
2152 }
2153
2154 =item payinfo_masked
2155
2156 Returns a "masked" payinfo field with all but the last four characters replaced
2157 by 'x'es.  Useful for displaying credit cards.
2158
2159 =cut
2160
2161 sub payinfo_masked {
2162   my $self = shift;
2163   my $payinfo = $self->payinfo;
2164   'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4));
2165 }
2166
2167 =item invoicing_list [ ARRAYREF ]
2168
2169 If an arguement is given, sets these email addresses as invoice recipients
2170 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
2171 (except as warnings), so use check_invoicing_list first.
2172
2173 Returns a list of email addresses (with svcnum entries expanded).
2174
2175 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
2176 check it without disturbing anything by passing nothing.
2177
2178 This interface may change in the future.
2179
2180 =cut
2181
2182 sub invoicing_list {
2183   my( $self, $arrayref ) = @_;
2184   if ( $arrayref ) {
2185     my @cust_main_invoice;
2186     if ( $self->custnum ) {
2187       @cust_main_invoice =
2188         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2189     } else {
2190       @cust_main_invoice = ();
2191     }
2192     foreach my $cust_main_invoice ( @cust_main_invoice ) {
2193       #warn $cust_main_invoice->destnum;
2194       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2195         #warn $cust_main_invoice->destnum;
2196         my $error = $cust_main_invoice->delete;
2197         warn $error if $error;
2198       }
2199     }
2200     if ( $self->custnum ) {
2201       @cust_main_invoice =
2202         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2203     } else {
2204       @cust_main_invoice = ();
2205     }
2206     my %seen = map { $_->address => 1 } @cust_main_invoice;
2207     foreach my $address ( @{$arrayref} ) {
2208       next if exists $seen{$address} && $seen{$address};
2209       $seen{$address} = 1;
2210       my $cust_main_invoice = new FS::cust_main_invoice ( {
2211         'custnum' => $self->custnum,
2212         'dest'    => $address,
2213       } );
2214       my $error = $cust_main_invoice->insert;
2215       warn $error if $error;
2216     }
2217   }
2218   if ( $self->custnum ) {
2219     map { $_->address }
2220       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2221   } else {
2222     ();
2223   }
2224 }
2225
2226 =item check_invoicing_list ARRAYREF
2227
2228 Checks these arguements as valid input for the invoicing_list method.  If there
2229 is an error, returns the error, otherwise returns false.
2230
2231 =cut
2232
2233 sub check_invoicing_list {
2234   my( $self, $arrayref ) = @_;
2235   foreach my $address ( @{$arrayref} ) {
2236     my $cust_main_invoice = new FS::cust_main_invoice ( {
2237       'custnum' => $self->custnum,
2238       'dest'    => $address,
2239     } );
2240     my $error = $self->custnum
2241                 ? $cust_main_invoice->check
2242                 : $cust_main_invoice->checkdest
2243     ;
2244     return $error if $error;
2245   }
2246   '';
2247 }
2248
2249 =item set_default_invoicing_list
2250
2251 Sets the invoicing list to all accounts associated with this customer,
2252 overwriting any previous invoicing list.
2253
2254 =cut
2255
2256 sub set_default_invoicing_list {
2257   my $self = shift;
2258   $self->invoicing_list($self->all_emails);
2259 }
2260
2261 =item all_emails
2262
2263 Returns the email addresses of all accounts provisioned for this customer.
2264
2265 =cut
2266
2267 sub all_emails {
2268   my $self = shift;
2269   my %list;
2270   foreach my $cust_pkg ( $self->all_pkgs ) {
2271     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2272     my @svc_acct =
2273       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2274         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2275           @cust_svc;
2276     $list{$_}=1 foreach map { $_->email } @svc_acct;
2277   }
2278   keys %list;
2279 }
2280
2281 =item invoicing_list_addpost
2282
2283 Adds postal invoicing to this customer.  If this customer is already configured
2284 to receive postal invoices, does nothing.
2285
2286 =cut
2287
2288 sub invoicing_list_addpost {
2289   my $self = shift;
2290   return if grep { $_ eq 'POST' } $self->invoicing_list;
2291   my @invoicing_list = $self->invoicing_list;
2292   push @invoicing_list, 'POST';
2293   $self->invoicing_list(\@invoicing_list);
2294 }
2295
2296 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2297
2298 Returns an array of customers referred by this customer (referral_custnum set
2299 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
2300 customers referred by customers referred by this customer and so on, inclusive.
2301 The default behavior is DEPTH 1 (no recursion).
2302
2303 =cut
2304
2305 sub referral_cust_main {
2306   my $self = shift;
2307   my $depth = @_ ? shift : 1;
2308   my $exclude = @_ ? shift : {};
2309
2310   my @cust_main =
2311     map { $exclude->{$_->custnum}++; $_; }
2312       grep { ! $exclude->{ $_->custnum } }
2313         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2314
2315   if ( $depth > 1 ) {
2316     push @cust_main,
2317       map { $_->referral_cust_main($depth-1, $exclude) }
2318         @cust_main;
2319   }
2320
2321   @cust_main;
2322 }
2323
2324 =item referral_cust_main_ncancelled
2325
2326 Same as referral_cust_main, except only returns customers with uncancelled
2327 packages.
2328
2329 =cut
2330
2331 sub referral_cust_main_ncancelled {
2332   my $self = shift;
2333   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2334 }
2335
2336 =item referral_cust_pkg [ DEPTH ]
2337
2338 Like referral_cust_main, except returns a flat list of all unsuspended (and
2339 uncancelled) packages for each customer.  The number of items in this list may
2340 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2341
2342 =cut
2343
2344 sub referral_cust_pkg {
2345   my $self = shift;
2346   my $depth = @_ ? shift : 1;
2347
2348   map { $_->unsuspended_pkgs }
2349     grep { $_->unsuspended_pkgs }
2350       $self->referral_cust_main($depth);
2351 }
2352
2353 =item credit AMOUNT, REASON
2354
2355 Applies a credit to this customer.  If there is an error, returns the error,
2356 otherwise returns false.
2357
2358 =cut
2359
2360 sub credit {
2361   my( $self, $amount, $reason ) = @_;
2362   my $cust_credit = new FS::cust_credit {
2363     'custnum' => $self->custnum,
2364     'amount'  => $amount,
2365     'reason'  => $reason,
2366   };
2367   $cust_credit->insert;
2368 }
2369
2370 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2371
2372 Creates a one-time charge for this customer.  If there is an error, returns
2373 the error, otherwise returns false.
2374
2375 =cut
2376
2377 sub charge {
2378   my ( $self, $amount ) = ( shift, shift );
2379   my $pkg      = @_ ? shift : 'One-time charge';
2380   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
2381   my $taxclass = @_ ? shift : '';
2382
2383   local $SIG{HUP} = 'IGNORE';
2384   local $SIG{INT} = 'IGNORE';
2385   local $SIG{QUIT} = 'IGNORE';
2386   local $SIG{TERM} = 'IGNORE';
2387   local $SIG{TSTP} = 'IGNORE';
2388   local $SIG{PIPE} = 'IGNORE';
2389
2390   my $oldAutoCommit = $FS::UID::AutoCommit;
2391   local $FS::UID::AutoCommit = 0;
2392   my $dbh = dbh;
2393
2394   my $part_pkg = new FS::part_pkg ( {
2395     'pkg'      => $pkg,
2396     'comment'  => $comment,
2397     'setup'    => $amount,
2398     'freq'     => 0,
2399     'recur'    => '0',
2400     'disabled' => 'Y',
2401     'taxclass' => $taxclass,
2402   } );
2403
2404   my $error = $part_pkg->insert;
2405   if ( $error ) {
2406     $dbh->rollback if $oldAutoCommit;
2407     return $error;
2408   }
2409
2410   my $pkgpart = $part_pkg->pkgpart;
2411   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2412   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2413     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2414     $error = $type_pkgs->insert;
2415     if ( $error ) {
2416       $dbh->rollback if $oldAutoCommit;
2417       return $error;
2418     }
2419   }
2420
2421   my $cust_pkg = new FS::cust_pkg ( {
2422     'custnum' => $self->custnum,
2423     'pkgpart' => $pkgpart,
2424   } );
2425
2426   $error = $cust_pkg->insert;
2427   if ( $error ) {
2428     $dbh->rollback if $oldAutoCommit;
2429     return $error;
2430   }
2431
2432   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2433   '';
2434
2435 }
2436
2437 =item cust_bill
2438
2439 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2440
2441 =cut
2442
2443 sub cust_bill {
2444   my $self = shift;
2445   sort { $a->_date <=> $b->_date }
2446     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2447 }
2448
2449 =item open_cust_bill
2450
2451 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2452 customer.
2453
2454 =cut
2455
2456 sub open_cust_bill {
2457   my $self = shift;
2458   grep { $_->owed > 0 } $self->cust_bill;
2459 }
2460
2461 =item cust_credit
2462
2463 Returns all the credits (see L<FS::cust_credit>) for this customer.
2464
2465 =cut
2466
2467 sub cust_credit {
2468   my $self = shift;
2469   sort { $a->_date <=> $b->_date }
2470     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
2471 }
2472
2473 =item cust_pay
2474
2475 Returns all the payments (see L<FS::cust_pay>) for this customer.
2476
2477 =cut
2478
2479 sub cust_pay {
2480   my $self = shift;
2481   sort { $a->_date <=> $b->_date }
2482     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
2483 }
2484
2485 =item cust_refund
2486
2487 Returns all the refunds (see L<FS::cust_refund>) for this customer.
2488
2489 =cut
2490
2491 sub cust_refund {
2492   my $self = shift;
2493   sort { $a->_date <=> $b->_date }
2494     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
2495 }
2496
2497 =item select_for_update
2498
2499 Selects this record with the SQL "FOR UPDATE" command.  This can be useful as
2500 a mutex.
2501
2502 =cut
2503
2504 sub select_for_update {
2505   my $self = shift;
2506   qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
2507 }
2508
2509 =back
2510
2511 =head1 SUBROUTINES
2512
2513 =over 4
2514
2515 =item check_and_rebuild_fuzzyfiles
2516
2517 =cut
2518
2519 sub check_and_rebuild_fuzzyfiles {
2520   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2521   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2522     or &rebuild_fuzzyfiles;
2523 }
2524
2525 =item rebuild_fuzzyfiles
2526
2527 =cut
2528
2529 sub rebuild_fuzzyfiles {
2530
2531   use Fcntl qw(:flock);
2532
2533   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2534
2535   #last
2536
2537   open(LASTLOCK,">>$dir/cust_main.last")
2538     or die "can't open $dir/cust_main.last: $!";
2539   flock(LASTLOCK,LOCK_EX)
2540     or die "can't lock $dir/cust_main.last: $!";
2541
2542   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2543   push @all_last,
2544                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2545     if defined dbdef->table('cust_main')->column('ship_last');
2546
2547   open (LASTCACHE,">$dir/cust_main.last.tmp")
2548     or die "can't open $dir/cust_main.last.tmp: $!";
2549   print LASTCACHE join("\n", @all_last), "\n";
2550   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2551
2552   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2553   close LASTLOCK;
2554
2555   #company
2556
2557   open(COMPANYLOCK,">>$dir/cust_main.company")
2558     or die "can't open $dir/cust_main.company: $!";
2559   flock(COMPANYLOCK,LOCK_EX)
2560     or die "can't lock $dir/cust_main.company: $!";
2561
2562   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2563   push @all_company,
2564        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2565     if defined dbdef->table('cust_main')->column('ship_last');
2566
2567   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2568     or die "can't open $dir/cust_main.company.tmp: $!";
2569   print COMPANYCACHE join("\n", @all_company), "\n";
2570   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2571
2572   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2573   close COMPANYLOCK;
2574
2575 }
2576
2577 =item all_last
2578
2579 =cut
2580
2581 sub all_last {
2582   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2583   open(LASTCACHE,"<$dir/cust_main.last")
2584     or die "can't open $dir/cust_main.last: $!";
2585   my @array = map { chomp; $_; } <LASTCACHE>;
2586   close LASTCACHE;
2587   \@array;
2588 }
2589
2590 =item all_company
2591
2592 =cut
2593
2594 sub all_company {
2595   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2596   open(COMPANYCACHE,"<$dir/cust_main.company")
2597     or die "can't open $dir/cust_main.last: $!";
2598   my @array = map { chomp; $_; } <COMPANYCACHE>;
2599   close COMPANYCACHE;
2600   \@array;
2601 }
2602
2603 =item append_fuzzyfiles LASTNAME COMPANY
2604
2605 =cut
2606
2607 sub append_fuzzyfiles {
2608   my( $last, $company ) = @_;
2609
2610   &check_and_rebuild_fuzzyfiles;
2611
2612   use Fcntl qw(:flock);
2613
2614   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2615
2616   if ( $last ) {
2617
2618     open(LAST,">>$dir/cust_main.last")
2619       or die "can't open $dir/cust_main.last: $!";
2620     flock(LAST,LOCK_EX)
2621       or die "can't lock $dir/cust_main.last: $!";
2622
2623     print LAST "$last\n";
2624
2625     flock(LAST,LOCK_UN)
2626       or die "can't unlock $dir/cust_main.last: $!";
2627     close LAST;
2628   }
2629
2630   if ( $company ) {
2631
2632     open(COMPANY,">>$dir/cust_main.company")
2633       or die "can't open $dir/cust_main.company: $!";
2634     flock(COMPANY,LOCK_EX)
2635       or die "can't lock $dir/cust_main.company: $!";
2636
2637     print COMPANY "$company\n";
2638
2639     flock(COMPANY,LOCK_UN)
2640       or die "can't unlock $dir/cust_main.company: $!";
2641
2642     close COMPANY;
2643   }
2644
2645   1;
2646 }
2647
2648 =item batch_import
2649
2650 =cut
2651
2652 sub batch_import {
2653   my $param = shift;
2654   #warn join('-',keys %$param);
2655   my $fh = $param->{filehandle};
2656   my $agentnum = $param->{agentnum};
2657   my $refnum = $param->{refnum};
2658   my $pkgpart = $param->{pkgpart};
2659   my @fields = @{$param->{fields}};
2660
2661   eval "use Date::Parse;";
2662   die $@ if $@;
2663   eval "use Text::CSV_XS;";
2664   die $@ if $@;
2665
2666   my $csv = new Text::CSV_XS;
2667   #warn $csv;
2668   #warn $fh;
2669
2670   my $imported = 0;
2671   #my $columns;
2672
2673   local $SIG{HUP} = 'IGNORE';
2674   local $SIG{INT} = 'IGNORE';
2675   local $SIG{QUIT} = 'IGNORE';
2676   local $SIG{TERM} = 'IGNORE';
2677   local $SIG{TSTP} = 'IGNORE';
2678   local $SIG{PIPE} = 'IGNORE';
2679
2680   my $oldAutoCommit = $FS::UID::AutoCommit;
2681   local $FS::UID::AutoCommit = 0;
2682   my $dbh = dbh;
2683
2684   #while ( $columns = $csv->getline($fh) ) {
2685   my $line;
2686   while ( defined($line=<$fh>) ) {
2687
2688     $csv->parse($line) or do {
2689       $dbh->rollback if $oldAutoCommit;
2690       return "can't parse: ". $csv->error_input();
2691     };
2692
2693     my @columns = $csv->fields();
2694     #warn join('-',@columns);
2695
2696     my %cust_main = (
2697       agentnum => $agentnum,
2698       refnum   => $refnum,
2699       country  => 'US', #default
2700       payby    => 'BILL', #default
2701       paydate  => '12/2037', #default
2702     );
2703     my $billtime = time;
2704     my %cust_pkg = ( pkgpart => $pkgpart );
2705     foreach my $field ( @fields ) {
2706       if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2707         #$cust_pkg{$1} = str2time( shift @$columns );
2708         if ( $1 eq 'setup' ) {
2709           $billtime = str2time(shift @columns);
2710         } else {
2711           $cust_pkg{$1} = str2time( shift @columns );
2712         }
2713       } else {
2714         #$cust_main{$field} = shift @$columns;
2715         $cust_main{$field} = shift @columns;
2716       }
2717     }
2718
2719     my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2720     my $cust_main = new FS::cust_main ( \%cust_main );
2721     use Tie::RefHash;
2722     tie my %hash, 'Tie::RefHash'; #this part is important
2723     $hash{$cust_pkg} = [] if $pkgpart;
2724     my $error = $cust_main->insert( \%hash );
2725
2726     if ( $error ) {
2727       $dbh->rollback if $oldAutoCommit;
2728       return "can't insert customer for $line: $error";
2729     }
2730
2731     #false laziness w/bill.cgi
2732     $error = $cust_main->bill( 'time' => $billtime );
2733     if ( $error ) {
2734       $dbh->rollback if $oldAutoCommit;
2735       return "can't bill customer for $line: $error";
2736     }
2737
2738     $cust_main->apply_payments;
2739     $cust_main->apply_credits;
2740
2741     $error = $cust_main->collect();
2742     if ( $error ) {
2743       $dbh->rollback if $oldAutoCommit;
2744       return "can't collect customer for $line: $error";
2745     }
2746
2747     $imported++;
2748   }
2749
2750   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2751
2752   return "Empty file!" unless $imported;
2753
2754   ''; #no error
2755
2756 }
2757
2758 =item batch_charge
2759
2760 =cut
2761
2762 sub batch_charge {
2763   my $param = shift;
2764   #warn join('-',keys %$param);
2765   my $fh = $param->{filehandle};
2766   my @fields = @{$param->{fields}};
2767
2768   eval "use Date::Parse;";
2769   die $@ if $@;
2770   eval "use Text::CSV_XS;";
2771   die $@ if $@;
2772
2773   my $csv = new Text::CSV_XS;
2774   #warn $csv;
2775   #warn $fh;
2776
2777   my $imported = 0;
2778   #my $columns;
2779
2780   local $SIG{HUP} = 'IGNORE';
2781   local $SIG{INT} = 'IGNORE';
2782   local $SIG{QUIT} = 'IGNORE';
2783   local $SIG{TERM} = 'IGNORE';
2784   local $SIG{TSTP} = 'IGNORE';
2785   local $SIG{PIPE} = 'IGNORE';
2786
2787   my $oldAutoCommit = $FS::UID::AutoCommit;
2788   local $FS::UID::AutoCommit = 0;
2789   my $dbh = dbh;
2790
2791   #while ( $columns = $csv->getline($fh) ) {
2792   my $line;
2793   while ( defined($line=<$fh>) ) {
2794
2795     $csv->parse($line) or do {
2796       $dbh->rollback if $oldAutoCommit;
2797       return "can't parse: ". $csv->error_input();
2798     };
2799
2800     my @columns = $csv->fields();
2801     #warn join('-',@columns);
2802
2803     my %row = ();
2804     foreach my $field ( @fields ) {
2805       $row{$field} = shift @columns;
2806     }
2807
2808     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2809     unless ( $cust_main ) {
2810       $dbh->rollback if $oldAutoCommit;
2811       return "unknown custnum $row{'custnum'}";
2812     }
2813
2814     if ( $row{'amount'} > 0 ) {
2815       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2816       if ( $error ) {
2817         $dbh->rollback if $oldAutoCommit;
2818         return $error;
2819       }
2820       $imported++;
2821     } elsif ( $row{'amount'} < 0 ) {
2822       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2823                                       $row{'pkg'}                         );
2824       if ( $error ) {
2825         $dbh->rollback if $oldAutoCommit;
2826         return $error;
2827       }
2828       $imported++;
2829     } else {
2830       #hmm?
2831     }
2832
2833   }
2834
2835   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2836
2837   return "Empty file!" unless $imported;
2838
2839   ''; #no error
2840
2841 }
2842
2843 =back
2844
2845 =head1 BUGS
2846
2847 The delete method.
2848
2849 The delete method should possibly take an FS::cust_main object reference
2850 instead of a scalar customer number.
2851
2852 Bill and collect options should probably be passed as references instead of a
2853 list.
2854
2855 There should probably be a configuration file with a list of allowed credit
2856 card types.
2857
2858 No multiple currency support (probably a larger project than just this module).
2859
2860 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
2861
2862 =head1 SEE ALSO
2863
2864 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2865 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2866 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
2867
2868 =cut
2869
2870 1;
2871