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 $name = $self->ship_name;
1250
1251   my $locationnum = '';
1252   foreach my $cust_pkg ( $self->all_pkgs ) {
1253     $cust_pkg->custnum($new_custnum);
1254
1255     unless ( $cust_pkg->locationnum ) {
1256       unless ( $locationnum ) {
1257         my $cust_location = new FS::cust_location {
1258           $self->location_hash,
1259           'custnum' => $new_custnum,
1260         };
1261         my $error = $cust_location->insert;
1262         if ( $error ) {
1263           $dbh->rollback if $oldAutoCommit;
1264           return $error;
1265         }
1266         $locationnum = $cust_location->locationnum;
1267       }
1268       $cust_pkg->locationnum($locationnum);
1269     }
1270
1271     my $error = $cust_pkg->replace;
1272     if ( $error ) {
1273       $dbh->rollback if $oldAutoCommit;
1274       return $error;
1275     }
1276
1277     # add customer (ship) name to svc_phone.phone_name if blank
1278     my @cust_svc = $cust_pkg->cust_svc;
1279     foreach my $cust_svc (@cust_svc) {
1280       my($label, $value, $svcdb) = $cust_svc->label;
1281       next unless $svcdb eq 'svc_phone';
1282       my $svc_phone = $cust_svc->svc_x;
1283       next if $svc_phone->phone_name;
1284       $svc_phone->phone_name($name);
1285       my $error = $svc_phone->replace;
1286       if ( $error ) {
1287         $dbh->rollback if $oldAutoCommit;
1288         return $error;
1289       }
1290     }
1291
1292   }
1293
1294   #not considered:
1295   # cust_tax_exempt (texas tax exemptions)
1296   # cust_recon (some sort of not-well understood thing for OnPac)
1297
1298   #these are moved over
1299   foreach my $table (qw(
1300     cust_tag cust_location contact cust_attachment cust_main_note
1301     cust_tax_adjustment cust_pay_batch queue
1302   )) {
1303     foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1304       $record->custnum($new_custnum);
1305       my $error = $record->replace;
1306       if ( $error ) {
1307         $dbh->rollback if $oldAutoCommit;
1308         return $error;
1309       }
1310     }
1311   }
1312
1313   #these aren't preserved
1314   foreach my $table (qw(
1315     cust_main_exemption cust_main_invoice
1316   )) {
1317     foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1318       my $error = $record->delete;
1319       if ( $error ) {
1320         $dbh->rollback if $oldAutoCommit;
1321         return $error;
1322       }
1323     }
1324   }
1325
1326
1327   my $sth = $dbh->prepare(
1328     'UPDATE cust_main SET referral_custnum = ? WHERE referral_custnum = ?'
1329   ) or do {
1330     my $errstr = $dbh->errstr;
1331     $dbh->rollback if $oldAutoCommit;
1332     return $errstr;
1333   };
1334   $sth->execute($new_custnum, $self->custnum) or do {
1335     my $errstr = $sth->errstr;
1336     $dbh->rollback if $oldAutoCommit;
1337     return $errstr;
1338   };
1339
1340   #tickets
1341
1342   my $ticket_dbh = '';
1343   if ($conf->config('ticket_system') eq 'RT_Internal') {
1344     $ticket_dbh = $dbh;
1345   } elsif ($conf->config('ticket_system') eq 'RT_External') {
1346     my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1347     $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1348       #or die "RT_External DBI->connect error: $DBI::errstr\n";
1349   }
1350
1351   if ( $ticket_dbh ) {
1352
1353     my $ticket_sth = $ticket_dbh->prepare(
1354       'UPDATE Links SET Target = ? WHERE Target = ?'
1355     ) or do {
1356       my $errstr = $ticket_dbh->errstr;
1357       $dbh->rollback if $oldAutoCommit;
1358       return $errstr;
1359     };
1360     $ticket_sth->execute('freeside://freeside/cust_main/'.$new_custnum,
1361                          'freeside://freeside/cust_main/'.$self->custnum)
1362       or do {
1363         my $errstr = $ticket_sth->errstr;
1364         $dbh->rollback if $oldAutoCommit;
1365         return $errstr;
1366       };
1367
1368   }
1369
1370   #delete the customer record
1371
1372   my $error = $self->delete;
1373   if ( $error ) {
1374     $dbh->rollback if $oldAutoCommit;
1375     return $error;
1376   }
1377
1378   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1379   '';
1380
1381 }
1382
1383 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1384
1385
1386 Replaces the OLD_RECORD with this one in the database.  If there is an error,
1387 returns the error, otherwise returns false.
1388
1389 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1390 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
1391 expected and rollback the entire transaction; it is not necessary to call
1392 check_invoicing_list first.  Here's an example:
1393
1394   $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1395
1396 Currently available options are: I<tax_exemption>.
1397
1398 The I<tax_exemption> option can be set to an arrayref of tax names.
1399 FS::cust_main_exemption records will be deleted and inserted as appropriate.
1400
1401 =cut
1402
1403 sub replace {
1404   my $self = shift;
1405
1406   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1407               ? shift
1408               : $self->replace_old;
1409
1410   my @param = @_;
1411
1412   warn "$me replace called\n"
1413     if $DEBUG;
1414
1415   my $curuser = $FS::CurrentUser::CurrentUser;
1416   if (    $self->payby eq 'COMP'
1417        && $self->payby ne $old->payby
1418        && ! $curuser->access_right('Complimentary customer')
1419      )
1420   {
1421     return "You are not permitted to create complimentary accounts.";
1422   }
1423
1424   if ( $old->get('geocode') && $old->get('geocode') eq $self->get('geocode')
1425        && $conf->exists('enable_taxproducts')
1426      )
1427   {
1428     my $pre = ($conf->exists('tax-ship_address') && $self->ship_zip)
1429                 ? 'ship_' : '';
1430     $self->set('geocode', '')
1431       if $old->get($pre.'zip') ne $self->get($pre.'zip')
1432       && length($self->get($pre.'zip')) >= 10;
1433   }
1434
1435   local($ignore_expired_card) = 1
1436     if $old->payby  =~ /^(CARD|DCRD)$/
1437     && $self->payby =~ /^(CARD|DCRD)$/
1438     && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1439
1440   local $SIG{HUP} = 'IGNORE';
1441   local $SIG{INT} = 'IGNORE';
1442   local $SIG{QUIT} = 'IGNORE';
1443   local $SIG{TERM} = 'IGNORE';
1444   local $SIG{TSTP} = 'IGNORE';
1445   local $SIG{PIPE} = 'IGNORE';
1446
1447   my $oldAutoCommit = $FS::UID::AutoCommit;
1448   local $FS::UID::AutoCommit = 0;
1449   my $dbh = dbh;
1450
1451   my $error = $self->SUPER::replace($old);
1452
1453   if ( $error ) {
1454     $dbh->rollback if $oldAutoCommit;
1455     return $error;
1456   }
1457
1458   if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1459     my $invoicing_list = shift @param;
1460     $error = $self->check_invoicing_list( $invoicing_list );
1461     if ( $error ) {
1462       $dbh->rollback if $oldAutoCommit;
1463       return $error;
1464     }
1465     $self->invoicing_list( $invoicing_list );
1466   }
1467
1468   if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1469
1470     #this could be more efficient than deleting and re-inserting, if it matters
1471     foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1472       my $error = $cust_tag->delete;
1473       if ( $error ) {
1474         $dbh->rollback if $oldAutoCommit;
1475         return $error;
1476       }
1477     }
1478     foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1479       my $cust_tag = new FS::cust_tag { 'tagnum'  => $tagnum,
1480                                         'custnum' => $self->custnum };
1481       my $error = $cust_tag->insert;
1482       if ( $error ) {
1483         $dbh->rollback if $oldAutoCommit;
1484         return $error;
1485       }
1486     }
1487
1488   }
1489
1490   my %options = @param;
1491
1492   my $tax_exemption = delete $options{'tax_exemption'};
1493   if ( $tax_exemption ) {
1494
1495     my %cust_main_exemption =
1496       map { $_->taxname => $_ }
1497           qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1498
1499     foreach my $taxname ( @$tax_exemption ) {
1500
1501       next if delete $cust_main_exemption{$taxname};
1502
1503       my $cust_main_exemption = new FS::cust_main_exemption {
1504         'custnum' => $self->custnum,
1505         'taxname' => $taxname,
1506       };
1507       my $error = $cust_main_exemption->insert;
1508       if ( $error ) {
1509         $dbh->rollback if $oldAutoCommit;
1510         return "inserting cust_main_exemption (transaction rolled back): $error";
1511       }
1512     }
1513
1514     foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1515       my $error = $cust_main_exemption->delete;
1516       if ( $error ) {
1517         $dbh->rollback if $oldAutoCommit;
1518         return "deleting cust_main_exemption (transaction rolled back): $error";
1519       }
1520     }
1521
1522   }
1523
1524   if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
1525        && ( ( $self->get('payinfo') ne $old->get('payinfo')
1526               && $self->get('payinfo') !~ /^99\d{14}$/
1527             )
1528             || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
1529           )
1530      )
1531   {
1532
1533     # card/check/lec info has changed, want to retry realtime_ invoice events
1534     my $error = $self->retry_realtime;
1535     if ( $error ) {
1536       $dbh->rollback if $oldAutoCommit;
1537       return $error;
1538     }
1539   }
1540
1541   unless ( $import || $skip_fuzzyfiles ) {
1542     $error = $self->queue_fuzzyfiles_update;
1543     if ( $error ) {
1544       $dbh->rollback if $oldAutoCommit;
1545       return "updating fuzzy search cache: $error";
1546     }
1547   }
1548
1549   # cust_main exports!
1550
1551   my $export_args = $options{'export_args'} || [];
1552
1553   my @part_export =
1554     map qsearch( 'part_export', {exportnum=>$_} ),
1555       $conf->config('cust_main-exports'); #, $agentnum
1556
1557   foreach my $part_export ( @part_export ) {
1558     my $error = $part_export->export_replace( $self, $old, @$export_args);
1559     if ( $error ) {
1560       $dbh->rollback if $oldAutoCommit;
1561       return "exporting to ". $part_export->exporttype.
1562              " (transaction rolled back): $error";
1563     }
1564   }
1565
1566   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1567   '';
1568
1569 }
1570
1571 =item queue_fuzzyfiles_update
1572
1573 Used by insert & replace to update the fuzzy search cache
1574
1575 =cut
1576
1577 sub queue_fuzzyfiles_update {
1578   my $self = shift;
1579
1580   local $SIG{HUP} = 'IGNORE';
1581   local $SIG{INT} = 'IGNORE';
1582   local $SIG{QUIT} = 'IGNORE';
1583   local $SIG{TERM} = 'IGNORE';
1584   local $SIG{TSTP} = 'IGNORE';
1585   local $SIG{PIPE} = 'IGNORE';
1586
1587   my $oldAutoCommit = $FS::UID::AutoCommit;
1588   local $FS::UID::AutoCommit = 0;
1589   my $dbh = dbh;
1590
1591   my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1592   my $error = $queue->insert( map $self->getfield($_), @fuzzyfields );
1593   if ( $error ) {
1594     $dbh->rollback if $oldAutoCommit;
1595     return "queueing job (transaction rolled back): $error";
1596   }
1597
1598   if ( $self->ship_last ) {
1599     $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1600     $error = $queue->insert( map $self->getfield("ship_$_"), @fuzzyfields );
1601     if ( $error ) {
1602       $dbh->rollback if $oldAutoCommit;
1603       return "queueing job (transaction rolled back): $error";
1604     }
1605   }
1606
1607   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1608   '';
1609
1610 }
1611
1612 =item check
1613
1614 Checks all fields to make sure this is a valid customer record.  If there is
1615 an error, returns the error, otherwise returns false.  Called by the insert
1616 and replace methods.
1617
1618 =cut
1619
1620 sub check {
1621   my $self = shift;
1622
1623   warn "$me check BEFORE: \n". $self->_dump
1624     if $DEBUG > 2;
1625
1626   my $error =
1627     $self->ut_numbern('custnum')
1628     || $self->ut_number('agentnum')
1629     || $self->ut_textn('agent_custid')
1630     || $self->ut_number('refnum')
1631     || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1632     || $self->ut_textn('custbatch')
1633     || $self->ut_name('last')
1634     || $self->ut_name('first')
1635     || $self->ut_snumbern('birthdate')
1636     || $self->ut_snumbern('signupdate')
1637     || $self->ut_textn('company')
1638     || $self->ut_text('address1')
1639     || $self->ut_textn('address2')
1640     || $self->ut_text('city')
1641     || $self->ut_textn('county')
1642     || $self->ut_textn('state')
1643     || $self->ut_country('country')
1644     || $self->ut_anything('comments')
1645     || $self->ut_numbern('referral_custnum')
1646     || $self->ut_textn('stateid')
1647     || $self->ut_textn('stateid_state')
1648     || $self->ut_textn('invoice_terms')
1649     || $self->ut_alphan('geocode')
1650     || $self->ut_floatn('cdr_termination_percentage')
1651     || $self->ut_floatn('credit_limit')
1652   ;
1653
1654   #barf.  need message catalogs.  i18n.  etc.
1655   $error .= "Please select an advertising source."
1656     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1657   return $error if $error;
1658
1659   return "Unknown agent"
1660     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1661
1662   return "Unknown refnum"
1663     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1664
1665   return "Unknown referring custnum: ". $self->referral_custnum
1666     unless ! $self->referral_custnum
1667            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1668
1669   if ( $self->censustract ne '' ) {
1670     $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/
1671       or return "Illegal census tract: ". $self->censustract;
1672
1673     $self->censustract("$1.$2");
1674   }
1675
1676   if ( $self->ss eq '' ) {
1677     $self->ss('');
1678   } else {
1679     my $ss = $self->ss;
1680     $ss =~ s/\D//g;
1681     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1682       or return "Illegal social security number: ". $self->ss;
1683     $self->ss("$1-$2-$3");
1684   }
1685
1686
1687 # bad idea to disable, causes billing to fail because of no tax rates later
1688 # except we don't fail any more
1689   unless ( $import ) {
1690     unless ( qsearch('cust_main_county', {
1691       'country' => $self->country,
1692       'state'   => '',
1693      } ) ) {
1694       return "Unknown state/county/country: ".
1695         $self->state. "/". $self->county. "/". $self->country
1696         unless qsearch('cust_main_county',{
1697           'state'   => $self->state,
1698           'county'  => $self->county,
1699           'country' => $self->country,
1700         } );
1701     }
1702   }
1703
1704   $error =
1705     $self->ut_phonen('daytime', $self->country)
1706     || $self->ut_phonen('night', $self->country)
1707     || $self->ut_phonen('fax', $self->country)
1708   ;
1709   return $error if $error;
1710
1711   unless ( $ignore_illegal_zip ) {
1712     $error = $self->ut_zip('zip', $self->country);
1713     return $error if $error;
1714   }
1715
1716   if ( $conf->exists('cust_main-require_phone')
1717        && ! length($self->daytime) && ! length($self->night)
1718      ) {
1719
1720     my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1721                           ? 'Day Phone'
1722                           : FS::Msgcat::_gettext('daytime');
1723     my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1724                         ? 'Night Phone'
1725                         : FS::Msgcat::_gettext('night');
1726
1727     return "$daytime_label or $night_label is required"
1728
1729   }
1730
1731   if ( $self->has_ship_address
1732        && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1733                         $self->addr_fields )
1734      )
1735   {
1736     my $error =
1737       $self->ut_name('ship_last')
1738       || $self->ut_name('ship_first')
1739       || $self->ut_textn('ship_company')
1740       || $self->ut_text('ship_address1')
1741       || $self->ut_textn('ship_address2')
1742       || $self->ut_text('ship_city')
1743       || $self->ut_textn('ship_county')
1744       || $self->ut_textn('ship_state')
1745       || $self->ut_country('ship_country')
1746     ;
1747     return $error if $error;
1748
1749     #false laziness with above
1750     unless ( qsearchs('cust_main_county', {
1751       'country' => $self->ship_country,
1752       'state'   => '',
1753      } ) ) {
1754       return "Unknown ship_state/ship_county/ship_country: ".
1755         $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1756         unless qsearch('cust_main_county',{
1757           'state'   => $self->ship_state,
1758           'county'  => $self->ship_county,
1759           'country' => $self->ship_country,
1760         } );
1761     }
1762     #eofalse
1763
1764     $error =
1765       $self->ut_phonen('ship_daytime', $self->ship_country)
1766       || $self->ut_phonen('ship_night', $self->ship_country)
1767       || $self->ut_phonen('ship_fax', $self->ship_country)
1768     ;
1769     return $error if $error;
1770
1771     unless ( $ignore_illegal_zip ) {
1772       $error = $self->ut_zip('ship_zip', $self->ship_country);
1773       return $error if $error;
1774     }
1775     return "Unit # is required."
1776       if $self->ship_address2 =~ /^\s*$/
1777       && $conf->exists('cust_main-require_address2');
1778
1779   } else { # ship_ info eq billing info, so don't store dup info in database
1780
1781     $self->setfield("ship_$_", '')
1782       foreach $self->addr_fields;
1783
1784     return "Unit # is required."
1785       if $self->address2 =~ /^\s*$/
1786       && $conf->exists('cust_main-require_address2');
1787
1788   }
1789
1790   #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1791   #  or return "Illegal payby: ". $self->payby;
1792   #$self->payby($1);
1793   FS::payby->can_payby($self->table, $self->payby)
1794     or return "Illegal payby: ". $self->payby;
1795
1796   $error =    $self->ut_numbern('paystart_month')
1797            || $self->ut_numbern('paystart_year')
1798            || $self->ut_numbern('payissue')
1799            || $self->ut_textn('paytype')
1800   ;
1801   return $error if $error;
1802
1803   if ( $self->payip eq '' ) {
1804     $self->payip('');
1805   } else {
1806     $error = $self->ut_ip('payip');
1807     return $error if $error;
1808   }
1809
1810   # If it is encrypted and the private key is not availaible then we can't
1811   # check the credit card.
1812   my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1813
1814   if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1815
1816     my $payinfo = $self->payinfo;
1817     $payinfo =~ s/\D//g;
1818     $payinfo =~ /^(\d{13,16})$/
1819       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1820     $payinfo = $1;
1821     $self->payinfo($payinfo);
1822     validate($payinfo)
1823       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1824
1825     return gettext('unknown_card_type')
1826       if $self->payinfo !~ /^99\d{14}$/ #token
1827       && cardtype($self->payinfo) eq "Unknown";
1828
1829     unless ( $ignore_banned_card ) {
1830       my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1831       if ( $ban ) {
1832         return 'Banned credit card: banned on '.
1833                time2str('%a %h %o at %r', $ban->_date).
1834                ' by '. $ban->otaker.
1835                ' (ban# '. $ban->bannum. ')';
1836       }
1837     }
1838
1839     if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1840       if ( cardtype($self->payinfo) eq 'American Express card' ) {
1841         $self->paycvv =~ /^(\d{4})$/
1842           or return "CVV2 (CID) for American Express cards is four digits.";
1843         $self->paycvv($1);
1844       } else {
1845         $self->paycvv =~ /^(\d{3})$/
1846           or return "CVV2 (CVC2/CID) is three digits.";
1847         $self->paycvv($1);
1848       }
1849     } else {
1850       $self->paycvv('');
1851     }
1852
1853     my $cardtype = cardtype($payinfo);
1854     if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1855
1856       return "Start date or issue number is required for $cardtype cards"
1857         unless $self->paystart_month && $self->paystart_year or $self->payissue;
1858
1859       return "Start month must be between 1 and 12"
1860         if $self->paystart_month
1861            and $self->paystart_month < 1 || $self->paystart_month > 12;
1862
1863       return "Start year must be 1990 or later"
1864         if $self->paystart_year
1865            and $self->paystart_year < 1990;
1866
1867       return "Issue number must be beween 1 and 99"
1868         if $self->payissue
1869           and $self->payissue < 1 || $self->payissue > 99;
1870
1871     } else {
1872       $self->paystart_month('');
1873       $self->paystart_year('');
1874       $self->payissue('');
1875     }
1876
1877   } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1878
1879     my $payinfo = $self->payinfo;
1880     $payinfo =~ s/[^\d\@]//g;
1881     if ( $conf->exists('echeck-nonus') ) {
1882       $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1883       $payinfo = "$1\@$2";
1884     } else {
1885       $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1886       $payinfo = "$1\@$2";
1887     }
1888     $self->payinfo($payinfo);
1889     $self->paycvv('');
1890
1891     unless ( $ignore_banned_card ) {
1892       my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1893       if ( $ban ) {
1894         return 'Banned ACH account: banned on '.
1895                time2str('%a %h %o at %r', $ban->_date).
1896                ' by '. $ban->otaker.
1897                ' (ban# '. $ban->bannum. ')';
1898       }
1899     }
1900
1901   } elsif ( $self->payby eq 'LECB' ) {
1902
1903     my $payinfo = $self->payinfo;
1904     $payinfo =~ s/\D//g;
1905     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1906     $payinfo = $1;
1907     $self->payinfo($payinfo);
1908     $self->paycvv('');
1909
1910   } elsif ( $self->payby eq 'BILL' ) {
1911
1912     $error = $self->ut_textn('payinfo');
1913     return "Illegal P.O. number: ". $self->payinfo if $error;
1914     $self->paycvv('');
1915
1916   } elsif ( $self->payby eq 'COMP' ) {
1917
1918     my $curuser = $FS::CurrentUser::CurrentUser;
1919     if (    ! $self->custnum
1920          && ! $curuser->access_right('Complimentary customer')
1921        )
1922     {
1923       return "You are not permitted to create complimentary accounts."
1924     }
1925
1926     $error = $self->ut_textn('payinfo');
1927     return "Illegal comp account issuer: ". $self->payinfo if $error;
1928     $self->paycvv('');
1929
1930   } elsif ( $self->payby eq 'PREPAY' ) {
1931
1932     my $payinfo = $self->payinfo;
1933     $payinfo =~ s/\W//g; #anything else would just confuse things
1934     $self->payinfo($payinfo);
1935     $error = $self->ut_alpha('payinfo');
1936     return "Illegal prepayment identifier: ". $self->payinfo if $error;
1937     return "Unknown prepayment identifier"
1938       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1939     $self->paycvv('');
1940
1941   }
1942
1943   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1944     return "Expiration date required"
1945       unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1946     $self->paydate('');
1947   } else {
1948     my( $m, $y );
1949     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1950       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1951     } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1952       ( $m, $y ) = ( $2, "19$1" );
1953     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1954       ( $m, $y ) = ( $3, "20$2" );
1955     } else {
1956       return "Illegal expiration date: ". $self->paydate;
1957     }
1958     $m = sprintf('%02d',$m);
1959     $self->paydate("$y-$m-01");
1960     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1961     return gettext('expired_card')
1962       if !$import
1963       && !$ignore_expired_card
1964       && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1965   }
1966
1967   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1968        ( ! $conf->exists('require_cardname')
1969          || $self->payby !~ /^(CARD|DCRD)$/  )
1970   ) {
1971     $self->payname( $self->first. " ". $self->getfield('last') );
1972   } else {
1973     $self->payname =~ /^([µ_0123456789aAáÁàÀâÂåÅäÄãÃªæÆbBcCçÇdDðÐeEéÉèÈêÊëËfFgGhHiIíÍìÌîÎïÏjJkKlLmMnNñÑoOóÓòÒôÔöÖõÕøØºpPqQrRsSßtTuUúÚùÙûÛüÜvVwWxXyYýÝÿzZþÞ \,\.\-\'\&]+)$/
1974       or return gettext('illegal_name'). " payname: ". $self->payname;
1975     $self->payname($1);
1976   }
1977
1978   foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
1979     $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1980     $self->$flag($1);
1981   }
1982
1983   $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
1984
1985   warn "$me check AFTER: \n". $self->_dump
1986     if $DEBUG > 2;
1987
1988   $self->SUPER::check;
1989 }
1990
1991 =item addr_fields
1992
1993 Returns a list of fields which have ship_ duplicates.
1994
1995 =cut
1996
1997 sub addr_fields {
1998   qw( last first company
1999       address1 address2 city county state zip country
2000       daytime night fax
2001     );
2002 }
2003
2004 =item has_ship_address
2005
2006 Returns true if this customer record has a separate shipping address.
2007
2008 =cut
2009
2010 sub has_ship_address {
2011   my $self = shift;
2012   scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
2013 }
2014
2015 =item location_hash
2016
2017 Returns a list of key/value pairs, with the following keys: address1, adddress2,
2018 city, county, state, zip, country, and geocode.  The shipping address is used if present.
2019
2020 =cut
2021
2022 =item cust_location
2023
2024 Returns all locations (see L<FS::cust_location>) for this customer.
2025
2026 =cut
2027
2028 sub cust_location {
2029   my $self = shift;
2030   qsearch('cust_location', { 'custnum' => $self->custnum } );
2031 }
2032
2033 =item unsuspend
2034
2035 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2036 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
2037 on success or a list of errors.
2038
2039 =cut
2040
2041 sub unsuspend {
2042   my $self = shift;
2043   grep { $_->unsuspend } $self->suspended_pkgs;
2044 }
2045
2046 =item suspend
2047
2048 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2049
2050 Returns a list: an empty list on success or a list of errors.
2051
2052 =cut
2053
2054 sub suspend {
2055   my $self = shift;
2056   grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2057 }
2058
2059 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2060
2061 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2062 PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref instead
2063 of a list of pkgparts; the hashref has the following keys:
2064
2065 =over 4
2066
2067 =item pkgparts - listref of pkgparts
2068
2069 =item (other options are passed to the suspend method)
2070
2071 =back
2072
2073
2074 Returns a list: an empty list on success or a list of errors.
2075
2076 =cut
2077
2078 sub suspend_if_pkgpart {
2079   my $self = shift;
2080   my (@pkgparts, %opt);
2081   if (ref($_[0]) eq 'HASH'){
2082     @pkgparts = @{$_[0]{pkgparts}};
2083     %opt      = %{$_[0]};
2084   }else{
2085     @pkgparts = @_;
2086   }
2087   grep { $_->suspend(%opt) }
2088     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2089       $self->unsuspended_pkgs;
2090 }
2091
2092 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2093
2094 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2095 given PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref
2096 instead of a list of pkgparts; the hashref has the following keys:
2097
2098 =over 4
2099
2100 =item pkgparts - listref of pkgparts
2101
2102 =item (other options are passed to the suspend method)
2103
2104 =back
2105
2106 Returns a list: an empty list on success or a list of errors.
2107
2108 =cut
2109
2110 sub suspend_unless_pkgpart {
2111   my $self = shift;
2112   my (@pkgparts, %opt);
2113   if (ref($_[0]) eq 'HASH'){
2114     @pkgparts = @{$_[0]{pkgparts}};
2115     %opt      = %{$_[0]};
2116   }else{
2117     @pkgparts = @_;
2118   }
2119   grep { $_->suspend(%opt) }
2120     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2121       $self->unsuspended_pkgs;
2122 }
2123
2124 =item cancel [ OPTION => VALUE ... ]
2125
2126 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2127
2128 Available options are:
2129
2130 =over 4
2131
2132 =item quiet - can be set true to supress email cancellation notices.
2133
2134 =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.
2135
2136 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2137
2138 =item nobill - can be set true to skip billing if it might otherwise be done.
2139
2140 =back
2141
2142 Always returns a list: an empty list on success or a list of errors.
2143
2144 =cut
2145
2146 # nb that dates are not specified as valid options to this method
2147
2148 sub cancel {
2149   my( $self, %opt ) = @_;
2150
2151   warn "$me cancel called on customer ". $self->custnum. " with options ".
2152        join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2153     if $DEBUG;
2154
2155   return ( 'access denied' )
2156     unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2157
2158   if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2159
2160     #should try decryption (we might have the private key)
2161     # and if not maybe queue a job for the server that does?
2162     return ( "Can't (yet) ban encrypted credit cards" )
2163       if $self->is_encrypted($self->payinfo);
2164
2165     my $ban = new FS::banned_pay $self->_banned_pay_hashref;
2166     my $error = $ban->insert;
2167     return ( $error ) if $error;
2168
2169   }
2170
2171   my @pkgs = $self->ncancelled_pkgs;
2172
2173   if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2174     $opt{nobill} = 1;
2175     my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2176     warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2177       if $error;
2178   }
2179
2180   warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2181        scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2182     if $DEBUG;
2183
2184   grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2185 }
2186
2187 sub _banned_pay_hashref {
2188   my $self = shift;
2189
2190   my %payby2ban = (
2191     'CARD' => 'CARD',
2192     'DCRD' => 'CARD',
2193     'CHEK' => 'CHEK',
2194     'DCHK' => 'CHEK'
2195   );
2196
2197   {
2198     'payby'   => $payby2ban{$self->payby},
2199     'payinfo' => md5_base64($self->payinfo),
2200     #don't ever *search* on reason! #'reason'  =>
2201   };
2202 }
2203
2204 =item notes
2205
2206 Returns all notes (see L<FS::cust_main_note>) for this customer.
2207
2208 =cut
2209
2210 sub notes {
2211   my $self = shift;
2212   #order by?
2213   qsearch( 'cust_main_note',
2214            { 'custnum' => $self->custnum },
2215            '',
2216            'ORDER BY _DATE DESC'
2217          );
2218 }
2219
2220 =item agent
2221
2222 Returns the agent (see L<FS::agent>) for this customer.
2223
2224 =cut
2225
2226 sub agent {
2227   my $self = shift;
2228   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2229 }
2230
2231 =item agent_name
2232
2233 Returns the agent name (see L<FS::agent>) for this customer.
2234
2235 =cut
2236
2237 sub agent_name {
2238   my $self = shift;
2239   $self->agent->agent;
2240 }
2241
2242 =item cust_tag
2243
2244 Returns any tags associated with this customer, as FS::cust_tag objects,
2245 or an empty list if there are no tags.
2246
2247 =cut
2248
2249 sub cust_tag {
2250   my $self = shift;
2251   qsearch('cust_tag', { 'custnum' => $self->custnum } );
2252 }
2253
2254 =item part_tag
2255
2256 Returns any tags associated with this customer, as FS::part_tag objects,
2257 or an empty list if there are no tags.
2258
2259 =cut
2260
2261 sub part_tag {
2262   my $self = shift;
2263   map $_->part_tag, $self->cust_tag;
2264 }
2265
2266
2267 =item cust_class
2268
2269 Returns the customer class, as an FS::cust_class object, or the empty string
2270 if there is no customer class.
2271
2272 =cut
2273
2274 sub cust_class {
2275   my $self = shift;
2276   if ( $self->classnum ) {
2277     qsearchs('cust_class', { 'classnum' => $self->classnum } );
2278   } else {
2279     return '';
2280   }
2281 }
2282
2283 =item categoryname
2284
2285 Returns the customer category name, or the empty string if there is no customer
2286 category.
2287
2288 =cut
2289
2290 sub categoryname {
2291   my $self = shift;
2292   my $cust_class = $self->cust_class;
2293   $cust_class
2294     ? $cust_class->categoryname
2295     : '';
2296 }
2297
2298 =item classname
2299
2300 Returns the customer class name, or the empty string if there is no customer
2301 class.
2302
2303 =cut
2304
2305 sub classname {
2306   my $self = shift;
2307   my $cust_class = $self->cust_class;
2308   $cust_class
2309     ? $cust_class->classname
2310     : '';
2311 }
2312
2313 =item BILLING METHODS
2314
2315 Documentation on billing methods has been moved to
2316 L<FS::cust_main::Billing>.
2317
2318 =item REALTIME BILLING METHODS
2319
2320 Documentation on realtime billing methods has been moved to
2321 L<FS::cust_main::Billing_Realtime>.
2322
2323 =item remove_cvv
2324
2325 Removes the I<paycvv> field from the database directly.
2326
2327 If there is an error, returns the error, otherwise returns false.
2328
2329 =cut
2330
2331 sub remove_cvv {
2332   my $self = shift;
2333   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2334     or return dbh->errstr;
2335   $sth->execute($self->custnum)
2336     or return $sth->errstr;
2337   $self->paycvv('');
2338   '';
2339 }
2340
2341 =item batch_card OPTION => VALUE...
2342
2343 Adds a payment for this invoice to the pending credit card batch (see
2344 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
2345 runs the payment using a realtime gateway.
2346
2347 =cut
2348
2349 sub batch_card {
2350   my ($self, %options) = @_;
2351
2352   my $amount;
2353   if (exists($options{amount})) {
2354     $amount = $options{amount};
2355   }else{
2356     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
2357   }
2358   return '' unless $amount > 0;
2359
2360   my $invnum = delete $options{invnum};
2361   my $payby = $options{payby} || $self->payby;  #still dubious
2362
2363   if ($options{'realtime'}) {
2364     return $self->realtime_bop( FS::payby->payby2bop($self->payby),
2365                                 $amount,
2366                                 %options,
2367                               );
2368   }
2369
2370   my $oldAutoCommit = $FS::UID::AutoCommit;
2371   local $FS::UID::AutoCommit = 0;
2372   my $dbh = dbh;
2373
2374   #this needs to handle mysql as well as Pg, like svc_acct.pm
2375   #(make it into a common function if folks need to do batching with mysql)
2376   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
2377     or return "Cannot lock pay_batch: " . $dbh->errstr;
2378
2379   my %pay_batch = (
2380     'status' => 'O',
2381     'payby'  => FS::payby->payby2payment($payby),
2382   );
2383
2384   my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
2385
2386   unless ( $pay_batch ) {
2387     $pay_batch = new FS::pay_batch \%pay_batch;
2388     my $error = $pay_batch->insert;
2389     if ( $error ) {
2390       $dbh->rollback if $oldAutoCommit;
2391       die "error creating new batch: $error\n";
2392     }
2393   }
2394
2395   my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
2396       'batchnum' => $pay_batch->batchnum,
2397       'custnum'  => $self->custnum,
2398   } );
2399
2400   foreach (qw( address1 address2 city state zip country payby payinfo paydate
2401                payname )) {
2402     $options{$_} = '' unless exists($options{$_});
2403   }
2404
2405   my $cust_pay_batch = new FS::cust_pay_batch ( {
2406     'batchnum' => $pay_batch->batchnum,
2407     'invnum'   => $invnum || 0,                    # is there a better value?
2408                                                    # this field should be
2409                                                    # removed...
2410                                                    # cust_bill_pay_batch now
2411     'custnum'  => $self->custnum,
2412     'last'     => $self->getfield('last'),
2413     'first'    => $self->getfield('first'),
2414     'address1' => $options{address1} || $self->address1,
2415     'address2' => $options{address2} || $self->address2,
2416     'city'     => $options{city}     || $self->city,
2417     'state'    => $options{state}    || $self->state,
2418     'zip'      => $options{zip}      || $self->zip,
2419     'country'  => $options{country}  || $self->country,
2420     'payby'    => $options{payby}    || $self->payby,
2421     'payinfo'  => $options{payinfo}  || $self->payinfo,
2422     'exp'      => $options{paydate}  || $self->paydate,
2423     'payname'  => $options{payname}  || $self->payname,
2424     'amount'   => $amount,                         # consolidating
2425   } );
2426
2427   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
2428     if $old_cust_pay_batch;
2429
2430   my $error;
2431   if ($old_cust_pay_batch) {
2432     $error = $cust_pay_batch->replace($old_cust_pay_batch)
2433   } else {
2434     $error = $cust_pay_batch->insert;
2435   }
2436
2437   if ( $error ) {
2438     $dbh->rollback if $oldAutoCommit;
2439     die $error;
2440   }
2441
2442   my $unapplied =   $self->total_unapplied_credits
2443                   + $self->total_unapplied_payments
2444                   + $self->in_transit_payments;
2445   foreach my $cust_bill ($self->open_cust_bill) {
2446     #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
2447     my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
2448       'invnum' => $cust_bill->invnum,
2449       'paybatchnum' => $cust_pay_batch->paybatchnum,
2450       'amount' => $cust_bill->owed,
2451       '_date' => time,
2452     };
2453     if ($unapplied >= $cust_bill_pay_batch->amount){
2454       $unapplied -= $cust_bill_pay_batch->amount;
2455       next;
2456     }else{
2457       $cust_bill_pay_batch->amount(sprintf ( "%.2f",
2458                                    $cust_bill_pay_batch->amount - $unapplied ));      $unapplied = 0;
2459     }
2460     $error = $cust_bill_pay_batch->insert;
2461     if ( $error ) {
2462       $dbh->rollback if $oldAutoCommit;
2463       die $error;
2464     }
2465   }
2466
2467   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2468   '';
2469 }
2470
2471 =item total_owed
2472
2473 Returns the total owed for this customer on all invoices
2474 (see L<FS::cust_bill/owed>).
2475
2476 =cut
2477
2478 sub total_owed {
2479   my $self = shift;
2480   $self->total_owed_date(2145859200); #12/31/2037
2481 }
2482
2483 =item total_owed_date TIME
2484
2485 Returns the total owed for this customer on all invoices with date earlier than
2486 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2487 see L<Time::Local> and L<Date::Parse> for conversion functions.
2488
2489 =cut
2490
2491 sub total_owed_date {
2492   my $self = shift;
2493   my $time = shift;
2494
2495   my $custnum = $self->custnum;
2496
2497   my $owed_sql = FS::cust_bill->owed_sql;
2498
2499   my $sql = "
2500     SELECT SUM($owed_sql) FROM cust_bill
2501       WHERE custnum = $custnum
2502         AND _date <= $time
2503   ";
2504
2505   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2506
2507 }
2508
2509 =item total_owed_pkgnum PKGNUM
2510
2511 Returns the total owed on all invoices for this customer's specific package
2512 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2513
2514 =cut
2515
2516 sub total_owed_pkgnum {
2517   my( $self, $pkgnum ) = @_;
2518   $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2519 }
2520
2521 =item total_owed_date_pkgnum TIME PKGNUM
2522
2523 Returns the total owed for this customer's specific package when using
2524 experimental package balances on all invoices with date earlier than
2525 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2526 see L<Time::Local> and L<Date::Parse> for conversion functions.
2527
2528 =cut
2529
2530 sub total_owed_date_pkgnum {
2531   my( $self, $time, $pkgnum ) = @_;
2532
2533   my $total_bill = 0;
2534   foreach my $cust_bill (
2535     grep { $_->_date <= $time }
2536       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2537   ) {
2538     $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2539   }
2540   sprintf( "%.2f", $total_bill );
2541
2542 }
2543
2544 =item total_paid
2545
2546 Returns the total amount of all payments.
2547
2548 =cut
2549
2550 sub total_paid {
2551   my $self = shift;
2552   my $total = 0;
2553   $total += $_->paid foreach $self->cust_pay;
2554   sprintf( "%.2f", $total );
2555 }
2556
2557 =item total_unapplied_credits
2558
2559 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2560 customer.  See L<FS::cust_credit/credited>.
2561
2562 =item total_credited
2563
2564 Old name for total_unapplied_credits.  Don't use.
2565
2566 =cut
2567
2568 sub total_credited {
2569   #carp "total_credited deprecated, use total_unapplied_credits";
2570   shift->total_unapplied_credits(@_);
2571 }
2572
2573 sub total_unapplied_credits {
2574   my $self = shift;
2575
2576   my $custnum = $self->custnum;
2577
2578   my $unapplied_sql = FS::cust_credit->unapplied_sql;
2579
2580   my $sql = "
2581     SELECT SUM($unapplied_sql) FROM cust_credit
2582       WHERE custnum = $custnum
2583   ";
2584
2585   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2586
2587 }
2588
2589 =item total_unapplied_credits_pkgnum PKGNUM
2590
2591 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2592 customer.  See L<FS::cust_credit/credited>.
2593
2594 =cut
2595
2596 sub total_unapplied_credits_pkgnum {
2597   my( $self, $pkgnum ) = @_;
2598   my $total_credit = 0;
2599   $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2600   sprintf( "%.2f", $total_credit );
2601 }
2602
2603
2604 =item total_unapplied_payments
2605
2606 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2607 See L<FS::cust_pay/unapplied>.
2608
2609 =cut
2610
2611 sub total_unapplied_payments {
2612   my $self = shift;
2613
2614   my $custnum = $self->custnum;
2615
2616   my $unapplied_sql = FS::cust_pay->unapplied_sql;
2617
2618   my $sql = "
2619     SELECT SUM($unapplied_sql) FROM cust_pay
2620       WHERE custnum = $custnum
2621   ";
2622
2623   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2624
2625 }
2626
2627 =item total_unapplied_payments_pkgnum PKGNUM
2628
2629 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2630 specific package when using experimental package balances.  See
2631 L<FS::cust_pay/unapplied>.
2632
2633 =cut
2634
2635 sub total_unapplied_payments_pkgnum {
2636   my( $self, $pkgnum ) = @_;
2637   my $total_unapplied = 0;
2638   $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2639   sprintf( "%.2f", $total_unapplied );
2640 }
2641
2642
2643 =item total_unapplied_refunds
2644
2645 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2646 customer.  See L<FS::cust_refund/unapplied>.
2647
2648 =cut
2649
2650 sub total_unapplied_refunds {
2651   my $self = shift;
2652   my $custnum = $self->custnum;
2653
2654   my $unapplied_sql = FS::cust_refund->unapplied_sql;
2655
2656   my $sql = "
2657     SELECT SUM($unapplied_sql) FROM cust_refund
2658       WHERE custnum = $custnum
2659   ";
2660
2661   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2662
2663 }
2664
2665 =item balance
2666
2667 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2668 total_unapplied_credits minus total_unapplied_payments).
2669
2670 =cut
2671
2672 sub balance {
2673   my $self = shift;
2674   $self->balance_date_range;
2675 }
2676
2677 =item balance_date TIME
2678
2679 Returns the balance for this customer, only considering invoices with date
2680 earlier than TIME (total_owed_date minus total_credited minus
2681 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
2682 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
2683 functions.
2684
2685 =cut
2686
2687 sub balance_date {
2688   my $self = shift;
2689   $self->balance_date_range(shift);
2690 }
2691
2692 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2693
2694 Returns the balance for this customer, optionally considering invoices with
2695 date earlier than START_TIME, and not later than END_TIME
2696 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2697
2698 Times are specified as SQL fragments or numeric
2699 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
2700 L<Date::Parse> for conversion functions.  The empty string can be passed
2701 to disable that time constraint completely.
2702
2703 Available options are:
2704
2705 =over 4
2706
2707 =item unapplied_date
2708
2709 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)
2710
2711 =back
2712
2713 =cut
2714
2715 sub balance_date_range {
2716   my $self = shift;
2717   my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2718             ') FROM cust_main WHERE custnum='. $self->custnum;
2719   sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2720 }
2721
2722 =item balance_pkgnum PKGNUM
2723
2724 Returns the balance for this customer's specific package when using
2725 experimental package balances (total_owed plus total_unrefunded, minus
2726 total_unapplied_credits minus total_unapplied_payments)
2727
2728 =cut
2729
2730 sub balance_pkgnum {
2731   my( $self, $pkgnum ) = @_;
2732
2733   sprintf( "%.2f",
2734       $self->total_owed_pkgnum($pkgnum)
2735 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2736 #    + $self->total_unapplied_refunds_pkgnum($pkgnum)
2737     - $self->total_unapplied_credits_pkgnum($pkgnum)
2738     - $self->total_unapplied_payments_pkgnum($pkgnum)
2739   );
2740 }
2741
2742 =item in_transit_payments
2743
2744 Returns the total of requests for payments for this customer pending in
2745 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
2746
2747 =cut
2748
2749 sub in_transit_payments {
2750   my $self = shift;
2751   my $in_transit_payments = 0;
2752   foreach my $pay_batch ( qsearch('pay_batch', {
2753     'status' => 'I',
2754   } ) ) {
2755     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
2756       'batchnum' => $pay_batch->batchnum,
2757       'custnum' => $self->custnum,
2758     } ) ) {
2759       $in_transit_payments += $cust_pay_batch->amount;
2760     }
2761   }
2762   sprintf( "%.2f", $in_transit_payments );
2763 }
2764
2765 =item payment_info
2766
2767 Returns a hash of useful information for making a payment.
2768
2769 =over 4
2770
2771 =item balance
2772
2773 Current balance.
2774
2775 =item payby
2776
2777 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2778 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2779 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2780
2781 =back
2782
2783 For credit card transactions:
2784
2785 =over 4
2786
2787 =item card_type 1
2788
2789 =item payname
2790
2791 Exact name on card
2792
2793 =back
2794
2795 For electronic check transactions:
2796
2797 =over 4
2798
2799 =item stateid_state
2800
2801 =back
2802
2803 =cut
2804
2805 sub payment_info {
2806   my $self = shift;
2807
2808   my %return = ();
2809
2810   $return{balance} = $self->balance;
2811
2812   $return{payname} = $self->payname
2813                      || ( $self->first. ' '. $self->get('last') );
2814
2815   $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
2816
2817   $return{payby} = $self->payby;
2818   $return{stateid_state} = $self->stateid_state;
2819
2820   if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
2821     $return{card_type} = cardtype($self->payinfo);
2822     $return{payinfo} = $self->paymask;
2823
2824     @return{'month', 'year'} = $self->paydate_monthyear;
2825
2826   }
2827
2828   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2829     my ($payinfo1, $payinfo2) = split '@', $self->paymask;
2830     $return{payinfo1} = $payinfo1;
2831     $return{payinfo2} = $payinfo2;
2832     $return{paytype}  = $self->paytype;
2833     $return{paystate} = $self->paystate;
2834
2835   }
2836
2837   #doubleclick protection
2838   my $_date = time;
2839   $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
2840
2841   %return;
2842
2843 }
2844
2845 =item paydate_monthyear
2846
2847 Returns a two-element list consisting of the month and year of this customer's
2848 paydate (credit card expiration date for CARD customers)
2849
2850 =cut
2851
2852 sub paydate_monthyear {
2853   my $self = shift;
2854   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2855     ( $2, $1 );
2856   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2857     ( $1, $3 );
2858   } else {
2859     ('', '');
2860   }
2861 }
2862
2863 =item tax_exemption TAXNAME
2864
2865 =cut
2866
2867 sub tax_exemption {
2868   my( $self, $taxname ) = @_;
2869
2870   qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
2871                                      'taxname' => $taxname,
2872                                    },
2873           );
2874 }
2875
2876 =item cust_main_exemption
2877
2878 =cut
2879
2880 sub cust_main_exemption {
2881   my $self = shift;
2882   qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
2883 }
2884
2885 =item invoicing_list [ ARRAYREF ]
2886
2887 If an arguement is given, sets these email addresses as invoice recipients
2888 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
2889 (except as warnings), so use check_invoicing_list first.
2890
2891 Returns a list of email addresses (with svcnum entries expanded).
2892
2893 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
2894 check it without disturbing anything by passing nothing.
2895
2896 This interface may change in the future.
2897
2898 =cut
2899
2900 sub invoicing_list {
2901   my( $self, $arrayref ) = @_;
2902
2903   if ( $arrayref ) {
2904     my @cust_main_invoice;
2905     if ( $self->custnum ) {
2906       @cust_main_invoice =
2907         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2908     } else {
2909       @cust_main_invoice = ();
2910     }
2911     foreach my $cust_main_invoice ( @cust_main_invoice ) {
2912       #warn $cust_main_invoice->destnum;
2913       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2914         #warn $cust_main_invoice->destnum;
2915         my $error = $cust_main_invoice->delete;
2916         warn $error if $error;
2917       }
2918     }
2919     if ( $self->custnum ) {
2920       @cust_main_invoice =
2921         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2922     } else {
2923       @cust_main_invoice = ();
2924     }
2925     my %seen = map { $_->address => 1 } @cust_main_invoice;
2926     foreach my $address ( @{$arrayref} ) {
2927       next if exists $seen{$address} && $seen{$address};
2928       $seen{$address} = 1;
2929       my $cust_main_invoice = new FS::cust_main_invoice ( {
2930         'custnum' => $self->custnum,
2931         'dest'    => $address,
2932       } );
2933       my $error = $cust_main_invoice->insert;
2934       warn $error if $error;
2935     }
2936   }
2937
2938   if ( $self->custnum ) {
2939     map { $_->address }
2940       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2941   } else {
2942     ();
2943   }
2944
2945 }
2946
2947 =item check_invoicing_list ARRAYREF
2948
2949 Checks these arguements as valid input for the invoicing_list method.  If there
2950 is an error, returns the error, otherwise returns false.
2951
2952 =cut
2953
2954 sub check_invoicing_list {
2955   my( $self, $arrayref ) = @_;
2956
2957   foreach my $address ( @$arrayref ) {
2958
2959     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
2960       return 'Can\'t add FAX invoice destination with a blank FAX number.';
2961     }
2962
2963     my $cust_main_invoice = new FS::cust_main_invoice ( {
2964       'custnum' => $self->custnum,
2965       'dest'    => $address,
2966     } );
2967     my $error = $self->custnum
2968                 ? $cust_main_invoice->check
2969                 : $cust_main_invoice->checkdest
2970     ;
2971     return $error if $error;
2972
2973   }
2974
2975   return "Email address required"
2976     if $conf->exists('cust_main-require_invoicing_list_email')
2977     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
2978
2979   '';
2980 }
2981
2982 =item set_default_invoicing_list
2983
2984 Sets the invoicing list to all accounts associated with this customer,
2985 overwriting any previous invoicing list.
2986
2987 =cut
2988
2989 sub set_default_invoicing_list {
2990   my $self = shift;
2991   $self->invoicing_list($self->all_emails);
2992 }
2993
2994 =item all_emails
2995
2996 Returns the email addresses of all accounts provisioned for this customer.
2997
2998 =cut
2999
3000 sub all_emails {
3001   my $self = shift;
3002   my %list;
3003   foreach my $cust_pkg ( $self->all_pkgs ) {
3004     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3005     my @svc_acct =
3006       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3007         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3008           @cust_svc;
3009     $list{$_}=1 foreach map { $_->email } @svc_acct;
3010   }
3011   keys %list;
3012 }
3013
3014 =item invoicing_list_addpost
3015
3016 Adds postal invoicing to this customer.  If this customer is already configured
3017 to receive postal invoices, does nothing.
3018
3019 =cut
3020
3021 sub invoicing_list_addpost {
3022   my $self = shift;
3023   return if grep { $_ eq 'POST' } $self->invoicing_list;
3024   my @invoicing_list = $self->invoicing_list;
3025   push @invoicing_list, 'POST';
3026   $self->invoicing_list(\@invoicing_list);
3027 }
3028
3029 =item invoicing_list_emailonly
3030
3031 Returns the list of email invoice recipients (invoicing_list without non-email
3032 destinations such as POST and FAX).
3033
3034 =cut
3035
3036 sub invoicing_list_emailonly {
3037   my $self = shift;
3038   warn "$me invoicing_list_emailonly called"
3039     if $DEBUG;
3040   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3041 }
3042
3043 =item invoicing_list_emailonly_scalar
3044
3045 Returns the list of email invoice recipients (invoicing_list without non-email
3046 destinations such as POST and FAX) as a comma-separated scalar.
3047
3048 =cut
3049
3050 sub invoicing_list_emailonly_scalar {
3051   my $self = shift;
3052   warn "$me invoicing_list_emailonly_scalar called"
3053     if $DEBUG;
3054   join(', ', $self->invoicing_list_emailonly);
3055 }
3056
3057 =item referral_custnum_cust_main
3058
3059 Returns the customer who referred this customer (or the empty string, if
3060 this customer was not referred).
3061
3062 Note the difference with referral_cust_main method: This method,
3063 referral_custnum_cust_main returns the single customer (if any) who referred
3064 this customer, while referral_cust_main returns an array of customers referred
3065 BY this customer.
3066
3067 =cut
3068
3069 sub referral_custnum_cust_main {
3070   my $self = shift;
3071   return '' unless $self->referral_custnum;
3072   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3073 }
3074
3075 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3076
3077 Returns an array of customers referred by this customer (referral_custnum set
3078 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
3079 customers referred by customers referred by this customer and so on, inclusive.
3080 The default behavior is DEPTH 1 (no recursion).
3081
3082 Note the difference with referral_custnum_cust_main method: This method,
3083 referral_cust_main, returns an array of customers referred BY this customer,
3084 while referral_custnum_cust_main returns the single customer (if any) who
3085 referred this customer.
3086
3087 =cut
3088
3089 sub referral_cust_main {
3090   my $self = shift;
3091   my $depth = @_ ? shift : 1;
3092   my $exclude = @_ ? shift : {};
3093
3094   my @cust_main =
3095     map { $exclude->{$_->custnum}++; $_; }
3096       grep { ! $exclude->{ $_->custnum } }
3097         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3098
3099   if ( $depth > 1 ) {
3100     push @cust_main,
3101       map { $_->referral_cust_main($depth-1, $exclude) }
3102         @cust_main;
3103   }
3104
3105   @cust_main;
3106 }
3107
3108 =item referral_cust_main_ncancelled
3109
3110 Same as referral_cust_main, except only returns customers with uncancelled
3111 packages.
3112
3113 =cut
3114
3115 sub referral_cust_main_ncancelled {
3116   my $self = shift;
3117   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3118 }
3119
3120 =item referral_cust_pkg [ DEPTH ]
3121
3122 Like referral_cust_main, except returns a flat list of all unsuspended (and
3123 uncancelled) packages for each customer.  The number of items in this list may
3124 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3125
3126 =cut
3127
3128 sub referral_cust_pkg {
3129   my $self = shift;
3130   my $depth = @_ ? shift : 1;
3131
3132   map { $_->unsuspended_pkgs }
3133     grep { $_->unsuspended_pkgs }
3134       $self->referral_cust_main($depth);
3135 }
3136
3137 =item referring_cust_main
3138
3139 Returns the single cust_main record for the customer who referred this customer
3140 (referral_custnum), or false.
3141
3142 =cut
3143
3144 sub referring_cust_main {
3145   my $self = shift;
3146   return '' unless $self->referral_custnum;
3147   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3148 }
3149
3150 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3151
3152 Applies a credit to this customer.  If there is an error, returns the error,
3153 otherwise returns false.
3154
3155 REASON can be a text string, an FS::reason object, or a scalar reference to
3156 a reasonnum.  If a text string, it will be automatically inserted as a new
3157 reason, and a 'reason_type' option must be passed to indicate the
3158 FS::reason_type for the new reason.
3159
3160 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3161
3162 Any other options are passed to FS::cust_credit::insert.
3163
3164 =cut
3165
3166 sub credit {
3167   my( $self, $amount, $reason, %options ) = @_;
3168
3169   my $cust_credit = new FS::cust_credit {
3170     'custnum' => $self->custnum,
3171     'amount'  => $amount,
3172   };
3173
3174   if ( ref($reason) ) {
3175
3176     if ( ref($reason) eq 'SCALAR' ) {
3177       $cust_credit->reasonnum( $$reason );
3178     } else {
3179       $cust_credit->reasonnum( $reason->reasonnum );
3180     }
3181
3182   } else {
3183     $cust_credit->set('reason', $reason)
3184   }
3185
3186   for (qw( addlinfo eventnum )) {
3187     $cust_credit->$_( delete $options{$_} )
3188       if exists($options{$_});
3189   }
3190
3191   $cust_credit->insert(%options);
3192
3193 }
3194
3195 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3196
3197 Creates a one-time charge for this customer.  If there is an error, returns
3198 the error, otherwise returns false.
3199
3200 New-style, with a hashref of options:
3201
3202   my $error = $cust_main->charge(
3203                                   {
3204                                     'amount'     => 54.32,
3205                                     'quantity'   => 1,
3206                                     'start_date' => str2time('7/4/2009'),
3207                                     'pkg'        => 'Description',
3208                                     'comment'    => 'Comment',
3209                                     'additional' => [], #extra invoice detail
3210                                     'classnum'   => 1,  #pkg_class
3211
3212                                     'setuptax'   => '', # or 'Y' for tax exempt
3213
3214                                     #internal taxation
3215                                     'taxclass'   => 'Tax class',
3216
3217                                     #vendor taxation
3218                                     'taxproduct' => 2,  #part_pkg_taxproduct
3219                                     'override'   => {}, #XXX describe
3220
3221                                     #will be filled in with the new object
3222                                     'cust_pkg_ref' => \$cust_pkg,
3223
3224                                     #generate an invoice immediately
3225                                     'bill_now' => 0,
3226                                     'invoice_terms' => '', #with these terms
3227                                   }
3228                                 );
3229
3230 Old-style:
3231
3232   my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3233
3234 =cut
3235
3236 sub charge {
3237   my $self = shift;
3238   my ( $amount, $quantity, $start_date, $classnum );
3239   my ( $pkg, $comment, $additional );
3240   my ( $setuptax, $taxclass );   #internal taxes
3241   my ( $taxproduct, $override ); #vendor (CCH) taxes
3242   my $no_auto = '';
3243   my $cust_pkg_ref = '';
3244   my ( $bill_now, $invoice_terms ) = ( 0, '' );
3245   if ( ref( $_[0] ) ) {
3246     $amount     = $_[0]->{amount};
3247     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3248     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3249     $no_auto    = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3250     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3251     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
3252                                            : '$'. sprintf("%.2f",$amount);
3253     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3254     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3255     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3256     $additional = $_[0]->{additional} || [];
3257     $taxproduct = $_[0]->{taxproductnum};
3258     $override   = { '' => $_[0]->{tax_override} };
3259     $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3260     $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3261     $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3262   } else {
3263     $amount     = shift;
3264     $quantity   = 1;
3265     $start_date = '';
3266     $pkg        = @_ ? shift : 'One-time charge';
3267     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
3268     $setuptax   = '';
3269     $taxclass   = @_ ? shift : '';
3270     $additional = [];
3271   }
3272
3273   local $SIG{HUP} = 'IGNORE';
3274   local $SIG{INT} = 'IGNORE';
3275   local $SIG{QUIT} = 'IGNORE';
3276   local $SIG{TERM} = 'IGNORE';
3277   local $SIG{TSTP} = 'IGNORE';
3278   local $SIG{PIPE} = 'IGNORE';
3279
3280   my $oldAutoCommit = $FS::UID::AutoCommit;
3281   local $FS::UID::AutoCommit = 0;
3282   my $dbh = dbh;
3283
3284   my $part_pkg = new FS::part_pkg ( {
3285     'pkg'           => $pkg,
3286     'comment'       => $comment,
3287     'plan'          => 'flat',
3288     'freq'          => 0,
3289     'disabled'      => 'Y',
3290     'classnum'      => ( $classnum ? $classnum : '' ),
3291     'setuptax'      => $setuptax,
3292     'taxclass'      => $taxclass,
3293     'taxproductnum' => $taxproduct,
3294   } );
3295
3296   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3297                         ( 0 .. @$additional - 1 )
3298                   ),
3299                   'additional_count' => scalar(@$additional),
3300                   'setup_fee' => $amount,
3301                 );
3302
3303   my $error = $part_pkg->insert( options       => \%options,
3304                                  tax_overrides => $override,
3305                                );
3306   if ( $error ) {
3307     $dbh->rollback if $oldAutoCommit;
3308     return $error;
3309   }
3310
3311   my $pkgpart = $part_pkg->pkgpart;
3312   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3313   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3314     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3315     $error = $type_pkgs->insert;
3316     if ( $error ) {
3317       $dbh->rollback if $oldAutoCommit;
3318       return $error;
3319     }
3320   }
3321
3322   my $cust_pkg = new FS::cust_pkg ( {
3323     'custnum'    => $self->custnum,
3324     'pkgpart'    => $pkgpart,
3325     'quantity'   => $quantity,
3326     'start_date' => $start_date,
3327     'no_auto'    => $no_auto,
3328   } );
3329
3330   $error = $cust_pkg->insert;
3331   if ( $error ) {
3332     $dbh->rollback if $oldAutoCommit;
3333     return $error;
3334   } elsif ( $cust_pkg_ref ) {
3335     ${$cust_pkg_ref} = $cust_pkg;
3336   }
3337
3338   if ( $bill_now ) {
3339     my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3340                              'pkg_list'      => [ $cust_pkg ],
3341                            );
3342     if ( $error ) {
3343       $dbh->rollback if $oldAutoCommit;
3344       return $error;
3345     }
3346   }
3347
3348   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3349   return '';
3350
3351 }
3352
3353 #=item charge_postal_fee
3354 #
3355 #Applies a one time charge this customer.  If there is an error,
3356 #returns the error, returns the cust_pkg charge object or false
3357 #if there was no charge.
3358 #
3359 #=cut
3360 #
3361 # This should be a customer event.  For that to work requires that bill
3362 # also be a customer event.
3363
3364 sub charge_postal_fee {
3365   my $self = shift;
3366
3367   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
3368   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3369
3370   my $cust_pkg = new FS::cust_pkg ( {
3371     'custnum'  => $self->custnum,
3372     'pkgpart'  => $pkgpart,
3373     'quantity' => 1,
3374   } );
3375
3376   my $error = $cust_pkg->insert;
3377   $error ? $error : $cust_pkg;
3378 }
3379
3380 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3381
3382 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3383
3384 Optionally, a list or hashref of additional arguments to the qsearch call can
3385 be passed.
3386
3387 =cut
3388
3389 sub cust_bill {
3390   my $self = shift;
3391   my $opt = ref($_[0]) ? shift : { @_ };
3392
3393   #return $self->num_cust_bill unless wantarray || keys %$opt;
3394
3395   $opt->{'table'} = 'cust_bill';
3396   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3397   $opt->{'hashref'}{'custnum'} = $self->custnum;
3398   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3399
3400   map { $_ } #behavior of sort undefined in scalar context
3401     sort { $a->_date <=> $b->_date }
3402       qsearch($opt);
3403 }
3404
3405 =item open_cust_bill
3406
3407 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3408 customer.
3409
3410 =cut
3411
3412 sub open_cust_bill {
3413   my $self = shift;
3414
3415   $self->cust_bill(
3416     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3417     #@_
3418   );
3419
3420 }
3421
3422 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3423
3424 Returns all the statements (see L<FS::cust_statement>) for this customer.
3425
3426 Optionally, a list or hashref of additional arguments to the qsearch call can
3427 be passed.
3428
3429 =cut
3430
3431 sub cust_statement {
3432   my $self = shift;
3433   my $opt = ref($_[0]) ? shift : { @_ };
3434
3435   #return $self->num_cust_statement unless wantarray || keys %$opt;
3436
3437   $opt->{'table'} = 'cust_statement';
3438   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3439   $opt->{'hashref'}{'custnum'} = $self->custnum;
3440   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3441
3442   map { $_ } #behavior of sort undefined in scalar context
3443     sort { $a->_date <=> $b->_date }
3444       qsearch($opt);
3445 }
3446
3447 =item cust_credit
3448
3449 Returns all the credits (see L<FS::cust_credit>) for this customer.
3450
3451 =cut
3452
3453 sub cust_credit {
3454   my $self = shift;
3455   map { $_ } #return $self->num_cust_credit unless wantarray;
3456   sort { $a->_date <=> $b->_date }
3457     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3458 }
3459
3460 =item cust_credit_pkgnum
3461
3462 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3463 package when using experimental package balances.
3464
3465 =cut
3466
3467 sub cust_credit_pkgnum {
3468   my( $self, $pkgnum ) = @_;
3469   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3470   sort { $a->_date <=> $b->_date }
3471     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3472                               'pkgnum'  => $pkgnum,
3473                             }
3474     );
3475 }
3476
3477 =item cust_pay
3478
3479 Returns all the payments (see L<FS::cust_pay>) for this customer.
3480
3481 =cut
3482
3483 sub cust_pay {
3484   my $self = shift;
3485   return $self->num_cust_pay unless wantarray;
3486   sort { $a->_date <=> $b->_date }
3487     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3488 }
3489
3490 =item num_cust_pay
3491
3492 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
3493 called automatically when the cust_pay method is used in a scalar context.
3494
3495 =cut
3496
3497 sub num_cust_pay {
3498   my $self = shift;
3499   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3500   my $sth = dbh->prepare($sql) or die dbh->errstr;
3501   $sth->execute($self->custnum) or die $sth->errstr;
3502   $sth->fetchrow_arrayref->[0];
3503 }
3504
3505 =item cust_pay_pkgnum
3506
3507 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3508 package when using experimental package balances.
3509
3510 =cut
3511
3512 sub cust_pay_pkgnum {
3513   my( $self, $pkgnum ) = @_;
3514   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3515   sort { $a->_date <=> $b->_date }
3516     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3517                            'pkgnum'  => $pkgnum,
3518                          }
3519     );
3520 }
3521
3522 =item cust_pay_void
3523
3524 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3525
3526 =cut
3527
3528 sub cust_pay_void {
3529   my $self = shift;
3530   map { $_ } #return $self->num_cust_pay_void unless wantarray;
3531   sort { $a->_date <=> $b->_date }
3532     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3533 }
3534
3535 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3536
3537 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
3538
3539 Optionally, a list or hashref of additional arguments to the qsearch call can
3540 be passed.
3541
3542 =cut
3543
3544 sub cust_pay_batch {
3545   my $self = shift;
3546   my $opt = ref($_[0]) ? shift : { @_ };
3547
3548   #return $self->num_cust_statement unless wantarray || keys %$opt;
3549
3550   $opt->{'table'} = 'cust_pay_batch';
3551   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3552   $opt->{'hashref'}{'custnum'} = $self->custnum;
3553   $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
3554
3555   map { $_ } #behavior of sort undefined in scalar context
3556     sort { $a->paybatchnum <=> $b->paybatchnum }
3557       qsearch($opt);
3558 }
3559
3560 =item cust_pay_pending
3561
3562 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3563 (without status "done").
3564
3565 =cut
3566
3567 sub cust_pay_pending {
3568   my $self = shift;
3569   return $self->num_cust_pay_pending unless wantarray;
3570   sort { $a->_date <=> $b->_date }
3571     qsearch( 'cust_pay_pending', {
3572                                    'custnum' => $self->custnum,
3573                                    'status'  => { op=>'!=', value=>'done' },
3574                                  },
3575            );
3576 }
3577
3578 =item cust_pay_pending_attempt
3579
3580 Returns all payment attempts / declined payments for this customer, as pending
3581 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3582 a corresponding payment (see L<FS::cust_pay>).
3583
3584 =cut
3585
3586 sub cust_pay_pending_attempt {
3587   my $self = shift;
3588   return $self->num_cust_pay_pending_attempt unless wantarray;
3589   sort { $a->_date <=> $b->_date }
3590     qsearch( 'cust_pay_pending', {
3591                                    'custnum' => $self->custnum,
3592                                    'status'  => 'done',
3593                                    'paynum'  => '',
3594                                  },
3595            );
3596 }
3597
3598 =item num_cust_pay_pending
3599
3600 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3601 customer (without status "done").  Also called automatically when the
3602 cust_pay_pending method is used in a scalar context.
3603
3604 =cut
3605
3606 sub num_cust_pay_pending {
3607   my $self = shift;
3608   $self->scalar_sql(
3609     " SELECT COUNT(*) FROM cust_pay_pending ".
3610       " WHERE custnum = ? AND status != 'done' ",
3611     $self->custnum
3612   );
3613 }
3614
3615 =item num_cust_pay_pending_attempt
3616
3617 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3618 customer, with status "done" but without a corresp.  Also called automatically when the
3619 cust_pay_pending method is used in a scalar context.
3620
3621 =cut
3622
3623 sub num_cust_pay_pending_attempt {
3624   my $self = shift;
3625   $self->scalar_sql(
3626     " SELECT COUNT(*) FROM cust_pay_pending ".
3627       " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3628     $self->custnum
3629   );
3630 }
3631
3632 =item cust_refund
3633
3634 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3635
3636 =cut
3637
3638 sub cust_refund {
3639   my $self = shift;
3640   map { $_ } #return $self->num_cust_refund unless wantarray;
3641   sort { $a->_date <=> $b->_date }
3642     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3643 }
3644
3645 =item display_custnum
3646
3647 Returns the displayed customer number for this customer: agent_custid if
3648 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3649
3650 =cut
3651
3652 sub display_custnum {
3653   my $self = shift;
3654   if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
3655     return $self->agent_custid;
3656   } else {
3657     return $self->custnum;
3658   }
3659 }
3660
3661 =item name
3662
3663 Returns a name string for this customer, either "Company (Last, First)" or
3664 "Last, First".
3665
3666 =cut
3667
3668 sub name {
3669   my $self = shift;
3670   my $name = $self->contact;
3671   $name = $self->company. " ($name)" if $self->company;
3672   $name;
3673 }
3674
3675 =item ship_name
3676
3677 Returns a name string for this (service/shipping) contact, either
3678 "Company (Last, First)" or "Last, First".
3679
3680 =cut
3681
3682 sub ship_name {
3683   my $self = shift;
3684   if ( $self->get('ship_last') ) {
3685     my $name = $self->ship_contact;
3686     $name = $self->ship_company. " ($name)" if $self->ship_company;
3687     $name;
3688   } else {
3689     $self->name;
3690   }
3691 }
3692
3693 =item name_short
3694
3695 Returns a name string for this customer, either "Company" or "First Last".
3696
3697 =cut
3698
3699 sub name_short {
3700   my $self = shift;
3701   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
3702 }
3703
3704 =item ship_name_short
3705
3706 Returns a name string for this (service/shipping) contact, either "Company"
3707 or "First Last".
3708
3709 =cut
3710
3711 sub ship_name_short {
3712   my $self = shift;
3713   if ( $self->get('ship_last') ) {
3714     $self->ship_company !~ /^\s*$/
3715       ? $self->ship_company
3716       : $self->ship_contact_firstlast;
3717   } else {
3718     $self->name_company_or_firstlast;
3719   }
3720 }
3721
3722 =item contact
3723
3724 Returns this customer's full (billing) contact name only, "Last, First"
3725
3726 =cut
3727
3728 sub contact {
3729   my $self = shift;
3730   $self->get('last'). ', '. $self->first;
3731 }
3732
3733 =item ship_contact
3734
3735 Returns this customer's full (shipping) contact name only, "Last, First"
3736
3737 =cut
3738
3739 sub ship_contact {
3740   my $self = shift;
3741   $self->get('ship_last')
3742     ? $self->get('ship_last'). ', '. $self->ship_first
3743     : $self->contact;
3744 }
3745
3746 =item contact_firstlast
3747
3748 Returns this customers full (billing) contact name only, "First Last".
3749
3750 =cut
3751
3752 sub contact_firstlast {
3753   my $self = shift;
3754   $self->first. ' '. $self->get('last');
3755 }
3756
3757 =item ship_contact_firstlast
3758
3759 Returns this customer's full (shipping) contact name only, "First Last".
3760
3761 =cut
3762
3763 sub ship_contact_firstlast {
3764   my $self = shift;
3765   $self->get('ship_last')
3766     ? $self->first. ' '. $self->get('ship_last')
3767     : $self->contact_firstlast;
3768 }
3769
3770 =item country_full
3771
3772 Returns this customer's full country name
3773
3774 =cut
3775
3776 sub country_full {
3777   my $self = shift;
3778   code2country($self->country);
3779 }
3780
3781 =item geocode DATA_VENDOR
3782
3783 Returns a value for the customer location as encoded by DATA_VENDOR.
3784 Currently this only makes sense for "CCH" as DATA_VENDOR.
3785
3786 =cut
3787
3788 =item cust_status
3789
3790 =item status
3791
3792 Returns a status string for this customer, currently:
3793
3794 =over 4
3795
3796 =item prospect - No packages have ever been ordered
3797
3798 =item ordered - Recurring packages all are new (not yet billed).
3799
3800 =item active - One or more recurring packages is active
3801
3802 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
3803
3804 =item suspended - All non-cancelled recurring packages are suspended
3805
3806 =item cancelled - All recurring packages are cancelled
3807
3808 =back
3809
3810 =cut
3811
3812 sub status { shift->cust_status(@_); }
3813
3814 sub cust_status {
3815   my $self = shift;
3816   for my $status ( FS::cust_main->statuses() ) {
3817     my $method = $status.'_sql';
3818     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3819     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3820     $sth->execute( ($self->custnum) x $numnum )
3821       or die "Error executing 'SELECT $sql': ". $sth->errstr;
3822     return $status if $sth->fetchrow_arrayref->[0];
3823   }
3824 }
3825
3826 =item ucfirst_cust_status
3827
3828 =item ucfirst_status
3829
3830 Returns the status with the first character capitalized.
3831
3832 =cut
3833
3834 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
3835
3836 sub ucfirst_cust_status {
3837   my $self = shift;
3838   ucfirst($self->cust_status);
3839 }
3840
3841 =item statuscolor
3842
3843 Returns a hex triplet color string for this customer's status.
3844
3845 =cut
3846
3847 use vars qw(%statuscolor);
3848 tie %statuscolor, 'Tie::IxHash',
3849   'prospect'  => '7e0079', #'000000', #black?  naw, purple
3850   'active'    => '00CC00', #green
3851   'ordered'   => '009999', #teal? cyan?
3852   'suspended' => 'FF9900', #yellow
3853   'cancelled' => 'FF0000', #red
3854   'inactive'  => '0000CC', #blue
3855 ;
3856
3857 sub statuscolor { shift->cust_statuscolor(@_); }
3858
3859 sub cust_statuscolor {
3860   my $self = shift;
3861   $statuscolor{$self->cust_status};
3862 }
3863
3864 =item tickets
3865
3866 Returns an array of hashes representing the customer's RT tickets.
3867
3868 =cut
3869
3870 sub tickets {
3871   my $self = shift;
3872
3873   my $num = $conf->config('cust_main-max_tickets') || 10;
3874   my @tickets = ();
3875
3876   if ( $conf->config('ticket_system') ) {
3877     unless ( $conf->config('ticket_system-custom_priority_field') ) {
3878
3879       @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
3880
3881     } else {
3882
3883       foreach my $priority (
3884         $conf->config('ticket_system-custom_priority_field-values'), ''
3885       ) {
3886         last if scalar(@tickets) >= $num;
3887         push @tickets,
3888           @{ FS::TicketSystem->customer_tickets( $self->custnum,
3889                                                  $num - scalar(@tickets),
3890                                                  $priority,
3891                                                )
3892            };
3893       }
3894     }
3895   }
3896   (@tickets);
3897 }
3898
3899 # Return services representing svc_accts in customer support packages
3900 sub support_services {
3901   my $self = shift;
3902   my %packages = map { $_ => 1 } $conf->config('support_packages');
3903
3904   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
3905     grep { $_->part_svc->svcdb eq 'svc_acct' }
3906     map { $_->cust_svc }
3907     grep { exists $packages{ $_->pkgpart } }
3908     $self->ncancelled_pkgs;
3909
3910 }
3911
3912 # Return a list of latitude/longitude for one of the services (if any)
3913 sub service_coordinates {
3914   my $self = shift;
3915
3916   my @svc_X =
3917     grep { $_->latitude && $_->longitude }
3918     map { $_->svc_x }
3919     map { $_->cust_svc }
3920     $self->ncancelled_pkgs;
3921
3922   scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
3923 }
3924
3925 =item masked FIELD
3926
3927 Returns a masked version of the named field
3928
3929 =cut
3930
3931 sub masked {
3932 my ($self,$field) = @_;
3933
3934 # Show last four
3935
3936 'x'x(length($self->getfield($field))-4).
3937   substr($self->getfield($field), (length($self->getfield($field))-4));
3938
3939 }
3940
3941 =back
3942
3943 =head1 CLASS METHODS
3944
3945 =over 4
3946
3947 =item statuses
3948
3949 Class method that returns the list of possible status strings for customers
3950 (see L<the status method|/status>).  For example:
3951
3952   @statuses = FS::cust_main->statuses();
3953
3954 =cut
3955
3956 sub statuses {
3957   #my $self = shift; #could be class...
3958   keys %statuscolor;
3959 }
3960
3961 =item cust_status_sql
3962
3963 Returns an SQL fragment to determine the status of a cust_main record, as a
3964 string.
3965
3966 =cut
3967
3968 sub cust_status_sql {
3969   my $sql = 'CASE';
3970   for my $status ( FS::cust_main->statuses() ) {
3971     my $method = $status.'_sql';
3972     $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
3973   }
3974   $sql .= ' END';
3975   return $sql;
3976 }
3977
3978
3979 =item prospect_sql
3980
3981 Returns an SQL expression identifying prospective cust_main records (customers
3982 with no packages ever ordered)
3983
3984 =cut
3985
3986 use vars qw($select_count_pkgs);
3987 $select_count_pkgs =
3988   "SELECT COUNT(*) FROM cust_pkg
3989     WHERE cust_pkg.custnum = cust_main.custnum";
3990
3991 sub select_count_pkgs_sql {
3992   $select_count_pkgs;
3993 }
3994
3995 sub prospect_sql {
3996   " 0 = ( $select_count_pkgs ) ";
3997 }
3998
3999 =item ordered_sql
4000
4001 Returns an SQL expression identifying ordered cust_main records (customers with
4002 recurring packages not yet setup).
4003
4004 =cut
4005
4006 sub ordered_sql {
4007   FS::cust_main->none_active_sql.
4008   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->ordered_sql. " ) ";
4009 }
4010
4011 =item active_sql
4012
4013 Returns an SQL expression identifying active cust_main records (customers with
4014 active recurring packages).
4015
4016 =cut
4017
4018 sub active_sql {
4019   " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4020 }
4021
4022 =item none_active_sql
4023
4024 Returns an SQL expression identifying cust_main records with no active
4025 recurring packages.  This includes customers of status prospect, ordered,
4026 inactive, and suspended.
4027
4028 =cut
4029
4030 sub none_active_sql {
4031   " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4032 }
4033
4034 =item inactive_sql
4035
4036 Returns an SQL expression identifying inactive cust_main records (customers with
4037 no active recurring packages, but otherwise unsuspended/uncancelled).
4038
4039 =cut
4040
4041 sub inactive_sql {
4042   FS::cust_main->none_active_sql.
4043   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4044 }
4045
4046 =item susp_sql
4047 =item suspended_sql
4048
4049 Returns an SQL expression identifying suspended cust_main records.
4050
4051 =cut
4052
4053
4054 sub suspended_sql { susp_sql(@_); }
4055 sub susp_sql {
4056   FS::cust_main->none_active_sql.
4057   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4058 }
4059
4060 =item cancel_sql
4061 =item cancelled_sql
4062
4063 Returns an SQL expression identifying cancelled cust_main records.
4064
4065 =cut
4066
4067 sub cancelled_sql { cancel_sql(@_); }
4068 sub cancel_sql {
4069
4070   my $recurring_sql = FS::cust_pkg->recurring_sql;
4071   my $cancelled_sql = FS::cust_pkg->cancelled_sql;
4072
4073   "
4074         0 < ( $select_count_pkgs )
4075     AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql   )
4076     AND 0 = ( $select_count_pkgs AND $recurring_sql
4077                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4078             )
4079   ";
4080 #    AND 0 = (  $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
4081
4082 }
4083
4084 =item uncancel_sql
4085 =item uncancelled_sql
4086
4087 Returns an SQL expression identifying un-cancelled cust_main records.
4088
4089 =cut
4090
4091 sub uncancelled_sql { uncancel_sql(@_); }
4092 sub uncancel_sql { "
4093   ( 0 < ( $select_count_pkgs
4094                    AND ( cust_pkg.cancel IS NULL
4095                          OR cust_pkg.cancel = 0
4096                        )
4097         )
4098     OR 0 = ( $select_count_pkgs )
4099   )
4100 "; }
4101
4102 =item balance_sql
4103
4104 Returns an SQL fragment to retreive the balance.
4105
4106 =cut
4107
4108 sub balance_sql { "
4109     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4110         WHERE cust_bill.custnum   = cust_main.custnum     )
4111   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
4112         WHERE cust_pay.custnum    = cust_main.custnum     )
4113   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
4114         WHERE cust_credit.custnum = cust_main.custnum     )
4115   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
4116         WHERE cust_refund.custnum = cust_main.custnum     )
4117 "; }
4118
4119 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4120
4121 Returns an SQL fragment to retreive the balance for this customer, optionally
4122 considering invoices with date earlier than START_TIME, and not
4123 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4124 total_unapplied_payments).
4125
4126 Times are specified as SQL fragments or numeric
4127 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4128 L<Date::Parse> for conversion functions.  The empty string can be passed
4129 to disable that time constraint completely.
4130
4131 Available options are:
4132
4133 =over 4
4134
4135 =item unapplied_date
4136
4137 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)
4138
4139 =item total
4140
4141 (unused.  obsolete?)
4142 set to true to remove all customer comparison clauses, for totals
4143
4144 =item where
4145
4146 (unused.  obsolete?)
4147 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4148
4149 =item join
4150
4151 (unused.  obsolete?)
4152 JOIN clause (typically used with the total option)
4153
4154 =item cutoff
4155
4156 An absolute cutoff time.  Payments, credits, and refunds I<applied> after this
4157 time will be ignored.  Note that START_TIME and END_TIME only limit the date
4158 range for invoices and I<unapplied> payments, credits, and refunds.
4159
4160 =back
4161
4162 =cut
4163
4164 sub balance_date_sql {
4165   my( $class, $start, $end, %opt ) = @_;
4166
4167   my $cutoff = $opt{'cutoff'};
4168
4169   my $owed         = FS::cust_bill->owed_sql($cutoff);
4170   my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4171   my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4172   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4173
4174   my $j = $opt{'join'} || '';
4175
4176   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
4177   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4178   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4179   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
4180
4181   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
4182     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4183     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4184     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
4185   ";
4186
4187 }
4188
4189 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4190
4191 Returns an SQL fragment to retreive the total unapplied payments for this
4192 customer, only considering invoices with date earlier than START_TIME, and
4193 optionally not later than END_TIME.
4194
4195 Times are specified as SQL fragments or numeric
4196 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4197 L<Date::Parse> for conversion functions.  The empty string can be passed
4198 to disable that time constraint completely.
4199
4200 Available options are:
4201
4202 =cut
4203
4204 sub unapplied_payments_date_sql {
4205   my( $class, $start, $end, %opt ) = @_;
4206
4207   my $cutoff = $opt{'cutoff'};
4208
4209   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4210
4211   my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4212                                                           'unapplied_date'=>1 );
4213
4214   " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4215 }
4216
4217 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4218
4219 Helper method for balance_date_sql; name (and usage) subject to change
4220 (suggestions welcome).
4221
4222 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4223 cust_refund, cust_credit or cust_pay).
4224
4225 If TABLE is "cust_bill" or the unapplied_date option is true, only
4226 considers records with date earlier than START_TIME, and optionally not
4227 later than END_TIME .
4228
4229 =cut
4230
4231 sub _money_table_where {
4232   my( $class, $table, $start, $end, %opt ) = @_;
4233
4234   my @where = ();
4235   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4236   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4237     push @where, "$table._date <= $start" if defined($start) && length($start);
4238     push @where, "$table._date >  $end"   if defined($end)   && length($end);
4239   }
4240   push @where, @{$opt{'where'}} if $opt{'where'};
4241   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4242
4243   $where;
4244
4245 }
4246
4247 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4248 use FS::cust_main::Search;
4249 sub search {
4250   my $class = shift;
4251   FS::cust_main::Search->search(@_);
4252 }
4253
4254 =back
4255
4256 =head1 SUBROUTINES
4257
4258 =over 4
4259
4260 =item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
4261
4262 =cut
4263
4264 use FS::cust_main::Search;
4265 sub append_fuzzyfiles {
4266   #my( $first, $last, $company ) = @_;
4267
4268   FS::cust_main::Search::check_and_rebuild_fuzzyfiles();
4269
4270   use Fcntl qw(:flock);
4271
4272   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
4273
4274   foreach my $field (@fuzzyfields) {
4275     my $value = shift;
4276
4277     if ( $value ) {
4278
4279       open(CACHE,">>$dir/cust_main.$field")
4280         or die "can't open $dir/cust_main.$field: $!";
4281       flock(CACHE,LOCK_EX)
4282         or die "can't lock $dir/cust_main.$field: $!";
4283
4284       print CACHE "$value\n";
4285
4286       flock(CACHE,LOCK_UN)
4287         or die "can't unlock $dir/cust_main.$field: $!";
4288       close CACHE;
4289     }
4290
4291   }
4292
4293   1;
4294 }
4295
4296 =item batch_charge
4297
4298 =cut
4299
4300 sub batch_charge {
4301   my $param = shift;
4302   #warn join('-',keys %$param);
4303   my $fh = $param->{filehandle};
4304   my $agentnum = $param->{agentnum};
4305   my $format = $param->{format};
4306
4307   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
4308
4309   my @fields;
4310   if ( $format eq 'simple' ) {
4311     @fields = qw( custnum agent_custid amount pkg );
4312   } else {
4313     die "unknown format $format";
4314   }
4315
4316   eval "use Text::CSV_XS;";
4317   die $@ if $@;
4318
4319   my $csv = new Text::CSV_XS;
4320   #warn $csv;
4321   #warn $fh;
4322
4323   my $imported = 0;
4324   #my $columns;
4325
4326   local $SIG{HUP} = 'IGNORE';
4327   local $SIG{INT} = 'IGNORE';
4328   local $SIG{QUIT} = 'IGNORE';
4329   local $SIG{TERM} = 'IGNORE';
4330   local $SIG{TSTP} = 'IGNORE';
4331   local $SIG{PIPE} = 'IGNORE';
4332
4333   my $oldAutoCommit = $FS::UID::AutoCommit;
4334   local $FS::UID::AutoCommit = 0;
4335   my $dbh = dbh;
4336
4337   #while ( $columns = $csv->getline($fh) ) {
4338   my $line;
4339   while ( defined($line=<$fh>) ) {
4340
4341     $csv->parse($line) or do {
4342       $dbh->rollback if $oldAutoCommit;
4343       return "can't parse: ". $csv->error_input();
4344     };
4345
4346     my @columns = $csv->fields();
4347     #warn join('-',@columns);
4348
4349     my %row = ();
4350     foreach my $field ( @fields ) {
4351       $row{$field} = shift @columns;
4352     }
4353
4354     if ( $row{custnum} && $row{agent_custid} ) {
4355       dbh->rollback if $oldAutoCommit;
4356       return "can't specify custnum with agent_custid $row{agent_custid}";
4357     }
4358
4359     my %hash = ();
4360     if ( $row{agent_custid} && $agentnum ) {
4361       %hash = ( 'agent_custid' => $row{agent_custid},
4362                 'agentnum'     => $agentnum,
4363               );
4364     }
4365
4366     if ( $row{custnum} ) {
4367       %hash = ( 'custnum' => $row{custnum} );
4368     }
4369
4370     unless ( scalar(keys %hash) ) {
4371       $dbh->rollback if $oldAutoCommit;
4372       return "can't find customer without custnum or agent_custid and agentnum";
4373     }
4374
4375     my $cust_main = qsearchs('cust_main', { %hash } );
4376     unless ( $cust_main ) {
4377       $dbh->rollback if $oldAutoCommit;
4378       my $custnum = $row{custnum} || $row{agent_custid};
4379       return "unknown custnum $custnum";
4380     }
4381
4382     if ( $row{'amount'} > 0 ) {
4383       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4384       if ( $error ) {
4385         $dbh->rollback if $oldAutoCommit;
4386         return $error;
4387       }
4388       $imported++;
4389     } elsif ( $row{'amount'} < 0 ) {
4390       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4391                                       $row{'pkg'}                         );
4392       if ( $error ) {
4393         $dbh->rollback if $oldAutoCommit;
4394         return $error;
4395       }
4396       $imported++;
4397     } else {
4398       #hmm?
4399     }
4400
4401   }
4402
4403   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4404
4405   return "Empty file!" unless $imported;
4406
4407   ''; #no error
4408
4409 }
4410
4411 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4412
4413 Deprecated.  Use event notification and message templates
4414 (L<FS::msg_template>) instead.
4415
4416 Sends a templated email notification to the customer (see L<Text::Template>).
4417
4418 OPTIONS is a hash and may include
4419
4420 I<from> - the email sender (default is invoice_from)
4421
4422 I<to> - comma-separated scalar or arrayref of recipients
4423    (default is invoicing_list)
4424
4425 I<subject> - The subject line of the sent email notification
4426    (default is "Notice from company_name")
4427
4428 I<extra_fields> - a hashref of name/value pairs which will be substituted
4429    into the template
4430
4431 The following variables are vavailable in the template.
4432
4433 I<$first> - the customer first name
4434 I<$last> - the customer last name
4435 I<$company> - the customer company
4436 I<$payby> - a description of the method of payment for the customer
4437             # would be nice to use FS::payby::shortname
4438 I<$payinfo> - the account information used to collect for this customer
4439 I<$expdate> - the expiration of the customer payment in seconds from epoch
4440
4441 =cut
4442
4443 sub notify {
4444   my ($self, $template, %options) = @_;
4445
4446   return unless $conf->exists($template);
4447
4448   my $from = $conf->config('invoice_from', $self->agentnum)
4449     if $conf->exists('invoice_from', $self->agentnum);
4450   $from = $options{from} if exists($options{from});
4451
4452   my $to = join(',', $self->invoicing_list_emailonly);
4453   $to = $options{to} if exists($options{to});
4454
4455   my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4456     if $conf->exists('company_name', $self->agentnum);
4457   $subject = $options{subject} if exists($options{subject});
4458
4459   my $notify_template = new Text::Template (TYPE => 'ARRAY',
4460                                             SOURCE => [ map "$_\n",
4461                                               $conf->config($template)]
4462                                            )
4463     or die "can't create new Text::Template object: Text::Template::ERROR";
4464   $notify_template->compile()
4465     or die "can't compile template: Text::Template::ERROR";
4466
4467   $FS::notify_template::_template::company_name =
4468     $conf->config('company_name', $self->agentnum);
4469   $FS::notify_template::_template::company_address =
4470     join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4471
4472   my $paydate = $self->paydate || '2037-12-31';
4473   $FS::notify_template::_template::first = $self->first;
4474   $FS::notify_template::_template::last = $self->last;
4475   $FS::notify_template::_template::company = $self->company;
4476   $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4477   my $payby = $self->payby;
4478   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4479   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4480
4481   #credit cards expire at the end of the month/year of their exp date
4482   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4483     $FS::notify_template::_template::payby = 'credit card';
4484     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4485     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4486     $expire_time--;
4487   }elsif ($payby eq 'COMP') {
4488     $FS::notify_template::_template::payby = 'complimentary account';
4489   }else{
4490     $FS::notify_template::_template::payby = 'current method';
4491   }
4492   $FS::notify_template::_template::expdate = $expire_time;
4493
4494   for (keys %{$options{extra_fields}}){
4495     no strict "refs";
4496     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4497   }
4498
4499   send_email(from => $from,
4500              to => $to,
4501              subject => $subject,
4502              body => $notify_template->fill_in( PACKAGE =>
4503                                                 'FS::notify_template::_template'                                              ),
4504             );
4505
4506 }
4507
4508 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4509
4510 Generates a templated notification to the customer (see L<Text::Template>).
4511
4512 OPTIONS is a hash and may include
4513
4514 I<extra_fields> - a hashref of name/value pairs which will be substituted
4515    into the template.  These values may override values mentioned below
4516    and those from the customer record.
4517
4518 The following variables are available in the template instead of or in addition
4519 to the fields of the customer record.
4520
4521 I<$payby> - a description of the method of payment for the customer
4522             # would be nice to use FS::payby::shortname
4523 I<$payinfo> - the masked account information used to collect for this customer
4524 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4525 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4526
4527 =cut
4528
4529 # a lot like cust_bill::print_latex
4530 sub generate_letter {
4531   my ($self, $template, %options) = @_;
4532
4533   return unless $conf->exists($template);
4534
4535   my $letter_template = new Text::Template
4536                         ( TYPE       => 'ARRAY',
4537                           SOURCE     => [ map "$_\n", $conf->config($template)],
4538                           DELIMITERS => [ '[@--', '--@]' ],
4539                         )
4540     or die "can't create new Text::Template object: Text::Template::ERROR";
4541
4542   $letter_template->compile()
4543     or die "can't compile template: Text::Template::ERROR";
4544
4545   my %letter_data = map { $_ => $self->$_ } $self->fields;
4546   $letter_data{payinfo} = $self->mask_payinfo;
4547
4548   #my $paydate = $self->paydate || '2037-12-31';
4549   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4550
4551   my $payby = $self->payby;
4552   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4553   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4554
4555   #credit cards expire at the end of the month/year of their exp date
4556   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4557     $letter_data{payby} = 'credit card';
4558     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4559     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4560     $expire_time--;
4561   }elsif ($payby eq 'COMP') {
4562     $letter_data{payby} = 'complimentary account';
4563   }else{
4564     $letter_data{payby} = 'current method';
4565   }
4566   $letter_data{expdate} = $expire_time;
4567
4568   for (keys %{$options{extra_fields}}){
4569     $letter_data{$_} = $options{extra_fields}->{$_};
4570   }
4571
4572   unless(exists($letter_data{returnaddress})){
4573     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4574                                                   $self->agent_template)
4575                      );
4576     if ( length($retadd) ) {
4577       $letter_data{returnaddress} = $retadd;
4578     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4579       $letter_data{returnaddress} =
4580         join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4581                           s/$/\\\\\*/;
4582                           $_;
4583                         }
4584                     ( $conf->config('company_name', $self->agentnum),
4585                       $conf->config('company_address', $self->agentnum),
4586                     )
4587         );
4588     } else {
4589       $letter_data{returnaddress} = '~';
4590     }
4591   }
4592
4593   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4594
4595   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4596
4597   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4598
4599   my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4600                            DIR      => $dir,
4601                            SUFFIX   => '.eps',
4602                            UNLINK   => 0,
4603                          ) or die "can't open temp file: $!\n";
4604   print $lh $conf->config_binary('logo.eps', $self->agentnum)
4605     or die "can't write temp file: $!\n";
4606   close $lh;
4607   $letter_data{'logo_file'} = $lh->filename;
4608
4609   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4610                            DIR      => $dir,
4611                            SUFFIX   => '.tex',
4612                            UNLINK   => 0,
4613                          ) or die "can't open temp file: $!\n";
4614
4615   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4616   close $fh;
4617   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4618   return ($1, $letter_data{'logo_file'});
4619
4620 }
4621
4622 =item print_ps TEMPLATE
4623
4624 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4625
4626 =cut
4627
4628 sub print_ps {
4629   my $self = shift;
4630   my($file, $lfile) = $self->generate_letter(@_);
4631   my $ps = FS::Misc::generate_ps($file);
4632   unlink($file.'.tex');
4633   unlink($lfile);
4634
4635   $ps;
4636 }
4637
4638 =item print TEMPLATE
4639
4640 Prints the filled in template.
4641
4642 TEMPLATE is the name of a L<Text::Template> to fill in and print.
4643
4644 =cut
4645
4646 sub queueable_print {
4647   my %opt = @_;
4648
4649   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
4650     or die "invalid customer number: " . $opt{custvnum};
4651
4652   my $error = $self->print( $opt{template} );
4653   die $error if $error;
4654 }
4655
4656 sub print {
4657   my ($self, $template) = (shift, shift);
4658   do_print [ $self->print_ps($template) ];
4659 }
4660
4661 #these three subs should just go away once agent stuff is all config overrides
4662
4663 sub agent_template {
4664   my $self = shift;
4665   $self->_agent_plandata('agent_templatename');
4666 }
4667
4668 sub agent_invoice_from {
4669   my $self = shift;
4670   $self->_agent_plandata('agent_invoice_from');
4671 }
4672
4673 sub _agent_plandata {
4674   my( $self, $option ) = @_;
4675
4676   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
4677   #agent-specific Conf
4678
4679   use FS::part_event::Condition;
4680
4681   my $agentnum = $self->agentnum;
4682
4683   my $regexp = regexp_sql();
4684
4685   my $part_event_option =
4686     qsearchs({
4687       'select'    => 'part_event_option.*',
4688       'table'     => 'part_event_option',
4689       'addl_from' => q{
4690         LEFT JOIN part_event USING ( eventpart )
4691         LEFT JOIN part_event_option AS peo_agentnum
4692           ON ( part_event.eventpart = peo_agentnum.eventpart
4693                AND peo_agentnum.optionname = 'agentnum'
4694                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
4695              )
4696         LEFT JOIN part_event_condition
4697           ON ( part_event.eventpart = part_event_condition.eventpart
4698                AND part_event_condition.conditionname = 'cust_bill_age'
4699              )
4700         LEFT JOIN part_event_condition_option
4701           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
4702                AND part_event_condition_option.optionname = 'age'
4703              )
4704       },
4705       #'hashref'   => { 'optionname' => $option },
4706       #'hashref'   => { 'part_event_option.optionname' => $option },
4707       'extra_sql' =>
4708         " WHERE part_event_option.optionname = ". dbh->quote($option).
4709         " AND action = 'cust_bill_send_agent' ".
4710         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
4711         " AND peo_agentnum.optionname = 'agentnum' ".
4712         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
4713         " ORDER BY
4714            CASE WHEN part_event_condition_option.optionname IS NULL
4715            THEN -1
4716            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
4717         " END
4718           , part_event.weight".
4719         " LIMIT 1"
4720     });
4721
4722   unless ( $part_event_option ) {
4723     return $self->agent->invoice_template || ''
4724       if $option eq 'agent_templatename';
4725     return '';
4726   }
4727
4728   $part_event_option->optionvalue;
4729
4730 }
4731
4732 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
4733
4734 Subroutine (not a method), designed to be called from the queue.
4735
4736 Takes a list of options and values.
4737
4738 Pulls up the customer record via the custnum option and calls bill_and_collect.
4739
4740 =cut
4741
4742 sub queued_bill {
4743   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
4744
4745   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
4746   warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
4747
4748   $cust_main->bill_and_collect( %args );
4749 }
4750
4751 sub process_bill_and_collect {
4752   my $job = shift;
4753   my $param = thaw(decode_base64(shift));
4754   my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
4755       or die "custnum '$param->{custnum}' not found!\n";
4756   $param->{'job'}   = $job;
4757   $param->{'fatal'} = 1; # runs from job queue, will be caught
4758   $param->{'retry'} = 1;
4759
4760   $cust_main->bill_and_collect( %$param );
4761 }
4762
4763 sub _upgrade_data { #class method
4764   my ($class, %opts) = @_;
4765
4766   my @statements = (
4767     'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
4768     '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',
4769   );
4770   # fix yyyy-m-dd formatted paydates
4771   if ( driver_name =~ /^mysql$/i ) {
4772     push @statements,
4773     "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
4774   }
4775   else { # the SQL standard
4776     push @statements,
4777     "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
4778   }
4779
4780   foreach my $sql ( @statements ) {
4781     my $sth = dbh->prepare($sql) or die dbh->errstr;
4782     $sth->execute or die $sth->errstr;
4783   }
4784
4785   local($ignore_expired_card) = 1;
4786   local($ignore_illegal_zip) = 1;
4787   local($ignore_banned_card) = 1;
4788   local($skip_fuzzyfiles) = 1;
4789   $class->_upgrade_otaker(%opts);
4790
4791 }
4792
4793 =back
4794
4795 =head1 BUGS
4796
4797 The delete method.
4798
4799 The delete method should possibly take an FS::cust_main object reference
4800 instead of a scalar customer number.
4801
4802 Bill and collect options should probably be passed as references instead of a
4803 list.
4804
4805 There should probably be a configuration file with a list of allowed credit
4806 card types.
4807
4808 No multiple currency support (probably a larger project than just this module).
4809
4810 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4811
4812 Birthdates rely on negative epoch values.
4813
4814 The payby for card/check batches is broken.  With mixed batching, bad
4815 things will happen.
4816
4817 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
4818
4819 =head1 SEE ALSO
4820
4821 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4822 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4823 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
4824
4825 =cut
4826
4827 1;
4828