FS/FS/cust_main.pm

   1 package FS::cust_main;
   2
   3 require 5.006;
   4 use strict;
   5              #FS::cust_main:_Marketgear when they're ready to move to 2.1
   6 use base qw( FS::cust_main::Packages
   7              FS::cust_main::Billing FS::cust_main::Billing_Realtime
   8              FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin
   9              FS::geocode_Mixin
  10              FS::Record
  11            );
  12 use vars qw( $DEBUG $me $conf
  13              @encrypted_fields
  14              $import
  15              $ignore_expired_card $ignore_illegal_zip $ignore_banned_card
  16              $skip_fuzzyfiles @fuzzyfields
  17              @paytypes
  18            );
  19 use Carp;
  20 use Scalar::Util qw( blessed );
  21 use Time::Local qw(timelocal);
  22 use Storable qw(thaw);
  23 use MIME::Base64;
  24 use Data::Dumper;
  25 use Tie::IxHash;
  26 use Digest::MD5 qw(md5_base64);
  27 use Date::Format;
  28 #use Date::Manip;
  29 use File::Temp; #qw( tempfile );
  30 use Business::CreditCard 0.28;
  31 use Locale::Country;
  32 use FS::UID qw( getotaker dbh driver_name );
  33 use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
  34 use FS::Misc qw( generate_email send_email generate_ps do_print );
  35 use FS::Msgcat qw(gettext);
  36 use FS::CurrentUser;
  37 use FS::payby;
  38 use FS::cust_pkg;
  39 use FS::cust_svc;
  40 use FS::cust_bill;
  41 use FS::cust_pay;
  42 use FS::cust_pay_pending;
  43 use FS::cust_pay_void;
  44 use FS::cust_pay_batch;
  45 use FS::cust_credit;
  46 use FS::cust_refund;
  47 use FS::part_referral;
  48 use FS::cust_main_county;
  49 use FS::cust_location;
  50 use FS::cust_class;
  51 use FS::cust_main_exemption;
  52 use FS::cust_tax_adjustment;
  53 use FS::cust_tax_location;
  54 use FS::agent;
  55 use FS::cust_main_invoice;
  56 use FS::cust_tag;
  57 use FS::prepay_credit;
  58 use FS::queue;
  59 use FS::part_pkg;
  60 use FS::part_export;
  61 #use FS::cust_event;
  62 use FS::type_pkgs;
  63 use FS::payment_gateway;
  64 use FS::agent_payment_gateway;
  65 use FS::banned_pay;
  66 use FS::TicketSystem;
  67
  68 # 1 is mostly method/subroutine entry and options
  69 # 2 traces progress of some operations
  70 # 3 is even more information including possibly sensitive data
  71 $DEBUG = 0;
  72 $me = '[FS::cust_main]';
  73
  74 $import = 0;
  75 $ignore_expired_card = 0;
  76 $ignore_illegal_zip = 0;
  77 $ignore_banned_card = 0;
  78
  79 $skip_fuzzyfiles = 0;
  80 @fuzzyfields = ( 'first', 'last', 'company', 'address1' );
  81
  82 @encrypted_fields = ('payinfo', 'paycvv');
  83 sub nohistory_fields { ('payinfo', 'paycvv'); }
  84
  85 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
  86
  87 #ask FS::UID to run this stuff for us later
  88 #$FS::UID::callback{'FS::cust_main'} = sub {
  89 install_callback FS::UID sub {
  90   $conf = new FS::Conf;
  91   #yes, need it for stuff below (prolly should be cached)
  92 };
  93
  94 sub _cache {
  95   my $self = shift;
  96   my ( $hashref, $cache ) = @_;
  97   if ( exists $hashref->{'pkgnum'} ) {
  98     #@{ $self->{'_pkgnum'} } = ();
  99     my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
 100     $self->{'_pkgnum'} = $subcache;
 101     #push @{ $self->{'_pkgnum'} },
 102     FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
 103   }
 104 }
 105
 106 =head1 NAME
 107
 108 FS::cust_main - Object methods for cust_main records
 109
 110 =head1 SYNOPSIS
 111
 112   use FS::cust_main;
 113
 114   $record = new FS::cust_main \%hash;
 115   $record = new FS::cust_main { 'column' => 'value' };
 116
 117   $error = $record->insert;
 118
 119   $error = $new_record->replace($old_record);
 120
 121   $error = $record->delete;
 122
 123   $error = $record->check;
 124
 125   @cust_pkg = $record->all_pkgs;
 126
 127   @cust_pkg = $record->ncancelled_pkgs;
 128
 129   @cust_pkg = $record->suspended_pkgs;
 130
 131   $error = $record->bill;
 132   $error = $record->bill %options;
 133   $error = $record->bill 'time' => $time;
 134
 135   $error = $record->collect;
 136   $error = $record->collect %options;
 137   $error = $record->collect 'invoice_time'   => $time,
 138                           ;
 139
 140 =head1 DESCRIPTION
 141
 142 An FS::cust_main object represents a customer.  FS::cust_main inherits from
 143 FS::Record.  The following fields are currently supported:
 144
 145 =over 4
 146
 147 =item custnum
 148
 149 Primary key (assigned automatically for new customers)
 150
 151 =item agentnum
 152
 153 Agent (see L<FS::agent>)
 154
 155 =item refnum
 156
 157 Advertising source (see L<FS::part_referral>)
 158
 159 =item first
 160
 161 First name
 162
 163 =item last
 164
 165 Last name
 166
 167 =item ss
 168
 169 Cocial security number (optional)
 170
 171 =item company
 172
 173 (optional)
 174
 175 =item address1
 176
 177 =item address2
 178
 179 (optional)
 180
 181 =item city
 182
 183 =item county
 184
 185 (optional, see L<FS::cust_main_county>)
 186
 187 =item state
 188
 189 (see L<FS::cust_main_county>)
 190
 191 =item zip
 192
 193 =item country
 194
 195 (see L<FS::cust_main_county>)
 196
 197 =item daytime
 198
 199 phone (optional)
 200
 201 =item night
 202
 203 phone (optional)
 204
 205 =item fax
 206
 207 phone (optional)
 208
 209 =item ship_first
 210
 211 Shipping first name
 212
 213 =item ship_last
 214
 215 Shipping last name
 216
 217 =item ship_company
 218
 219 (optional)
 220
 221 =item ship_address1
 222
 223 =item ship_address2
 224
 225 (optional)
 226
 227 =item ship_city
 228
 229 =item ship_county
 230
 231 (optional, see L<FS::cust_main_county>)
 232
 233 =item ship_state
 234
 235 (see L<FS::cust_main_county>)
 236
 237 =item ship_zip
 238
 239 =item ship_country
 240
 241 (see L<FS::cust_main_county>)
 242
 243 =item ship_daytime
 244
 245 phone (optional)
 246
 247 =item ship_night
 248
 249 phone (optional)
 250
 251 =item ship_fax
 252
 253 phone (optional)
 254
 255 =item payby
 256
 257 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
 258
 259 =item payinfo
 260
 261 Payment Information (See L<FS::payinfo_Mixin> for data format)
 262
 263 =item paymask
 264
 265 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
 266
 267 =item paycvv
 268
 269 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
 270
 271 =item paydate
 272
 273 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
 274
 275 =item paystart_month
 276
 277 Start date month (maestro/solo cards only)
 278
 279 =item paystart_year
 280
 281 Start date year (maestro/solo cards only)
 282
 283 =item payissue
 284
 285 Issue number (maestro/solo cards only)
 286
 287 =item payname
 288
 289 Name on card or billing name
 290
 291 =item payip
 292
 293 IP address from which payment information was received
 294
 295 =item tax
 296
 297 Tax exempt, empty or `Y'
 298
 299 =item usernum
 300
 301 Order taker (see L<FS::access_user>)
 302
 303 =item comments
 304
 305 Comments (optional)
 306
 307 =item referral_custnum
 308
 309 Referring customer number
 310
 311 =item spool_cdr
 312
 313 Enable individual CDR spooling, empty or `Y'
 314
 315 =item dundate
 316
 317 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
 318
 319 =item squelch_cdr
 320
 321 Discourage individual CDR printing, empty or `Y'
 322
 323 =back
 324
 325 =head1 METHODS
 326
 327 =over 4
 328
 329 =item new HASHREF
 330
 331 Creates a new customer.  To add the customer to the database, see L<"insert">.
 332
 333 Note that this stores the hash reference, not a distinct copy of the hash it
 334 points to.  You can ask the object for a copy with the I<hash> method.
 335
 336 =cut
 337
 338 sub table { 'cust_main'; }
 339
 340 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
 341
 342 Adds this customer to the database.  If there is an error, returns the error,
 343 otherwise returns false.
 344
 345 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
 346 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
 347 are inserted atomicly, or the transaction is rolled back.  Passing an empty
 348 hash reference is equivalent to not supplying this parameter.  There should be
 349 a better explanation of this, but until then, here's an example:
 350
 351   use Tie::RefHash;
 352   tie %hash, 'Tie::RefHash'; #this part is important
 353   %hash = (
 354     $cust_pkg => [ $svc_acct ],
 355     ...
 356   );
 357   $cust_main->insert( \%hash );
 358
 359 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 360 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 361 expected and rollback the entire transaction; it is not necessary to call
 362 check_invoicing_list first.  The invoicing_list is set after the records in the
 363 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
 364 invoicing_list destination to the newly-created svc_acct.  Here's an example:
 365
 366   $cust_main->insert( {}, [ $email, 'POST' ] );
 367
 368 Currently available options are: I<depend_jobnum>, I<noexport> and I<tax_exemption>.
 369
 370 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 371 on the supplied jobnum (they will not run until the specific job completes).
 372 This can be used to defer provisioning until some action completes (such
 373 as running the customer's credit card successfully).
 374
 375 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 376 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 377 the B<reexport> method.)
 378
 379 The I<tax_exemption> option can be set to an arrayref of tax names.
 380 FS::cust_main_exemption records will be created and inserted.
 381
 382 =cut
 383
 384 sub insert {
 385   my $self = shift;
 386   my $cust_pkgs = @_ ? shift : {};
 387   my $invoicing_list = @_ ? shift : '';
 388   my %options = @_;
 389   warn "$me insert called with options ".
 390        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 391     if $DEBUG;
 392
 393   local $SIG{HUP} = 'IGNORE';
 394   local $SIG{INT} = 'IGNORE';
 395   local $SIG{QUIT} = 'IGNORE';
 396   local $SIG{TERM} = 'IGNORE';
 397   local $SIG{TSTP} = 'IGNORE';
 398   local $SIG{PIPE} = 'IGNORE';
 399
 400   my $oldAutoCommit = $FS::UID::AutoCommit;
 401   local $FS::UID::AutoCommit = 0;
 402   my $dbh = dbh;
 403
 404   my $prepay_identifier = '';
 405   my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
 406   my $payby = '';
 407   if ( $self->payby eq 'PREPAY' ) {
 408
 409     $self->payby('BILL');
 410     $prepay_identifier = $self->payinfo;
 411     $self->payinfo('');
 412
 413     warn "  looking up prepaid card $prepay_identifier\n"
 414       if $DEBUG > 1;
 415
 416     my $error = $self->get_prepay( $prepay_identifier,
 417                                    'amount_ref'     => \$amount,
 418                                    'seconds_ref'    => \$seconds,
 419                                    'upbytes_ref'    => \$upbytes,
 420                                    'downbytes_ref'  => \$downbytes,
 421                                    'totalbytes_ref' => \$totalbytes,
 422                                  );
 423     if ( $error ) {
 424       $dbh->rollback if $oldAutoCommit;
 425       #return "error applying prepaid card (transaction rolled back): $error";
 426       return $error;
 427     }
 428
 429     $payby = 'PREP' if $amount;
 430
 431   } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
 432
 433     $payby = $1;
 434     $self->payby('BILL');
 435     $amount = $self->paid;
 436
 437   }
 438
 439   warn "  inserting $self\n"
 440     if $DEBUG > 1;
 441
 442   $self->signupdate(time) unless $self->signupdate;
 443
 444   $self->auto_agent_custid()
 445     if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
 446
 447   my $error = $self->SUPER::insert;
 448   if ( $error ) {
 449     $dbh->rollback if $oldAutoCommit;
 450     #return "inserting cust_main record (transaction rolled back): $error";
 451     return $error;
 452   }
 453
 454   warn "  setting invoicing list\n"
 455     if $DEBUG > 1;
 456
 457   if ( $invoicing_list ) {
 458     $error = $self->check_invoicing_list( $invoicing_list );
 459     if ( $error ) {
 460       $dbh->rollback if $oldAutoCommit;
 461       #return "checking invoicing_list (transaction rolled back): $error";
 462       return $error;
 463     }
 464     $self->invoicing_list( $invoicing_list );
 465   }
 466
 467   warn "  setting customer tags\n"
 468     if $DEBUG > 1;
 469
 470   foreach my $tagnum ( @{ $self->tagnum || [] } ) {
 471     my $cust_tag = new FS::cust_tag { 'tagnum'  => $tagnum,
 472                                       'custnum' => $self->custnum };
 473     my $error = $cust_tag->insert;
 474     if ( $error ) {
 475       $dbh->rollback if $oldAutoCommit;
 476       return $error;
 477     }
 478   }
 479
 480   if ( $invoicing_list ) {
 481     $error = $self->check_invoicing_list( $invoicing_list );
 482     if ( $error ) {
 483       $dbh->rollback if $oldAutoCommit;
 484       #return "checking invoicing_list (transaction rolled back): $error";
 485       return $error;
 486     }
 487     $self->invoicing_list( $invoicing_list );
 488   }
 489
 490
 491   warn "  setting cust_main_exemption\n"
 492     if $DEBUG > 1;
 493
 494   my $tax_exemption = delete $options{'tax_exemption'};
 495   if ( $tax_exemption ) {
 496     foreach my $taxname ( @$tax_exemption ) {
 497       my $cust_main_exemption = new FS::cust_main_exemption {
 498         'custnum' => $self->custnum,
 499         'taxname' => $taxname,
 500       };
 501       my $error = $cust_main_exemption->insert;
 502       if ( $error ) {
 503         $dbh->rollback if $oldAutoCommit;
 504         return "inserting cust_main_exemption (transaction rolled back): $error";
 505       }
 506     }
 507   }
 508
 509   if ( $self->can('start_copy_skel') ) {
 510     my $error = $self->start_copy_skel;
 511     if ( $error ) {
 512       $dbh->rollback if $oldAutoCommit;
 513       return $error;
 514     }
 515   }
 516
 517   warn "  ordering packages\n"
 518     if $DEBUG > 1;
 519
 520   $error = $self->order_pkgs( $cust_pkgs,
 521                               %options,
 522                               'seconds_ref'    => \$seconds,
 523                               'upbytes_ref'    => \$upbytes,
 524                               'downbytes_ref'  => \$downbytes,
 525                               'totalbytes_ref' => \$totalbytes,
 526                             );
 527   if ( $error ) {
 528     $dbh->rollback if $oldAutoCommit;
 529     return $error;
 530   }
 531
 532   if ( $seconds ) {
 533     $dbh->rollback if $oldAutoCommit;
 534     return "No svc_acct record to apply pre-paid time";
 535   }
 536   if ( $upbytes || $downbytes || $totalbytes ) {
 537     $dbh->rollback if $oldAutoCommit;
 538     return "No svc_acct record to apply pre-paid data";
 539   }
 540
 541   if ( $amount ) {
 542     warn "  inserting initial $payby payment of $amount\n"
 543       if $DEBUG > 1;
 544     $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
 545     if ( $error ) {
 546       $dbh->rollback if $oldAutoCommit;
 547       return "inserting payment (transaction rolled back): $error";
 548     }
 549   }
 550
 551   unless ( $import || $skip_fuzzyfiles ) {
 552     warn "  queueing fuzzyfiles update\n"
 553       if $DEBUG > 1;
 554     $error = $self->queue_fuzzyfiles_update;
 555     if ( $error ) {
 556       $dbh->rollback if $oldAutoCommit;
 557       return "updating fuzzy search cache: $error";
 558     }
 559   }
 560
 561   # cust_main exports!
 562   warn "  exporting\n" if $DEBUG > 1;
 563
 564   my $export_args = $options{'export_args'} || [];
 565
 566   my @part_export =
 567     map qsearch( 'part_export', {exportnum=>$_} ),
 568       $conf->config('cust_main-exports'); #, $agentnum
 569
 570   foreach my $part_export ( @part_export ) {
 571     my $error = $part_export->export_insert($self, @$export_args);
 572     if ( $error ) {
 573       $dbh->rollback if $oldAutoCommit;
 574       return "exporting to ". $part_export->exporttype.
 575              " (transaction rolled back): $error";
 576     }
 577   }
 578
 579   #foreach my $depend_jobnum ( @$depend_jobnums ) {
 580   #    warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
 581   #      if $DEBUG;
 582   #    foreach my $jobnum ( @jobnums ) {
 583   #      my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
 584   #      warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
 585   #        if $DEBUG;
 586   #      my $error = $queue->depend_insert($depend_jobnum);
 587   #      if ( $error ) {
 588   #        $dbh->rollback if $oldAutoCommit;
 589   #        return "error queuing job dependancy: $error";
 590   #      }
 591   #    }
 592   #  }
 593   #
 594   #}
 595   #
 596   #if ( exists $options{'jobnums'} ) {
 597   #  push @{ $options{'jobnums'} }, @jobnums;
 598   #}
 599
 600   warn "  insert complete; committing transaction\n"
 601     if $DEBUG > 1;
 602
 603   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 604   '';
 605
 606 }
 607
 608 use File::CounterFile;
 609 sub auto_agent_custid {
 610   my $self = shift;
 611
 612   my $format = $conf->config('cust_main-auto_agent_custid');
 613   my $agent_custid;
 614   if ( $format eq '1YMMXXXXXXXX' ) {
 615
 616     my $counter = new File::CounterFile 'cust_main.agent_custid';
 617     $counter->lock;
 618
 619     my $ym = 100000000000 + time2str('%y%m00000000', time);
 620     if ( $ym > $counter->value ) {
 621       $counter->{'value'} = $agent_custid = $ym;
 622       $counter->{'updated'} = 1;
 623     } else {
 624       $agent_custid = $counter->inc;
 625     }
 626
 627     $counter->unlock;
 628
 629   } else {
 630     die "Unknown cust_main-auto_agent_custid format: $format";
 631   }
 632
 633   $self->agent_custid($agent_custid);
 634
 635 }
 636
 637 =item PACKAGE METHODS
 638
 639 Documentation on customer package methods has been moved to
 640 L<FS::cust_main::Packages>.
 641
 642 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
 643
 644 Recharges this (existing) customer with the specified prepaid card (see
 645 L<FS::prepay_credit>), specified either by I<identifier> or as an
 646 FS::prepay_credit object.  If there is an error, returns the error, otherwise
 647 returns false.
 648
 649 Optionally, five scalar references can be passed as well.  They will have their
 650 values filled in with the amount, number of seconds, and number of upload,
 651 download, and total bytes applied by this prepaid card.
 652
 653 =cut
 654
 655 #the ref bullshit here should be refactored like get_prepay.  MyAccount.pm is
 656 #the only place that uses these args
 657 sub recharge_prepay {
 658   my( $self, $prepay_credit, $amountref, $secondsref,
 659       $upbytesref, $downbytesref, $totalbytesref ) = @_;
 660
 661   local $SIG{HUP} = 'IGNORE';
 662   local $SIG{INT} = 'IGNORE';
 663   local $SIG{QUIT} = 'IGNORE';
 664   local $SIG{TERM} = 'IGNORE';
 665   local $SIG{TSTP} = 'IGNORE';
 666   local $SIG{PIPE} = 'IGNORE';
 667
 668   my $oldAutoCommit = $FS::UID::AutoCommit;
 669   local $FS::UID::AutoCommit = 0;
 670   my $dbh = dbh;
 671
 672   my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
 673
 674   my $error = $self->get_prepay( $prepay_credit,
 675                                  'amount_ref'     => \$amount,
 676                                  'seconds_ref'    => \$seconds,
 677                                  'upbytes_ref'    => \$upbytes,
 678                                  'downbytes_ref'  => \$downbytes,
 679                                  'totalbytes_ref' => \$totalbytes,
 680                                )
 681            || $self->increment_seconds($seconds)
 682            || $self->increment_upbytes($upbytes)
 683            || $self->increment_downbytes($downbytes)
 684            || $self->increment_totalbytes($totalbytes)
 685            || $self->insert_cust_pay_prepay( $amount,
 686                                              ref($prepay_credit)
 687                                                ? $prepay_credit->identifier
 688                                                : $prepay_credit
 689                                            );
 690
 691   if ( $error ) {
 692     $dbh->rollback if $oldAutoCommit;
 693     return $error;
 694   }
 695
 696   if ( defined($amountref)  ) { $$amountref  = $amount;  }
 697   if ( defined($secondsref) ) { $$secondsref = $seconds; }
 698   if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
 699   if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
 700   if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
 701
 702   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 703   '';
 704
 705 }
 706
 707 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
 708
 709 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
 710 specified either by I<identifier> or as an FS::prepay_credit object.
 711
 712 Available options are: I<amount_ref>, I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.  The scalars (provided by references) will be
 713 incremented by the values of the prepaid card.
 714
 715 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
 716 check or set this customer's I<agentnum>.
 717
 718 If there is an error, returns the error, otherwise returns false.
 719
 720 =cut
 721
 722
 723 sub get_prepay {
 724   my( $self, $prepay_credit, %opt ) = @_;
 725
 726   local $SIG{HUP} = 'IGNORE';
 727   local $SIG{INT} = 'IGNORE';
 728   local $SIG{QUIT} = 'IGNORE';
 729   local $SIG{TERM} = 'IGNORE';
 730   local $SIG{TSTP} = 'IGNORE';
 731   local $SIG{PIPE} = 'IGNORE';
 732
 733   my $oldAutoCommit = $FS::UID::AutoCommit;
 734   local $FS::UID::AutoCommit = 0;
 735   my $dbh = dbh;
 736
 737   unless ( ref($prepay_credit) ) {
 738
 739     my $identifier = $prepay_credit;
 740
 741     $prepay_credit = qsearchs(
 742       'prepay_credit',
 743       { 'identifier' => $prepay_credit },
 744       '',
 745       'FOR UPDATE'
 746     );
 747
 748     unless ( $prepay_credit ) {
 749       $dbh->rollback if $oldAutoCommit;
 750       return "Invalid prepaid card: ". $identifier;
 751     }
 752
 753   }
 754
 755   if ( $prepay_credit->agentnum ) {
 756     if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
 757       $dbh->rollback if $oldAutoCommit;
 758       return "prepaid card not valid for agent ". $self->agentnum;
 759     }
 760     $self->agentnum($prepay_credit->agentnum);
 761   }
 762
 763   my $error = $prepay_credit->delete;
 764   if ( $error ) {
 765     $dbh->rollback if $oldAutoCommit;
 766     return "removing prepay_credit (transaction rolled back): $error";
 767   }
 768
 769   ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
 770     for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
 771
 772   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 773   '';
 774
 775 }
 776
 777 =item increment_upbytes SECONDS
 778
 779 Updates this customer's single or primary account (see L<FS::svc_acct>) by
 780 the specified number of upbytes.  If there is an error, returns the error,
 781 otherwise returns false.
 782
 783 =cut
 784
 785 sub increment_upbytes {
 786   _increment_column( shift, 'upbytes', @_);
 787 }
 788
 789 =item increment_downbytes SECONDS
 790
 791 Updates this customer's single or primary account (see L<FS::svc_acct>) by
 792 the specified number of downbytes.  If there is an error, returns the error,
 793 otherwise returns false.
 794
 795 =cut
 796
 797 sub increment_downbytes {
 798   _increment_column( shift, 'downbytes', @_);
 799 }
 800
 801 =item increment_totalbytes SECONDS
 802
 803 Updates this customer's single or primary account (see L<FS::svc_acct>) by
 804 the specified number of totalbytes.  If there is an error, returns the error,
 805 otherwise returns false.
 806
 807 =cut
 808
 809 sub increment_totalbytes {
 810   _increment_column( shift, 'totalbytes', @_);
 811 }
 812
 813 =item increment_seconds SECONDS
 814
 815 Updates this customer's single or primary account (see L<FS::svc_acct>) by
 816 the specified number of seconds.  If there is an error, returns the error,
 817 otherwise returns false.
 818
 819 =cut
 820
 821 sub increment_seconds {
 822   _increment_column( shift, 'seconds', @_);
 823 }
 824
 825 =item _increment_column AMOUNT
 826
 827 Updates this customer's single or primary account (see L<FS::svc_acct>) by
 828 the specified number of seconds or bytes.  If there is an error, returns
 829 the error, otherwise returns false.
 830
 831 =cut
 832
 833 sub _increment_column {
 834   my( $self, $column, $amount ) = @_;
 835   warn "$me increment_column called: $column, $amount\n"
 836     if $DEBUG;
 837
 838   return '' unless $amount;
 839
 840   my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
 841                       $self->ncancelled_pkgs;
 842
 843   if ( ! @cust_pkg ) {
 844     return 'No packages with primary or single services found'.
 845            ' to apply pre-paid time';
 846   } elsif ( scalar(@cust_pkg) > 1 ) {
 847     #maybe have a way to specify the package/account?
 848     return 'Multiple packages found to apply pre-paid time';
 849   }
 850
 851   my $cust_pkg = $cust_pkg[0];
 852   warn "  found package pkgnum ". $cust_pkg->pkgnum. "\n"
 853     if $DEBUG > 1;
 854
 855   my @cust_svc =
 856     $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
 857
 858   if ( ! @cust_svc ) {
 859     return 'No account found to apply pre-paid time';
 860   } elsif ( scalar(@cust_svc) > 1 ) {
 861     return 'Multiple accounts found to apply pre-paid time';
 862   }
 863
 864   my $svc_acct = $cust_svc[0]->svc_x;
 865   warn "  found service svcnum ". $svc_acct->pkgnum.
 866        ' ('. $svc_acct->email. ")\n"
 867     if $DEBUG > 1;
 868
 869   $column = "increment_$column";
 870   $svc_acct->$column($amount);
 871
 872 }
 873
 874 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
 875
 876 Inserts a prepayment in the specified amount for this customer.  An optional
 877 second argument can specify the prepayment identifier for tracking purposes.
 878 If there is an error, returns the error, otherwise returns false.
 879
 880 =cut
 881
 882 sub insert_cust_pay_prepay {
 883   shift->insert_cust_pay('PREP', @_);
 884 }
 885
 886 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
 887
 888 Inserts a cash payment in the specified amount for this customer.  An optional
 889 second argument can specify the payment identifier for tracking purposes.
 890 If there is an error, returns the error, otherwise returns false.
 891
 892 =cut
 893
 894 sub insert_cust_pay_cash {
 895   shift->insert_cust_pay('CASH', @_);
 896 }
 897
 898 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
 899
 900 Inserts a Western Union payment in the specified amount for this customer.  An
 901 optional second argument can specify the prepayment identifier for tracking
 902 purposes.  If there is an error, returns the error, otherwise returns false.
 903
 904 =cut
 905
 906 sub insert_cust_pay_west {
 907   shift->insert_cust_pay('WEST', @_);
 908 }
 909
 910 sub insert_cust_pay {
 911   my( $self, $payby, $amount ) = splice(@_, 0, 3);
 912   my $payinfo = scalar(@_) ? shift : '';
 913
 914   my $cust_pay = new FS::cust_pay {
 915     'custnum' => $self->custnum,
 916     'paid'    => sprintf('%.2f', $amount),
 917     #'_date'   => #date the prepaid card was purchased???
 918     'payby'   => $payby,
 919     'payinfo' => $payinfo,
 920   };
 921   $cust_pay->insert;
 922
 923 }
 924
 925 =item reexport
 926
 927 This method is deprecated.  See the I<depend_jobnum> option to the insert and
 928 order_pkgs methods for a better way to defer provisioning.
 929
 930 Re-schedules all exports by calling the B<reexport> method of all associated
 931 packages (see L<FS::cust_pkg>).  If there is an error, returns the error;
 932 otherwise returns false.
 933
 934 =cut
 935
 936 sub reexport {
 937   my $self = shift;
 938
 939   carp "WARNING: FS::cust_main::reexport is deprectated; ".
 940        "use the depend_jobnum option to insert or order_pkgs to delay export";
 941
 942   local $SIG{HUP} = 'IGNORE';
 943   local $SIG{INT} = 'IGNORE';
 944   local $SIG{QUIT} = 'IGNORE';
 945   local $SIG{TERM} = 'IGNORE';
 946   local $SIG{TSTP} = 'IGNORE';
 947   local $SIG{PIPE} = 'IGNORE';
 948
 949   my $oldAutoCommit = $FS::UID::AutoCommit;
 950   local $FS::UID::AutoCommit = 0;
 951   my $dbh = dbh;
 952
 953   foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
 954     my $error = $cust_pkg->reexport;
 955     if ( $error ) {
 956       $dbh->rollback if $oldAutoCommit;
 957       return $error;
 958     }
 959   }
 960
 961   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 962   '';
 963
 964 }
 965
 966 =item delete [ OPTION => VALUE ... ]
 967
 968 This deletes the customer.  If there is an error, returns the error, otherwise
 969 returns false.
 970
 971 This will completely remove all traces of the customer record.  This is not
 972 what you want when a customer cancels service; for that, cancel all of the
 973 customer's packages (see L</cancel>).
 974
 975 If the customer has any uncancelled packages, you need to pass a new (valid)
 976 customer number for those packages to be transferred to, as the "new_customer"
 977 option.  Cancelled packages will be deleted.  Did I mention that this is NOT
 978 what you want when a customer cancels service and that you really should be
 979 looking at L<FS::cust_pkg/cancel>?
 980
 981 You can't delete a customer with invoices (see L<FS::cust_bill>),
 982 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
 983 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
 984 set the "delete_financials" option to a true value.
 985
 986 =cut
 987
 988 sub delete {
 989   my( $self, %opt ) = @_;
 990
 991   local $SIG{HUP} = 'IGNORE';
 992   local $SIG{INT} = 'IGNORE';
 993   local $SIG{QUIT} = 'IGNORE';
 994   local $SIG{TERM} = 'IGNORE';
 995   local $SIG{TSTP} = 'IGNORE';
 996   local $SIG{PIPE} = 'IGNORE';
 997
 998   my $oldAutoCommit = $FS::UID::AutoCommit;
 999   local $FS::UID::AutoCommit = 0;
1000   my $dbh = dbh;
1001
1002   if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1003      $dbh->rollback if $oldAutoCommit;
1004      return "Can't delete a master agent customer";
1005   }
1006
1007   #use FS::access_user
1008   if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1009      $dbh->rollback if $oldAutoCommit;
1010      return "Can't delete a master employee customer";
1011   }
1012
1013   tie my %financial_tables, 'Tie::IxHash',
1014     'cust_bill'      => 'invoices',
1015     'cust_statement' => 'statements',
1016     'cust_credit'    => 'credits',
1017     'cust_pay'       => 'payments',
1018     'cust_refund'    => 'refunds',
1019   ;
1020
1021   foreach my $table ( keys %financial_tables ) {
1022
1023     my @records = $self->$table();
1024
1025     if ( @records && ! $opt{'delete_financials'} ) {
1026       $dbh->rollback if $oldAutoCommit;
1027       return "Can't delete a customer with ". $financial_tables{$table};
1028     }
1029
1030     foreach my $record ( @records ) {
1031       my $error = $record->delete;
1032       if ( $error ) {
1033         $dbh->rollback if $oldAutoCommit;
1034         return "Error deleting ". $financial_tables{$table}. ": $error\n";
1035       }
1036     }
1037
1038   }
1039
1040   my @cust_pkg = $self->ncancelled_pkgs;
1041   if ( @cust_pkg ) {
1042     my $new_custnum = $opt{'new_custnum'};
1043     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1044       $dbh->rollback if $oldAutoCommit;
1045       return "Invalid new customer number: $new_custnum";
1046     }
1047     foreach my $cust_pkg ( @cust_pkg ) {
1048       my %hash = $cust_pkg->hash;
1049       $hash{'custnum'} = $new_custnum;
1050       my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1051       my $error = $new_cust_pkg->replace($cust_pkg,
1052                                          options => { $cust_pkg->options },
1053                                         );
1054       if ( $error ) {
1055         $dbh->rollback if $oldAutoCommit;
1056         return $error;
1057       }
1058     }
1059   }
1060   my @cancelled_cust_pkg = $self->all_pkgs;
1061   foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1062     my $error = $cust_pkg->delete;
1063     if ( $error ) {
1064       $dbh->rollback if $oldAutoCommit;
1065       return $error;
1066     }
1067   }
1068
1069   #cust_tax_adjustment in financials?
1070   #cust_pay_pending?  ouch
1071   #cust_recon?
1072   foreach my $table (qw(
1073     cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1074     cust_location cust_main_note cust_tax_adjustment
1075     cust_pay_void cust_pay_batch queue cust_tax_exempt
1076   )) {
1077     foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1078       my $error = $record->delete;
1079       if ( $error ) {
1080         $dbh->rollback if $oldAutoCommit;
1081         return $error;
1082       }
1083     }
1084   }
1085
1086   my $sth = $dbh->prepare(
1087     'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1088   ) or do {
1089     my $errstr = $dbh->errstr;
1090     $dbh->rollback if $oldAutoCommit;
1091     return $errstr;
1092   };
1093   $sth->execute($self->custnum) or do {
1094     my $errstr = $sth->errstr;
1095     $dbh->rollback if $oldAutoCommit;
1096     return $errstr;
1097   };
1098
1099   #tickets
1100
1101   my $ticket_dbh = '';
1102   if ($conf->config('ticket_system') eq 'RT_Internal') {
1103     $ticket_dbh = $dbh;
1104   } elsif ($conf->config('ticket_system') eq 'RT_External') {
1105     my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1106     $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1107       #or die "RT_External DBI->connect error: $DBI::errstr\n";
1108   }
1109
1110   if ( $ticket_dbh ) {
1111
1112     my $ticket_sth = $ticket_dbh->prepare(
1113       'DELETE FROM Links WHERE Target = ?'
1114     ) or do {
1115       my $errstr = $ticket_dbh->errstr;
1116       $dbh->rollback if $oldAutoCommit;
1117       return $errstr;
1118     };
1119     $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1120       or do {
1121         my $errstr = $ticket_sth->errstr;
1122         $dbh->rollback if $oldAutoCommit;
1123         return $errstr;
1124       };
1125
1126     #check and see if the customer is the only link on the ticket, and
1127     #if so, set the ticket to deleted status in RT?
1128     #maybe someday, for now this will at least fix tickets not displaying
1129
1130   }
1131
1132   #delete the customer record
1133
1134   my $error = $self->SUPER::delete;
1135   if ( $error ) {
1136     $dbh->rollback if $oldAutoCommit;
1137     return $error;
1138   }
1139
1140   # cust_main exports!
1141
1142   #my $export_args = $options{'export_args'} || [];
1143
1144   my @part_export =
1145     map qsearch( 'part_export', {exportnum=>$_} ),
1146       $conf->config('cust_main-exports'); #, $agentnum
1147
1148   foreach my $part_export ( @part_export ) {
1149     my $error = $part_export->export_delete( $self ); #, @$export_args);
1150     if ( $error ) {
1151       $dbh->rollback if $oldAutoCommit;
1152       return "exporting to ". $part_export->exporttype.
1153              " (transaction rolled back): $error";
1154     }
1155   }
1156
1157   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1158   '';
1159
1160 }
1161
1162 =item merge NEW_CUSTNUM [ , OPTION => VALUE ... ]
1163
1164 This merges this customer into the provided new custnum, and then deletes the
1165 customer.  If there is an error, returns the error, otherwise returns false.
1166
1167 The source customer's name, company name, phone numbers, agent,
1168 referring customer, customer class, advertising source, order taker, and
1169 billing information (except balance) are discarded.
1170
1171 All packages are moved to the target customer.  Packages with package locations
1172 are preserved.  Packages without package locations are moved to a new package
1173 location with the source customer's service/shipping address.
1174
1175 All invoices, statements, payments, credits and refunds are moved to the target
1176 customer.  The source customer's balance is added to the target customer.
1177
1178 All notes, attachments, tickets and customer tags are moved to the target
1179 customer.
1180
1181 Change history is not currently moved.
1182
1183 =cut
1184
1185 sub merge {
1186   my( $self, $new_custnum, %opt ) = @_;
1187
1188   return "Can't merge a customer into self" if $self->custnum == $new_custnum;
1189
1190   unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1191     return "Invalid new customer number: $new_custnum";
1192   }
1193
1194   local $SIG{HUP} = 'IGNORE';
1195   local $SIG{INT} = 'IGNORE';
1196   local $SIG{QUIT} = 'IGNORE';
1197   local $SIG{TERM} = 'IGNORE';
1198   local $SIG{TSTP} = 'IGNORE';
1199   local $SIG{PIPE} = 'IGNORE';
1200
1201   my $oldAutoCommit = $FS::UID::AutoCommit;
1202   local $FS::UID::AutoCommit = 0;
1203   my $dbh = dbh;
1204
1205   if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1206      $dbh->rollback if $oldAutoCommit;
1207      return "Can't merge a master agent customer";
1208   }
1209
1210   #use FS::access_user
1211   if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1212      $dbh->rollback if $oldAutoCommit;
1213      return "Can't merge a master employee customer";
1214   }
1215
1216   if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
1217                                      'status'  => { op=>'!=', value=>'done' },
1218                                    }
1219               )
1220   ) {
1221      $dbh->rollback if $oldAutoCommit;
1222      return "Can't merge a customer with pending payments";
1223   }
1224
1225   tie my %financial_tables, 'Tie::IxHash',
1226     'cust_bill'      => 'invoices',
1227     'cust_statement' => 'statements',
1228     'cust_credit'    => 'credits',
1229     'cust_pay'       => 'payments',
1230     'cust_pay_void'  => 'voided payments',
1231     'cust_refund'    => 'refunds',
1232   ;
1233
1234   foreach my $table ( keys %financial_tables ) {
1235
1236     my @records = $self->$table();
1237
1238     foreach my $record ( @records ) {
1239       $record->custnum($new_custnum);
1240       my $error = $record->replace;
1241       if ( $error ) {
1242         $dbh->rollback if $oldAutoCommit;
1243         return "Error merging ". $financial_tables{$table}. ": $error\n";
1244       }
1245     }
1246
1247   }
1248
1249   my $locationnum = '';
1250   foreach my $cust_pkg ( $self->all_pkgs ) {
1251     $cust_pkg->custnum($new_custnum);
1252
1253     unless ( $cust_pkg->locationnum ) {
1254       unless ( $locationnum ) {
1255         my $cust_location = new FS::cust_location {
1256           $self->location_hash,
1257           'custnum' => $new_custnum,
1258         };
1259         my $error = $cust_location->insert;
1260         if ( $error ) {
1261           $dbh->rollback if $oldAutoCommit;
1262           return $error;
1263         }
1264         $locationnum = $cust_location->locationnum;
1265       }
1266       $cust_pkg->locationnum($locationnum);
1267     }
1268
1269     my $error = $cust_pkg->replace;
1270     if ( $error ) {
1271       $dbh->rollback if $oldAutoCommit;
1272       return $error;
1273     }
1274   }
1275
1276   #not considered:
1277   # cust_tax_exempt (texas tax exemptions)
1278   # cust_recon (some sort of not-well understood thing for OnPac)
1279
1280   #these are moved over
1281   foreach my $table (qw(
1282     cust_tag cust_location contact cust_attachment cust_main_note
1283     cust_tax_adjustment cust_pay_batch queue
1284   )) {
1285     foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1286       $record->custnum($new_custnum);
1287       my $error = $record->replace;
1288       if ( $error ) {
1289         $dbh->rollback if $oldAutoCommit;
1290         return $error;
1291       }
1292     }
1293   }
1294
1295   #these aren't preserved
1296   foreach my $table (qw(
1297     cust_main_exemption cust_main_invoice
1298   )) {
1299     foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1300       my $error = $record->delete;
1301       if ( $error ) {
1302         $dbh->rollback if $oldAutoCommit;
1303         return $error;
1304       }
1305     }
1306   }
1307
1308
1309   my $sth = $dbh->prepare(
1310     'UPDATE cust_main SET referral_custnum = ? WHERE referral_custnum = ?'
1311   ) or do {
1312     my $errstr = $dbh->errstr;
1313     $dbh->rollback if $oldAutoCommit;
1314     return $errstr;
1315   };
1316   $sth->execute($new_custnum, $self->custnum) or do {
1317     my $errstr = $sth->errstr;
1318     $dbh->rollback if $oldAutoCommit;
1319     return $errstr;
1320   };
1321
1322   #tickets
1323
1324   my $ticket_dbh = '';
1325   if ($conf->config('ticket_system') eq 'RT_Internal') {
1326     $ticket_dbh = $dbh;
1327   } elsif ($conf->config('ticket_system') eq 'RT_External') {
1328     my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1329     $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1330       #or die "RT_External DBI->connect error: $DBI::errstr\n";
1331   }
1332
1333   if ( $ticket_dbh ) {
1334
1335     my $ticket_sth = $ticket_dbh->prepare(
1336       'UPDATE Links SET Target = ? WHERE Target = ?'
1337     ) or do {
1338       my $errstr = $ticket_dbh->errstr;
1339       $dbh->rollback if $oldAutoCommit;
1340       return $errstr;
1341     };
1342     $ticket_sth->execute('freeside://freeside/cust_main/'.$new_custnum,
1343                          'freeside://freeside/cust_main/'.$self->custnum)
1344       or do {
1345         my $errstr = $ticket_sth->errstr;
1346         $dbh->rollback if $oldAutoCommit;
1347         return $errstr;
1348       };
1349
1350   }
1351
1352   #delete the customer record
1353
1354   my $error = $self->delete;
1355   if ( $error ) {
1356     $dbh->rollback if $oldAutoCommit;
1357     return $error;
1358   }
1359
1360   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1361   '';
1362
1363 }
1364
1365 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1366
1367
1368 Replaces the OLD_RECORD with this one in the database.  If there is an error,
1369 returns the error, otherwise returns false.
1370
1371 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1372 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
1373 expected and rollback the entire transaction; it is not necessary to call
1374 check_invoicing_list first.  Here's an example:
1375
1376   $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1377
1378 Currently available options are: I<tax_exemption>.
1379
1380 The I<tax_exemption> option can be set to an arrayref of tax names.
1381 FS::cust_main_exemption records will be deleted and inserted as appropriate.
1382
1383 =cut
1384
1385 sub replace {
1386   my $self = shift;
1387
1388   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1389               ? shift
1390               : $self->replace_old;
1391
1392   my @param = @_;
1393
1394   warn "$me replace called\n"
1395     if $DEBUG;
1396
1397   my $curuser = $FS::CurrentUser::CurrentUser;
1398   if (    $self->payby eq 'COMP'
1399        && $self->payby ne $old->payby
1400        && ! $curuser->access_right('Complimentary customer')
1401      )
1402   {
1403     return "You are not permitted to create complimentary accounts.";
1404   }
1405
1406   if ( $old->get('geocode') && $old->get('geocode') eq $self->get('geocode')
1407        && $conf->exists('enable_taxproducts')
1408      )
1409   {
1410     my $pre = ($conf->exists('tax-ship_address') && $self->ship_zip)
1411                 ? 'ship_' : '';
1412     $self->set('geocode', '')
1413       if $old->get($pre.'zip') ne $self->get($pre.'zip')
1414       && length($self->get($pre.'zip')) >= 10;
1415   }
1416
1417   local($ignore_expired_card) = 1
1418     if $old->payby  =~ /^(CARD|DCRD)$/
1419     && $self->payby =~ /^(CARD|DCRD)$/
1420     && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1421
1422   local $SIG{HUP} = 'IGNORE';
1423   local $SIG{INT} = 'IGNORE';
1424   local $SIG{QUIT} = 'IGNORE';
1425   local $SIG{TERM} = 'IGNORE';
1426   local $SIG{TSTP} = 'IGNORE';
1427   local $SIG{PIPE} = 'IGNORE';
1428
1429   my $oldAutoCommit = $FS::UID::AutoCommit;
1430   local $FS::UID::AutoCommit = 0;
1431   my $dbh = dbh;
1432
1433   my $error = $self->SUPER::replace($old);
1434
1435   if ( $error ) {
1436     $dbh->rollback if $oldAutoCommit;
1437     return $error;
1438   }
1439
1440   if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1441     my $invoicing_list = shift @param;
1442     $error = $self->check_invoicing_list( $invoicing_list );
1443     if ( $error ) {
1444       $dbh->rollback if $oldAutoCommit;
1445       return $error;
1446     }
1447     $self->invoicing_list( $invoicing_list );
1448   }
1449
1450   if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1451
1452     #this could be more efficient than deleting and re-inserting, if it matters
1453     foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1454       my $error = $cust_tag->delete;
1455       if ( $error ) {
1456         $dbh->rollback if $oldAutoCommit;
1457         return $error;
1458       }
1459     }
1460     foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1461       my $cust_tag = new FS::cust_tag { 'tagnum'  => $tagnum,
1462                                         'custnum' => $self->custnum };
1463       my $error = $cust_tag->insert;
1464       if ( $error ) {
1465         $dbh->rollback if $oldAutoCommit;
1466         return $error;
1467       }
1468     }
1469
1470   }
1471
1472   my %options = @param;
1473
1474   my $tax_exemption = delete $options{'tax_exemption'};
1475   if ( $tax_exemption ) {
1476
1477     my %cust_main_exemption =
1478       map { $_->taxname => $_ }
1479           qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1480
1481     foreach my $taxname ( @$tax_exemption ) {
1482
1483       next if delete $cust_main_exemption{$taxname};
1484
1485       my $cust_main_exemption = new FS::cust_main_exemption {
1486         'custnum' => $self->custnum,
1487         'taxname' => $taxname,
1488       };
1489       my $error = $cust_main_exemption->insert;
1490       if ( $error ) {
1491         $dbh->rollback if $oldAutoCommit;
1492         return "inserting cust_main_exemption (transaction rolled back): $error";
1493       }
1494     }
1495
1496     foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1497       my $error = $cust_main_exemption->delete;
1498       if ( $error ) {
1499         $dbh->rollback if $oldAutoCommit;
1500         return "deleting cust_main_exemption (transaction rolled back): $error";
1501       }
1502     }
1503
1504   }
1505
1506   if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
1507        && ( ( $self->get('payinfo') ne $old->get('payinfo')
1508               && $self->get('payinfo') !~ /^99\d{14}$/
1509             )
1510             || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
1511           )
1512      )
1513   {
1514
1515     # card/check/lec info has changed, want to retry realtime_ invoice events
1516     my $error = $self->retry_realtime;
1517     if ( $error ) {
1518       $dbh->rollback if $oldAutoCommit;
1519       return $error;
1520     }
1521   }
1522
1523   unless ( $import || $skip_fuzzyfiles ) {
1524     $error = $self->queue_fuzzyfiles_update;
1525     if ( $error ) {
1526       $dbh->rollback if $oldAutoCommit;
1527       return "updating fuzzy search cache: $error";
1528     }
1529   }
1530
1531   # cust_main exports!
1532
1533   my $export_args = $options{'export_args'} || [];
1534
1535   my @part_export =
1536     map qsearch( 'part_export', {exportnum=>$_} ),
1537       $conf->config('cust_main-exports'); #, $agentnum
1538
1539   foreach my $part_export ( @part_export ) {
1540     my $error = $part_export->export_replace( $self, $old, @$export_args);
1541     if ( $error ) {
1542       $dbh->rollback if $oldAutoCommit;
1543       return "exporting to ". $part_export->exporttype.
1544              " (transaction rolled back): $error";
1545     }
1546   }
1547
1548   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1549   '';
1550
1551 }
1552
1553 =item queue_fuzzyfiles_update
1554
1555 Used by insert & replace to update the fuzzy search cache
1556
1557 =cut
1558
1559 sub queue_fuzzyfiles_update {
1560   my $self = shift;
1561
1562   local $SIG{HUP} = 'IGNORE';
1563   local $SIG{INT} = 'IGNORE';
1564   local $SIG{QUIT} = 'IGNORE';
1565   local $SIG{TERM} = 'IGNORE';
1566   local $SIG{TSTP} = 'IGNORE';
1567   local $SIG{PIPE} = 'IGNORE';
1568
1569   my $oldAutoCommit = $FS::UID::AutoCommit;
1570   local $FS::UID::AutoCommit = 0;
1571   my $dbh = dbh;
1572
1573   my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1574   my $error = $queue->insert( map $self->getfield($_), @fuzzyfields );
1575   if ( $error ) {
1576     $dbh->rollback if $oldAutoCommit;
1577     return "queueing job (transaction rolled back): $error";
1578   }
1579
1580   if ( $self->ship_last ) {
1581     $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1582     $error = $queue->insert( map $self->getfield("ship_$_"), @fuzzyfields );
1583     if ( $error ) {
1584       $dbh->rollback if $oldAutoCommit;
1585       return "queueing job (transaction rolled back): $error";
1586     }
1587   }
1588
1589   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1590   '';
1591
1592 }
1593
1594 =item check
1595
1596 Checks all fields to make sure this is a valid customer record.  If there is
1597 an error, returns the error, otherwise returns false.  Called by the insert
1598 and replace methods.
1599
1600 =cut
1601
1602 sub check {
1603   my $self = shift;
1604
1605   warn "$me check BEFORE: \n". $self->_dump
1606     if $DEBUG > 2;
1607
1608   my $error =
1609     $self->ut_numbern('custnum')
1610     || $self->ut_number('agentnum')
1611     || $self->ut_textn('agent_custid')
1612     || $self->ut_number('refnum')
1613     || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1614     || $self->ut_textn('custbatch')
1615     || $self->ut_name('last')
1616     || $self->ut_name('first')
1617     || $self->ut_snumbern('birthdate')
1618     || $self->ut_snumbern('signupdate')
1619     || $self->ut_textn('company')
1620     || $self->ut_text('address1')
1621     || $self->ut_textn('address2')
1622     || $self->ut_text('city')
1623     || $self->ut_textn('county')
1624     || $self->ut_textn('state')
1625     || $self->ut_country('country')
1626     || $self->ut_anything('comments')
1627     || $self->ut_numbern('referral_custnum')
1628     || $self->ut_textn('stateid')
1629     || $self->ut_textn('stateid_state')
1630     || $self->ut_textn('invoice_terms')
1631     || $self->ut_alphan('geocode')
1632     || $self->ut_floatn('cdr_termination_percentage')
1633     || $self->ut_floatn('credit_limit')
1634   ;
1635
1636   #barf.  need message catalogs.  i18n.  etc.
1637   $error .= "Please select an advertising source."
1638     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1639   return $error if $error;
1640
1641   return "Unknown agent"
1642     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1643
1644   return "Unknown refnum"
1645     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1646
1647   return "Unknown referring custnum: ". $self->referral_custnum
1648     unless ! $self->referral_custnum
1649            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1650
1651   if ( $self->censustract ne '' ) {
1652     $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/
1653       or return "Illegal census tract: ". $self->censustract;
1654
1655     $self->censustract("$1.$2");
1656   }
1657
1658   if ( $self->ss eq '' ) {
1659     $self->ss('');
1660   } else {
1661     my $ss = $self->ss;
1662     $ss =~ s/\D//g;
1663     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1664       or return "Illegal social security number: ". $self->ss;
1665     $self->ss("$1-$2-$3");
1666   }
1667
1668
1669 # bad idea to disable, causes billing to fail because of no tax rates later
1670 # except we don't fail any more
1671   unless ( $import ) {
1672     unless ( qsearch('cust_main_county', {
1673       'country' => $self->country,
1674       'state'   => '',
1675      } ) ) {
1676       return "Unknown state/county/country: ".
1677         $self->state. "/". $self->county. "/". $self->country
1678         unless qsearch('cust_main_county',{
1679           'state'   => $self->state,
1680           'county'  => $self->county,
1681           'country' => $self->country,
1682         } );
1683     }
1684   }
1685
1686   $error =
1687     $self->ut_phonen('daytime', $self->country)
1688     || $self->ut_phonen('night', $self->country)
1689     || $self->ut_phonen('fax', $self->country)
1690   ;
1691   return $error if $error;
1692
1693   unless ( $ignore_illegal_zip ) {
1694     $error = $self->ut_zip('zip', $self->country);
1695     return $error if $error;
1696   }
1697
1698   if ( $conf->exists('cust_main-require_phone')
1699        && ! length($self->daytime) && ! length($self->night)
1700      ) {
1701
1702     my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1703                           ? 'Day Phone'
1704                           : FS::Msgcat::_gettext('daytime');
1705     my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1706                         ? 'Night Phone'
1707                         : FS::Msgcat::_gettext('night');
1708
1709     return "$daytime_label or $night_label is required"
1710
1711   }
1712
1713   if ( $self->has_ship_address
1714        && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1715                         $self->addr_fields )
1716      )
1717   {
1718     my $error =
1719       $self->ut_name('ship_last')
1720       || $self->ut_name('ship_first')
1721       || $self->ut_textn('ship_company')
1722       || $self->ut_text('ship_address1')
1723       || $self->ut_textn('ship_address2')
1724       || $self->ut_text('ship_city')
1725       || $self->ut_textn('ship_county')
1726       || $self->ut_textn('ship_state')
1727       || $self->ut_country('ship_country')
1728     ;
1729     return $error if $error;
1730
1731     #false laziness with above
1732     unless ( qsearchs('cust_main_county', {
1733       'country' => $self->ship_country,
1734       'state'   => '',
1735      } ) ) {
1736       return "Unknown ship_state/ship_county/ship_country: ".
1737         $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1738         unless qsearch('cust_main_county',{
1739           'state'   => $self->ship_state,
1740           'county'  => $self->ship_county,
1741           'country' => $self->ship_country,
1742         } );
1743     }
1744     #eofalse
1745
1746     $error =
1747       $self->ut_phonen('ship_daytime', $self->ship_country)
1748       || $self->ut_phonen('ship_night', $self->ship_country)
1749       || $self->ut_phonen('ship_fax', $self->ship_country)
1750     ;
1751     return $error if $error;
1752
1753     unless ( $ignore_illegal_zip ) {
1754       $error = $self->ut_zip('ship_zip', $self->ship_country);
1755       return $error if $error;
1756     }
1757     return "Unit # is required."
1758       if $self->ship_address2 =~ /^\s*$/
1759       && $conf->exists('cust_main-require_address2');
1760
1761   } else { # ship_ info eq billing info, so don't store dup info in database
1762
1763     $self->setfield("ship_$_", '')
1764       foreach $self->addr_fields;
1765
1766     return "Unit # is required."
1767       if $self->address2 =~ /^\s*$/
1768       && $conf->exists('cust_main-require_address2');
1769
1770   }
1771
1772   #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1773   #  or return "Illegal payby: ". $self->payby;
1774   #$self->payby($1);
1775   FS::payby->can_payby($self->table, $self->payby)
1776     or return "Illegal payby: ". $self->payby;
1777
1778   $error =    $self->ut_numbern('paystart_month')
1779            || $self->ut_numbern('paystart_year')
1780            || $self->ut_numbern('payissue')
1781            || $self->ut_textn('paytype')
1782   ;
1783   return $error if $error;
1784
1785   if ( $self->payip eq '' ) {
1786     $self->payip('');
1787   } else {
1788     $error = $self->ut_ip('payip');
1789     return $error if $error;
1790   }
1791
1792   # If it is encrypted and the private key is not availaible then we can't
1793   # check the credit card.
1794   my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1795
1796   if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1797
1798     my $payinfo = $self->payinfo;
1799     $payinfo =~ s/\D//g;
1800     $payinfo =~ /^(\d{13,16})$/
1801       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1802     $payinfo = $1;
1803     $self->payinfo($payinfo);
1804     validate($payinfo)
1805       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1806
1807     return gettext('unknown_card_type')
1808       if $self->payinfo !~ /^99\d{14}$/ #token
1809       && cardtype($self->payinfo) eq "Unknown";
1810
1811     unless ( $ignore_banned_card ) {
1812       my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1813       if ( $ban ) {
1814         return 'Banned credit card: banned on '.
1815                time2str('%a %h %o at %r', $ban->_date).
1816                ' by '. $ban->otaker.
1817                ' (ban# '. $ban->bannum. ')';
1818       }
1819     }
1820
1821     if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1822       if ( cardtype($self->payinfo) eq 'American Express card' ) {
1823         $self->paycvv =~ /^(\d{4})$/
1824           or return "CVV2 (CID) for American Express cards is four digits.";
1825         $self->paycvv($1);
1826       } else {
1827         $self->paycvv =~ /^(\d{3})$/
1828           or return "CVV2 (CVC2/CID) is three digits.";
1829         $self->paycvv($1);
1830       }
1831     } else {
1832       $self->paycvv('');
1833     }
1834
1835     my $cardtype = cardtype($payinfo);
1836     if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1837
1838       return "Start date or issue number is required for $cardtype cards"
1839         unless $self->paystart_month && $self->paystart_year or $self->payissue;
1840
1841       return "Start month must be between 1 and 12"
1842         if $self->paystart_month
1843            and $self->paystart_month < 1 || $self->paystart_month > 12;
1844
1845       return "Start year must be 1990 or later"
1846         if $self->paystart_year
1847            and $self->paystart_year < 1990;
1848
1849       return "Issue number must be beween 1 and 99"
1850         if $self->payissue
1851           and $self->payissue < 1 || $self->payissue > 99;
1852
1853     } else {
1854       $self->paystart_month('');
1855       $self->paystart_year('');
1856       $self->payissue('');
1857     }
1858
1859   } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1860
1861     my $payinfo = $self->payinfo;
1862     $payinfo =~ s/[^\d\@]//g;
1863     if ( $conf->exists('echeck-nonus') ) {
1864       $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1865       $payinfo = "$1\@$2";
1866     } else {
1867       $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1868       $payinfo = "$1\@$2";
1869     }
1870     $self->payinfo($payinfo);
1871     $self->paycvv('');
1872
1873     unless ( $ignore_banned_card ) {
1874       my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1875       if ( $ban ) {
1876         return 'Banned ACH account: banned on '.
1877                time2str('%a %h %o at %r', $ban->_date).
1878                ' by '. $ban->otaker.
1879                ' (ban# '. $ban->bannum. ')';
1880       }
1881     }
1882
1883   } elsif ( $self->payby eq 'LECB' ) {
1884
1885     my $payinfo = $self->payinfo;
1886     $payinfo =~ s/\D//g;
1887     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1888     $payinfo = $1;
1889     $self->payinfo($payinfo);
1890     $self->paycvv('');
1891
1892   } elsif ( $self->payby eq 'BILL' ) {
1893
1894     $error = $self->ut_textn('payinfo');
1895     return "Illegal P.O. number: ". $self->payinfo if $error;
1896     $self->paycvv('');
1897
1898   } elsif ( $self->payby eq 'COMP' ) {
1899
1900     my $curuser = $FS::CurrentUser::CurrentUser;
1901     if (    ! $self->custnum
1902          && ! $curuser->access_right('Complimentary customer')
1903        )
1904     {
1905       return "You are not permitted to create complimentary accounts."
1906     }
1907
1908     $error = $self->ut_textn('payinfo');
1909     return "Illegal comp account issuer: ". $self->payinfo if $error;
1910     $self->paycvv('');
1911
1912   } elsif ( $self->payby eq 'PREPAY' ) {
1913
1914     my $payinfo = $self->payinfo;
1915     $payinfo =~ s/\W//g; #anything else would just confuse things
1916     $self->payinfo($payinfo);
1917     $error = $self->ut_alpha('payinfo');
1918     return "Illegal prepayment identifier: ". $self->payinfo if $error;
1919     return "Unknown prepayment identifier"
1920       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1921     $self->paycvv('');
1922
1923   }
1924
1925   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1926     return "Expiration date required"
1927       unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1928     $self->paydate('');
1929   } else {
1930     my( $m, $y );
1931     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1932       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1933     } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1934       ( $m, $y ) = ( $2, "19$1" );
1935     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1936       ( $m, $y ) = ( $3, "20$2" );
1937     } else {
1938       return "Illegal expiration date: ". $self->paydate;
1939     }
1940     $m = sprintf('%02d',$m);
1941     $self->paydate("$y-$m-01");
1942     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1943     return gettext('expired_card')
1944       if !$import
1945       && !$ignore_expired_card
1946       && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1947   }
1948
1949   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1950        ( ! $conf->exists('require_cardname')
1951          || $self->payby !~ /^(CARD|DCRD)$/  )
1952   ) {
1953     $self->payname( $self->first. " ". $self->getfield('last') );
1954   } else {
1955     $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1956       or return gettext('illegal_name'). " payname: ". $self->payname;
1957     $self->payname($1);
1958   }
1959
1960   foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
1961     $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1962     $self->$flag($1);
1963   }
1964
1965   $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
1966
1967   warn "$me check AFTER: \n". $self->_dump
1968     if $DEBUG > 2;
1969
1970   $self->SUPER::check;
1971 }
1972
1973 =item addr_fields
1974
1975 Returns a list of fields which have ship_ duplicates.
1976
1977 =cut
1978
1979 sub addr_fields {
1980   qw( last first company
1981       address1 address2 city county state zip country
1982       daytime night fax
1983     );
1984 }
1985
1986 =item has_ship_address
1987
1988 Returns true if this customer record has a separate shipping address.
1989
1990 =cut
1991
1992 sub has_ship_address {
1993   my $self = shift;
1994   scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
1995 }
1996
1997 =item location_hash
1998
1999 Returns a list of key/value pairs, with the following keys: address1, adddress2,
2000 city, county, state, zip, country, and geocode.  The shipping address is used if present.
2001
2002 =cut
2003
2004 =item cust_location
2005
2006 Returns all locations (see L<FS::cust_location>) for this customer.
2007
2008 =cut
2009
2010 sub cust_location {
2011   my $self = shift;
2012   qsearch('cust_location', { 'custnum' => $self->custnum } );
2013 }
2014
2015 =item unsuspend
2016
2017 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2018 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
2019 on success or a list of errors.
2020
2021 =cut
2022
2023 sub unsuspend {
2024   my $self = shift;
2025   grep { $_->unsuspend } $self->suspended_pkgs;
2026 }
2027
2028 =item suspend
2029
2030 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2031
2032 Returns a list: an empty list on success or a list of errors.
2033
2034 =cut
2035
2036 sub suspend {
2037   my $self = shift;
2038   grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2039 }
2040
2041 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2042
2043 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2044 PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref instead
2045 of a list of pkgparts; the hashref has the following keys:
2046
2047 =over 4
2048
2049 =item pkgparts - listref of pkgparts
2050
2051 =item (other options are passed to the suspend method)
2052
2053 =back
2054
2055
2056 Returns a list: an empty list on success or a list of errors.
2057
2058 =cut
2059
2060 sub suspend_if_pkgpart {
2061   my $self = shift;
2062   my (@pkgparts, %opt);
2063   if (ref($_[0]) eq 'HASH'){
2064     @pkgparts = @{$_[0]{pkgparts}};
2065     %opt      = %{$_[0]};
2066   }else{
2067     @pkgparts = @_;
2068   }
2069   grep { $_->suspend(%opt) }
2070     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2071       $self->unsuspended_pkgs;
2072 }
2073
2074 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2075
2076 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2077 given PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref
2078 instead of a list of pkgparts; the hashref has the following keys:
2079
2080 =over 4
2081
2082 =item pkgparts - listref of pkgparts
2083
2084 =item (other options are passed to the suspend method)
2085
2086 =back
2087
2088 Returns a list: an empty list on success or a list of errors.
2089
2090 =cut
2091
2092 sub suspend_unless_pkgpart {
2093   my $self = shift;
2094   my (@pkgparts, %opt);
2095   if (ref($_[0]) eq 'HASH'){
2096     @pkgparts = @{$_[0]{pkgparts}};
2097     %opt      = %{$_[0]};
2098   }else{
2099     @pkgparts = @_;
2100   }
2101   grep { $_->suspend(%opt) }
2102     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2103       $self->unsuspended_pkgs;
2104 }
2105
2106 =item cancel [ OPTION => VALUE ... ]
2107
2108 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2109
2110 Available options are:
2111
2112 =over 4
2113
2114 =item quiet - can be set true to supress email cancellation notices.
2115
2116 =item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason.  The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
2117
2118 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2119
2120 =item nobill - can be set true to skip billing if it might otherwise be done.
2121
2122 =back
2123
2124 Always returns a list: an empty list on success or a list of errors.
2125
2126 =cut
2127
2128 # nb that dates are not specified as valid options to this method
2129
2130 sub cancel {
2131   my( $self, %opt ) = @_;
2132
2133   warn "$me cancel called on customer ". $self->custnum. " with options ".
2134        join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2135     if $DEBUG;
2136
2137   return ( 'access denied' )
2138     unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2139
2140   if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2141
2142     #should try decryption (we might have the private key)
2143     # and if not maybe queue a job for the server that does?
2144     return ( "Can't (yet) ban encrypted credit cards" )
2145       if $self->is_encrypted($self->payinfo);
2146
2147     my $ban = new FS::banned_pay $self->_banned_pay_hashref;
2148     my $error = $ban->insert;
2149     return ( $error ) if $error;
2150
2151   }
2152
2153   my @pkgs = $self->ncancelled_pkgs;
2154
2155   if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2156     $opt{nobill} = 1;
2157     my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2158     warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2159       if $error;
2160   }
2161
2162   warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2163        scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2164     if $DEBUG;
2165
2166   grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2167 }
2168
2169 sub _banned_pay_hashref {
2170   my $self = shift;
2171
2172   my %payby2ban = (
2173     'CARD' => 'CARD',
2174     'DCRD' => 'CARD',
2175     'CHEK' => 'CHEK',
2176     'DCHK' => 'CHEK'
2177   );
2178
2179   {
2180     'payby'   => $payby2ban{$self->payby},
2181     'payinfo' => md5_base64($self->payinfo),
2182     #don't ever *search* on reason! #'reason'  =>
2183   };
2184 }
2185
2186 =item notes
2187
2188 Returns all notes (see L<FS::cust_main_note>) for this customer.
2189
2190 =cut
2191
2192 sub notes {
2193   my $self = shift;
2194   #order by?
2195   qsearch( 'cust_main_note',
2196            { 'custnum' => $self->custnum },
2197            '',
2198            'ORDER BY _DATE DESC'
2199          );
2200 }
2201
2202 =item agent
2203
2204 Returns the agent (see L<FS::agent>) for this customer.
2205
2206 =cut
2207
2208 sub agent {
2209   my $self = shift;
2210   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2211 }
2212
2213 =item agent_name
2214
2215 Returns the agent name (see L<FS::agent>) for this customer.
2216
2217 =cut
2218
2219 sub agent_name {
2220   my $self = shift;
2221   $self->agent->agent;
2222 }
2223
2224 =item cust_tag
2225
2226 Returns any tags associated with this customer, as FS::cust_tag objects,
2227 or an empty list if there are no tags.
2228
2229 =cut
2230
2231 sub cust_tag {
2232   my $self = shift;
2233   qsearch('cust_tag', { 'custnum' => $self->custnum } );
2234 }
2235
2236 =item part_tag
2237
2238 Returns any tags associated with this customer, as FS::part_tag objects,
2239 or an empty list if there are no tags.
2240
2241 =cut
2242
2243 sub part_tag {
2244   my $self = shift;
2245   map $_->part_tag, $self->cust_tag;
2246 }
2247
2248
2249 =item cust_class
2250
2251 Returns the customer class, as an FS::cust_class object, or the empty string
2252 if there is no customer class.
2253
2254 =cut
2255
2256 sub cust_class {
2257   my $self = shift;
2258   if ( $self->classnum ) {
2259     qsearchs('cust_class', { 'classnum' => $self->classnum } );
2260   } else {
2261     return '';
2262   }
2263 }
2264
2265 =item categoryname
2266
2267 Returns the customer category name, or the empty string if there is no customer
2268 category.
2269
2270 =cut
2271
2272 sub categoryname {
2273   my $self = shift;
2274   my $cust_class = $self->cust_class;
2275   $cust_class
2276     ? $cust_class->categoryname
2277     : '';
2278 }
2279
2280 =item classname
2281
2282 Returns the customer class name, or the empty string if there is no customer
2283 class.
2284
2285 =cut
2286
2287 sub classname {
2288   my $self = shift;
2289   my $cust_class = $self->cust_class;
2290   $cust_class
2291     ? $cust_class->classname
2292     : '';
2293 }
2294
2295 =item BILLING METHODS
2296
2297 Documentation on billing methods has been moved to
2298 L<FS::cust_main::Billing>.
2299
2300 =item REALTIME BILLING METHODS
2301
2302 Documentation on realtime billing methods has been moved to
2303 L<FS::cust_main::Billing_Realtime>.
2304
2305 =item remove_cvv
2306
2307 Removes the I<paycvv> field from the database directly.
2308
2309 If there is an error, returns the error, otherwise returns false.
2310
2311 =cut
2312
2313 sub remove_cvv {
2314   my $self = shift;
2315   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2316     or return dbh->errstr;
2317   $sth->execute($self->custnum)
2318     or return $sth->errstr;
2319   $self->paycvv('');
2320   '';
2321 }
2322
2323 =item batch_card OPTION => VALUE...
2324
2325 Adds a payment for this invoice to the pending credit card batch (see
2326 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
2327 runs the payment using a realtime gateway.
2328
2329 =cut
2330
2331 sub batch_card {
2332   my ($self, %options) = @_;
2333
2334   my $amount;
2335   if (exists($options{amount})) {
2336     $amount = $options{amount};
2337   }else{
2338     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
2339   }
2340   return '' unless $amount > 0;
2341
2342   my $invnum = delete $options{invnum};
2343   my $payby = $options{payby} || $self->payby;  #still dubious
2344
2345   if ($options{'realtime'}) {
2346     return $self->realtime_bop( FS::payby->payby2bop($self->payby),
2347                                 $amount,
2348                                 %options,
2349                               );
2350   }
2351
2352   my $oldAutoCommit = $FS::UID::AutoCommit;
2353   local $FS::UID::AutoCommit = 0;
2354   my $dbh = dbh;
2355
2356   #this needs to handle mysql as well as Pg, like svc_acct.pm
2357   #(make it into a common function if folks need to do batching with mysql)
2358   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
2359     or return "Cannot lock pay_batch: " . $dbh->errstr;
2360
2361   my %pay_batch = (
2362     'status' => 'O',
2363     'payby'  => FS::payby->payby2payment($payby),
2364   );
2365
2366   my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
2367
2368   unless ( $pay_batch ) {
2369     $pay_batch = new FS::pay_batch \%pay_batch;
2370     my $error = $pay_batch->insert;
2371     if ( $error ) {
2372       $dbh->rollback if $oldAutoCommit;
2373       die "error creating new batch: $error\n";
2374     }
2375   }
2376
2377   my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
2378       'batchnum' => $pay_batch->batchnum,
2379       'custnum'  => $self->custnum,
2380   } );
2381
2382   foreach (qw( address1 address2 city state zip country payby payinfo paydate
2383                payname )) {
2384     $options{$_} = '' unless exists($options{$_});
2385   }
2386
2387   my $cust_pay_batch = new FS::cust_pay_batch ( {
2388     'batchnum' => $pay_batch->batchnum,
2389     'invnum'   => $invnum || 0,                    # is there a better value?
2390                                                    # this field should be
2391                                                    # removed...
2392                                                    # cust_bill_pay_batch now
2393     'custnum'  => $self->custnum,
2394     'last'     => $self->getfield('last'),
2395     'first'    => $self->getfield('first'),
2396     'address1' => $options{address1} || $self->address1,
2397     'address2' => $options{address2} || $self->address2,
2398     'city'     => $options{city}     || $self->city,
2399     'state'    => $options{state}    || $self->state,
2400     'zip'      => $options{zip}      || $self->zip,
2401     'country'  => $options{country}  || $self->country,
2402     'payby'    => $options{payby}    || $self->payby,
2403     'payinfo'  => $options{payinfo}  || $self->payinfo,
2404     'exp'      => $options{paydate}  || $self->paydate,
2405     'payname'  => $options{payname}  || $self->payname,
2406     'amount'   => $amount,                         # consolidating
2407   } );
2408
2409   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
2410     if $old_cust_pay_batch;
2411
2412   my $error;
2413   if ($old_cust_pay_batch) {
2414     $error = $cust_pay_batch->replace($old_cust_pay_batch)
2415   } else {
2416     $error = $cust_pay_batch->insert;
2417   }
2418
2419   if ( $error ) {
2420     $dbh->rollback if $oldAutoCommit;
2421     die $error;
2422   }
2423
2424   my $unapplied =   $self->total_unapplied_credits
2425                   + $self->total_unapplied_payments
2426                   + $self->in_transit_payments;
2427   foreach my $cust_bill ($self->open_cust_bill) {
2428     #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
2429     my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
2430       'invnum' => $cust_bill->invnum,
2431       'paybatchnum' => $cust_pay_batch->paybatchnum,
2432       'amount' => $cust_bill->owed,
2433       '_date' => time,
2434     };
2435     if ($unapplied >= $cust_bill_pay_batch->amount){
2436       $unapplied -= $cust_bill_pay_batch->amount;
2437       next;
2438     }else{
2439       $cust_bill_pay_batch->amount(sprintf ( "%.2f",
2440                                    $cust_bill_pay_batch->amount - $unapplied ));      $unapplied = 0;
2441     }
2442     $error = $cust_bill_pay_batch->insert;
2443     if ( $error ) {
2444       $dbh->rollback if $oldAutoCommit;
2445       die $error;
2446     }
2447   }
2448
2449   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2450   '';
2451 }
2452
2453 =item total_owed
2454
2455 Returns the total owed for this customer on all invoices
2456 (see L<FS::cust_bill/owed>).
2457
2458 =cut
2459
2460 sub total_owed {
2461   my $self = shift;
2462   $self->total_owed_date(2145859200); #12/31/2037
2463 }
2464
2465 =item total_owed_date TIME
2466
2467 Returns the total owed for this customer on all invoices with date earlier than
2468 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2469 see L<Time::Local> and L<Date::Parse> for conversion functions.
2470
2471 =cut
2472
2473 sub total_owed_date {
2474   my $self = shift;
2475   my $time = shift;
2476
2477   my $custnum = $self->custnum;
2478
2479   my $owed_sql = FS::cust_bill->owed_sql;
2480
2481   my $sql = "
2482     SELECT SUM($owed_sql) FROM cust_bill
2483       WHERE custnum = $custnum
2484         AND _date <= $time
2485   ";
2486
2487   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2488
2489 }
2490
2491 =item total_owed_pkgnum PKGNUM
2492
2493 Returns the total owed on all invoices for this customer's specific package
2494 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2495
2496 =cut
2497
2498 sub total_owed_pkgnum {
2499   my( $self, $pkgnum ) = @_;
2500   $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2501 }
2502
2503 =item total_owed_date_pkgnum TIME PKGNUM
2504
2505 Returns the total owed for this customer's specific package when using
2506 experimental package balances on all invoices with date earlier than
2507 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2508 see L<Time::Local> and L<Date::Parse> for conversion functions.
2509
2510 =cut
2511
2512 sub total_owed_date_pkgnum {
2513   my( $self, $time, $pkgnum ) = @_;
2514
2515   my $total_bill = 0;
2516   foreach my $cust_bill (
2517     grep { $_->_date <= $time }
2518       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2519   ) {
2520     $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2521   }
2522   sprintf( "%.2f", $total_bill );
2523
2524 }
2525
2526 =item total_paid
2527
2528 Returns the total amount of all payments.
2529
2530 =cut
2531
2532 sub total_paid {
2533   my $self = shift;
2534   my $total = 0;
2535   $total += $_->paid foreach $self->cust_pay;
2536   sprintf( "%.2f", $total );
2537 }
2538
2539 =item total_unapplied_credits
2540
2541 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2542 customer.  See L<FS::cust_credit/credited>.
2543
2544 =item total_credited
2545
2546 Old name for total_unapplied_credits.  Don't use.
2547
2548 =cut
2549
2550 sub total_credited {
2551   #carp "total_credited deprecated, use total_unapplied_credits";
2552   shift->total_unapplied_credits(@_);
2553 }
2554
2555 sub total_unapplied_credits {
2556   my $self = shift;
2557
2558   my $custnum = $self->custnum;
2559
2560   my $unapplied_sql = FS::cust_credit->unapplied_sql;
2561
2562   my $sql = "
2563     SELECT SUM($unapplied_sql) FROM cust_credit
2564       WHERE custnum = $custnum
2565   ";
2566
2567   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2568
2569 }
2570
2571 =item total_unapplied_credits_pkgnum PKGNUM
2572
2573 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2574 customer.  See L<FS::cust_credit/credited>.
2575
2576 =cut
2577
2578 sub total_unapplied_credits_pkgnum {
2579   my( $self, $pkgnum ) = @_;
2580   my $total_credit = 0;
2581   $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2582   sprintf( "%.2f", $total_credit );
2583 }
2584
2585
2586 =item total_unapplied_payments
2587
2588 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2589 See L<FS::cust_pay/unapplied>.
2590
2591 =cut
2592
2593 sub total_unapplied_payments {
2594   my $self = shift;
2595
2596   my $custnum = $self->custnum;
2597
2598   my $unapplied_sql = FS::cust_pay->unapplied_sql;
2599
2600   my $sql = "
2601     SELECT SUM($unapplied_sql) FROM cust_pay
2602       WHERE custnum = $custnum
2603   ";
2604
2605   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2606
2607 }
2608
2609 =item total_unapplied_payments_pkgnum PKGNUM
2610
2611 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2612 specific package when using experimental package balances.  See
2613 L<FS::cust_pay/unapplied>.
2614
2615 =cut
2616
2617 sub total_unapplied_payments_pkgnum {
2618   my( $self, $pkgnum ) = @_;
2619   my $total_unapplied = 0;
2620   $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2621   sprintf( "%.2f", $total_unapplied );
2622 }
2623
2624
2625 =item total_unapplied_refunds
2626
2627 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2628 customer.  See L<FS::cust_refund/unapplied>.
2629
2630 =cut
2631
2632 sub total_unapplied_refunds {
2633   my $self = shift;
2634   my $custnum = $self->custnum;
2635
2636   my $unapplied_sql = FS::cust_refund->unapplied_sql;
2637
2638   my $sql = "
2639     SELECT SUM($unapplied_sql) FROM cust_refund
2640       WHERE custnum = $custnum
2641   ";
2642
2643   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2644
2645 }
2646
2647 =item balance
2648
2649 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2650 total_unapplied_credits minus total_unapplied_payments).
2651
2652 =cut
2653
2654 sub balance {
2655   my $self = shift;
2656   $self->balance_date_range;
2657 }
2658
2659 =item balance_date TIME
2660
2661 Returns the balance for this customer, only considering invoices with date
2662 earlier than TIME (total_owed_date minus total_credited minus
2663 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
2664 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
2665 functions.
2666
2667 =cut
2668
2669 sub balance_date {
2670   my $self = shift;
2671   $self->balance_date_range(shift);
2672 }
2673
2674 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2675
2676 Returns the balance for this customer, optionally considering invoices with
2677 date earlier than START_TIME, and not later than END_TIME
2678 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2679
2680 Times are specified as SQL fragments or numeric
2681 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
2682 L<Date::Parse> for conversion functions.  The empty string can be passed
2683 to disable that time constraint completely.
2684
2685 Available options are:
2686
2687 =over 4
2688
2689 =item unapplied_date
2690
2691 set to true to disregard unapplied credits, payments and refunds outside the specified time period - by default the time period restriction only applies to invoices (useful for reporting, probably a bad idea for event triggering)
2692
2693 =back
2694
2695 =cut
2696
2697 sub balance_date_range {
2698   my $self = shift;
2699   my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2700             ') FROM cust_main WHERE custnum='. $self->custnum;
2701   sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2702 }
2703
2704 =item balance_pkgnum PKGNUM
2705
2706 Returns the balance for this customer's specific package when using
2707 experimental package balances (total_owed plus total_unrefunded, minus
2708 total_unapplied_credits minus total_unapplied_payments)
2709
2710 =cut
2711
2712 sub balance_pkgnum {
2713   my( $self, $pkgnum ) = @_;
2714
2715   sprintf( "%.2f",
2716       $self->total_owed_pkgnum($pkgnum)
2717 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2718 #    + $self->total_unapplied_refunds_pkgnum($pkgnum)
2719     - $self->total_unapplied_credits_pkgnum($pkgnum)
2720     - $self->total_unapplied_payments_pkgnum($pkgnum)
2721   );
2722 }
2723
2724 =item in_transit_payments
2725
2726 Returns the total of requests for payments for this customer pending in
2727 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
2728
2729 =cut
2730
2731 sub in_transit_payments {
2732   my $self = shift;
2733   my $in_transit_payments = 0;
2734   foreach my $pay_batch ( qsearch('pay_batch', {
2735     'status' => 'I',
2736   } ) ) {
2737     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
2738       'batchnum' => $pay_batch->batchnum,
2739       'custnum' => $self->custnum,
2740     } ) ) {
2741       $in_transit_payments += $cust_pay_batch->amount;
2742     }
2743   }
2744   sprintf( "%.2f", $in_transit_payments );
2745 }
2746
2747 =item payment_info
2748
2749 Returns a hash of useful information for making a payment.
2750
2751 =over 4
2752
2753 =item balance
2754
2755 Current balance.
2756
2757 =item payby
2758
2759 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2760 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2761 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2762
2763 =back
2764
2765 For credit card transactions:
2766
2767 =over 4
2768
2769 =item card_type 1
2770
2771 =item payname
2772
2773 Exact name on card
2774
2775 =back
2776
2777 For electronic check transactions:
2778
2779 =over 4
2780
2781 =item stateid_state
2782
2783 =back
2784
2785 =cut
2786
2787 sub payment_info {
2788   my $self = shift;
2789
2790   my %return = ();
2791
2792   $return{balance} = $self->balance;
2793
2794   $return{payname} = $self->payname
2795                      || ( $self->first. ' '. $self->get('last') );
2796
2797   $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
2798
2799   $return{payby} = $self->payby;
2800   $return{stateid_state} = $self->stateid_state;
2801
2802   if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
2803     $return{card_type} = cardtype($self->payinfo);
2804     $return{payinfo} = $self->paymask;
2805
2806     @return{'month', 'year'} = $self->paydate_monthyear;
2807
2808   }
2809
2810   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2811     my ($payinfo1, $payinfo2) = split '@', $self->paymask;
2812     $return{payinfo1} = $payinfo1;
2813     $return{payinfo2} = $payinfo2;
2814     $return{paytype}  = $self->paytype;
2815     $return{paystate} = $self->paystate;
2816
2817   }
2818
2819   #doubleclick protection
2820   my $_date = time;
2821   $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
2822
2823   %return;
2824
2825 }
2826
2827 =item paydate_monthyear
2828
2829 Returns a two-element list consisting of the month and year of this customer's
2830 paydate (credit card expiration date for CARD customers)
2831
2832 =cut
2833
2834 sub paydate_monthyear {
2835   my $self = shift;
2836   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2837     ( $2, $1 );
2838   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2839     ( $1, $3 );
2840   } else {
2841     ('', '');
2842   }
2843 }
2844
2845 =item tax_exemption TAXNAME
2846
2847 =cut
2848
2849 sub tax_exemption {
2850   my( $self, $taxname ) = @_;
2851
2852   qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
2853                                      'taxname' => $taxname,
2854                                    },
2855           );
2856 }
2857
2858 =item cust_main_exemption
2859
2860 =cut
2861
2862 sub cust_main_exemption {
2863   my $self = shift;
2864   qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
2865 }
2866
2867 =item invoicing_list [ ARRAYREF ]
2868
2869 If an arguement is given, sets these email addresses as invoice recipients
2870 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
2871 (except as warnings), so use check_invoicing_list first.
2872
2873 Returns a list of email addresses (with svcnum entries expanded).
2874
2875 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
2876 check it without disturbing anything by passing nothing.
2877
2878 This interface may change in the future.
2879
2880 =cut
2881
2882 sub invoicing_list {
2883   my( $self, $arrayref ) = @_;
2884
2885   if ( $arrayref ) {
2886     my @cust_main_invoice;
2887     if ( $self->custnum ) {
2888       @cust_main_invoice =
2889         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2890     } else {
2891       @cust_main_invoice = ();
2892     }
2893     foreach my $cust_main_invoice ( @cust_main_invoice ) {
2894       #warn $cust_main_invoice->destnum;
2895       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2896         #warn $cust_main_invoice->destnum;
2897         my $error = $cust_main_invoice->delete;
2898         warn $error if $error;
2899       }
2900     }
2901     if ( $self->custnum ) {
2902       @cust_main_invoice =
2903         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2904     } else {
2905       @cust_main_invoice = ();
2906     }
2907     my %seen = map { $_->address => 1 } @cust_main_invoice;
2908     foreach my $address ( @{$arrayref} ) {
2909       next if exists $seen{$address} && $seen{$address};
2910       $seen{$address} = 1;
2911       my $cust_main_invoice = new FS::cust_main_invoice ( {
2912         'custnum' => $self->custnum,
2913         'dest'    => $address,
2914       } );
2915       my $error = $cust_main_invoice->insert;
2916       warn $error if $error;
2917     }
2918   }
2919
2920   if ( $self->custnum ) {
2921     map { $_->address }
2922       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2923   } else {
2924     ();
2925   }
2926
2927 }
2928
2929 =item check_invoicing_list ARRAYREF
2930
2931 Checks these arguements as valid input for the invoicing_list method.  If there
2932 is an error, returns the error, otherwise returns false.
2933
2934 =cut
2935
2936 sub check_invoicing_list {
2937   my( $self, $arrayref ) = @_;
2938
2939   foreach my $address ( @$arrayref ) {
2940
2941     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
2942       return 'Can\'t add FAX invoice destination with a blank FAX number.';
2943     }
2944
2945     my $cust_main_invoice = new FS::cust_main_invoice ( {
2946       'custnum' => $self->custnum,
2947       'dest'    => $address,
2948     } );
2949     my $error = $self->custnum
2950                 ? $cust_main_invoice->check
2951                 : $cust_main_invoice->checkdest
2952     ;
2953     return $error if $error;
2954
2955   }
2956
2957   return "Email address required"
2958     if $conf->exists('cust_main-require_invoicing_list_email')
2959     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
2960
2961   '';
2962 }
2963
2964 =item set_default_invoicing_list
2965
2966 Sets the invoicing list to all accounts associated with this customer,
2967 overwriting any previous invoicing list.
2968
2969 =cut
2970
2971 sub set_default_invoicing_list {
2972   my $self = shift;
2973   $self->invoicing_list($self->all_emails);
2974 }
2975
2976 =item all_emails
2977
2978 Returns the email addresses of all accounts provisioned for this customer.
2979
2980 =cut
2981
2982 sub all_emails {
2983   my $self = shift;
2984   my %list;
2985   foreach my $cust_pkg ( $self->all_pkgs ) {
2986     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2987     my @svc_acct =
2988       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2989         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2990           @cust_svc;
2991     $list{$_}=1 foreach map { $_->email } @svc_acct;
2992   }
2993   keys %list;
2994 }
2995
2996 =item invoicing_list_addpost
2997
2998 Adds postal invoicing to this customer.  If this customer is already configured
2999 to receive postal invoices, does nothing.
3000
3001 =cut
3002
3003 sub invoicing_list_addpost {
3004   my $self = shift;
3005   return if grep { $_ eq 'POST' } $self->invoicing_list;
3006   my @invoicing_list = $self->invoicing_list;
3007   push @invoicing_list, 'POST';
3008   $self->invoicing_list(\@invoicing_list);
3009 }
3010
3011 =item invoicing_list_emailonly
3012
3013 Returns the list of email invoice recipients (invoicing_list without non-email
3014 destinations such as POST and FAX).
3015
3016 =cut
3017
3018 sub invoicing_list_emailonly {
3019   my $self = shift;
3020   warn "$me invoicing_list_emailonly called"
3021     if $DEBUG;
3022   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3023 }
3024
3025 =item invoicing_list_emailonly_scalar
3026
3027 Returns the list of email invoice recipients (invoicing_list without non-email
3028 destinations such as POST and FAX) as a comma-separated scalar.
3029
3030 =cut
3031
3032 sub invoicing_list_emailonly_scalar {
3033   my $self = shift;
3034   warn "$me invoicing_list_emailonly_scalar called"
3035     if $DEBUG;
3036   join(', ', $self->invoicing_list_emailonly);
3037 }
3038
3039 =item referral_custnum_cust_main
3040
3041 Returns the customer who referred this customer (or the empty string, if
3042 this customer was not referred).
3043
3044 Note the difference with referral_cust_main method: This method,
3045 referral_custnum_cust_main returns the single customer (if any) who referred
3046 this customer, while referral_cust_main returns an array of customers referred
3047 BY this customer.
3048
3049 =cut
3050
3051 sub referral_custnum_cust_main {
3052   my $self = shift;
3053   return '' unless $self->referral_custnum;
3054   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3055 }
3056
3057 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3058
3059 Returns an array of customers referred by this customer (referral_custnum set
3060 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
3061 customers referred by customers referred by this customer and so on, inclusive.
3062 The default behavior is DEPTH 1 (no recursion).
3063
3064 Note the difference with referral_custnum_cust_main method: This method,
3065 referral_cust_main, returns an array of customers referred BY this customer,
3066 while referral_custnum_cust_main returns the single customer (if any) who
3067 referred this customer.
3068
3069 =cut
3070
3071 sub referral_cust_main {
3072   my $self = shift;
3073   my $depth = @_ ? shift : 1;
3074   my $exclude = @_ ? shift : {};
3075
3076   my @cust_main =
3077     map { $exclude->{$_->custnum}++; $_; }
3078       grep { ! $exclude->{ $_->custnum } }
3079         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3080
3081   if ( $depth > 1 ) {
3082     push @cust_main,
3083       map { $_->referral_cust_main($depth-1, $exclude) }
3084         @cust_main;
3085   }
3086
3087   @cust_main;
3088 }
3089
3090 =item referral_cust_main_ncancelled
3091
3092 Same as referral_cust_main, except only returns customers with uncancelled
3093 packages.
3094
3095 =cut
3096
3097 sub referral_cust_main_ncancelled {
3098   my $self = shift;
3099   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3100 }
3101
3102 =item referral_cust_pkg [ DEPTH ]
3103
3104 Like referral_cust_main, except returns a flat list of all unsuspended (and
3105 uncancelled) packages for each customer.  The number of items in this list may
3106 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3107
3108 =cut
3109
3110 sub referral_cust_pkg {
3111   my $self = shift;
3112   my $depth = @_ ? shift : 1;
3113
3114   map { $_->unsuspended_pkgs }
3115     grep { $_->unsuspended_pkgs }
3116       $self->referral_cust_main($depth);
3117 }
3118
3119 =item referring_cust_main
3120
3121 Returns the single cust_main record for the customer who referred this customer
3122 (referral_custnum), or false.
3123
3124 =cut
3125
3126 sub referring_cust_main {
3127   my $self = shift;
3128   return '' unless $self->referral_custnum;
3129   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3130 }
3131
3132 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3133
3134 Applies a credit to this customer.  If there is an error, returns the error,
3135 otherwise returns false.
3136
3137 REASON can be a text string, an FS::reason object, or a scalar reference to
3138 a reasonnum.  If a text string, it will be automatically inserted as a new
3139 reason, and a 'reason_type' option must be passed to indicate the
3140 FS::reason_type for the new reason.
3141
3142 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3143
3144 Any other options are passed to FS::cust_credit::insert.
3145
3146 =cut
3147
3148 sub credit {
3149   my( $self, $amount, $reason, %options ) = @_;
3150
3151   my $cust_credit = new FS::cust_credit {
3152     'custnum' => $self->custnum,
3153     'amount'  => $amount,
3154   };
3155
3156   if ( ref($reason) ) {
3157
3158     if ( ref($reason) eq 'SCALAR' ) {
3159       $cust_credit->reasonnum( $$reason );
3160     } else {
3161       $cust_credit->reasonnum( $reason->reasonnum );
3162     }
3163
3164   } else {
3165     $cust_credit->set('reason', $reason)
3166   }
3167
3168   for (qw( addlinfo eventnum )) {
3169     $cust_credit->$_( delete $options{$_} )
3170       if exists($options{$_});
3171   }
3172
3173   $cust_credit->insert(%options);
3174
3175 }
3176
3177 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3178
3179 Creates a one-time charge for this customer.  If there is an error, returns
3180 the error, otherwise returns false.
3181
3182 New-style, with a hashref of options:
3183
3184   my $error = $cust_main->charge(
3185                                   {
3186                                     'amount'     => 54.32,
3187                                     'quantity'   => 1,
3188                                     'start_date' => str2time('7/4/2009'),
3189                                     'pkg'        => 'Description',
3190                                     'comment'    => 'Comment',
3191                                     'additional' => [], #extra invoice detail
3192                                     'classnum'   => 1,  #pkg_class
3193
3194                                     'setuptax'   => '', # or 'Y' for tax exempt
3195
3196                                     #internal taxation
3197                                     'taxclass'   => 'Tax class',
3198
3199                                     #vendor taxation
3200                                     'taxproduct' => 2,  #part_pkg_taxproduct
3201                                     'override'   => {}, #XXX describe
3202
3203                                     #will be filled in with the new object
3204                                     'cust_pkg_ref' => \$cust_pkg,
3205
3206                                     #generate an invoice immediately
3207                                     'bill_now' => 0,
3208                                     'invoice_terms' => '', #with these terms
3209                                   }
3210                                 );
3211
3212 Old-style:
3213
3214   my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3215
3216 =cut
3217
3218 sub charge {
3219   my $self = shift;
3220   my ( $amount, $quantity, $start_date, $classnum );
3221   my ( $pkg, $comment, $additional );
3222   my ( $setuptax, $taxclass );   #internal taxes
3223   my ( $taxproduct, $override ); #vendor (CCH) taxes
3224   my $no_auto = '';
3225   my $cust_pkg_ref = '';
3226   my ( $bill_now, $invoice_terms ) = ( 0, '' );
3227   if ( ref( $_[0] ) ) {
3228     $amount     = $_[0]->{amount};
3229     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3230     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3231     $no_auto    = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3232     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3233     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
3234                                            : '$'. sprintf("%.2f",$amount);
3235     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3236     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3237     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3238     $additional = $_[0]->{additional} || [];
3239     $taxproduct = $_[0]->{taxproductnum};
3240     $override   = { '' => $_[0]->{tax_override} };
3241     $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3242     $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3243     $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3244   } else {
3245     $amount     = shift;
3246     $quantity   = 1;
3247     $start_date = '';
3248     $pkg        = @_ ? shift : 'One-time charge';
3249     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
3250     $setuptax   = '';
3251     $taxclass   = @_ ? shift : '';
3252     $additional = [];
3253   }
3254
3255   local $SIG{HUP} = 'IGNORE';
3256   local $SIG{INT} = 'IGNORE';
3257   local $SIG{QUIT} = 'IGNORE';
3258   local $SIG{TERM} = 'IGNORE';
3259   local $SIG{TSTP} = 'IGNORE';
3260   local $SIG{PIPE} = 'IGNORE';
3261
3262   my $oldAutoCommit = $FS::UID::AutoCommit;
3263   local $FS::UID::AutoCommit = 0;
3264   my $dbh = dbh;
3265
3266   my $part_pkg = new FS::part_pkg ( {
3267     'pkg'           => $pkg,
3268     'comment'       => $comment,
3269     'plan'          => 'flat',
3270     'freq'          => 0,
3271     'disabled'      => 'Y',
3272     'classnum'      => ( $classnum ? $classnum : '' ),
3273     'setuptax'      => $setuptax,
3274     'taxclass'      => $taxclass,
3275     'taxproductnum' => $taxproduct,
3276   } );
3277
3278   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3279                         ( 0 .. @$additional - 1 )
3280                   ),
3281                   'additional_count' => scalar(@$additional),
3282                   'setup_fee' => $amount,
3283                 );
3284
3285   my $error = $part_pkg->insert( options       => \%options,
3286                                  tax_overrides => $override,
3287                                );
3288   if ( $error ) {
3289     $dbh->rollback if $oldAutoCommit;
3290     return $error;
3291   }
3292
3293   my $pkgpart = $part_pkg->pkgpart;
3294   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3295   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3296     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3297     $error = $type_pkgs->insert;
3298     if ( $error ) {
3299       $dbh->rollback if $oldAutoCommit;
3300       return $error;
3301     }
3302   }
3303
3304   my $cust_pkg = new FS::cust_pkg ( {
3305     'custnum'    => $self->custnum,
3306     'pkgpart'    => $pkgpart,
3307     'quantity'   => $quantity,
3308     'start_date' => $start_date,
3309     'no_auto'    => $no_auto,
3310   } );
3311
3312   $error = $cust_pkg->insert;
3313   if ( $error ) {
3314     $dbh->rollback if $oldAutoCommit;
3315     return $error;
3316   } elsif ( $cust_pkg_ref ) {
3317     ${$cust_pkg_ref} = $cust_pkg;
3318   }
3319
3320   if ( $bill_now ) {
3321     my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3322                              'pkg_list'      => [ $cust_pkg ],
3323                            );
3324     if ( $error ) {
3325       $dbh->rollback if $oldAutoCommit;
3326       return $error;
3327     }
3328   }
3329
3330   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3331   return '';
3332
3333 }
3334
3335 #=item charge_postal_fee
3336 #
3337 #Applies a one time charge this customer.  If there is an error,
3338 #returns the error, returns the cust_pkg charge object or false
3339 #if there was no charge.
3340 #
3341 #=cut
3342 #
3343 # This should be a customer event.  For that to work requires that bill
3344 # also be a customer event.
3345
3346 sub charge_postal_fee {
3347   my $self = shift;
3348
3349   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
3350   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3351
3352   my $cust_pkg = new FS::cust_pkg ( {
3353     'custnum'  => $self->custnum,
3354     'pkgpart'  => $pkgpart,
3355     'quantity' => 1,
3356   } );
3357
3358   my $error = $cust_pkg->insert;
3359   $error ? $error : $cust_pkg;
3360 }
3361
3362 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3363
3364 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3365
3366 Optionally, a list or hashref of additional arguments to the qsearch call can
3367 be passed.
3368
3369 =cut
3370
3371 sub cust_bill {
3372   my $self = shift;
3373   my $opt = ref($_[0]) ? shift : { @_ };
3374
3375   #return $self->num_cust_bill unless wantarray || keys %$opt;
3376
3377   $opt->{'table'} = 'cust_bill';
3378   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3379   $opt->{'hashref'}{'custnum'} = $self->custnum;
3380   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3381
3382   map { $_ } #behavior of sort undefined in scalar context
3383     sort { $a->_date <=> $b->_date }
3384       qsearch($opt);
3385 }
3386
3387 =item open_cust_bill
3388
3389 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3390 customer.
3391
3392 =cut
3393
3394 sub open_cust_bill {
3395   my $self = shift;
3396
3397   $self->cust_bill(
3398     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3399     #@_
3400   );
3401
3402 }
3403
3404 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3405
3406 Returns all the statements (see L<FS::cust_statement>) for this customer.
3407
3408 Optionally, a list or hashref of additional arguments to the qsearch call can
3409 be passed.
3410
3411 =cut
3412
3413 sub cust_statement {
3414   my $self = shift;
3415   my $opt = ref($_[0]) ? shift : { @_ };
3416
3417   #return $self->num_cust_statement unless wantarray || keys %$opt;
3418
3419   $opt->{'table'} = 'cust_statement';
3420   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3421   $opt->{'hashref'}{'custnum'} = $self->custnum;
3422   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3423
3424   map { $_ } #behavior of sort undefined in scalar context
3425     sort { $a->_date <=> $b->_date }
3426       qsearch($opt);
3427 }
3428
3429 =item cust_credit
3430
3431 Returns all the credits (see L<FS::cust_credit>) for this customer.
3432
3433 =cut
3434
3435 sub cust_credit {
3436   my $self = shift;
3437   map { $_ } #return $self->num_cust_credit unless wantarray;
3438   sort { $a->_date <=> $b->_date }
3439     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3440 }
3441
3442 =item cust_credit_pkgnum
3443
3444 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3445 package when using experimental package balances.
3446
3447 =cut
3448
3449 sub cust_credit_pkgnum {
3450   my( $self, $pkgnum ) = @_;
3451   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3452   sort { $a->_date <=> $b->_date }
3453     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3454                               'pkgnum'  => $pkgnum,
3455                             }
3456     );
3457 }
3458
3459 =item cust_pay
3460
3461 Returns all the payments (see L<FS::cust_pay>) for this customer.
3462
3463 =cut
3464
3465 sub cust_pay {
3466   my $self = shift;
3467   return $self->num_cust_pay unless wantarray;
3468   sort { $a->_date <=> $b->_date }
3469     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3470 }
3471
3472 =item num_cust_pay
3473
3474 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
3475 called automatically when the cust_pay method is used in a scalar context.
3476
3477 =cut
3478
3479 sub num_cust_pay {
3480   my $self = shift;
3481   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3482   my $sth = dbh->prepare($sql) or die dbh->errstr;
3483   $sth->execute($self->custnum) or die $sth->errstr;
3484   $sth->fetchrow_arrayref->[0];
3485 }
3486
3487 =item cust_pay_pkgnum
3488
3489 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3490 package when using experimental package balances.
3491
3492 =cut
3493
3494 sub cust_pay_pkgnum {
3495   my( $self, $pkgnum ) = @_;
3496   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3497   sort { $a->_date <=> $b->_date }
3498     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3499                            'pkgnum'  => $pkgnum,
3500                          }
3501     );
3502 }
3503
3504 =item cust_pay_void
3505
3506 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3507
3508 =cut
3509
3510 sub cust_pay_void {
3511   my $self = shift;
3512   map { $_ } #return $self->num_cust_pay_void unless wantarray;
3513   sort { $a->_date <=> $b->_date }
3514     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3515 }
3516
3517 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3518
3519 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
3520
3521 Optionally, a list or hashref of additional arguments to the qsearch call can
3522 be passed.
3523
3524 =cut
3525
3526 sub cust_pay_batch {
3527   my $self = shift;
3528   my $opt = ref($_[0]) ? shift : { @_ };
3529
3530   #return $self->num_cust_statement unless wantarray || keys %$opt;
3531
3532   $opt->{'table'} = 'cust_pay_batch';
3533   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3534   $opt->{'hashref'}{'custnum'} = $self->custnum;
3535   $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
3536
3537   map { $_ } #behavior of sort undefined in scalar context
3538     sort { $a->paybatchnum <=> $b->paybatchnum }
3539       qsearch($opt);
3540 }
3541
3542 =item cust_pay_pending
3543
3544 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3545 (without status "done").
3546
3547 =cut
3548
3549 sub cust_pay_pending {
3550   my $self = shift;
3551   return $self->num_cust_pay_pending unless wantarray;
3552   sort { $a->_date <=> $b->_date }
3553     qsearch( 'cust_pay_pending', {
3554                                    'custnum' => $self->custnum,
3555                                    'status'  => { op=>'!=', value=>'done' },
3556                                  },
3557            );
3558 }
3559
3560 =item cust_pay_pending_attempt
3561
3562 Returns all payment attempts / declined payments for this customer, as pending
3563 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3564 a corresponding payment (see L<FS::cust_pay>).
3565
3566 =cut
3567
3568 sub cust_pay_pending_attempt {
3569   my $self = shift;
3570   return $self->num_cust_pay_pending_attempt unless wantarray;
3571   sort { $a->_date <=> $b->_date }
3572     qsearch( 'cust_pay_pending', {
3573                                    'custnum' => $self->custnum,
3574                                    'status'  => 'done',
3575                                    'paynum'  => '',
3576                                  },
3577            );
3578 }
3579
3580 =item num_cust_pay_pending
3581
3582 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3583 customer (without status "done").  Also called automatically when the
3584 cust_pay_pending method is used in a scalar context.
3585
3586 =cut
3587
3588 sub num_cust_pay_pending {
3589   my $self = shift;
3590   $self->scalar_sql(
3591     " SELECT COUNT(*) FROM cust_pay_pending ".
3592       " WHERE custnum = ? AND status != 'done' ",
3593     $self->custnum
3594   );
3595 }
3596
3597 =item num_cust_pay_pending_attempt
3598
3599 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3600 customer, with status "done" but without a corresp.  Also called automatically when the
3601 cust_pay_pending method is used in a scalar context.
3602
3603 =cut
3604
3605 sub num_cust_pay_pending_attempt {
3606   my $self = shift;
3607   $self->scalar_sql(
3608     " SELECT COUNT(*) FROM cust_pay_pending ".
3609       " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3610     $self->custnum
3611   );
3612 }
3613
3614 =item cust_refund
3615
3616 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3617
3618 =cut
3619
3620 sub cust_refund {
3621   my $self = shift;
3622   map { $_ } #return $self->num_cust_refund unless wantarray;
3623   sort { $a->_date <=> $b->_date }
3624     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3625 }
3626
3627 =item display_custnum
3628
3629 Returns the displayed customer number for this customer: agent_custid if
3630 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3631
3632 =cut
3633
3634 sub display_custnum {
3635   my $self = shift;
3636   if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
3637     return $self->agent_custid;
3638   } else {
3639     return $self->custnum;
3640   }
3641 }
3642
3643 =item name
3644
3645 Returns a name string for this customer, either "Company (Last, First)" or
3646 "Last, First".
3647
3648 =cut
3649
3650 sub name {
3651   my $self = shift;
3652   my $name = $self->contact;
3653   $name = $self->company. " ($name)" if $self->company;
3654   $name;
3655 }
3656
3657 =item ship_name
3658
3659 Returns a name string for this (service/shipping) contact, either
3660 "Company (Last, First)" or "Last, First".
3661
3662 =cut
3663
3664 sub ship_name {
3665   my $self = shift;
3666   if ( $self->get('ship_last') ) {
3667     my $name = $self->ship_contact;
3668     $name = $self->ship_company. " ($name)" if $self->ship_company;
3669     $name;
3670   } else {
3671     $self->name;
3672   }
3673 }
3674
3675 =item name_short
3676
3677 Returns a name string for this customer, either "Company" or "First Last".
3678
3679 =cut
3680
3681 sub name_short {
3682   my $self = shift;
3683   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
3684 }
3685
3686 =item ship_name_short
3687
3688 Returns a name string for this (service/shipping) contact, either "Company"
3689 or "First Last".
3690
3691 =cut
3692
3693 sub ship_name_short {
3694   my $self = shift;
3695   if ( $self->get('ship_last') ) {
3696     $self->ship_company !~ /^\s*$/
3697       ? $self->ship_company
3698       : $self->ship_contact_firstlast;
3699   } else {
3700     $self->name_company_or_firstlast;
3701   }
3702 }
3703
3704 =item contact
3705
3706 Returns this customer's full (billing) contact name only, "Last, First"
3707
3708 =cut
3709
3710 sub contact {
3711   my $self = shift;
3712   $self->get('last'). ', '. $self->first;
3713 }
3714
3715 =item ship_contact
3716
3717 Returns this customer's full (shipping) contact name only, "Last, First"
3718
3719 =cut
3720
3721 sub ship_contact {
3722   my $self = shift;
3723   $self->get('ship_last')
3724     ? $self->get('ship_last'). ', '. $self->ship_first
3725     : $self->contact;
3726 }
3727
3728 =item contact_firstlast
3729
3730 Returns this customers full (billing) contact name only, "First Last".
3731
3732 =cut
3733
3734 sub contact_firstlast {
3735   my $self = shift;
3736   $self->first. ' '. $self->get('last');
3737 }
3738
3739 =item ship_contact_firstlast
3740
3741 Returns this customer's full (shipping) contact name only, "First Last".
3742
3743 =cut
3744
3745 sub ship_contact_firstlast {
3746   my $self = shift;
3747   $self->get('ship_last')
3748     ? $self->first. ' '. $self->get('ship_last')
3749     : $self->contact_firstlast;
3750 }
3751
3752 =item country_full
3753
3754 Returns this customer's full country name
3755
3756 =cut
3757
3758 sub country_full {
3759   my $self = shift;
3760   code2country($self->country);
3761 }
3762
3763 =item geocode DATA_VENDOR
3764
3765 Returns a value for the customer location as encoded by DATA_VENDOR.
3766 Currently this only makes sense for "CCH" as DATA_VENDOR.
3767
3768 =cut
3769
3770 =item cust_status
3771
3772 =item status
3773
3774 Returns a status string for this customer, currently:
3775
3776 =over 4
3777
3778 =item prospect - No packages have ever been ordered
3779
3780 =item ordered - Recurring packages all are new (not yet billed).
3781
3782 =item active - One or more recurring packages is active
3783
3784 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
3785
3786 =item suspended - All non-cancelled recurring packages are suspended
3787
3788 =item cancelled - All recurring packages are cancelled
3789
3790 =back
3791
3792 =cut
3793
3794 sub status { shift->cust_status(@_); }
3795
3796 sub cust_status {
3797   my $self = shift;
3798   for my $status ( FS::cust_main->statuses() ) {
3799     my $method = $status.'_sql';
3800     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3801     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3802     $sth->execute( ($self->custnum) x $numnum )
3803       or die "Error executing 'SELECT $sql': ". $sth->errstr;
3804     return $status if $sth->fetchrow_arrayref->[0];
3805   }
3806 }
3807
3808 =item ucfirst_cust_status
3809
3810 =item ucfirst_status
3811
3812 Returns the status with the first character capitalized.
3813
3814 =cut
3815
3816 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
3817
3818 sub ucfirst_cust_status {
3819   my $self = shift;
3820   ucfirst($self->cust_status);
3821 }
3822
3823 =item statuscolor
3824
3825 Returns a hex triplet color string for this customer's status.
3826
3827 =cut
3828
3829 use vars qw(%statuscolor);
3830 tie %statuscolor, 'Tie::IxHash',
3831   'prospect'  => '7e0079', #'000000', #black?  naw, purple
3832   'active'    => '00CC00', #green
3833   'ordered'   => '009999', #teal? cyan?
3834   'suspended' => 'FF9900', #yellow
3835   'cancelled' => 'FF0000', #red
3836   'inactive'  => '0000CC', #blue
3837 ;
3838
3839 sub statuscolor { shift->cust_statuscolor(@_); }
3840
3841 sub cust_statuscolor {
3842   my $self = shift;
3843   $statuscolor{$self->cust_status};
3844 }
3845
3846 =item tickets
3847
3848 Returns an array of hashes representing the customer's RT tickets.
3849
3850 =cut
3851
3852 sub tickets {
3853   my $self = shift;
3854
3855   my $num = $conf->config('cust_main-max_tickets') || 10;
3856   my @tickets = ();
3857
3858   if ( $conf->config('ticket_system') ) {
3859     unless ( $conf->config('ticket_system-custom_priority_field') ) {
3860
3861       @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
3862
3863     } else {
3864
3865       foreach my $priority (
3866         $conf->config('ticket_system-custom_priority_field-values'), ''
3867       ) {
3868         last if scalar(@tickets) >= $num;
3869         push @tickets,
3870           @{ FS::TicketSystem->customer_tickets( $self->custnum,
3871                                                  $num - scalar(@tickets),
3872                                                  $priority,
3873                                                )
3874            };
3875       }
3876     }
3877   }
3878   (@tickets);
3879 }
3880
3881 # Return services representing svc_accts in customer support packages
3882 sub support_services {
3883   my $self = shift;
3884   my %packages = map { $_ => 1 } $conf->config('support_packages');
3885
3886   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
3887     grep { $_->part_svc->svcdb eq 'svc_acct' }
3888     map { $_->cust_svc }
3889     grep { exists $packages{ $_->pkgpart } }
3890     $self->ncancelled_pkgs;
3891
3892 }
3893
3894 # Return a list of latitude/longitude for one of the services (if any)
3895 sub service_coordinates {
3896   my $self = shift;
3897
3898   my @svc_X =
3899     grep { $_->latitude && $_->longitude }
3900     map { $_->svc_x }
3901     map { $_->cust_svc }
3902     $self->ncancelled_pkgs;
3903
3904   scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
3905 }
3906
3907 =item masked FIELD
3908
3909 Returns a masked version of the named field
3910
3911 =cut
3912
3913 sub masked {
3914 my ($self,$field) = @_;
3915
3916 # Show last four
3917
3918 'x'x(length($self->getfield($field))-4).
3919   substr($self->getfield($field), (length($self->getfield($field))-4));
3920
3921 }
3922
3923 =back
3924
3925 =head1 CLASS METHODS
3926
3927 =over 4
3928
3929 =item statuses
3930
3931 Class method that returns the list of possible status strings for customers
3932 (see L<the status method|/status>).  For example:
3933
3934   @statuses = FS::cust_main->statuses();
3935
3936 =cut
3937
3938 sub statuses {
3939   #my $self = shift; #could be class...
3940   keys %statuscolor;
3941 }
3942
3943 =item cust_status_sql
3944
3945 Returns an SQL fragment to determine the status of a cust_main record, as a
3946 string.
3947
3948 =cut
3949
3950 sub cust_status_sql {
3951   my $sql = 'CASE';
3952   for my $status ( FS::cust_main->statuses() ) {
3953     my $method = $status.'_sql';
3954     $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
3955   }
3956   $sql .= ' END';
3957   return $sql;
3958 }
3959
3960
3961 =item prospect_sql
3962
3963 Returns an SQL expression identifying prospective cust_main records (customers
3964 with no packages ever ordered)
3965
3966 =cut
3967
3968 use vars qw($select_count_pkgs);
3969 $select_count_pkgs =
3970   "SELECT COUNT(*) FROM cust_pkg
3971     WHERE cust_pkg.custnum = cust_main.custnum";
3972
3973 sub select_count_pkgs_sql {
3974   $select_count_pkgs;
3975 }
3976
3977 sub prospect_sql {
3978   " 0 = ( $select_count_pkgs ) ";
3979 }
3980
3981 =item ordered_sql
3982
3983 Returns an SQL expression identifying ordered cust_main records (customers with
3984 recurring packages not yet setup).
3985
3986 =cut
3987
3988 sub ordered_sql {
3989   FS::cust_main->none_active_sql.
3990   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->ordered_sql. " ) ";
3991 }
3992
3993 =item active_sql
3994
3995 Returns an SQL expression identifying active cust_main records (customers with
3996 active recurring packages).
3997
3998 =cut
3999
4000 sub active_sql {
4001   " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4002 }
4003
4004 =item none_active_sql
4005
4006 Returns an SQL expression identifying cust_main records with no active
4007 recurring packages.  This includes customers of status prospect, ordered,
4008 inactive, and suspended.
4009
4010 =cut
4011
4012 sub none_active_sql {
4013   " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4014 }
4015
4016 =item inactive_sql
4017
4018 Returns an SQL expression identifying inactive cust_main records (customers with
4019 no active recurring packages, but otherwise unsuspended/uncancelled).
4020
4021 =cut
4022
4023 sub inactive_sql {
4024   FS::cust_main->none_active_sql.
4025   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4026 }
4027
4028 =item susp_sql
4029 =item suspended_sql
4030
4031 Returns an SQL expression identifying suspended cust_main records.
4032
4033 =cut
4034
4035
4036 sub suspended_sql { susp_sql(@_); }
4037 sub susp_sql {
4038   FS::cust_main->none_active_sql.
4039   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4040 }
4041
4042 =item cancel_sql
4043 =item cancelled_sql
4044
4045 Returns an SQL expression identifying cancelled cust_main records.
4046
4047 =cut
4048
4049 sub cancelled_sql { cancel_sql(@_); }
4050 sub cancel_sql {
4051
4052   my $recurring_sql = FS::cust_pkg->recurring_sql;
4053   my $cancelled_sql = FS::cust_pkg->cancelled_sql;
4054
4055   "
4056         0 < ( $select_count_pkgs )
4057     AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql   )
4058     AND 0 = ( $select_count_pkgs AND $recurring_sql
4059                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4060             )
4061   ";
4062 #    AND 0 = (  $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
4063
4064 }
4065
4066 =item uncancel_sql
4067 =item uncancelled_sql
4068
4069 Returns an SQL expression identifying un-cancelled cust_main records.
4070
4071 =cut
4072
4073 sub uncancelled_sql { uncancel_sql(@_); }
4074 sub uncancel_sql { "
4075   ( 0 < ( $select_count_pkgs
4076                    AND ( cust_pkg.cancel IS NULL
4077                          OR cust_pkg.cancel = 0
4078                        )
4079         )
4080     OR 0 = ( $select_count_pkgs )
4081   )
4082 "; }
4083
4084 =item balance_sql
4085
4086 Returns an SQL fragment to retreive the balance.
4087
4088 =cut
4089
4090 sub balance_sql { "
4091     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4092         WHERE cust_bill.custnum   = cust_main.custnum     )
4093   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
4094         WHERE cust_pay.custnum    = cust_main.custnum     )
4095   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
4096         WHERE cust_credit.custnum = cust_main.custnum     )
4097   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
4098         WHERE cust_refund.custnum = cust_main.custnum     )
4099 "; }
4100
4101 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4102
4103 Returns an SQL fragment to retreive the balance for this customer, optionally
4104 considering invoices with date earlier than START_TIME, and not
4105 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4106 total_unapplied_payments).
4107
4108 Times are specified as SQL fragments or numeric
4109 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4110 L<Date::Parse> for conversion functions.  The empty string can be passed
4111 to disable that time constraint completely.
4112
4113 Available options are:
4114
4115 =over 4
4116
4117 =item unapplied_date
4118
4119 set to true to disregard unapplied credits, payments and refunds outside the specified time period - by default the time period restriction only applies to invoices (useful for reporting, probably a bad idea for event triggering)
4120
4121 =item total
4122
4123 (unused.  obsolete?)
4124 set to true to remove all customer comparison clauses, for totals
4125
4126 =item where
4127
4128 (unused.  obsolete?)
4129 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4130
4131 =item join
4132
4133 (unused.  obsolete?)
4134 JOIN clause (typically used with the total option)
4135
4136 =item cutoff
4137
4138 An absolute cutoff time.  Payments, credits, and refunds I<applied> after this
4139 time will be ignored.  Note that START_TIME and END_TIME only limit the date
4140 range for invoices and I<unapplied> payments, credits, and refunds.
4141
4142 =back
4143
4144 =cut
4145
4146 sub balance_date_sql {
4147   my( $class, $start, $end, %opt ) = @_;
4148
4149   my $cutoff = $opt{'cutoff'};
4150
4151   my $owed         = FS::cust_bill->owed_sql($cutoff);
4152   my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4153   my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4154   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4155
4156   my $j = $opt{'join'} || '';
4157
4158   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
4159   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4160   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4161   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
4162
4163   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
4164     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4165     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4166     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
4167   ";
4168
4169 }
4170
4171 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4172
4173 Returns an SQL fragment to retreive the total unapplied payments for this
4174 customer, only considering invoices with date earlier than START_TIME, and
4175 optionally not later than END_TIME.
4176
4177 Times are specified as SQL fragments or numeric
4178 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4179 L<Date::Parse> for conversion functions.  The empty string can be passed
4180 to disable that time constraint completely.
4181
4182 Available options are:
4183
4184 =cut
4185
4186 sub unapplied_payments_date_sql {
4187   my( $class, $start, $end, %opt ) = @_;
4188
4189   my $cutoff = $opt{'cutoff'};
4190
4191   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4192
4193   my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4194                                                           'unapplied_date'=>1 );
4195
4196   " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4197 }
4198
4199 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4200
4201 Helper method for balance_date_sql; name (and usage) subject to change
4202 (suggestions welcome).
4203
4204 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4205 cust_refund, cust_credit or cust_pay).
4206
4207 If TABLE is "cust_bill" or the unapplied_date option is true, only
4208 considers records with date earlier than START_TIME, and optionally not
4209 later than END_TIME .
4210
4211 =cut
4212
4213 sub _money_table_where {
4214   my( $class, $table, $start, $end, %opt ) = @_;
4215
4216   my @where = ();
4217   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4218   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4219     push @where, "$table._date <= $start" if defined($start) && length($start);
4220     push @where, "$table._date >  $end"   if defined($end)   && length($end);
4221   }
4222   push @where, @{$opt{'where'}} if $opt{'where'};
4223   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4224
4225   $where;
4226
4227 }
4228
4229 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4230 use FS::cust_main::Search;
4231 sub search {
4232   my $class = shift;
4233   FS::cust_main::Search->search(@_);
4234 }
4235
4236 =back
4237
4238 =head1 SUBROUTINES
4239
4240 =over 4
4241
4242 =item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
4243
4244 =cut
4245
4246 use FS::cust_main::Search;
4247 sub append_fuzzyfiles {
4248   #my( $first, $last, $company ) = @_;
4249
4250   FS::cust_main::Search::check_and_rebuild_fuzzyfiles();
4251
4252   use Fcntl qw(:flock);
4253
4254   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
4255
4256   foreach my $field (@fuzzyfields) {
4257     my $value = shift;
4258
4259     if ( $value ) {
4260
4261       open(CACHE,">>$dir/cust_main.$field")
4262         or die "can't open $dir/cust_main.$field: $!";
4263       flock(CACHE,LOCK_EX)
4264         or die "can't lock $dir/cust_main.$field: $!";
4265
4266       print CACHE "$value\n";
4267
4268       flock(CACHE,LOCK_UN)
4269         or die "can't unlock $dir/cust_main.$field: $!";
4270       close CACHE;
4271     }
4272
4273   }
4274
4275   1;
4276 }
4277
4278 =item batch_charge
4279
4280 =cut
4281
4282 sub batch_charge {
4283   my $param = shift;
4284   #warn join('-',keys %$param);
4285   my $fh = $param->{filehandle};
4286   my $agentnum = $param->{agentnum};
4287   my $format = $param->{format};
4288
4289   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
4290
4291   my @fields;
4292   if ( $format eq 'simple' ) {
4293     @fields = qw( custnum agent_custid amount pkg );
4294   } else {
4295     die "unknown format $format";
4296   }
4297
4298   eval "use Text::CSV_XS;";
4299   die $@ if $@;
4300
4301   my $csv = new Text::CSV_XS;
4302   #warn $csv;
4303   #warn $fh;
4304
4305   my $imported = 0;
4306   #my $columns;
4307
4308   local $SIG{HUP} = 'IGNORE';
4309   local $SIG{INT} = 'IGNORE';
4310   local $SIG{QUIT} = 'IGNORE';
4311   local $SIG{TERM} = 'IGNORE';
4312   local $SIG{TSTP} = 'IGNORE';
4313   local $SIG{PIPE} = 'IGNORE';
4314
4315   my $oldAutoCommit = $FS::UID::AutoCommit;
4316   local $FS::UID::AutoCommit = 0;
4317   my $dbh = dbh;
4318
4319   #while ( $columns = $csv->getline($fh) ) {
4320   my $line;
4321   while ( defined($line=<$fh>) ) {
4322
4323     $csv->parse($line) or do {
4324       $dbh->rollback if $oldAutoCommit;
4325       return "can't parse: ". $csv->error_input();
4326     };
4327
4328     my @columns = $csv->fields();
4329     #warn join('-',@columns);
4330
4331     my %row = ();
4332     foreach my $field ( @fields ) {
4333       $row{$field} = shift @columns;
4334     }
4335
4336     if ( $row{custnum} && $row{agent_custid} ) {
4337       dbh->rollback if $oldAutoCommit;
4338       return "can't specify custnum with agent_custid $row{agent_custid}";
4339     }
4340
4341     my %hash = ();
4342     if ( $row{agent_custid} && $agentnum ) {
4343       %hash = ( 'agent_custid' => $row{agent_custid},
4344                 'agentnum'     => $agentnum,
4345               );
4346     }
4347
4348     if ( $row{custnum} ) {
4349       %hash = ( 'custnum' => $row{custnum} );
4350     }
4351
4352     unless ( scalar(keys %hash) ) {
4353       $dbh->rollback if $oldAutoCommit;
4354       return "can't find customer without custnum or agent_custid and agentnum";
4355     }
4356
4357     my $cust_main = qsearchs('cust_main', { %hash } );
4358     unless ( $cust_main ) {
4359       $dbh->rollback if $oldAutoCommit;
4360       my $custnum = $row{custnum} || $row{agent_custid};
4361       return "unknown custnum $custnum";
4362     }
4363
4364     if ( $row{'amount'} > 0 ) {
4365       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4366       if ( $error ) {
4367         $dbh->rollback if $oldAutoCommit;
4368         return $error;
4369       }
4370       $imported++;
4371     } elsif ( $row{'amount'} < 0 ) {
4372       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4373                                       $row{'pkg'}                         );
4374       if ( $error ) {
4375         $dbh->rollback if $oldAutoCommit;
4376         return $error;
4377       }
4378       $imported++;
4379     } else {
4380       #hmm?
4381     }
4382
4383   }
4384
4385   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4386
4387   return "Empty file!" unless $imported;
4388
4389   ''; #no error
4390
4391 }
4392
4393 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4394
4395 Deprecated.  Use event notification and message templates
4396 (L<FS::msg_template>) instead.
4397
4398 Sends a templated email notification to the customer (see L<Text::Template>).
4399
4400 OPTIONS is a hash and may include
4401
4402 I<from> - the email sender (default is invoice_from)
4403
4404 I<to> - comma-separated scalar or arrayref of recipients
4405    (default is invoicing_list)
4406
4407 I<subject> - The subject line of the sent email notification
4408    (default is "Notice from company_name")
4409
4410 I<extra_fields> - a hashref of name/value pairs which will be substituted
4411    into the template
4412
4413 The following variables are vavailable in the template.
4414
4415 I<$first> - the customer first name
4416 I<$last> - the customer last name
4417 I<$company> - the customer company
4418 I<$payby> - a description of the method of payment for the customer
4419             # would be nice to use FS::payby::shortname
4420 I<$payinfo> - the account information used to collect for this customer
4421 I<$expdate> - the expiration of the customer payment in seconds from epoch
4422
4423 =cut
4424
4425 sub notify {
4426   my ($self, $template, %options) = @_;
4427
4428   return unless $conf->exists($template);
4429
4430   my $from = $conf->config('invoice_from', $self->agentnum)
4431     if $conf->exists('invoice_from', $self->agentnum);
4432   $from = $options{from} if exists($options{from});
4433
4434   my $to = join(',', $self->invoicing_list_emailonly);
4435   $to = $options{to} if exists($options{to});
4436
4437   my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4438     if $conf->exists('company_name', $self->agentnum);
4439   $subject = $options{subject} if exists($options{subject});
4440
4441   my $notify_template = new Text::Template (TYPE => 'ARRAY',
4442                                             SOURCE => [ map "$_\n",
4443                                               $conf->config($template)]
4444                                            )
4445     or die "can't create new Text::Template object: Text::Template::ERROR";
4446   $notify_template->compile()
4447     or die "can't compile template: Text::Template::ERROR";
4448
4449   $FS::notify_template::_template::company_name =
4450     $conf->config('company_name', $self->agentnum);
4451   $FS::notify_template::_template::company_address =
4452     join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4453
4454   my $paydate = $self->paydate || '2037-12-31';
4455   $FS::notify_template::_template::first = $self->first;
4456   $FS::notify_template::_template::last = $self->last;
4457   $FS::notify_template::_template::company = $self->company;
4458   $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4459   my $payby = $self->payby;
4460   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4461   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4462
4463   #credit cards expire at the end of the month/year of their exp date
4464   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4465     $FS::notify_template::_template::payby = 'credit card';
4466     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4467     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4468     $expire_time--;
4469   }elsif ($payby eq 'COMP') {
4470     $FS::notify_template::_template::payby = 'complimentary account';
4471   }else{
4472     $FS::notify_template::_template::payby = 'current method';
4473   }
4474   $FS::notify_template::_template::expdate = $expire_time;
4475
4476   for (keys %{$options{extra_fields}}){
4477     no strict "refs";
4478     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4479   }
4480
4481   send_email(from => $from,
4482              to => $to,
4483              subject => $subject,
4484              body => $notify_template->fill_in( PACKAGE =>
4485                                                 'FS::notify_template::_template'                                              ),
4486             );
4487
4488 }
4489
4490 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4491
4492 Generates a templated notification to the customer (see L<Text::Template>).
4493
4494 OPTIONS is a hash and may include
4495
4496 I<extra_fields> - a hashref of name/value pairs which will be substituted
4497    into the template.  These values may override values mentioned below
4498    and those from the customer record.
4499
4500 The following variables are available in the template instead of or in addition
4501 to the fields of the customer record.
4502
4503 I<$payby> - a description of the method of payment for the customer
4504             # would be nice to use FS::payby::shortname
4505 I<$payinfo> - the masked account information used to collect for this customer
4506 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4507 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4508
4509 =cut
4510
4511 # a lot like cust_bill::print_latex
4512 sub generate_letter {
4513   my ($self, $template, %options) = @_;
4514
4515   return unless $conf->exists($template);
4516
4517   my $letter_template = new Text::Template
4518                         ( TYPE       => 'ARRAY',
4519                           SOURCE     => [ map "$_\n", $conf->config($template)],
4520                           DELIMITERS => [ '[@--', '--@]' ],
4521                         )
4522     or die "can't create new Text::Template object: Text::Template::ERROR";
4523
4524   $letter_template->compile()
4525     or die "can't compile template: Text::Template::ERROR";
4526
4527   my %letter_data = map { $_ => $self->$_ } $self->fields;
4528   $letter_data{payinfo} = $self->mask_payinfo;
4529
4530   #my $paydate = $self->paydate || '2037-12-31';
4531   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4532
4533   my $payby = $self->payby;
4534   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4535   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4536
4537   #credit cards expire at the end of the month/year of their exp date
4538   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4539     $letter_data{payby} = 'credit card';
4540     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4541     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4542     $expire_time--;
4543   }elsif ($payby eq 'COMP') {
4544     $letter_data{payby} = 'complimentary account';
4545   }else{
4546     $letter_data{payby} = 'current method';
4547   }
4548   $letter_data{expdate} = $expire_time;
4549
4550   for (keys %{$options{extra_fields}}){
4551     $letter_data{$_} = $options{extra_fields}->{$_};
4552   }
4553
4554   unless(exists($letter_data{returnaddress})){
4555     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4556                                                   $self->agent_template)
4557                      );
4558     if ( length($retadd) ) {
4559       $letter_data{returnaddress} = $retadd;
4560     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4561       $letter_data{returnaddress} =
4562         join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4563                           s/$/\\\\\*/;
4564                           $_;
4565                         }
4566                     ( $conf->config('company_name', $self->agentnum),
4567                       $conf->config('company_address', $self->agentnum),
4568                     )
4569         );
4570     } else {
4571       $letter_data{returnaddress} = '~';
4572     }
4573   }
4574
4575   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4576
4577   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4578
4579   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4580
4581   my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4582                            DIR      => $dir,
4583                            SUFFIX   => '.eps',
4584                            UNLINK   => 0,
4585                          ) or die "can't open temp file: $!\n";
4586   print $lh $conf->config_binary('logo.eps', $self->agentnum)
4587     or die "can't write temp file: $!\n";
4588   close $lh;
4589   $letter_data{'logo_file'} = $lh->filename;
4590
4591   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4592                            DIR      => $dir,
4593                            SUFFIX   => '.tex',
4594                            UNLINK   => 0,
4595                          ) or die "can't open temp file: $!\n";
4596
4597   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4598   close $fh;
4599   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4600   return ($1, $letter_data{'logo_file'});
4601
4602 }
4603
4604 =item print_ps TEMPLATE
4605
4606 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4607
4608 =cut
4609
4610 sub print_ps {
4611   my $self = shift;
4612   my($file, $lfile) = $self->generate_letter(@_);
4613   my $ps = FS::Misc::generate_ps($file);
4614   unlink($file.'.tex');
4615   unlink($lfile);
4616
4617   $ps;
4618 }
4619
4620 =item print TEMPLATE
4621
4622 Prints the filled in template.
4623
4624 TEMPLATE is the name of a L<Text::Template> to fill in and print.
4625
4626 =cut
4627
4628 sub queueable_print {
4629   my %opt = @_;
4630
4631   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
4632     or die "invalid customer number: " . $opt{custvnum};
4633
4634   my $error = $self->print( $opt{template} );
4635   die $error if $error;
4636 }
4637
4638 sub print {
4639   my ($self, $template) = (shift, shift);
4640   do_print [ $self->print_ps($template) ];
4641 }
4642
4643 #these three subs should just go away once agent stuff is all config overrides
4644
4645 sub agent_template {
4646   my $self = shift;
4647   $self->_agent_plandata('agent_templatename');
4648 }
4649
4650 sub agent_invoice_from {
4651   my $self = shift;
4652   $self->_agent_plandata('agent_invoice_from');
4653 }
4654
4655 sub _agent_plandata {
4656   my( $self, $option ) = @_;
4657
4658   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
4659   #agent-specific Conf
4660
4661   use FS::part_event::Condition;
4662
4663   my $agentnum = $self->agentnum;
4664
4665   my $regexp = regexp_sql();
4666
4667   my $part_event_option =
4668     qsearchs({
4669       'select'    => 'part_event_option.*',
4670       'table'     => 'part_event_option',
4671       'addl_from' => q{
4672         LEFT JOIN part_event USING ( eventpart )
4673         LEFT JOIN part_event_option AS peo_agentnum
4674           ON ( part_event.eventpart = peo_agentnum.eventpart
4675                AND peo_agentnum.optionname = 'agentnum'
4676                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
4677              )
4678         LEFT JOIN part_event_condition
4679           ON ( part_event.eventpart = part_event_condition.eventpart
4680                AND part_event_condition.conditionname = 'cust_bill_age'
4681              )
4682         LEFT JOIN part_event_condition_option
4683           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
4684                AND part_event_condition_option.optionname = 'age'
4685              )
4686       },
4687       #'hashref'   => { 'optionname' => $option },
4688       #'hashref'   => { 'part_event_option.optionname' => $option },
4689       'extra_sql' =>
4690         " WHERE part_event_option.optionname = ". dbh->quote($option).
4691         " AND action = 'cust_bill_send_agent' ".
4692         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
4693         " AND peo_agentnum.optionname = 'agentnum' ".
4694         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
4695         " ORDER BY
4696            CASE WHEN part_event_condition_option.optionname IS NULL
4697            THEN -1
4698            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
4699         " END
4700           , part_event.weight".
4701         " LIMIT 1"
4702     });
4703
4704   unless ( $part_event_option ) {
4705     return $self->agent->invoice_template || ''
4706       if $option eq 'agent_templatename';
4707     return '';
4708   }
4709
4710   $part_event_option->optionvalue;
4711
4712 }
4713
4714 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
4715
4716 Subroutine (not a method), designed to be called from the queue.
4717
4718 Takes a list of options and values.
4719
4720 Pulls up the customer record via the custnum option and calls bill_and_collect.
4721
4722 =cut
4723
4724 sub queued_bill {
4725   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
4726
4727   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
4728   warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
4729
4730   $cust_main->bill_and_collect( %args );
4731 }
4732
4733 sub process_bill_and_collect {
4734   my $job = shift;
4735   my $param = thaw(decode_base64(shift));
4736   my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
4737       or die "custnum '$param->{custnum}' not found!\n";
4738   $param->{'job'}   = $job;
4739   $param->{'fatal'} = 1; # runs from job queue, will be caught
4740   $param->{'retry'} = 1;
4741
4742   $cust_main->bill_and_collect( %$param );
4743 }
4744
4745 sub _upgrade_data { #class method
4746   my ($class, %opts) = @_;
4747
4748   my @statements = (
4749     'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
4750     'UPDATE cust_main SET signupdate = (SELECT signupdate FROM h_cust_main WHERE signupdate IS NOT NULL AND h_cust_main.custnum = cust_main.custnum ORDER BY historynum DESC LIMIT 1) WHERE signupdate IS NULL',
4751   );
4752   # fix yyyy-m-dd formatted paydates
4753   if ( driver_name =~ /^mysql$/i ) {
4754     push @statements,
4755     "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
4756   }
4757   else { # the SQL standard
4758     push @statements,
4759     "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
4760   }
4761
4762   foreach my $sql ( @statements ) {
4763     my $sth = dbh->prepare($sql) or die dbh->errstr;
4764     $sth->execute or die $sth->errstr;
4765   }
4766
4767   local($ignore_expired_card) = 1;
4768   local($ignore_illegal_zip) = 1;
4769   local($ignore_banned_card) = 1;
4770   local($skip_fuzzyfiles) = 1;
4771   $class->_upgrade_otaker(%opts);
4772
4773 }
4774
4775 =back
4776
4777 =head1 BUGS
4778
4779 The delete method.
4780
4781 The delete method should possibly take an FS::cust_main object reference
4782 instead of a scalar customer number.
4783
4784 Bill and collect options should probably be passed as references instead of a
4785 list.
4786
4787 There should probably be a configuration file with a list of allowed credit
4788 card types.
4789
4790 No multiple currency support (probably a larger project than just this module).
4791
4792 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4793
4794 Birthdates rely on negative epoch values.
4795
4796 The payby for card/check batches is broken.  With mixed batching, bad
4797 things will happen.
4798
4799 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
4800
4801 =head1 SEE ALSO
4802
4803 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4804 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4805 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
4806
4807 =cut
4808
4809 1;
4810