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   } else {
 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->paymask) && $self->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) ) {
 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     my $cust_main_invoice = new FS::cust_main_invoice ( {
2659       'custnum' => $self->custnum,
2660       'dest'    => $address,
2661     } );
2662     my $error = $self->custnum
2663                 ? $cust_main_invoice->check
2664                 : $cust_main_invoice->checkdest
2665     ;
2666     return $error if $error;
2667   }
2668   '';
2669 }
2670
2671 =item set_default_invoicing_list
2672
2673 Sets the invoicing list to all accounts associated with this customer,
2674 overwriting any previous invoicing list.
2675
2676 =cut
2677
2678 sub set_default_invoicing_list {
2679   my $self = shift;
2680   $self->invoicing_list($self->all_emails);
2681 }
2682
2683 =item all_emails
2684
2685 Returns the email addresses of all accounts provisioned for this customer.
2686
2687 =cut
2688
2689 sub all_emails {
2690   my $self = shift;
2691   my %list;
2692   foreach my $cust_pkg ( $self->all_pkgs ) {
2693     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2694     my @svc_acct =
2695       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2696         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2697           @cust_svc;
2698     $list{$_}=1 foreach map { $_->email } @svc_acct;
2699   }
2700   keys %list;
2701 }
2702
2703 =item invoicing_list_addpost
2704
2705 Adds postal invoicing to this customer.  If this customer is already configured
2706 to receive postal invoices, does nothing.
2707
2708 =cut
2709
2710 sub invoicing_list_addpost {
2711   my $self = shift;
2712   return if grep { $_ eq 'POST' } $self->invoicing_list;
2713   my @invoicing_list = $self->invoicing_list;
2714   push @invoicing_list, 'POST';
2715   $self->invoicing_list(\@invoicing_list);
2716 }
2717
2718 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2719
2720 Returns an array of customers referred by this customer (referral_custnum set
2721 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
2722 customers referred by customers referred by this customer and so on, inclusive.
2723 The default behavior is DEPTH 1 (no recursion).
2724
2725 =cut
2726
2727 sub referral_cust_main {
2728   my $self = shift;
2729   my $depth = @_ ? shift : 1;
2730   my $exclude = @_ ? shift : {};
2731
2732   my @cust_main =
2733     map { $exclude->{$_->custnum}++; $_; }
2734       grep { ! $exclude->{ $_->custnum } }
2735         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2736
2737   if ( $depth > 1 ) {
2738     push @cust_main,
2739       map { $_->referral_cust_main($depth-1, $exclude) }
2740         @cust_main;
2741   }
2742
2743   @cust_main;
2744 }
2745
2746 =item referral_cust_main_ncancelled
2747
2748 Same as referral_cust_main, except only returns customers with uncancelled
2749 packages.
2750
2751 =cut
2752
2753 sub referral_cust_main_ncancelled {
2754   my $self = shift;
2755   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2756 }
2757
2758 =item referral_cust_pkg [ DEPTH ]
2759
2760 Like referral_cust_main, except returns a flat list of all unsuspended (and
2761 uncancelled) packages for each customer.  The number of items in this list may
2762 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2763
2764 =cut
2765
2766 sub referral_cust_pkg {
2767   my $self = shift;
2768   my $depth = @_ ? shift : 1;
2769
2770   map { $_->unsuspended_pkgs }
2771     grep { $_->unsuspended_pkgs }
2772       $self->referral_cust_main($depth);
2773 }
2774
2775 =item referring_cust_main
2776
2777 Returns the single cust_main record for the customer who referred this customer
2778 (referral_custnum), or false.
2779
2780 =cut
2781
2782 sub referring_cust_main {
2783   my $self = shift;
2784   return '' unless $self->referral_custnum;
2785   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
2786 }
2787
2788 =item credit AMOUNT, REASON
2789
2790 Applies a credit to this customer.  If there is an error, returns the error,
2791 otherwise returns false.
2792
2793 =cut
2794
2795 sub credit {
2796   my( $self, $amount, $reason ) = @_;
2797   my $cust_credit = new FS::cust_credit {
2798     'custnum' => $self->custnum,
2799     'amount'  => $amount,
2800     'reason'  => $reason,
2801   };
2802   $cust_credit->insert;
2803 }
2804
2805 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2806
2807 Creates a one-time charge for this customer.  If there is an error, returns
2808 the error, otherwise returns false.
2809
2810 =cut
2811
2812 sub charge {
2813   my ( $self, $amount ) = ( shift, shift );
2814   my $pkg      = @_ ? shift : 'One-time charge';
2815   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
2816   my $taxclass = @_ ? shift : '';
2817
2818   local $SIG{HUP} = 'IGNORE';
2819   local $SIG{INT} = 'IGNORE';
2820   local $SIG{QUIT} = 'IGNORE';
2821   local $SIG{TERM} = 'IGNORE';
2822   local $SIG{TSTP} = 'IGNORE';
2823   local $SIG{PIPE} = 'IGNORE';
2824
2825   my $oldAutoCommit = $FS::UID::AutoCommit;
2826   local $FS::UID::AutoCommit = 0;
2827   my $dbh = dbh;
2828
2829   my $part_pkg = new FS::part_pkg ( {
2830     'pkg'      => $pkg,
2831     'comment'  => $comment,
2832     #'setup'    => $amount,
2833     #'recur'    => '0',
2834     'plan'     => 'flat',
2835     'plandata' => "setup_fee=$amount",
2836     'freq'     => 0,
2837     'disabled' => 'Y',
2838     'taxclass' => $taxclass,
2839   } );
2840
2841   my $error = $part_pkg->insert;
2842   if ( $error ) {
2843     $dbh->rollback if $oldAutoCommit;
2844     return $error;
2845   }
2846
2847   my $pkgpart = $part_pkg->pkgpart;
2848   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2849   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2850     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2851     $error = $type_pkgs->insert;
2852     if ( $error ) {
2853       $dbh->rollback if $oldAutoCommit;
2854       return $error;
2855     }
2856   }
2857
2858   my $cust_pkg = new FS::cust_pkg ( {
2859     'custnum' => $self->custnum,
2860     'pkgpart' => $pkgpart,
2861   } );
2862
2863   $error = $cust_pkg->insert;
2864   if ( $error ) {
2865     $dbh->rollback if $oldAutoCommit;
2866     return $error;
2867   }
2868
2869   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2870   '';
2871
2872 }
2873
2874 =item cust_bill
2875
2876 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2877
2878 =cut
2879
2880 sub cust_bill {
2881   my $self = shift;
2882   sort { $a->_date <=> $b->_date }
2883     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2884 }
2885
2886 =item open_cust_bill
2887
2888 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2889 customer.
2890
2891 =cut
2892
2893 sub open_cust_bill {
2894   my $self = shift;
2895   grep { $_->owed > 0 } $self->cust_bill;
2896 }
2897
2898 =item cust_credit
2899
2900 Returns all the credits (see L<FS::cust_credit>) for this customer.
2901
2902 =cut
2903
2904 sub cust_credit {
2905   my $self = shift;
2906   sort { $a->_date <=> $b->_date }
2907     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
2908 }
2909
2910 =item cust_pay
2911
2912 Returns all the payments (see L<FS::cust_pay>) for this customer.
2913
2914 =cut
2915
2916 sub cust_pay {
2917   my $self = shift;
2918   sort { $a->_date <=> $b->_date }
2919     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
2920 }
2921
2922 =item cust_pay_void
2923
2924 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
2925
2926 =cut
2927
2928 sub cust_pay_void {
2929   my $self = shift;
2930   sort { $a->_date <=> $b->_date }
2931     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
2932 }
2933
2934
2935 =item cust_refund
2936
2937 Returns all the refunds (see L<FS::cust_refund>) for this customer.
2938
2939 =cut
2940
2941 sub cust_refund {
2942   my $self = shift;
2943   sort { $a->_date <=> $b->_date }
2944     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
2945 }
2946
2947 =item select_for_update
2948
2949 Selects this record with the SQL "FOR UPDATE" command.  This can be useful as
2950 a mutex.
2951
2952 =cut
2953
2954 sub select_for_update {
2955   my $self = shift;
2956   qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
2957 }
2958
2959 =item name
2960
2961 Returns a name string for this customer, either "Company (Last, First)" or
2962 "Last, First".
2963
2964 =cut
2965
2966 sub name {
2967   my $self = shift;
2968   my $name = $self->get('last'). ', '. $self->first;
2969   $name = $self->company. " ($name)" if $self->company;
2970   $name;
2971 }
2972
2973 =item status
2974
2975 Returns a status string for this customer, currently:
2976
2977 =over 4
2978
2979 =item prospect - No packages have ever been ordered
2980
2981 =item active - One or more recurring packages is active
2982
2983 =item suspended - All non-cancelled recurring packages are suspended
2984
2985 =item cancelled - All recurring packages are cancelled
2986
2987 =back
2988
2989 =cut
2990
2991 sub status {
2992   my $self = shift;
2993   for my $status (qw( prospect active suspended cancelled )) {
2994     my $method = $status.'_sql';
2995     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
2996     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
2997     $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
2998     return $status if $sth->fetchrow_arrayref->[0];
2999   }
3000 }
3001
3002 =item statuscolor
3003
3004 Returns a hex triplet color string for this customer's status.
3005
3006 =cut
3007
3008 my %statuscolor = (
3009   'prospect'  => '000000',
3010   'active'    => '00CC00',
3011   'suspended' => 'FF9900',
3012   'cancelled' => 'FF0000',
3013 );
3014 sub statuscolor {
3015   my $self = shift;
3016   $statuscolor{$self->status};
3017 }
3018
3019 =back
3020
3021 =head1 CLASS METHODS
3022
3023 =over 4
3024
3025 =item prospect_sql
3026
3027 Returns an SQL expression identifying prospective cust_main records (customers
3028 with no packages ever ordered)
3029
3030 =cut
3031
3032 sub prospect_sql { "
3033   0 = ( SELECT COUNT(*) FROM cust_pkg
3034           WHERE cust_pkg.custnum = cust_main.custnum
3035       )
3036 "; }
3037
3038 =item active_sql
3039
3040 Returns an SQL expression identifying active cust_main records.
3041
3042 =cut
3043
3044 sub active_sql { "
3045   0 < ( SELECT COUNT(*) FROM cust_pkg
3046           WHERE cust_pkg.custnum = cust_main.custnum
3047             AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3048             AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
3049       )
3050 "; }
3051
3052 =item susp_sql
3053 =item suspended_sql
3054
3055 Returns an SQL expression identifying suspended cust_main records.
3056
3057 =cut
3058
3059 sub suspended_sql { susp_sql(@_); }
3060 sub susp_sql { "
3061     0 < ( SELECT COUNT(*) FROM cust_pkg
3062             WHERE cust_pkg.custnum = cust_main.custnum
3063               AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3064         )
3065     AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3066                 WHERE cust_pkg.custnum = cust_main.custnum
3067                   AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
3068                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3069             )
3070 "; }
3071
3072 =item cancel_sql
3073 =item cancelled_sql
3074
3075 Returns an SQL expression identifying cancelled cust_main records.
3076
3077 =cut
3078
3079 sub cancelled_sql { cancel_sql(@_); }
3080 sub cancel_sql { "
3081   0 < ( SELECT COUNT(*) FROM cust_pkg
3082           WHERE cust_pkg.custnum = cust_main.custnum
3083       )
3084   AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3085               WHERE cust_pkg.custnum = cust_main.custnum
3086                 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3087           )
3088 "; }
3089
3090 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
3091
3092 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
3093 records.  Currently, only I<last> or I<company> may be specified (the
3094 appropriate ship_ field is also searched if applicable).
3095
3096 Additional options are the same as FS::Record::qsearch
3097
3098 =cut
3099
3100 sub fuzzy_search {
3101   my( $self, $fuzzy, $hash, @opt) = @_;
3102   #$self
3103   $hash ||= {};
3104   my @cust_main = ();
3105
3106   check_and_rebuild_fuzzyfiles();
3107   foreach my $field ( keys %$fuzzy ) {
3108     my $sub = \&{"all_$field"};
3109     my %match = ();
3110     $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) );
3111
3112     foreach ( keys %match ) {
3113       push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
3114       push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt)
3115         if defined dbdef->table('cust_main')->column('ship_last');
3116     }
3117   }
3118
3119   my %saw = ();
3120   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
3121
3122   @cust_main;
3123
3124 }
3125
3126 =back
3127
3128 =head1 SUBROUTINES
3129
3130 =over 4
3131
3132 =item smart_search OPTION => VALUE ...
3133
3134 Accepts the following options: I<search>, the string to search for.  The string
3135 will be searched for as a customer number, last name or company name, first
3136 searching for an exact match then fuzzy and substring matches.
3137
3138 Any additional options treated as an additional qualifier on the search
3139 (i.e. I<agentnum>).
3140
3141 Returns a (possibly empty) array of FS::cust_main objects.
3142
3143 =cut
3144
3145 sub smart_search {
3146   my %options = @_;
3147   my $search = delete $options{'search'};
3148   my @cust_main = ();
3149
3150   if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
3151
3152     push @cust_main, qsearch('cust_main', { 'custnum' => $1, %options } );
3153
3154   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search
3155
3156     my $value = lc($1);
3157     my $q_value = dbh->quote($value);
3158
3159     #exact
3160     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
3161     $sql .= " ( LOWER(last) = $q_value OR LOWER(company) = $q_value";
3162     $sql .= " OR LOWER(ship_last) = $q_value OR LOWER(ship_company) = $q_value"
3163       if defined dbdef->table('cust_main')->column('ship_last');
3164     $sql .= ' )';
3165
3166     push @cust_main, qsearch( 'cust_main', \%options, '', $sql );
3167
3168     unless ( @cust_main ) {  #no exact match, trying substring/fuzzy
3169
3170       #still some false laziness w/ search/cust_main.cgi
3171
3172       #substring
3173       push @cust_main, qsearch( 'cust_main',
3174                                 { 'last'     => { 'op'    => 'ILIKE',
3175                                                   'value' => "%$q_value%" },
3176                                   %options,
3177                                 }
3178                               );
3179       push @cust_main, qsearch( 'cust_main',
3180                                 { 'ship_last' => { 'op'    => 'ILIKE',
3181                                                    'value' => "%$q_value%" },
3182                                   %options,
3183
3184                                 }
3185                               )
3186         if defined dbdef->table('cust_main')->column('ship_last');
3187
3188       push @cust_main, qsearch( 'cust_main',
3189                                 { 'company'  => { 'op'    => 'ILIKE',
3190                                                   'value' => "%$q_value%" },
3191                                   %options,
3192                                 }
3193                               );
3194       push @cust_main, qsearch( 'cust_main',
3195                                 { 'ship_company' => { 'op' => 'ILIKE',
3196                                                    'value' => "%$q_value%" },
3197                                   %options,
3198                                 }
3199                               )
3200         if defined dbdef->table('cust_main')->column('ship_last');
3201
3202       #fuzzy
3203       push @cust_main, FS::cust_main->fuzzy_search(
3204         { 'last'     => $value },
3205         \%options,
3206       );
3207       push @cust_main, FS::cust_main->fuzzy_search(
3208         { 'company'  => $value },
3209         \%options,
3210       );
3211
3212     }
3213
3214   }
3215
3216   @cust_main;
3217
3218 }
3219
3220 =item check_and_rebuild_fuzzyfiles
3221
3222 =cut
3223
3224 sub check_and_rebuild_fuzzyfiles {
3225   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3226   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
3227     or &rebuild_fuzzyfiles;
3228 }
3229
3230 =item rebuild_fuzzyfiles
3231
3232 =cut
3233
3234 sub rebuild_fuzzyfiles {
3235
3236   use Fcntl qw(:flock);
3237
3238   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3239
3240   #last
3241
3242   open(LASTLOCK,">>$dir/cust_main.last")
3243     or die "can't open $dir/cust_main.last: $!";
3244   flock(LASTLOCK,LOCK_EX)
3245     or die "can't lock $dir/cust_main.last: $!";
3246
3247   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
3248   push @all_last,
3249                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
3250     if defined dbdef->table('cust_main')->column('ship_last');
3251
3252   open (LASTCACHE,">$dir/cust_main.last.tmp")
3253     or die "can't open $dir/cust_main.last.tmp: $!";
3254   print LASTCACHE join("\n", @all_last), "\n";
3255   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
3256
3257   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
3258   close LASTLOCK;
3259
3260   #company
3261
3262   open(COMPANYLOCK,">>$dir/cust_main.company")
3263     or die "can't open $dir/cust_main.company: $!";
3264   flock(COMPANYLOCK,LOCK_EX)
3265     or die "can't lock $dir/cust_main.company: $!";
3266
3267   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
3268   push @all_company,
3269        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
3270     if defined dbdef->table('cust_main')->column('ship_last');
3271
3272   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
3273     or die "can't open $dir/cust_main.company.tmp: $!";
3274   print COMPANYCACHE join("\n", @all_company), "\n";
3275   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
3276
3277   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
3278   close COMPANYLOCK;
3279
3280 }
3281
3282 =item all_last
3283
3284 =cut
3285
3286 sub all_last {
3287   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3288   open(LASTCACHE,"<$dir/cust_main.last")
3289     or die "can't open $dir/cust_main.last: $!";
3290   my @array = map { chomp; $_; } <LASTCACHE>;
3291   close LASTCACHE;
3292   \@array;
3293 }
3294
3295 =item all_company
3296
3297 =cut
3298
3299 sub all_company {
3300   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3301   open(COMPANYCACHE,"<$dir/cust_main.company")
3302     or die "can't open $dir/cust_main.last: $!";
3303   my @array = map { chomp; $_; } <COMPANYCACHE>;
3304   close COMPANYCACHE;
3305   \@array;
3306 }
3307
3308 =item append_fuzzyfiles LASTNAME COMPANY
3309
3310 =cut
3311
3312 sub append_fuzzyfiles {
3313   my( $last, $company ) = @_;
3314
3315   &check_and_rebuild_fuzzyfiles;
3316
3317   use Fcntl qw(:flock);
3318
3319   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3320
3321   if ( $last ) {
3322
3323     open(LAST,">>$dir/cust_main.last")
3324       or die "can't open $dir/cust_main.last: $!";
3325     flock(LAST,LOCK_EX)
3326       or die "can't lock $dir/cust_main.last: $!";
3327
3328     print LAST "$last\n";
3329
3330     flock(LAST,LOCK_UN)
3331       or die "can't unlock $dir/cust_main.last: $!";
3332     close LAST;
3333   }
3334
3335   if ( $company ) {
3336
3337     open(COMPANY,">>$dir/cust_main.company")
3338       or die "can't open $dir/cust_main.company: $!";
3339     flock(COMPANY,LOCK_EX)
3340       or die "can't lock $dir/cust_main.company: $!";
3341
3342     print COMPANY "$company\n";
3343
3344     flock(COMPANY,LOCK_UN)
3345       or die "can't unlock $dir/cust_main.company: $!";
3346
3347     close COMPANY;
3348   }
3349
3350   1;
3351 }
3352
3353 =item batch_import
3354
3355 =cut
3356
3357 sub batch_import {
3358   my $param = shift;
3359   #warn join('-',keys %$param);
3360   my $fh = $param->{filehandle};
3361   my $agentnum = $param->{agentnum};
3362   my $refnum = $param->{refnum};
3363   my $pkgpart = $param->{pkgpart};
3364   my @fields = @{$param->{fields}};
3365
3366   eval "use Date::Parse;";
3367   die $@ if $@;
3368   eval "use Text::CSV_XS;";
3369   die $@ if $@;
3370
3371   my $csv = new Text::CSV_XS;
3372   #warn $csv;
3373   #warn $fh;
3374
3375   my $imported = 0;
3376   #my $columns;
3377
3378   local $SIG{HUP} = 'IGNORE';
3379   local $SIG{INT} = 'IGNORE';
3380   local $SIG{QUIT} = 'IGNORE';
3381   local $SIG{TERM} = 'IGNORE';
3382   local $SIG{TSTP} = 'IGNORE';
3383   local $SIG{PIPE} = 'IGNORE';
3384
3385   my $oldAutoCommit = $FS::UID::AutoCommit;
3386   local $FS::UID::AutoCommit = 0;
3387   my $dbh = dbh;
3388
3389   #while ( $columns = $csv->getline($fh) ) {
3390   my $line;
3391   while ( defined($line=<$fh>) ) {
3392
3393     $csv->parse($line) or do {
3394       $dbh->rollback if $oldAutoCommit;
3395       return "can't parse: ". $csv->error_input();
3396     };
3397
3398     my @columns = $csv->fields();
3399     #warn join('-',@columns);
3400
3401     my %cust_main = (
3402       agentnum => $agentnum,
3403       refnum   => $refnum,
3404       country  => $conf->config('countrydefault') || 'US',
3405       payby    => 'BILL', #default
3406       paydate  => '12/2037', #default
3407     );
3408     my $billtime = time;
3409     my %cust_pkg = ( pkgpart => $pkgpart );
3410     foreach my $field ( @fields ) {
3411       if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
3412         #$cust_pkg{$1} = str2time( shift @$columns );
3413         if ( $1 eq 'setup' ) {
3414           $billtime = str2time(shift @columns);
3415         } else {
3416           $cust_pkg{$1} = str2time( shift @columns );
3417         }
3418       } else {
3419         #$cust_main{$field} = shift @$columns;
3420         $cust_main{$field} = shift @columns;
3421       }
3422     }
3423
3424     my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
3425     my $cust_main = new FS::cust_main ( \%cust_main );
3426     use Tie::RefHash;
3427     tie my %hash, 'Tie::RefHash'; #this part is important
3428     $hash{$cust_pkg} = [] if $pkgpart;
3429     my $error = $cust_main->insert( \%hash );
3430
3431     if ( $error ) {
3432       $dbh->rollback if $oldAutoCommit;
3433       return "can't insert customer for $line: $error";
3434     }
3435
3436     #false laziness w/bill.cgi
3437     $error = $cust_main->bill( 'time' => $billtime );
3438     if ( $error ) {
3439       $dbh->rollback if $oldAutoCommit;
3440       return "can't bill customer for $line: $error";
3441     }
3442
3443     $cust_main->apply_payments;
3444     $cust_main->apply_credits;
3445
3446     $error = $cust_main->collect();
3447     if ( $error ) {
3448       $dbh->rollback if $oldAutoCommit;
3449       return "can't collect customer for $line: $error";
3450     }
3451
3452     $imported++;
3453   }
3454
3455   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3456
3457   return "Empty file!" unless $imported;
3458
3459   ''; #no error
3460
3461 }
3462
3463 =item batch_charge
3464
3465 =cut
3466
3467 sub batch_charge {
3468   my $param = shift;
3469   #warn join('-',keys %$param);
3470   my $fh = $param->{filehandle};
3471   my @fields = @{$param->{fields}};
3472
3473   eval "use Date::Parse;";
3474   die $@ if $@;
3475   eval "use Text::CSV_XS;";
3476   die $@ if $@;
3477
3478   my $csv = new Text::CSV_XS;
3479   #warn $csv;
3480   #warn $fh;
3481
3482   my $imported = 0;
3483   #my $columns;
3484
3485   local $SIG{HUP} = 'IGNORE';
3486   local $SIG{INT} = 'IGNORE';
3487   local $SIG{QUIT} = 'IGNORE';
3488   local $SIG{TERM} = 'IGNORE';
3489   local $SIG{TSTP} = 'IGNORE';
3490   local $SIG{PIPE} = 'IGNORE';
3491
3492   my $oldAutoCommit = $FS::UID::AutoCommit;
3493   local $FS::UID::AutoCommit = 0;
3494   my $dbh = dbh;
3495
3496   #while ( $columns = $csv->getline($fh) ) {
3497   my $line;
3498   while ( defined($line=<$fh>) ) {
3499
3500     $csv->parse($line) or do {
3501       $dbh->rollback if $oldAutoCommit;
3502       return "can't parse: ". $csv->error_input();
3503     };
3504
3505     my @columns = $csv->fields();
3506     #warn join('-',@columns);
3507
3508     my %row = ();
3509     foreach my $field ( @fields ) {
3510       $row{$field} = shift @columns;
3511     }
3512
3513     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
3514     unless ( $cust_main ) {
3515       $dbh->rollback if $oldAutoCommit;
3516       return "unknown custnum $row{'custnum'}";
3517     }
3518
3519     if ( $row{'amount'} > 0 ) {
3520       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
3521       if ( $error ) {
3522         $dbh->rollback if $oldAutoCommit;
3523         return $error;
3524       }
3525       $imported++;
3526     } elsif ( $row{'amount'} < 0 ) {
3527       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
3528                                       $row{'pkg'}                         );
3529       if ( $error ) {
3530         $dbh->rollback if $oldAutoCommit;
3531         return $error;
3532       }
3533       $imported++;
3534     } else {
3535       #hmm?
3536     }
3537
3538   }
3539
3540   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3541
3542   return "Empty file!" unless $imported;
3543
3544   ''; #no error
3545
3546 }
3547
3548 =back
3549
3550 =head1 BUGS
3551
3552 The delete method.
3553
3554 The delete method should possibly take an FS::cust_main object reference
3555 instead of a scalar customer number.
3556
3557 Bill and collect options should probably be passed as references instead of a
3558 list.
3559
3560 There should probably be a configuration file with a list of allowed credit
3561 card types.
3562
3563 No multiple currency support (probably a larger project than just this module).
3564
3565 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
3566
3567 =head1 SEE ALSO
3568
3569 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
3570 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
3571 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
3572
3573 =cut
3574
3575 1;
3576