FS/FS/cust_main.pm

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