FS/FS/cust_main.pm

   1 package FS::cust_main;
   2
   3 require 5.006;
   4 use strict;
   5 use base qw( FS::cust_main::Packages FS::cust_main::Status
   6              FS::cust_main::NationalID
   7              FS::cust_main::Billing FS::cust_main::Billing_Realtime
   8              FS::cust_main::Billing_Discount
   9              FS::cust_main::Location
  10              FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin
  11              FS::geocode_Mixin FS::Quotable_Mixin
  12              FS::o2m_Common
  13              FS::Record
  14            );
  15 use vars qw( $DEBUG $me $conf
  16              @encrypted_fields
  17              $import
  18              $ignore_expired_card $ignore_banned_card $ignore_illegal_zip
  19              $skip_fuzzyfiles
  20              @paytypes
  21            );
  22 use Carp;
  23 use Scalar::Util qw( blessed );
  24 use Time::Local qw(timelocal);
  25 use Storable qw(thaw);
  26 use MIME::Base64;
  27 use Data::Dumper;
  28 use Tie::IxHash;
  29 use Digest::MD5 qw(md5_base64);
  30 use Date::Format;
  31 #use Date::Manip;
  32 use File::Temp; #qw( tempfile );
  33 use Business::CreditCard 0.28;
  34 use Locale::Country;
  35 use FS::UID qw( dbh driver_name );
  36 use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
  37 use FS::Misc qw( generate_email send_email generate_ps do_print );
  38 use FS::Msgcat qw(gettext);
  39 use FS::CurrentUser;
  40 use FS::TicketSystem;
  41 use FS::payby;
  42 use FS::cust_pkg;
  43 use FS::cust_svc;
  44 use FS::cust_bill;
  45 use FS::cust_bill_void;
  46 use FS::legacy_cust_bill;
  47 use FS::cust_pay;
  48 use FS::cust_pay_pending;
  49 use FS::cust_pay_void;
  50 use FS::cust_pay_batch;
  51 use FS::cust_credit;
  52 use FS::cust_refund;
  53 use FS::part_referral;
  54 use FS::cust_main_county;
  55 use FS::cust_location;
  56 use FS::cust_class;
  57 use FS::cust_main_exemption;
  58 use FS::cust_tax_adjustment;
  59 use FS::cust_tax_location;
  60 use FS::agent;
  61 use FS::cust_main_invoice;
  62 use FS::cust_tag;
  63 use FS::prepay_credit;
  64 use FS::queue;
  65 use FS::part_pkg;
  66 use FS::part_export;
  67 #use FS::cust_event;
  68 use FS::type_pkgs;
  69 use FS::payment_gateway;
  70 use FS::agent_payment_gateway;
  71 use FS::banned_pay;
  72 use FS::cust_main_note;
  73 use FS::cust_attachment;
  74 use FS::contact;
  75 use FS::Locales;
  76 use FS::upgrade_journal;
  77
  78 # 1 is mostly method/subroutine entry and options
  79 # 2 traces progress of some operations
  80 # 3 is even more information including possibly sensitive data
  81 $DEBUG = 0;
  82 $me = '[FS::cust_main]';
  83
  84 $import = 0;
  85 $ignore_expired_card = 0;
  86 $ignore_banned_card = 0;
  87
  88 $skip_fuzzyfiles = 0;
  89
  90 @encrypted_fields = ('payinfo', 'paycvv');
  91 sub nohistory_fields { ('payinfo', 'paycvv'); }
  92
  93 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
  94
  95 #ask FS::UID to run this stuff for us later
  96 #$FS::UID::callback{'FS::cust_main'} = sub {
  97 install_callback FS::UID sub {
  98   $conf = new FS::Conf;
  99   #yes, need it for stuff below (prolly should be cached)
 100 };
 101
 102 sub _cache {
 103   my $self = shift;
 104   my ( $hashref, $cache ) = @_;
 105   if ( exists $hashref->{'pkgnum'} ) {
 106     #@{ $self->{'_pkgnum'} } = ();
 107     my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
 108     $self->{'_pkgnum'} = $subcache;
 109     #push @{ $self->{'_pkgnum'} },
 110     FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
 111   }
 112 }
 113
 114 =head1 NAME
 115
 116 FS::cust_main - Object methods for cust_main records
 117
 118 =head1 SYNOPSIS
 119
 120   use FS::cust_main;
 121
 122   $record = new FS::cust_main \%hash;
 123   $record = new FS::cust_main { 'column' => 'value' };
 124
 125   $error = $record->insert;
 126
 127   $error = $new_record->replace($old_record);
 128
 129   $error = $record->delete;
 130
 131   $error = $record->check;
 132
 133   @cust_pkg = $record->all_pkgs;
 134
 135   @cust_pkg = $record->ncancelled_pkgs;
 136
 137   @cust_pkg = $record->suspended_pkgs;
 138
 139   $error = $record->bill;
 140   $error = $record->bill %options;
 141   $error = $record->bill 'time' => $time;
 142
 143   $error = $record->collect;
 144   $error = $record->collect %options;
 145   $error = $record->collect 'invoice_time'   => $time,
 146                           ;
 147
 148 =head1 DESCRIPTION
 149
 150 An FS::cust_main object represents a customer.  FS::cust_main inherits from
 151 FS::Record.  The following fields are currently supported:
 152
 153 =over 4
 154
 155 =item custnum
 156
 157 Primary key (assigned automatically for new customers)
 158
 159 =item agentnum
 160
 161 Agent (see L<FS::agent>)
 162
 163 =item refnum
 164
 165 Advertising source (see L<FS::part_referral>)
 166
 167 =item first
 168
 169 First name
 170
 171 =item last
 172
 173 Last name
 174
 175 =item ss
 176
 177 Cocial security number (optional)
 178
 179 =item company
 180
 181 (optional)
 182
 183 =item daytime
 184
 185 phone (optional)
 186
 187 =item night
 188
 189 phone (optional)
 190
 191 =item fax
 192
 193 phone (optional)
 194
 195 =item mobile
 196
 197 phone (optional)
 198
 199 =item payby
 200
 201 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
 202
 203 =item payinfo
 204
 205 Payment Information (See L<FS::payinfo_Mixin> for data format)
 206
 207 =item paymask
 208
 209 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
 210
 211 =item paycvv
 212
 213 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
 214
 215 =item paydate
 216
 217 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
 218
 219 =item paystart_month
 220
 221 Start date month (maestro/solo cards only)
 222
 223 =item paystart_year
 224
 225 Start date year (maestro/solo cards only)
 226
 227 =item payissue
 228
 229 Issue number (maestro/solo cards only)
 230
 231 =item payname
 232
 233 Name on card or billing name
 234
 235 =item payip
 236
 237 IP address from which payment information was received
 238
 239 =item tax
 240
 241 Tax exempt, empty or `Y'
 242
 243 =item usernum
 244
 245 Order taker (see L<FS::access_user>)
 246
 247 =item comments
 248
 249 Comments (optional)
 250
 251 =item referral_custnum
 252
 253 Referring customer number
 254
 255 =item spool_cdr
 256
 257 Enable individual CDR spooling, empty or `Y'
 258
 259 =item dundate
 260
 261 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
 262
 263 =item squelch_cdr
 264
 265 Discourage individual CDR printing, empty or `Y'
 266
 267 =item edit_subject
 268
 269 Allow self-service editing of ticket subjects, empty or 'Y'
 270
 271 =item calling_list_exempt
 272
 273 Do not call, empty or 'Y'
 274
 275 =back
 276
 277 =head1 METHODS
 278
 279 =over 4
 280
 281 =item new HASHREF
 282
 283 Creates a new customer.  To add the customer to the database, see L<"insert">.
 284
 285 Note that this stores the hash reference, not a distinct copy of the hash it
 286 points to.  You can ask the object for a copy with the I<hash> method.
 287
 288 =cut
 289
 290 sub table { 'cust_main'; }
 291
 292 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
 293
 294 Adds this customer to the database.  If there is an error, returns the error,
 295 otherwise returns false.
 296
 297 Usually the customer's location will not yet exist in the database, and
 298 the C<bill_location> and C<ship_location> pseudo-fields must be set to
 299 uninserted L<FS::cust_location> objects.  These will be inserted and linked
 300 (in both directions) to the new customer record.  If they're references
 301 to the same object, they will become the same location.
 302
 303 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
 304 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
 305 are inserted atomicly, or the transaction is rolled back.  Passing an empty
 306 hash reference is equivalent to not supplying this parameter.  There should be
 307 a better explanation of this, but until then, here's an example:
 308
 309   use Tie::RefHash;
 310   tie %hash, 'Tie::RefHash'; #this part is important
 311   %hash = (
 312     $cust_pkg => [ $svc_acct ],
 313     ...
 314   );
 315   $cust_main->insert( \%hash );
 316
 317 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 318 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 319 expected and rollback the entire transaction; it is not necessary to call
 320 check_invoicing_list first.  The invoicing_list is set after the records in the
 321 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
 322 invoicing_list destination to the newly-created svc_acct.  Here's an example:
 323
 324   $cust_main->insert( {}, [ $email, 'POST' ] );
 325
 326 Currently available options are: I<depend_jobnum>, I<noexport>,
 327 I<tax_exemption> and I<prospectnum>.
 328
 329 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 330 on the supplied jobnum (they will not run until the specific job completes).
 331 This can be used to defer provisioning until some action completes (such
 332 as running the customer's credit card successfully).
 333
 334 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 335 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 336 the B<reexport> method.)
 337
 338 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
 339 of tax names and exemption numbers.  FS::cust_main_exemption records will be
 340 created and inserted.
 341
 342 If I<prospectnum> is set, moves contacts and locations from that prospect.
 343
 344 =cut
 345
 346 sub insert {
 347   my $self = shift;
 348   my $cust_pkgs = @_ ? shift : {};
 349   my $invoicing_list = @_ ? shift : '';
 350   my %options = @_;
 351   warn "$me insert called with options ".
 352        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 353     if $DEBUG;
 354
 355   local $SIG{HUP} = 'IGNORE';
 356   local $SIG{INT} = 'IGNORE';
 357   local $SIG{QUIT} = 'IGNORE';
 358   local $SIG{TERM} = 'IGNORE';
 359   local $SIG{TSTP} = 'IGNORE';
 360   local $SIG{PIPE} = 'IGNORE';
 361
 362   my $oldAutoCommit = $FS::UID::AutoCommit;
 363   local $FS::UID::AutoCommit = 0;
 364   my $dbh = dbh;
 365
 366   my $prepay_identifier = '';
 367   my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
 368   my $payby = '';
 369   if ( $self->payby eq 'PREPAY' ) {
 370
 371     $self->payby('BILL');
 372     $prepay_identifier = $self->payinfo;
 373     $self->payinfo('');
 374
 375     warn "  looking up prepaid card $prepay_identifier\n"
 376       if $DEBUG > 1;
 377
 378     my $error = $self->get_prepay( $prepay_identifier,
 379                                    'amount_ref'     => \$amount,
 380                                    'seconds_ref'    => \$seconds,
 381                                    'upbytes_ref'    => \$upbytes,
 382                                    'downbytes_ref'  => \$downbytes,
 383                                    'totalbytes_ref' => \$totalbytes,
 384                                  );
 385     if ( $error ) {
 386       $dbh->rollback if $oldAutoCommit;
 387       #return "error applying prepaid card (transaction rolled back): $error";
 388       return $error;
 389     }
 390
 391     $payby = 'PREP' if $amount;
 392
 393   } elsif ( $self->payby =~ /^(CASH|WEST|MCRD|PPAL)$/ ) {
 394
 395     $payby = $1;
 396     $self->payby('BILL');
 397     $amount = $self->paid;
 398
 399   }
 400
 401   # insert locations
 402   foreach my $l (qw(bill_location ship_location)) {
 403     my $loc = delete $self->hashref->{$l};
 404     # XXX if we're moving a prospect's locations, do that here
 405     if ( !$loc ) {
 406       return "$l not set";
 407     }
 408
 409     if ( !$loc->locationnum ) {
 410       # warn the location that we're going to insert it with no custnum
 411       $loc->set(custnum_pending => 1);
 412       warn "  inserting $l\n"
 413         if $DEBUG > 1;
 414       my $error = $loc->insert;
 415       if ( $error ) {
 416         $dbh->rollback if $oldAutoCommit;
 417         my $label = $l eq 'ship_location' ? 'service' : 'billing';
 418         return "$error (in $label location)";
 419       }
 420     }
 421     elsif ( ($loc->custnum || 0) > 0 or $loc->prospectnum ) {
 422       # then it somehow belongs to another customer--shouldn't happen
 423       $dbh->rollback if $oldAutoCommit;
 424       return "$l belongs to customer ".$loc->custnum;
 425     }
 426     # else it already belongs to this customer
 427     # (happens when ship_location is identical to bill_location)
 428
 429     $self->set($l.'num', $loc->locationnum);
 430
 431     if ( $self->get($l.'num') eq '' ) {
 432       $dbh->rollback if $oldAutoCommit;
 433       return "$l not set";
 434     }
 435   }
 436
 437   warn "  inserting $self\n"
 438     if $DEBUG > 1;
 439
 440   $self->signupdate(time) unless $self->signupdate;
 441
 442   $self->auto_agent_custid()
 443     if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
 444
 445   my $error = $self->SUPER::insert;
 446   if ( $error ) {
 447     $dbh->rollback if $oldAutoCommit;
 448     #return "inserting cust_main record (transaction rolled back): $error";
 449     return $error;
 450   }
 451
 452   # now set cust_location.custnum
 453   foreach my $l (qw(bill_location ship_location)) {
 454     warn "  setting $l.custnum\n"
 455       if $DEBUG > 1;
 456     my $loc = $self->$l;
 457     unless ( $loc->custnum ) {
 458       $loc->set(custnum => $self->custnum);
 459       $error ||= $loc->replace;
 460     }
 461
 462     if ( $error ) {
 463       $dbh->rollback if $oldAutoCommit;
 464       return "error setting $l custnum: $error";
 465     }
 466   }
 467
 468   warn "  setting invoicing list\n"
 469     if $DEBUG > 1;
 470
 471   if ( $invoicing_list ) {
 472     $error = $self->check_invoicing_list( $invoicing_list );
 473     if ( $error ) {
 474       $dbh->rollback if $oldAutoCommit;
 475       #return "checking invoicing_list (transaction rolled back): $error";
 476       return $error;
 477     }
 478     $self->invoicing_list( $invoicing_list );
 479   }
 480
 481   warn "  setting customer tags\n"
 482     if $DEBUG > 1;
 483
 484   foreach my $tagnum ( @{ $self->tagnum || [] } ) {
 485     my $cust_tag = new FS::cust_tag { 'tagnum'  => $tagnum,
 486                                       'custnum' => $self->custnum };
 487     my $error = $cust_tag->insert;
 488     if ( $error ) {
 489       $dbh->rollback if $oldAutoCommit;
 490       return $error;
 491     }
 492   }
 493
 494   my $prospectnum = delete $options{'prospectnum'};
 495   if ( $prospectnum ) {
 496
 497     warn "  moving contacts and locations from prospect $prospectnum\n"
 498       if $DEBUG > 1;
 499
 500     my $prospect_main =
 501       qsearchs('prospect_main', { 'prospectnum' => $prospectnum } );
 502     unless ( $prospect_main ) {
 503       $dbh->rollback if $oldAutoCommit;
 504       return "Unknown prospectnum $prospectnum";
 505     }
 506     $prospect_main->custnum($self->custnum);
 507     $prospect_main->disabled('Y');
 508     my $error = $prospect_main->replace;
 509     if ( $error ) {
 510       $dbh->rollback if $oldAutoCommit;
 511       return $error;
 512     }
 513
 514     my @contact = $prospect_main->contact;
 515     my @cust_location = $prospect_main->cust_location;
 516     my @qual = $prospect_main->qual;
 517
 518     foreach my $r ( @contact, @cust_location, @qual ) {
 519       $r->prospectnum('');
 520       $r->custnum($self->custnum);
 521       my $error = $r->replace;
 522       if ( $error ) {
 523         $dbh->rollback if $oldAutoCommit;
 524         return $error;
 525       }
 526     }
 527
 528   }
 529
 530   warn "  setting cust_main_exemption\n"
 531     if $DEBUG > 1;
 532
 533   my $tax_exemption = delete $options{'tax_exemption'};
 534   if ( $tax_exemption ) {
 535
 536     $tax_exemption = { map { $_ => '' } @$tax_exemption }
 537       if ref($tax_exemption) eq 'ARRAY';
 538
 539     foreach my $taxname ( keys %$tax_exemption ) {
 540       my $cust_main_exemption = new FS::cust_main_exemption {
 541         'custnum'       => $self->custnum,
 542         'taxname'       => $taxname,
 543         'exempt_number' => $tax_exemption->{$taxname},
 544       };
 545       my $error = $cust_main_exemption->insert;
 546       if ( $error ) {
 547         $dbh->rollback if $oldAutoCommit;
 548         return "inserting cust_main_exemption (transaction rolled back): $error";
 549       }
 550     }
 551   }
 552
 553   warn "  ordering packages\n"
 554     if $DEBUG > 1;
 555
 556   $error = $self->order_pkgs( $cust_pkgs,
 557                               %options,
 558                               'seconds_ref'    => \$seconds,
 559                               'upbytes_ref'    => \$upbytes,
 560                               'downbytes_ref'  => \$downbytes,
 561                               'totalbytes_ref' => \$totalbytes,
 562                             );
 563   if ( $error ) {
 564     $dbh->rollback if $oldAutoCommit;
 565     return $error;
 566   }
 567
 568   if ( $seconds ) {
 569     $dbh->rollback if $oldAutoCommit;
 570     return "No svc_acct record to apply pre-paid time";
 571   }
 572   if ( $upbytes || $downbytes || $totalbytes ) {
 573     $dbh->rollback if $oldAutoCommit;
 574     return "No svc_acct record to apply pre-paid data";
 575   }
 576
 577   if ( $amount ) {
 578     warn "  inserting initial $payby payment of $amount\n"
 579       if $DEBUG > 1;
 580     $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
 581     if ( $error ) {
 582       $dbh->rollback if $oldAutoCommit;
 583       return "inserting payment (transaction rolled back): $error";
 584     }
 585   }
 586
 587   unless ( $import || $skip_fuzzyfiles ) {
 588     warn "  queueing fuzzyfiles update\n"
 589       if $DEBUG > 1;
 590     $error = $self->queue_fuzzyfiles_update;
 591     if ( $error ) {
 592       $dbh->rollback if $oldAutoCommit;
 593       return "updating fuzzy search cache: $error";
 594     }
 595   }
 596
 597   # FS::geocode_Mixin::after_insert or something?
 598   if ( $conf->config('tax_district_method') and !$import ) {
 599     # if anything non-empty, try to look it up
 600     my $queue = new FS::queue {
 601       'job'     => 'FS::geocode_Mixin::process_district_update',
 602       'custnum' => $self->custnum,
 603     };
 604     my $error = $queue->insert( ref($self), $self->custnum );
 605     if ( $error ) {
 606       $dbh->rollback if $oldAutoCommit;
 607       return "queueing tax district update: $error";
 608     }
 609   }
 610
 611   # cust_main exports!
 612   warn "  exporting\n" if $DEBUG > 1;
 613
 614   my $export_args = $options{'export_args'} || [];
 615
 616   my @part_export =
 617     map qsearch( 'part_export', {exportnum=>$_} ),
 618       $conf->config('cust_main-exports'); #, $agentnum
 619
 620   foreach my $part_export ( @part_export ) {
 621     my $error = $part_export->export_insert($self, @$export_args);
 622     if ( $error ) {
 623       $dbh->rollback if $oldAutoCommit;
 624       return "exporting to ". $part_export->exporttype.
 625              " (transaction rolled back): $error";
 626     }
 627   }
 628
 629   #foreach my $depend_jobnum ( @$depend_jobnums ) {
 630   #    warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
 631   #      if $DEBUG;
 632   #    foreach my $jobnum ( @jobnums ) {
 633   #      my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
 634   #      warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
 635   #        if $DEBUG;
 636   #      my $error = $queue->depend_insert($depend_jobnum);
 637   #      if ( $error ) {
 638   #        $dbh->rollback if $oldAutoCommit;
 639   #        return "error queuing job dependancy: $error";
 640   #      }
 641   #    }
 642   #  }
 643   #
 644   #}
 645   #
 646   #if ( exists $options{'jobnums'} ) {
 647   #  push @{ $options{'jobnums'} }, @jobnums;
 648   #}
 649
 650   warn "  insert complete; committing transaction\n"
 651     if $DEBUG > 1;
 652
 653   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 654   '';
 655
 656 }
 657
 658 use File::CounterFile;
 659 sub auto_agent_custid {
 660   my $self = shift;
 661
 662   my $format = $conf->config('cust_main-auto_agent_custid');
 663   my $agent_custid;
 664   if ( $format eq '1YMMXXXXXXXX' ) {
 665
 666     my $counter = new File::CounterFile 'cust_main.agent_custid';
 667     $counter->lock;
 668
 669     my $ym = 100000000000 + time2str('%y%m00000000', time);
 670     if ( $ym > $counter->value ) {
 671       $counter->{'value'} = $agent_custid = $ym;
 672       $counter->{'updated'} = 1;
 673     } else {
 674       $agent_custid = $counter->inc;
 675     }
 676
 677     $counter->unlock;
 678
 679   } else {
 680     die "Unknown cust_main-auto_agent_custid format: $format";
 681   }
 682
 683   $self->agent_custid($agent_custid);
 684
 685 }
 686
 687 =item PACKAGE METHODS
 688
 689 Documentation on customer package methods has been moved to
 690 L<FS::cust_main::Packages>.
 691
 692 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
 693
 694 Recharges this (existing) customer with the specified prepaid card (see
 695 L<FS::prepay_credit>), specified either by I<identifier> or as an
 696 FS::prepay_credit object.  If there is an error, returns the error, otherwise
 697 returns false.
 698
 699 Optionally, five scalar references can be passed as well.  They will have their
 700 values filled in with the amount, number of seconds, and number of upload,
 701 download, and total bytes applied by this prepaid card.
 702
 703 =cut
 704
 705 #the ref bullshit here should be refactored like get_prepay.  MyAccount.pm is
 706 #the only place that uses these args
 707 sub recharge_prepay {
 708   my( $self, $prepay_credit, $amountref, $secondsref,
 709       $upbytesref, $downbytesref, $totalbytesref ) = @_;
 710
 711   local $SIG{HUP} = 'IGNORE';
 712   local $SIG{INT} = 'IGNORE';
 713   local $SIG{QUIT} = 'IGNORE';
 714   local $SIG{TERM} = 'IGNORE';
 715   local $SIG{TSTP} = 'IGNORE';
 716   local $SIG{PIPE} = 'IGNORE';
 717
 718   my $oldAutoCommit = $FS::UID::AutoCommit;
 719   local $FS::UID::AutoCommit = 0;
 720   my $dbh = dbh;
 721
 722   my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
 723
 724   my $error = $self->get_prepay( $prepay_credit,
 725                                  'amount_ref'     => \$amount,
 726                                  'seconds_ref'    => \$seconds,
 727                                  'upbytes_ref'    => \$upbytes,
 728                                  'downbytes_ref'  => \$downbytes,
 729                                  'totalbytes_ref' => \$totalbytes,
 730                                )
 731            || $self->increment_seconds($seconds)
 732            || $self->increment_upbytes($upbytes)
 733            || $self->increment_downbytes($downbytes)
 734            || $self->increment_totalbytes($totalbytes)
 735            || $self->insert_cust_pay_prepay( $amount,
 736                                              ref($prepay_credit)
 737                                                ? $prepay_credit->identifier
 738                                                : $prepay_credit
 739                                            );
 740
 741   if ( $error ) {
 742     $dbh->rollback if $oldAutoCommit;
 743     return $error;
 744   }
 745
 746   if ( defined($amountref)  ) { $$amountref  = $amount;  }
 747   if ( defined($secondsref) ) { $$secondsref = $seconds; }
 748   if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
 749   if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
 750   if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
 751
 752   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 753   '';
 754
 755 }
 756
 757 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
 758
 759 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
 760 specified either by I<identifier> or as an FS::prepay_credit object.
 761
 762 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
 763 incremented by the values of the prepaid card.
 764
 765 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
 766 check or set this customer's I<agentnum>.
 767
 768 If there is an error, returns the error, otherwise returns false.
 769
 770 =cut
 771
 772
 773 sub get_prepay {
 774   my( $self, $prepay_credit, %opt ) = @_;
 775
 776   local $SIG{HUP} = 'IGNORE';
 777   local $SIG{INT} = 'IGNORE';
 778   local $SIG{QUIT} = 'IGNORE';
 779   local $SIG{TERM} = 'IGNORE';
 780   local $SIG{TSTP} = 'IGNORE';
 781   local $SIG{PIPE} = 'IGNORE';
 782
 783   my $oldAutoCommit = $FS::UID::AutoCommit;
 784   local $FS::UID::AutoCommit = 0;
 785   my $dbh = dbh;
 786
 787   unless ( ref($prepay_credit) ) {
 788
 789     my $identifier = $prepay_credit;
 790
 791     $prepay_credit = qsearchs(
 792       'prepay_credit',
 793       { 'identifier' => $identifier },
 794       '',
 795       'FOR UPDATE'
 796     );
 797
 798     unless ( $prepay_credit ) {
 799       $dbh->rollback if $oldAutoCommit;
 800       return "Invalid prepaid card: ". $identifier;
 801     }
 802
 803   }
 804
 805   if ( $prepay_credit->agentnum ) {
 806     if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
 807       $dbh->rollback if $oldAutoCommit;
 808       return "prepaid card not valid for agent ". $self->agentnum;
 809     }
 810     $self->agentnum($prepay_credit->agentnum);
 811   }
 812
 813   my $error = $prepay_credit->delete;
 814   if ( $error ) {
 815     $dbh->rollback if $oldAutoCommit;
 816     return "removing prepay_credit (transaction rolled back): $error";
 817   }
 818
 819   ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
 820     for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
 821
 822   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 823   '';
 824
 825 }
 826
 827 =item increment_upbytes SECONDS
 828
 829 Updates this customer's single or primary account (see L<FS::svc_acct>) by
 830 the specified number of upbytes.  If there is an error, returns the error,
 831 otherwise returns false.
 832
 833 =cut
 834
 835 sub increment_upbytes {
 836   _increment_column( shift, 'upbytes', @_);
 837 }
 838
 839 =item increment_downbytes SECONDS
 840
 841 Updates this customer's single or primary account (see L<FS::svc_acct>) by
 842 the specified number of downbytes.  If there is an error, returns the error,
 843 otherwise returns false.
 844
 845 =cut
 846
 847 sub increment_downbytes {
 848   _increment_column( shift, 'downbytes', @_);
 849 }
 850
 851 =item increment_totalbytes SECONDS
 852
 853 Updates this customer's single or primary account (see L<FS::svc_acct>) by
 854 the specified number of totalbytes.  If there is an error, returns the error,
 855 otherwise returns false.
 856
 857 =cut
 858
 859 sub increment_totalbytes {
 860   _increment_column( shift, 'totalbytes', @_);
 861 }
 862
 863 =item increment_seconds SECONDS
 864
 865 Updates this customer's single or primary account (see L<FS::svc_acct>) by
 866 the specified number of seconds.  If there is an error, returns the error,
 867 otherwise returns false.
 868
 869 =cut
 870
 871 sub increment_seconds {
 872   _increment_column( shift, 'seconds', @_);
 873 }
 874
 875 =item _increment_column AMOUNT
 876
 877 Updates this customer's single or primary account (see L<FS::svc_acct>) by
 878 the specified number of seconds or bytes.  If there is an error, returns
 879 the error, otherwise returns false.
 880
 881 =cut
 882
 883 sub _increment_column {
 884   my( $self, $column, $amount ) = @_;
 885   warn "$me increment_column called: $column, $amount\n"
 886     if $DEBUG;
 887
 888   return '' unless $amount;
 889
 890   my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
 891                       $self->ncancelled_pkgs;
 892
 893   if ( ! @cust_pkg ) {
 894     return 'No packages with primary or single services found'.
 895            ' to apply pre-paid time';
 896   } elsif ( scalar(@cust_pkg) > 1 ) {
 897     #maybe have a way to specify the package/account?
 898     return 'Multiple packages found to apply pre-paid time';
 899   }
 900
 901   my $cust_pkg = $cust_pkg[0];
 902   warn "  found package pkgnum ". $cust_pkg->pkgnum. "\n"
 903     if $DEBUG > 1;
 904
 905   my @cust_svc =
 906     $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
 907
 908   if ( ! @cust_svc ) {
 909     return 'No account found to apply pre-paid time';
 910   } elsif ( scalar(@cust_svc) > 1 ) {
 911     return 'Multiple accounts found to apply pre-paid time';
 912   }
 913
 914   my $svc_acct = $cust_svc[0]->svc_x;
 915   warn "  found service svcnum ". $svc_acct->pkgnum.
 916        ' ('. $svc_acct->email. ")\n"
 917     if $DEBUG > 1;
 918
 919   $column = "increment_$column";
 920   $svc_acct->$column($amount);
 921
 922 }
 923
 924 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
 925
 926 Inserts a prepayment in the specified amount for this customer.  An optional
 927 second argument can specify the prepayment identifier for tracking purposes.
 928 If there is an error, returns the error, otherwise returns false.
 929
 930 =cut
 931
 932 sub insert_cust_pay_prepay {
 933   shift->insert_cust_pay('PREP', @_);
 934 }
 935
 936 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
 937
 938 Inserts a cash payment in the specified amount for this customer.  An optional
 939 second argument can specify the payment identifier for tracking purposes.
 940 If there is an error, returns the error, otherwise returns false.
 941
 942 =cut
 943
 944 sub insert_cust_pay_cash {
 945   shift->insert_cust_pay('CASH', @_);
 946 }
 947
 948 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
 949
 950 Inserts a Western Union payment in the specified amount for this customer.  An
 951 optional second argument can specify the prepayment identifier for tracking
 952 purposes.  If there is an error, returns the error, otherwise returns false.
 953
 954 =cut
 955
 956 sub insert_cust_pay_west {
 957   shift->insert_cust_pay('WEST', @_);
 958 }
 959
 960 sub insert_cust_pay {
 961   my( $self, $payby, $amount ) = splice(@_, 0, 3);
 962   my $payinfo = scalar(@_) ? shift : '';
 963
 964   my $cust_pay = new FS::cust_pay {
 965     'custnum' => $self->custnum,
 966     'paid'    => sprintf('%.2f', $amount),
 967     #'_date'   => #date the prepaid card was purchased???
 968     'payby'   => $payby,
 969     'payinfo' => $payinfo,
 970   };
 971   $cust_pay->insert;
 972
 973 }
 974
 975 =item reexport
 976
 977 This method is deprecated.  See the I<depend_jobnum> option to the insert and
 978 order_pkgs methods for a better way to defer provisioning.
 979
 980 Re-schedules all exports by calling the B<reexport> method of all associated
 981 packages (see L<FS::cust_pkg>).  If there is an error, returns the error;
 982 otherwise returns false.
 983
 984 =cut
 985
 986 sub reexport {
 987   my $self = shift;
 988
 989   carp "WARNING: FS::cust_main::reexport is deprectated; ".
 990        "use the depend_jobnum option to insert or order_pkgs to delay export";
 991
 992   local $SIG{HUP} = 'IGNORE';
 993   local $SIG{INT} = 'IGNORE';
 994   local $SIG{QUIT} = 'IGNORE';
 995   local $SIG{TERM} = 'IGNORE';
 996   local $SIG{TSTP} = 'IGNORE';
 997   local $SIG{PIPE} = 'IGNORE';
 998
 999   my $oldAutoCommit = $FS::UID::AutoCommit;
1000   local $FS::UID::AutoCommit = 0;
1001   my $dbh = dbh;
1002
1003   foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1004     my $error = $cust_pkg->reexport;
1005     if ( $error ) {
1006       $dbh->rollback if $oldAutoCommit;
1007       return $error;
1008     }
1009   }
1010
1011   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1012   '';
1013
1014 }
1015
1016 =item delete [ OPTION => VALUE ... ]
1017
1018 This deletes the customer.  If there is an error, returns the error, otherwise
1019 returns false.
1020
1021 This will completely remove all traces of the customer record.  This is not
1022 what you want when a customer cancels service; for that, cancel all of the
1023 customer's packages (see L</cancel>).
1024
1025 If the customer has any uncancelled packages, you need to pass a new (valid)
1026 customer number for those packages to be transferred to, as the "new_customer"
1027 option.  Cancelled packages will be deleted.  Did I mention that this is NOT
1028 what you want when a customer cancels service and that you really should be
1029 looking at L<FS::cust_pkg/cancel>?
1030
1031 You can't delete a customer with invoices (see L<FS::cust_bill>),
1032 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1033 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1034 set the "delete_financials" option to a true value.
1035
1036 =cut
1037
1038 sub delete {
1039   my( $self, %opt ) = @_;
1040
1041   local $SIG{HUP} = 'IGNORE';
1042   local $SIG{INT} = 'IGNORE';
1043   local $SIG{QUIT} = 'IGNORE';
1044   local $SIG{TERM} = 'IGNORE';
1045   local $SIG{TSTP} = 'IGNORE';
1046   local $SIG{PIPE} = 'IGNORE';
1047
1048   my $oldAutoCommit = $FS::UID::AutoCommit;
1049   local $FS::UID::AutoCommit = 0;
1050   my $dbh = dbh;
1051
1052   if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1053      $dbh->rollback if $oldAutoCommit;
1054      return "Can't delete a master agent customer";
1055   }
1056
1057   #use FS::access_user
1058   if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1059      $dbh->rollback if $oldAutoCommit;
1060      return "Can't delete a master employee customer";
1061   }
1062
1063   tie my %financial_tables, 'Tie::IxHash',
1064     'cust_bill'      => 'invoices',
1065     'cust_statement' => 'statements',
1066     'cust_credit'    => 'credits',
1067     'cust_pay'       => 'payments',
1068     'cust_refund'    => 'refunds',
1069   ;
1070
1071   foreach my $table ( keys %financial_tables ) {
1072
1073     my @records = $self->$table();
1074
1075     if ( @records && ! $opt{'delete_financials'} ) {
1076       $dbh->rollback if $oldAutoCommit;
1077       return "Can't delete a customer with ". $financial_tables{$table};
1078     }
1079
1080     foreach my $record ( @records ) {
1081       my $error = $record->delete;
1082       if ( $error ) {
1083         $dbh->rollback if $oldAutoCommit;
1084         return "Error deleting ". $financial_tables{$table}. ": $error\n";
1085       }
1086     }
1087
1088   }
1089
1090   my @cust_pkg = $self->ncancelled_pkgs;
1091   if ( @cust_pkg ) {
1092     my $new_custnum = $opt{'new_custnum'};
1093     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1094       $dbh->rollback if $oldAutoCommit;
1095       return "Invalid new customer number: $new_custnum";
1096     }
1097     foreach my $cust_pkg ( @cust_pkg ) {
1098       my %hash = $cust_pkg->hash;
1099       $hash{'custnum'} = $new_custnum;
1100       my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1101       my $error = $new_cust_pkg->replace($cust_pkg,
1102                                          options => { $cust_pkg->options },
1103                                         );
1104       if ( $error ) {
1105         $dbh->rollback if $oldAutoCommit;
1106         return $error;
1107       }
1108     }
1109   }
1110   my @cancelled_cust_pkg = $self->all_pkgs;
1111   foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1112     my $error = $cust_pkg->delete;
1113     if ( $error ) {
1114       $dbh->rollback if $oldAutoCommit;
1115       return $error;
1116     }
1117   }
1118
1119   #cust_tax_adjustment in financials?
1120   #cust_pay_pending?  ouch
1121   #cust_recon?
1122   foreach my $table (qw(
1123     cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1124     cust_location cust_main_note cust_tax_adjustment
1125     cust_pay_void cust_pay_batch queue cust_tax_exempt
1126   )) {
1127     foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1128       my $error = $record->delete;
1129       if ( $error ) {
1130         $dbh->rollback if $oldAutoCommit;
1131         return $error;
1132       }
1133     }
1134   }
1135
1136   my $sth = $dbh->prepare(
1137     'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1138   ) or do {
1139     my $errstr = $dbh->errstr;
1140     $dbh->rollback if $oldAutoCommit;
1141     return $errstr;
1142   };
1143   $sth->execute($self->custnum) or do {
1144     my $errstr = $sth->errstr;
1145     $dbh->rollback if $oldAutoCommit;
1146     return $errstr;
1147   };
1148
1149   #tickets
1150
1151   my $ticket_dbh = '';
1152   if ($conf->config('ticket_system') eq 'RT_Internal') {
1153     $ticket_dbh = $dbh;
1154   } elsif ($conf->config('ticket_system') eq 'RT_External') {
1155     my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1156     $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1157       #or die "RT_External DBI->connect error: $DBI::errstr\n";
1158   }
1159
1160   if ( $ticket_dbh ) {
1161
1162     my $ticket_sth = $ticket_dbh->prepare(
1163       'DELETE FROM Links WHERE Target = ?'
1164     ) or do {
1165       my $errstr = $ticket_dbh->errstr;
1166       $dbh->rollback if $oldAutoCommit;
1167       return $errstr;
1168     };
1169     $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1170       or do {
1171         my $errstr = $ticket_sth->errstr;
1172         $dbh->rollback if $oldAutoCommit;
1173         return $errstr;
1174       };
1175
1176     #check and see if the customer is the only link on the ticket, and
1177     #if so, set the ticket to deleted status in RT?
1178     #maybe someday, for now this will at least fix tickets not displaying
1179
1180   }
1181
1182   #delete the customer record
1183
1184   my $error = $self->SUPER::delete;
1185   if ( $error ) {
1186     $dbh->rollback if $oldAutoCommit;
1187     return $error;
1188   }
1189
1190   # cust_main exports!
1191
1192   #my $export_args = $options{'export_args'} || [];
1193
1194   my @part_export =
1195     map qsearch( 'part_export', {exportnum=>$_} ),
1196       $conf->config('cust_main-exports'); #, $agentnum
1197
1198   foreach my $part_export ( @part_export ) {
1199     my $error = $part_export->export_delete( $self ); #, @$export_args);
1200     if ( $error ) {
1201       $dbh->rollback if $oldAutoCommit;
1202       return "exporting to ". $part_export->exporttype.
1203              " (transaction rolled back): $error";
1204     }
1205   }
1206
1207   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1208   '';
1209
1210 }
1211
1212 =item merge NEW_CUSTNUM [ , OPTION => VALUE ... ]
1213
1214 This merges this customer into the provided new custnum, and then deletes the
1215 customer.  If there is an error, returns the error, otherwise returns false.
1216
1217 The source customer's name, company name, phone numbers, agent,
1218 referring customer, customer class, advertising source, order taker, and
1219 billing information (except balance) are discarded.
1220
1221 All packages are moved to the target customer.  Packages with package locations
1222 are preserved.  Packages without package locations are moved to a new package
1223 location with the source customer's service/shipping address.
1224
1225 All invoices, statements, payments, credits and refunds are moved to the target
1226 customer.  The source customer's balance is added to the target customer.
1227
1228 All notes, attachments, tickets and customer tags are moved to the target
1229 customer.
1230
1231 Change history is not currently moved.
1232
1233 =cut
1234
1235 sub merge {
1236   my( $self, $new_custnum, %opt ) = @_;
1237
1238   return "Can't merge a customer into self" if $self->custnum == $new_custnum;
1239
1240   my $new_cust_main = qsearchs( 'cust_main', { 'custnum' => $new_custnum } )
1241     or return "Invalid new customer number: $new_custnum";
1242
1243   return 'Access denied: "Merge customer across agents" access right required to merge into a customer of a different agent'
1244     if $self->agentnum != $new_cust_main->agentnum
1245     && ! $FS::CurrentUser::CurrentUser->access_right('Merge customer across agents');
1246
1247   local $SIG{HUP} = 'IGNORE';
1248   local $SIG{INT} = 'IGNORE';
1249   local $SIG{QUIT} = 'IGNORE';
1250   local $SIG{TERM} = 'IGNORE';
1251   local $SIG{TSTP} = 'IGNORE';
1252   local $SIG{PIPE} = 'IGNORE';
1253
1254   my $oldAutoCommit = $FS::UID::AutoCommit;
1255   local $FS::UID::AutoCommit = 0;
1256   my $dbh = dbh;
1257
1258   if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1259      $dbh->rollback if $oldAutoCommit;
1260      return "Can't merge a master agent customer";
1261   }
1262
1263   #use FS::access_user
1264   if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1265      $dbh->rollback if $oldAutoCommit;
1266      return "Can't merge a master employee customer";
1267   }
1268
1269   if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
1270                                      'status'  => { op=>'!=', value=>'done' },
1271                                    }
1272               )
1273   ) {
1274      $dbh->rollback if $oldAutoCommit;
1275      return "Can't merge a customer with pending payments";
1276   }
1277
1278   tie my %financial_tables, 'Tie::IxHash',
1279     'cust_bill'      => 'invoices',
1280     'cust_bill_void' => 'voided invoices',
1281     'cust_statement' => 'statements',
1282     'cust_credit'    => 'credits',
1283     'cust_pay'       => 'payments',
1284     'cust_pay_void'  => 'voided payments',
1285     'cust_refund'    => 'refunds',
1286   ;
1287
1288   foreach my $table ( keys %financial_tables ) {
1289
1290     my @records = $self->$table();
1291
1292     foreach my $record ( @records ) {
1293       $record->custnum($new_custnum);
1294       my $error = $record->replace;
1295       if ( $error ) {
1296         $dbh->rollback if $oldAutoCommit;
1297         return "Error merging ". $financial_tables{$table}. ": $error\n";
1298       }
1299     }
1300
1301   }
1302
1303   my $name = $self->ship_name; #?
1304
1305   my $locationnum = '';
1306   foreach my $cust_pkg ( $self->all_pkgs ) {
1307     $cust_pkg->custnum($new_custnum);
1308
1309     unless ( $cust_pkg->locationnum ) {
1310       unless ( $locationnum ) {
1311         my $cust_location = new FS::cust_location {
1312           $self->location_hash,
1313           'custnum' => $new_custnum,
1314         };
1315         my $error = $cust_location->insert;
1316         if ( $error ) {
1317           $dbh->rollback if $oldAutoCommit;
1318           return $error;
1319         }
1320         $locationnum = $cust_location->locationnum;
1321       }
1322       $cust_pkg->locationnum($locationnum);
1323     }
1324
1325     my $error = $cust_pkg->replace;
1326     if ( $error ) {
1327       $dbh->rollback if $oldAutoCommit;
1328       return $error;
1329     }
1330
1331     # add customer (ship) name to svc_phone.phone_name if blank
1332     my @cust_svc = $cust_pkg->cust_svc;
1333     foreach my $cust_svc (@cust_svc) {
1334       my($label, $value, $svcdb) = $cust_svc->label;
1335       next unless $svcdb eq 'svc_phone';
1336       my $svc_phone = $cust_svc->svc_x;
1337       next if $svc_phone->phone_name;
1338       $svc_phone->phone_name($name);
1339       my $error = $svc_phone->replace;
1340       if ( $error ) {
1341         $dbh->rollback if $oldAutoCommit;
1342         return $error;
1343       }
1344     }
1345
1346   }
1347
1348   #not considered:
1349   # cust_tax_exempt (texas tax exemptions)
1350   # cust_recon (some sort of not-well understood thing for OnPac)
1351
1352   #these are moved over
1353   foreach my $table (qw(
1354     cust_tag cust_location contact cust_attachment cust_main_note
1355     cust_tax_adjustment cust_pay_batch queue
1356   )) {
1357     foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1358       $record->custnum($new_custnum);
1359       my $error = $record->replace;
1360       if ( $error ) {
1361         $dbh->rollback if $oldAutoCommit;
1362         return $error;
1363       }
1364     }
1365   }
1366
1367   #these aren't preserved
1368   foreach my $table (qw(
1369     cust_main_exemption cust_main_invoice
1370   )) {
1371     foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1372       my $error = $record->delete;
1373       if ( $error ) {
1374         $dbh->rollback if $oldAutoCommit;
1375         return $error;
1376       }
1377     }
1378   }
1379
1380
1381   my $sth = $dbh->prepare(
1382     'UPDATE cust_main SET referral_custnum = ? WHERE referral_custnum = ?'
1383   ) or do {
1384     my $errstr = $dbh->errstr;
1385     $dbh->rollback if $oldAutoCommit;
1386     return $errstr;
1387   };
1388   $sth->execute($new_custnum, $self->custnum) or do {
1389     my $errstr = $sth->errstr;
1390     $dbh->rollback if $oldAutoCommit;
1391     return $errstr;
1392   };
1393
1394   #tickets
1395
1396   my $ticket_dbh = '';
1397   if ($conf->config('ticket_system') eq 'RT_Internal') {
1398     $ticket_dbh = $dbh;
1399   } elsif ($conf->config('ticket_system') eq 'RT_External') {
1400     my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1401     $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1402       #or die "RT_External DBI->connect error: $DBI::errstr\n";
1403   }
1404
1405   if ( $ticket_dbh ) {
1406
1407     my $ticket_sth = $ticket_dbh->prepare(
1408       'UPDATE Links SET Target = ? WHERE Target = ?'
1409     ) or do {
1410       my $errstr = $ticket_dbh->errstr;
1411       $dbh->rollback if $oldAutoCommit;
1412       return $errstr;
1413     };
1414     $ticket_sth->execute('freeside://freeside/cust_main/'.$new_custnum,
1415                          'freeside://freeside/cust_main/'.$self->custnum)
1416       or do {
1417         my $errstr = $ticket_sth->errstr;
1418         $dbh->rollback if $oldAutoCommit;
1419         return $errstr;
1420       };
1421
1422   }
1423
1424   #delete the customer record
1425
1426   my $error = $self->delete;
1427   if ( $error ) {
1428     $dbh->rollback if $oldAutoCommit;
1429     return $error;
1430   }
1431
1432   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1433   '';
1434
1435 }
1436
1437 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1438
1439 Replaces the OLD_RECORD with this one in the database.  If there is an error,
1440 returns the error, otherwise returns false.
1441
1442 To change the customer's address, set the pseudo-fields C<bill_location> and
1443 C<ship_location>.  The address will still only change if at least one of the
1444 address fields differs from the existing values.
1445
1446 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1447 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
1448 expected and rollback the entire transaction; it is not necessary to call
1449 check_invoicing_list first.  Here's an example:
1450
1451   $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1452
1453 Currently available options are: I<tax_exemption>.
1454
1455 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
1456 of tax names and exemption numbers.  FS::cust_main_exemption records will be
1457 deleted and inserted as appropriate.
1458
1459 =cut
1460
1461 sub replace {
1462   my $self = shift;
1463
1464   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1465               ? shift
1466               : $self->replace_old;
1467
1468   my @param = @_;
1469
1470   warn "$me replace called\n"
1471     if $DEBUG;
1472
1473   my $curuser = $FS::CurrentUser::CurrentUser;
1474   if (    $self->payby eq 'COMP'
1475        && $self->payby ne $old->payby
1476        && ! $curuser->access_right('Complimentary customer')
1477      )
1478   {
1479     return "You are not permitted to create complimentary accounts.";
1480   }
1481
1482   local($ignore_expired_card) = 1
1483     if $old->payby  =~ /^(CARD|DCRD)$/
1484     && $self->payby =~ /^(CARD|DCRD)$/
1485     && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1486
1487   local($ignore_banned_card) = 1
1488     if (    $old->payby  =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
1489          || $old->payby  =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
1490     && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1491
1492   return "Invoicing locale is required"
1493     if $old->locale
1494     && ! $self->locale
1495     && $conf->exists('cust_main-require_locale');
1496
1497   local $SIG{HUP} = 'IGNORE';
1498   local $SIG{INT} = 'IGNORE';
1499   local $SIG{QUIT} = 'IGNORE';
1500   local $SIG{TERM} = 'IGNORE';
1501   local $SIG{TSTP} = 'IGNORE';
1502   local $SIG{PIPE} = 'IGNORE';
1503
1504   my $oldAutoCommit = $FS::UID::AutoCommit;
1505   local $FS::UID::AutoCommit = 0;
1506   my $dbh = dbh;
1507
1508   for my $l (qw(bill_location ship_location)) {
1509     my $old_loc = $old->$l;
1510     my $new_loc = $self->$l;
1511
1512     # find the existing location if there is one
1513     $new_loc->set('custnum' => $self->custnum);
1514     my $error = $new_loc->find_or_insert;
1515     if ( $error ) {
1516       $dbh->rollback if $oldAutoCommit;
1517       return $error;
1518     }
1519     $self->set($l.'num', $new_loc->locationnum);
1520   } #for $l
1521
1522   # replace the customer record
1523   my $error = $self->SUPER::replace($old);
1524
1525   if ( $error ) {
1526     $dbh->rollback if $oldAutoCommit;
1527     return $error;
1528   }
1529
1530   # now move packages to the new service location
1531   $self->set('ship_location', ''); #flush cache
1532   if ( $old->ship_locationnum and # should only be null during upgrade...
1533        $old->ship_locationnum != $self->ship_locationnum ) {
1534     $error = $old->ship_location->move_to($self->ship_location);
1535     if ( $error ) {
1536       $dbh->rollback if $oldAutoCommit;
1537       return $error;
1538     }
1539   }
1540   # don't move packages based on the billing location, but
1541   # disable it if it's no longer in use
1542   if ( $old->bill_locationnum and
1543        $old->bill_locationnum != $self->bill_locationnum ) {
1544     $error = $old->bill_location->disable_if_unused;
1545     if ( $error ) {
1546       $dbh->rollback if $oldAutoCommit;
1547       return $error;
1548     }
1549   }
1550
1551   if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1552     my $invoicing_list = shift @param;
1553     $error = $self->check_invoicing_list( $invoicing_list );
1554     if ( $error ) {
1555       $dbh->rollback if $oldAutoCommit;
1556       return $error;
1557     }
1558     $self->invoicing_list( $invoicing_list );
1559   }
1560
1561   if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1562
1563     #this could be more efficient than deleting and re-inserting, if it matters
1564     foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1565       my $error = $cust_tag->delete;
1566       if ( $error ) {
1567         $dbh->rollback if $oldAutoCommit;
1568         return $error;
1569       }
1570     }
1571     foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1572       my $cust_tag = new FS::cust_tag { 'tagnum'  => $tagnum,
1573                                         'custnum' => $self->custnum };
1574       my $error = $cust_tag->insert;
1575       if ( $error ) {
1576         $dbh->rollback if $oldAutoCommit;
1577         return $error;
1578       }
1579     }
1580
1581   }
1582
1583   my %options = @param;
1584
1585   my $tax_exemption = delete $options{'tax_exemption'};
1586   if ( $tax_exemption ) {
1587
1588     $tax_exemption = { map { $_ => '' } @$tax_exemption }
1589       if ref($tax_exemption) eq 'ARRAY';
1590
1591     my %cust_main_exemption =
1592       map { $_->taxname => $_ }
1593           qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1594
1595     foreach my $taxname ( keys %$tax_exemption ) {
1596
1597       if ( $cust_main_exemption{$taxname} &&
1598            $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname}
1599          )
1600       {
1601         delete $cust_main_exemption{$taxname};
1602         next;
1603       }
1604
1605       my $cust_main_exemption = new FS::cust_main_exemption {
1606         'custnum'       => $self->custnum,
1607         'taxname'       => $taxname,
1608         'exempt_number' => $tax_exemption->{$taxname},
1609       };
1610       my $error = $cust_main_exemption->insert;
1611       if ( $error ) {
1612         $dbh->rollback if $oldAutoCommit;
1613         return "inserting cust_main_exemption (transaction rolled back): $error";
1614       }
1615     }
1616
1617     foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1618       my $error = $cust_main_exemption->delete;
1619       if ( $error ) {
1620         $dbh->rollback if $oldAutoCommit;
1621         return "deleting cust_main_exemption (transaction rolled back): $error";
1622       }
1623     }
1624
1625   }
1626
1627   if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
1628        && ( ( $self->get('payinfo') ne $old->get('payinfo')
1629               && $self->get('payinfo') !~ /^99\d{14}$/
1630             )
1631             || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
1632           )
1633      )
1634   {
1635
1636     # card/check/lec info has changed, want to retry realtime_ invoice events
1637     my $error = $self->retry_realtime;
1638     if ( $error ) {
1639       $dbh->rollback if $oldAutoCommit;
1640       return $error;
1641     }
1642   }
1643
1644   unless ( $import || $skip_fuzzyfiles ) {
1645     $error = $self->queue_fuzzyfiles_update;
1646     if ( $error ) {
1647       $dbh->rollback if $oldAutoCommit;
1648       return "updating fuzzy search cache: $error";
1649     }
1650   }
1651
1652   # tax district update in cust_location
1653
1654   # cust_main exports!
1655
1656   my $export_args = $options{'export_args'} || [];
1657
1658   my @part_export =
1659     map qsearch( 'part_export', {exportnum=>$_} ),
1660       $conf->config('cust_main-exports'); #, $agentnum
1661
1662   foreach my $part_export ( @part_export ) {
1663     my $error = $part_export->export_replace( $self, $old, @$export_args);
1664     if ( $error ) {
1665       $dbh->rollback if $oldAutoCommit;
1666       return "exporting to ". $part_export->exporttype.
1667              " (transaction rolled back): $error";
1668     }
1669   }
1670
1671   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1672   '';
1673
1674 }
1675
1676 =item queue_fuzzyfiles_update
1677
1678 Used by insert & replace to update the fuzzy search cache
1679
1680 =cut
1681
1682 use FS::cust_main::Search;
1683 sub queue_fuzzyfiles_update {
1684   my $self = shift;
1685
1686   local $SIG{HUP} = 'IGNORE';
1687   local $SIG{INT} = 'IGNORE';
1688   local $SIG{QUIT} = 'IGNORE';
1689   local $SIG{TERM} = 'IGNORE';
1690   local $SIG{TSTP} = 'IGNORE';
1691   local $SIG{PIPE} = 'IGNORE';
1692
1693   my $oldAutoCommit = $FS::UID::AutoCommit;
1694   local $FS::UID::AutoCommit = 0;
1695   my $dbh = dbh;
1696
1697   my @locations = $self->bill_location;
1698   push @locations, $self->ship_location if $self->has_ship_address;
1699   foreach my $location (@locations) {
1700     my $queue = new FS::queue {
1701       'job' => 'FS::cust_main::Search::append_fuzzyfiles'
1702     };
1703     my @args = map $location->get($_), @FS::cust_main::Search::fuzzyfields;
1704     my $error = $queue->insert( @args );
1705     if ( $error ) {
1706       $dbh->rollback if $oldAutoCommit;
1707       return "queueing job (transaction rolled back): $error";
1708     }
1709   }
1710
1711   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1712   '';
1713
1714 }
1715
1716 =item check
1717
1718 Checks all fields to make sure this is a valid customer record.  If there is
1719 an error, returns the error, otherwise returns false.  Called by the insert
1720 and replace methods.
1721
1722 =cut
1723
1724 sub check {
1725   my $self = shift;
1726
1727   warn "$me check BEFORE: \n". $self->_dump
1728     if $DEBUG > 2;
1729
1730   my $error =
1731     $self->ut_numbern('custnum')
1732     || $self->ut_number('agentnum')
1733     || $self->ut_textn('agent_custid')
1734     || $self->ut_number('refnum')
1735     || $self->ut_foreign_key('bill_locationnum', 'cust_location','locationnum')
1736     || $self->ut_foreign_key('ship_locationnum', 'cust_location','locationnum')
1737     || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1738     || $self->ut_textn('custbatch')
1739     || $self->ut_name('last')
1740     || $self->ut_name('first')
1741     || $self->ut_snumbern('signupdate')
1742     || $self->ut_snumbern('birthdate')
1743     || $self->ut_snumbern('spouse_birthdate')
1744     || $self->ut_snumbern('anniversary_date')
1745     || $self->ut_textn('company')
1746     || $self->ut_anything('comments')
1747     || $self->ut_numbern('referral_custnum')
1748     || $self->ut_textn('stateid')
1749     || $self->ut_textn('stateid_state')
1750     || $self->ut_textn('invoice_terms')
1751     || $self->ut_floatn('cdr_termination_percentage')
1752     || $self->ut_floatn('credit_limit')
1753     || $self->ut_numbern('billday')
1754     || $self->ut_numbern('prorate_day')
1755     || $self->ut_flag('edit_subject')
1756     || $self->ut_flag('calling_list_exempt')
1757     || $self->ut_flag('invoice_noemail')
1758     || $self->ut_flag('message_noemail')
1759     || $self->ut_enum('locale', [ '', FS::Locales->locales ])
1760   ;
1761
1762   my $company = $self->company;
1763   $company =~ s/^\s+//;
1764   $company =~ s/\s+$//;
1765   $company =~ s/\s+/ /g;
1766   $self->company($company);
1767
1768   #barf.  need message catalogs.  i18n.  etc.
1769   $error .= "Please select an advertising source."
1770     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1771   return $error if $error;
1772
1773   return "Unknown agent"
1774     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1775
1776   return "Unknown refnum"
1777     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1778
1779   return "Unknown referring custnum: ". $self->referral_custnum
1780     unless ! $self->referral_custnum
1781            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1782
1783   if ( $self->ss eq '' ) {
1784     $self->ss('');
1785   } else {
1786     my $ss = $self->ss;
1787     $ss =~ s/\D//g;
1788     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1789       or return "Illegal social security number: ". $self->ss;
1790     $self->ss("$1-$2-$3");
1791   }
1792
1793   # cust_main_county verification now handled by cust_location check
1794
1795   $error =
1796        $self->ut_phonen('daytime', $self->country)
1797     || $self->ut_phonen('night',   $self->country)
1798     || $self->ut_phonen('fax',     $self->country)
1799     || $self->ut_phonen('mobile',  $self->country)
1800   ;
1801   return $error if $error;
1802
1803   if ( $conf->exists('cust_main-require_phone', $self->agentnum)
1804        && ! $import
1805        && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
1806      ) {
1807
1808     my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1809                           ? 'Day Phone'
1810                           : FS::Msgcat::_gettext('daytime');
1811     my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1812                         ? 'Night Phone'
1813                         : FS::Msgcat::_gettext('night');
1814
1815     my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
1816                         ? 'Mobile Phone'
1817                         : FS::Msgcat::_gettext('mobile');
1818
1819     return "$daytime_label, $night_label or $mobile_label is required"
1820
1821   }
1822
1823   #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1824   #  or return "Illegal payby: ". $self->payby;
1825   #$self->payby($1);
1826   FS::payby->can_payby($self->table, $self->payby)
1827     or return "Illegal payby: ". $self->payby;
1828
1829   $error =    $self->ut_numbern('paystart_month')
1830            || $self->ut_numbern('paystart_year')
1831            || $self->ut_numbern('payissue')
1832            || $self->ut_textn('paytype')
1833   ;
1834   return $error if $error;
1835
1836   if ( $self->payip eq '' ) {
1837     $self->payip('');
1838   } else {
1839     $error = $self->ut_ip('payip');
1840     return $error if $error;
1841   }
1842
1843   # If it is encrypted and the private key is not availaible then we can't
1844   # check the credit card.
1845   my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1846
1847   # Need some kind of global flag to accept invalid cards, for testing
1848   # on scrubbed data.
1849   if ( !$import && $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1850
1851     my $payinfo = $self->payinfo;
1852     $payinfo =~ s/\D//g;
1853     $payinfo =~ /^(\d{13,16}|\d{8,9})$/
1854       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1855     $payinfo = $1;
1856     $self->payinfo($payinfo);
1857     validate($payinfo)
1858       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1859
1860     return gettext('unknown_card_type')
1861       if $self->payinfo !~ /^99\d{14}$/ #token
1862       && cardtype($self->payinfo) eq "Unknown";
1863
1864     unless ( $ignore_banned_card ) {
1865       my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1866       if ( $ban ) {
1867         if ( $ban->bantype eq 'warn' ) {
1868           #or others depending on value of $ban->reason ?
1869           return '_duplicate_card'.
1870                  ': disabled from'. time2str('%a %h %o at %r', $ban->_date).
1871                  ' until '.         time2str('%a %h %o at %r', $ban->_end_date).
1872                  ' (ban# '. $ban->bannum. ')'
1873             unless $self->override_ban_warn;
1874         } else {
1875           return 'Banned credit card: banned on '.
1876                  time2str('%a %h %o at %r', $ban->_date).
1877                  ' by '. $ban->otaker.
1878                  ' (ban# '. $ban->bannum. ')';
1879         }
1880       }
1881     }
1882
1883     if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1884       if ( cardtype($self->payinfo) eq 'American Express card' ) {
1885         $self->paycvv =~ /^(\d{4})$/
1886           or return "CVV2 (CID) for American Express cards is four digits.";
1887         $self->paycvv($1);
1888       } else {
1889         $self->paycvv =~ /^(\d{3})$/
1890           or return "CVV2 (CVC2/CID) is three digits.";
1891         $self->paycvv($1);
1892       }
1893     } else {
1894       $self->paycvv('');
1895     }
1896
1897     my $cardtype = cardtype($payinfo);
1898     if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1899
1900       return "Start date or issue number is required for $cardtype cards"
1901         unless $self->paystart_month && $self->paystart_year or $self->payissue;
1902
1903       return "Start month must be between 1 and 12"
1904         if $self->paystart_month
1905            and $self->paystart_month < 1 || $self->paystart_month > 12;
1906
1907       return "Start year must be 1990 or later"
1908         if $self->paystart_year
1909            and $self->paystart_year < 1990;
1910
1911       return "Issue number must be beween 1 and 99"
1912         if $self->payissue
1913           and $self->payissue < 1 || $self->payissue > 99;
1914
1915     } else {
1916       $self->paystart_month('');
1917       $self->paystart_year('');
1918       $self->payissue('');
1919     }
1920
1921   } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1922
1923     my $payinfo = $self->payinfo;
1924     $payinfo =~ s/[^\d\@\.]//g;
1925     if ( $conf->config('echeck-country') eq 'CA' ) {
1926       $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/
1927         or return 'invalid echeck account@branch.bank';
1928       $payinfo = "$1\@$2.$3";
1929     } elsif ( $conf->config('echeck-country') eq 'US' ) {
1930       $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1931       $payinfo = "$1\@$2";
1932     } else {
1933       $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing';
1934       $payinfo = "$1\@$2";
1935     }
1936     $self->payinfo($payinfo);
1937     $self->paycvv('');
1938
1939     unless ( $ignore_banned_card ) {
1940       my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1941       if ( $ban ) {
1942         if ( $ban->bantype eq 'warn' ) {
1943           #or others depending on value of $ban->reason ?
1944           return '_duplicate_ach' unless $self->override_ban_warn;
1945         } else {
1946           return 'Banned ACH account: banned on '.
1947                  time2str('%a %h %o at %r', $ban->_date).
1948                  ' by '. $ban->otaker.
1949                  ' (ban# '. $ban->bannum. ')';
1950         }
1951       }
1952     }
1953
1954   } elsif ( $self->payby eq 'LECB' ) {
1955
1956     my $payinfo = $self->payinfo;
1957     $payinfo =~ s/\D//g;
1958     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1959     $payinfo = $1;
1960     $self->payinfo($payinfo);
1961     $self->paycvv('');
1962
1963   } elsif ( $self->payby eq 'BILL' ) {
1964
1965     $error = $self->ut_textn('payinfo');
1966     return "Illegal P.O. number: ". $self->payinfo if $error;
1967     $self->paycvv('');
1968
1969   } elsif ( $self->payby eq 'COMP' ) {
1970
1971     my $curuser = $FS::CurrentUser::CurrentUser;
1972     if (    ! $self->custnum
1973          && ! $curuser->access_right('Complimentary customer')
1974        )
1975     {
1976       return "You are not permitted to create complimentary accounts."
1977     }
1978
1979     $error = $self->ut_textn('payinfo');
1980     return "Illegal comp account issuer: ". $self->payinfo if $error;
1981     $self->paycvv('');
1982
1983   } elsif ( $self->payby eq 'PREPAY' ) {
1984
1985     my $payinfo = $self->payinfo;
1986     $payinfo =~ s/\W//g; #anything else would just confuse things
1987     $self->payinfo($payinfo);
1988     $error = $self->ut_alpha('payinfo');
1989     return "Illegal prepayment identifier: ". $self->payinfo if $error;
1990     return "Unknown prepayment identifier"
1991       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1992     $self->paycvv('');
1993
1994   }
1995
1996   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1997     return "Expiration date required"
1998       # shouldn't payinfo_check do this?
1999       unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD|PPAL)$/;
2000     $self->paydate('');
2001   } else {
2002     my( $m, $y );
2003     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
2004       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
2005     } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2006       ( $m, $y ) = ( $2, "19$1" );
2007     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2008       ( $m, $y ) = ( $3, "20$2" );
2009     } else {
2010       return "Illegal expiration date: ". $self->paydate;
2011     }
2012     $m = sprintf('%02d',$m);
2013     $self->paydate("$y-$m-01");
2014     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
2015     return gettext('expired_card')
2016       if !$import
2017       && !$ignore_expired_card
2018       && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
2019   }
2020
2021   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
2022        ( ! $conf->exists('require_cardname')
2023          || $self->payby !~ /^(CARD|DCRD)$/  )
2024   ) {
2025     $self->payname( $self->first. " ". $self->getfield('last') );
2026   } else {
2027     $self->payname =~ /^([\w \,\.\-\'\&]+)$/
2028       or return gettext('illegal_name'). " payname: ". $self->payname;
2029     $self->payname($1);
2030   }
2031
2032   return "Please select an invoicing locale"
2033     if ! $self->locale
2034     && ! $self->custnum
2035     && $conf->exists('cust_main-require_locale');
2036
2037   foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
2038     $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
2039     $self->$flag($1);
2040   }
2041
2042   $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
2043
2044   warn "$me check AFTER: \n". $self->_dump
2045     if $DEBUG > 2;
2046
2047   $self->SUPER::check;
2048 }
2049
2050 =item addr_fields
2051
2052 Returns a list of fields which have ship_ duplicates.
2053
2054 =cut
2055
2056 sub addr_fields {
2057   qw( last first company
2058       address1 address2 city county state zip country
2059       latitude longitude
2060       daytime night fax mobile
2061     );
2062 }
2063
2064 =item has_ship_address
2065
2066 Returns true if this customer record has a separate shipping address.
2067
2068 =cut
2069
2070 sub has_ship_address {
2071   my $self = shift;
2072   $self->bill_locationnum != $self->ship_locationnum;
2073 }
2074
2075 =item location_hash
2076
2077 Returns a list of key/value pairs, with the following keys: address1,
2078 adddress2, city, county, state, zip, country, district, and geocode.  The
2079 shipping address is used if present.
2080
2081 =cut
2082
2083 sub location_hash {
2084   my $self = shift;
2085   $self->ship_location->location_hash;
2086 }
2087
2088 =item cust_location
2089
2090 Returns all locations (see L<FS::cust_location>) for this customer.
2091
2092 =cut
2093
2094 sub cust_location {
2095   my $self = shift;
2096   qsearch('cust_location', { 'custnum' => $self->custnum,
2097                              'prospectnum' => '' } );
2098 }
2099
2100 =item cust_contact
2101
2102 Returns all contacts (see L<FS::contact>) for this customer.
2103
2104 =cut
2105
2106 #already used :/ sub contact {
2107 sub cust_contact {
2108   my $self = shift;
2109   qsearch('contact', { 'custnum' => $self->custnum } );
2110 }
2111
2112 =item unsuspend
2113
2114 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2115 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
2116 on success or a list of errors.
2117
2118 =cut
2119
2120 sub unsuspend {
2121   my $self = shift;
2122   grep { $_->unsuspend } $self->suspended_pkgs;
2123 }
2124
2125 =item suspend
2126
2127 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2128
2129 Returns a list: an empty list on success or a list of errors.
2130
2131 =cut
2132
2133 sub suspend {
2134   my $self = shift;
2135   grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2136 }
2137
2138 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2139
2140 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2141 PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref instead
2142 of a list of pkgparts; the hashref has the following keys:
2143
2144 =over 4
2145
2146 =item pkgparts - listref of pkgparts
2147
2148 =item (other options are passed to the suspend method)
2149
2150 =back
2151
2152
2153 Returns a list: an empty list on success or a list of errors.
2154
2155 =cut
2156
2157 sub suspend_if_pkgpart {
2158   my $self = shift;
2159   my (@pkgparts, %opt);
2160   if (ref($_[0]) eq 'HASH'){
2161     @pkgparts = @{$_[0]{pkgparts}};
2162     %opt      = %{$_[0]};
2163   }else{
2164     @pkgparts = @_;
2165   }
2166   grep { $_->suspend(%opt) }
2167     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2168       $self->unsuspended_pkgs;
2169 }
2170
2171 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2172
2173 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2174 given PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref
2175 instead of a list of pkgparts; the hashref has the following keys:
2176
2177 =over 4
2178
2179 =item pkgparts - listref of pkgparts
2180
2181 =item (other options are passed to the suspend method)
2182
2183 =back
2184
2185 Returns a list: an empty list on success or a list of errors.
2186
2187 =cut
2188
2189 sub suspend_unless_pkgpart {
2190   my $self = shift;
2191   my (@pkgparts, %opt);
2192   if (ref($_[0]) eq 'HASH'){
2193     @pkgparts = @{$_[0]{pkgparts}};
2194     %opt      = %{$_[0]};
2195   }else{
2196     @pkgparts = @_;
2197   }
2198   grep { $_->suspend(%opt) }
2199     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2200       $self->unsuspended_pkgs;
2201 }
2202
2203 =item cancel [ OPTION => VALUE ... ]
2204
2205 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2206
2207 Available options are:
2208
2209 =over 4
2210
2211 =item quiet - can be set true to supress email cancellation notices.
2212
2213 =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.
2214
2215 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2216
2217 =item nobill - can be set true to skip billing if it might otherwise be done.
2218
2219 =back
2220
2221 Always returns a list: an empty list on success or a list of errors.
2222
2223 =cut
2224
2225 # nb that dates are not specified as valid options to this method
2226
2227 sub cancel {
2228   my( $self, %opt ) = @_;
2229
2230   warn "$me cancel called on customer ". $self->custnum. " with options ".
2231        join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2232     if $DEBUG;
2233
2234   return ( 'access denied' )
2235     unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2236
2237   if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2238
2239     #should try decryption (we might have the private key)
2240     # and if not maybe queue a job for the server that does?
2241     return ( "Can't (yet) ban encrypted credit cards" )
2242       if $self->is_encrypted($self->payinfo);
2243
2244     my $ban = new FS::banned_pay $self->_new_banned_pay_hashref;
2245     my $error = $ban->insert;
2246     return ( $error ) if $error;
2247
2248   }
2249
2250   my @pkgs = $self->ncancelled_pkgs;
2251
2252   if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2253     $opt{nobill} = 1;
2254     my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2255     warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2256       if $error;
2257   }
2258
2259   warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2260        scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2261     if $DEBUG;
2262
2263   grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2264 }
2265
2266 sub _banned_pay_hashref {
2267   my $self = shift;
2268
2269   my %payby2ban = (
2270     'CARD' => 'CARD',
2271     'DCRD' => 'CARD',
2272     'CHEK' => 'CHEK',
2273     'DCHK' => 'CHEK'
2274   );
2275
2276   {
2277     'payby'   => $payby2ban{$self->payby},
2278     'payinfo' => $self->payinfo,
2279     #don't ever *search* on reason! #'reason'  =>
2280   };
2281 }
2282
2283 sub _new_banned_pay_hashref {
2284   my $self = shift;
2285   my $hr = $self->_banned_pay_hashref;
2286   $hr->{payinfo} = md5_base64($hr->{payinfo});
2287   $hr;
2288 }
2289
2290 =item notes
2291
2292 Returns all notes (see L<FS::cust_main_note>) for this customer.
2293
2294 =cut
2295
2296 sub notes {
2297   my($self,$orderby_classnum) = (shift,shift);
2298   my $orderby = "_DATE DESC";
2299   $orderby = "CLASSNUM ASC, $orderby" if $orderby_classnum;
2300   qsearch( 'cust_main_note',
2301            { 'custnum' => $self->custnum },
2302            '',
2303            "ORDER BY $orderby",
2304          );
2305 }
2306
2307 =item agent
2308
2309 Returns the agent (see L<FS::agent>) for this customer.
2310
2311 =cut
2312
2313 sub agent {
2314   my $self = shift;
2315   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2316 }
2317
2318 =item agent_name
2319
2320 Returns the agent name (see L<FS::agent>) for this customer.
2321
2322 =cut
2323
2324 sub agent_name {
2325   my $self = shift;
2326   $self->agent->agent;
2327 }
2328
2329 =item cust_tag
2330
2331 Returns any tags associated with this customer, as FS::cust_tag objects,
2332 or an empty list if there are no tags.
2333
2334 =cut
2335
2336 sub cust_tag {
2337   my $self = shift;
2338   qsearch('cust_tag', { 'custnum' => $self->custnum } );
2339 }
2340
2341 =item part_tag
2342
2343 Returns any tags associated with this customer, as FS::part_tag objects,
2344 or an empty list if there are no tags.
2345
2346 =cut
2347
2348 sub part_tag {
2349   my $self = shift;
2350   map $_->part_tag, $self->cust_tag;
2351 }
2352
2353
2354 =item cust_class
2355
2356 Returns the customer class, as an FS::cust_class object, or the empty string
2357 if there is no customer class.
2358
2359 =cut
2360
2361 sub cust_class {
2362   my $self = shift;
2363   if ( $self->classnum ) {
2364     qsearchs('cust_class', { 'classnum' => $self->classnum } );
2365   } else {
2366     return '';
2367   }
2368 }
2369
2370 =item categoryname
2371
2372 Returns the customer category name, or the empty string if there is no customer
2373 category.
2374
2375 =cut
2376
2377 sub categoryname {
2378   my $self = shift;
2379   my $cust_class = $self->cust_class;
2380   $cust_class
2381     ? $cust_class->categoryname
2382     : '';
2383 }
2384
2385 =item classname
2386
2387 Returns the customer class name, or the empty string if there is no customer
2388 class.
2389
2390 =cut
2391
2392 sub classname {
2393   my $self = shift;
2394   my $cust_class = $self->cust_class;
2395   $cust_class
2396     ? $cust_class->classname
2397     : '';
2398 }
2399
2400 =item BILLING METHODS
2401
2402 Documentation on billing methods has been moved to
2403 L<FS::cust_main::Billing>.
2404
2405 =item REALTIME BILLING METHODS
2406
2407 Documentation on realtime billing methods has been moved to
2408 L<FS::cust_main::Billing_Realtime>.
2409
2410 =item remove_cvv
2411
2412 Removes the I<paycvv> field from the database directly.
2413
2414 If there is an error, returns the error, otherwise returns false.
2415
2416 =cut
2417
2418 sub remove_cvv {
2419   my $self = shift;
2420   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2421     or return dbh->errstr;
2422   $sth->execute($self->custnum)
2423     or return $sth->errstr;
2424   $self->paycvv('');
2425   '';
2426 }
2427
2428 =item batch_card OPTION => VALUE...
2429
2430 Adds a payment for this invoice to the pending credit card batch (see
2431 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
2432 runs the payment using a realtime gateway.
2433
2434 Options may include:
2435
2436 B<amount>: the amount to be paid; defaults to the customer's balance minus
2437 any payments in transit.
2438
2439 B<payby>: the payment method; defaults to cust_main.payby
2440
2441 B<realtime>: runs this as a realtime payment instead of adding it to a
2442 batch.  Deprecated.
2443
2444 B<invnum>: sets cust_pay_batch.invnum.
2445
2446 B<address1>, B<address2>, B<city>, B<state>, B<zip>, B<country>: sets
2447 the billing address for the payment; defaults to the customer's billing
2448 location.
2449
2450 B<payinfo>, B<paydate>, B<payname>: sets the payment account, expiration
2451 date, and name; defaults to those fields in cust_main.
2452
2453 =cut
2454
2455 sub batch_card {
2456   my ($self, %options) = @_;
2457
2458   my $amount;
2459   if (exists($options{amount})) {
2460     $amount = $options{amount};
2461   }else{
2462     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
2463   }
2464   return '' unless $amount > 0;
2465
2466   my $invnum = delete $options{invnum};
2467   my $payby = $options{payby} || $self->payby;  #still dubious
2468
2469   if ($options{'realtime'}) {
2470     return $self->realtime_bop( FS::payby->payby2bop($self->payby),
2471                                 $amount,
2472                                 %options,
2473                               );
2474   }
2475
2476   my $oldAutoCommit = $FS::UID::AutoCommit;
2477   local $FS::UID::AutoCommit = 0;
2478   my $dbh = dbh;
2479
2480   #this needs to handle mysql as well as Pg, like svc_acct.pm
2481   #(make it into a common function if folks need to do batching with mysql)
2482   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
2483     or return "Cannot lock pay_batch: " . $dbh->errstr;
2484
2485   my %pay_batch = (
2486     'status' => 'O',
2487     'payby'  => FS::payby->payby2payment($payby),
2488   );
2489   $pay_batch{agentnum} = $self->agentnum if $conf->exists('batch-spoolagent');
2490
2491   my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
2492
2493   unless ( $pay_batch ) {
2494     $pay_batch = new FS::pay_batch \%pay_batch;
2495     my $error = $pay_batch->insert;
2496     if ( $error ) {
2497       $dbh->rollback if $oldAutoCommit;
2498       die "error creating new batch: $error\n";
2499     }
2500   }
2501
2502   my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
2503       'batchnum' => $pay_batch->batchnum,
2504       'custnum'  => $self->custnum,
2505   } );
2506
2507   foreach (qw( address1 address2 city state zip country latitude longitude
2508                payby payinfo paydate payname ))
2509   {
2510     $options{$_} = '' unless exists($options{$_});
2511   }
2512
2513   my $loc = $self->bill_location;
2514
2515   my $cust_pay_batch = new FS::cust_pay_batch ( {
2516     'batchnum' => $pay_batch->batchnum,
2517     'invnum'   => $invnum || 0,                    # is there a better value?
2518                                                    # this field should be
2519                                                    # removed...
2520                                                    # cust_bill_pay_batch now
2521     'custnum'  => $self->custnum,
2522     'last'     => $self->getfield('last'),
2523     'first'    => $self->getfield('first'),
2524     'address1' => $options{address1} || $loc->address1,
2525     'address2' => $options{address2} || $loc->address2,
2526     'city'     => $options{city}     || $loc->city,
2527     'state'    => $options{state}    || $loc->state,
2528     'zip'      => $options{zip}      || $loc->zip,
2529     'country'  => $options{country}  || $loc->country,
2530     'payby'    => $options{payby}    || $self->payby,
2531     'payinfo'  => $options{payinfo}  || $self->payinfo,
2532     'exp'      => $options{paydate}  || $self->paydate,
2533     'payname'  => $options{payname}  || $self->payname,
2534     'amount'   => $amount,                         # consolidating
2535   } );
2536
2537   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
2538     if $old_cust_pay_batch;
2539
2540   my $error;
2541   if ($old_cust_pay_batch) {
2542     $error = $cust_pay_batch->replace($old_cust_pay_batch)
2543   } else {
2544     $error = $cust_pay_batch->insert;
2545   }
2546
2547   if ( $error ) {
2548     $dbh->rollback if $oldAutoCommit;
2549     die $error;
2550   }
2551
2552   my $unapplied =   $self->total_unapplied_credits
2553                   + $self->total_unapplied_payments
2554                   + $self->in_transit_payments;
2555   foreach my $cust_bill ($self->open_cust_bill) {
2556     #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
2557     my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
2558       'invnum' => $cust_bill->invnum,
2559       'paybatchnum' => $cust_pay_batch->paybatchnum,
2560       'amount' => $cust_bill->owed,
2561       '_date' => time,
2562     };
2563     if ($unapplied >= $cust_bill_pay_batch->amount){
2564       $unapplied -= $cust_bill_pay_batch->amount;
2565       next;
2566     }else{
2567       $cust_bill_pay_batch->amount(sprintf ( "%.2f",
2568                                    $cust_bill_pay_batch->amount - $unapplied ));      $unapplied = 0;
2569     }
2570     $error = $cust_bill_pay_batch->insert;
2571     if ( $error ) {
2572       $dbh->rollback if $oldAutoCommit;
2573       die $error;
2574     }
2575   }
2576
2577   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2578   '';
2579 }
2580
2581 =item total_owed
2582
2583 Returns the total owed for this customer on all invoices
2584 (see L<FS::cust_bill/owed>).
2585
2586 =cut
2587
2588 sub total_owed {
2589   my $self = shift;
2590   $self->total_owed_date(2145859200); #12/31/2037
2591 }
2592
2593 =item total_owed_date TIME
2594
2595 Returns the total owed for this customer on all invoices with date earlier than
2596 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2597 see L<Time::Local> and L<Date::Parse> for conversion functions.
2598
2599 =cut
2600
2601 sub total_owed_date {
2602   my $self = shift;
2603   my $time = shift;
2604
2605   my $custnum = $self->custnum;
2606
2607   my $owed_sql = FS::cust_bill->owed_sql;
2608
2609   my $sql = "
2610     SELECT SUM($owed_sql) FROM cust_bill
2611       WHERE custnum = $custnum
2612         AND _date <= $time
2613   ";
2614
2615   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2616
2617 }
2618
2619 =item total_owed_pkgnum PKGNUM
2620
2621 Returns the total owed on all invoices for this customer's specific package
2622 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2623
2624 =cut
2625
2626 sub total_owed_pkgnum {
2627   my( $self, $pkgnum ) = @_;
2628   $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2629 }
2630
2631 =item total_owed_date_pkgnum TIME PKGNUM
2632
2633 Returns the total owed for this customer's specific package when using
2634 experimental package balances on all invoices with date earlier than
2635 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2636 see L<Time::Local> and L<Date::Parse> for conversion functions.
2637
2638 =cut
2639
2640 sub total_owed_date_pkgnum {
2641   my( $self, $time, $pkgnum ) = @_;
2642
2643   my $total_bill = 0;
2644   foreach my $cust_bill (
2645     grep { $_->_date <= $time }
2646       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2647   ) {
2648     $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2649   }
2650   sprintf( "%.2f", $total_bill );
2651
2652 }
2653
2654 =item total_paid
2655
2656 Returns the total amount of all payments.
2657
2658 =cut
2659
2660 sub total_paid {
2661   my $self = shift;
2662   my $total = 0;
2663   $total += $_->paid foreach $self->cust_pay;
2664   sprintf( "%.2f", $total );
2665 }
2666
2667 =item total_unapplied_credits
2668
2669 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2670 customer.  See L<FS::cust_credit/credited>.
2671
2672 =item total_credited
2673
2674 Old name for total_unapplied_credits.  Don't use.
2675
2676 =cut
2677
2678 sub total_credited {
2679   #carp "total_credited deprecated, use total_unapplied_credits";
2680   shift->total_unapplied_credits(@_);
2681 }
2682
2683 sub total_unapplied_credits {
2684   my $self = shift;
2685
2686   my $custnum = $self->custnum;
2687
2688   my $unapplied_sql = FS::cust_credit->unapplied_sql;
2689
2690   my $sql = "
2691     SELECT SUM($unapplied_sql) FROM cust_credit
2692       WHERE custnum = $custnum
2693   ";
2694
2695   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2696
2697 }
2698
2699 =item total_unapplied_credits_pkgnum PKGNUM
2700
2701 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2702 customer.  See L<FS::cust_credit/credited>.
2703
2704 =cut
2705
2706 sub total_unapplied_credits_pkgnum {
2707   my( $self, $pkgnum ) = @_;
2708   my $total_credit = 0;
2709   $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2710   sprintf( "%.2f", $total_credit );
2711 }
2712
2713
2714 =item total_unapplied_payments
2715
2716 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2717 See L<FS::cust_pay/unapplied>.
2718
2719 =cut
2720
2721 sub total_unapplied_payments {
2722   my $self = shift;
2723
2724   my $custnum = $self->custnum;
2725
2726   my $unapplied_sql = FS::cust_pay->unapplied_sql;
2727
2728   my $sql = "
2729     SELECT SUM($unapplied_sql) FROM cust_pay
2730       WHERE custnum = $custnum
2731   ";
2732
2733   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2734
2735 }
2736
2737 =item total_unapplied_payments_pkgnum PKGNUM
2738
2739 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2740 specific package when using experimental package balances.  See
2741 L<FS::cust_pay/unapplied>.
2742
2743 =cut
2744
2745 sub total_unapplied_payments_pkgnum {
2746   my( $self, $pkgnum ) = @_;
2747   my $total_unapplied = 0;
2748   $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2749   sprintf( "%.2f", $total_unapplied );
2750 }
2751
2752
2753 =item total_unapplied_refunds
2754
2755 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2756 customer.  See L<FS::cust_refund/unapplied>.
2757
2758 =cut
2759
2760 sub total_unapplied_refunds {
2761   my $self = shift;
2762   my $custnum = $self->custnum;
2763
2764   my $unapplied_sql = FS::cust_refund->unapplied_sql;
2765
2766   my $sql = "
2767     SELECT SUM($unapplied_sql) FROM cust_refund
2768       WHERE custnum = $custnum
2769   ";
2770
2771   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2772
2773 }
2774
2775 =item balance
2776
2777 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2778 total_unapplied_credits minus total_unapplied_payments).
2779
2780 =cut
2781
2782 sub balance {
2783   my $self = shift;
2784   $self->balance_date_range;
2785 }
2786
2787 =item balance_date TIME
2788
2789 Returns the balance for this customer, only considering invoices with date
2790 earlier than TIME (total_owed_date minus total_credited minus
2791 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
2792 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
2793 functions.
2794
2795 =cut
2796
2797 sub balance_date {
2798   my $self = shift;
2799   $self->balance_date_range(shift);
2800 }
2801
2802 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2803
2804 Returns the balance for this customer, optionally considering invoices with
2805 date earlier than START_TIME, and not later than END_TIME
2806 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2807
2808 Times are specified as SQL fragments or numeric
2809 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
2810 L<Date::Parse> for conversion functions.  The empty string can be passed
2811 to disable that time constraint completely.
2812
2813 Available options are:
2814
2815 =over 4
2816
2817 =item unapplied_date
2818
2819 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)
2820
2821 =back
2822
2823 =cut
2824
2825 sub balance_date_range {
2826   my $self = shift;
2827   my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2828             ') FROM cust_main WHERE custnum='. $self->custnum;
2829   sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2830 }
2831
2832 =item balance_pkgnum PKGNUM
2833
2834 Returns the balance for this customer's specific package when using
2835 experimental package balances (total_owed plus total_unrefunded, minus
2836 total_unapplied_credits minus total_unapplied_payments)
2837
2838 =cut
2839
2840 sub balance_pkgnum {
2841   my( $self, $pkgnum ) = @_;
2842
2843   sprintf( "%.2f",
2844       $self->total_owed_pkgnum($pkgnum)
2845 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2846 #    + $self->total_unapplied_refunds_pkgnum($pkgnum)
2847     - $self->total_unapplied_credits_pkgnum($pkgnum)
2848     - $self->total_unapplied_payments_pkgnum($pkgnum)
2849   );
2850 }
2851
2852 =item in_transit_payments
2853
2854 Returns the total of requests for payments for this customer pending in
2855 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
2856
2857 =cut
2858
2859 sub in_transit_payments {
2860   my $self = shift;
2861   my $in_transit_payments = 0;
2862   foreach my $pay_batch ( qsearch('pay_batch', {
2863     'status' => 'I',
2864   } ) ) {
2865     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
2866       'batchnum' => $pay_batch->batchnum,
2867       'custnum' => $self->custnum,
2868     } ) ) {
2869       $in_transit_payments += $cust_pay_batch->amount;
2870     }
2871   }
2872   sprintf( "%.2f", $in_transit_payments );
2873 }
2874
2875 =item payment_info
2876
2877 Returns a hash of useful information for making a payment.
2878
2879 =over 4
2880
2881 =item balance
2882
2883 Current balance.
2884
2885 =item payby
2886
2887 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2888 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2889 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2890
2891 =back
2892
2893 For credit card transactions:
2894
2895 =over 4
2896
2897 =item card_type 1
2898
2899 =item payname
2900
2901 Exact name on card
2902
2903 =back
2904
2905 For electronic check transactions:
2906
2907 =over 4
2908
2909 =item stateid_state
2910
2911 =back
2912
2913 =cut
2914
2915 sub payment_info {
2916   my $self = shift;
2917
2918   my %return = ();
2919
2920   $return{balance} = $self->balance;
2921
2922   $return{payname} = $self->payname
2923                      || ( $self->first. ' '. $self->get('last') );
2924
2925   $return{$_} = $self->bill_location->$_
2926     for qw(address1 address2 city state zip);
2927
2928   $return{payby} = $self->payby;
2929   $return{stateid_state} = $self->stateid_state;
2930
2931   if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
2932     $return{card_type} = cardtype($self->payinfo);
2933     $return{payinfo} = $self->paymask;
2934
2935     @return{'month', 'year'} = $self->paydate_monthyear;
2936
2937   }
2938
2939   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2940     my ($payinfo1, $payinfo2) = split '@', $self->paymask;
2941     $return{payinfo1} = $payinfo1;
2942     $return{payinfo2} = $payinfo2;
2943     $return{paytype}  = $self->paytype;
2944     $return{paystate} = $self->paystate;
2945
2946   }
2947
2948   #doubleclick protection
2949   my $_date = time;
2950   $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
2951
2952   %return;
2953
2954 }
2955
2956 =item paydate_monthyear
2957
2958 Returns a two-element list consisting of the month and year of this customer's
2959 paydate (credit card expiration date for CARD customers)
2960
2961 =cut
2962
2963 sub paydate_monthyear {
2964   my $self = shift;
2965   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2966     ( $2, $1 );
2967   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2968     ( $1, $3 );
2969   } else {
2970     ('', '');
2971   }
2972 }
2973
2974 =item paydate_epoch
2975
2976 Returns the exact time in seconds corresponding to the payment method
2977 expiration date.  For CARD/DCRD customers this is the end of the month;
2978 for others (COMP is the only other payby that uses paydate) it's the start.
2979 Returns 0 if the paydate is empty or set to the far future.
2980
2981 =cut
2982
2983 sub paydate_epoch {
2984   my $self = shift;
2985   my ($month, $year) = $self->paydate_monthyear;
2986   return 0 if !$year or $year >= 2037;
2987   if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) {
2988     $month++;
2989     if ( $month == 13 ) {
2990       $month = 1;
2991       $year++;
2992     }
2993     return timelocal(0,0,0,1,$month-1,$year) - 1;
2994   }
2995   else {
2996     return timelocal(0,0,0,1,$month-1,$year);
2997   }
2998 }
2999
3000 =item paydate_epoch_sql
3001
3002 Class method.  Returns an SQL expression to obtain the payment expiration date
3003 as a number of seconds.
3004
3005 =cut
3006
3007 # Special expiration date behavior for non-CARD/DCRD customers has been
3008 # carefully preserved.  Do we really use that?
3009 sub paydate_epoch_sql {
3010   my $class = shift;
3011   my $table = shift || 'cust_main';
3012   my ($case1, $case2);
3013   if ( driver_name eq 'Pg' ) {
3014     $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1";
3015     $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )";
3016   }
3017   elsif ( lc(driver_name) eq 'mysql' ) {
3018     $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1";
3019     $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )";
3020   }
3021   else { return '' }
3022   return "CASE WHEN $table.payby IN('CARD','DCRD')
3023   THEN ($case1)
3024   ELSE ($case2)
3025   END"
3026 }
3027
3028 =item tax_exemption TAXNAME
3029
3030 =cut
3031
3032 sub tax_exemption {
3033   my( $self, $taxname ) = @_;
3034
3035   qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
3036                                      'taxname' => $taxname,
3037                                    },
3038           );
3039 }
3040
3041 =item cust_main_exemption
3042
3043 =cut
3044
3045 sub cust_main_exemption {
3046   my $self = shift;
3047   qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
3048 }
3049
3050 =item invoicing_list [ ARRAYREF ]
3051
3052 If an arguement is given, sets these email addresses as invoice recipients
3053 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
3054 (except as warnings), so use check_invoicing_list first.
3055
3056 Returns a list of email addresses (with svcnum entries expanded).
3057
3058 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
3059 check it without disturbing anything by passing nothing.
3060
3061 This interface may change in the future.
3062
3063 =cut
3064
3065 sub invoicing_list {
3066   my( $self, $arrayref ) = @_;
3067
3068   if ( $arrayref ) {
3069     my @cust_main_invoice;
3070     if ( $self->custnum ) {
3071       @cust_main_invoice =
3072         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3073     } else {
3074       @cust_main_invoice = ();
3075     }
3076     foreach my $cust_main_invoice ( @cust_main_invoice ) {
3077       #warn $cust_main_invoice->destnum;
3078       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3079         #warn $cust_main_invoice->destnum;
3080         my $error = $cust_main_invoice->delete;
3081         warn $error if $error;
3082       }
3083     }
3084     if ( $self->custnum ) {
3085       @cust_main_invoice =
3086         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3087     } else {
3088       @cust_main_invoice = ();
3089     }
3090     my %seen = map { $_->address => 1 } @cust_main_invoice;
3091     foreach my $address ( @{$arrayref} ) {
3092       next if exists $seen{$address} && $seen{$address};
3093       $seen{$address} = 1;
3094       my $cust_main_invoice = new FS::cust_main_invoice ( {
3095         'custnum' => $self->custnum,
3096         'dest'    => $address,
3097       } );
3098       my $error = $cust_main_invoice->insert;
3099       warn $error if $error;
3100     }
3101   }
3102
3103   if ( $self->custnum ) {
3104     map { $_->address }
3105       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3106   } else {
3107     ();
3108   }
3109
3110 }
3111
3112 =item check_invoicing_list ARRAYREF
3113
3114 Checks these arguements as valid input for the invoicing_list method.  If there
3115 is an error, returns the error, otherwise returns false.
3116
3117 =cut
3118
3119 sub check_invoicing_list {
3120   my( $self, $arrayref ) = @_;
3121
3122   foreach my $address ( @$arrayref ) {
3123
3124     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3125       return 'Can\'t add FAX invoice destination with a blank FAX number.';
3126     }
3127
3128     my $cust_main_invoice = new FS::cust_main_invoice ( {
3129       'custnum' => $self->custnum,
3130       'dest'    => $address,
3131     } );
3132     my $error = $self->custnum
3133                 ? $cust_main_invoice->check
3134                 : $cust_main_invoice->checkdest
3135     ;
3136     return $error if $error;
3137
3138   }
3139
3140   return "Email address required"
3141     if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
3142     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
3143
3144   '';
3145 }
3146
3147 =item set_default_invoicing_list
3148
3149 Sets the invoicing list to all accounts associated with this customer,
3150 overwriting any previous invoicing list.
3151
3152 =cut
3153
3154 sub set_default_invoicing_list {
3155   my $self = shift;
3156   $self->invoicing_list($self->all_emails);
3157 }
3158
3159 =item all_emails
3160
3161 Returns the email addresses of all accounts provisioned for this customer.
3162
3163 =cut
3164
3165 sub all_emails {
3166   my $self = shift;
3167   my %list;
3168   foreach my $cust_pkg ( $self->all_pkgs ) {
3169     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3170     my @svc_acct =
3171       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3172         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3173           @cust_svc;
3174     $list{$_}=1 foreach map { $_->email } @svc_acct;
3175   }
3176   keys %list;
3177 }
3178
3179 =item invoicing_list_addpost
3180
3181 Adds postal invoicing to this customer.  If this customer is already configured
3182 to receive postal invoices, does nothing.
3183
3184 =cut
3185
3186 sub invoicing_list_addpost {
3187   my $self = shift;
3188   return if grep { $_ eq 'POST' } $self->invoicing_list;
3189   my @invoicing_list = $self->invoicing_list;
3190   push @invoicing_list, 'POST';
3191   $self->invoicing_list(\@invoicing_list);
3192 }
3193
3194 =item invoicing_list_emailonly
3195
3196 Returns the list of email invoice recipients (invoicing_list without non-email
3197 destinations such as POST and FAX).
3198
3199 =cut
3200
3201 sub invoicing_list_emailonly {
3202   my $self = shift;
3203   warn "$me invoicing_list_emailonly called"
3204     if $DEBUG;
3205   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3206 }
3207
3208 =item invoicing_list_emailonly_scalar
3209
3210 Returns the list of email invoice recipients (invoicing_list without non-email
3211 destinations such as POST and FAX) as a comma-separated scalar.
3212
3213 =cut
3214
3215 sub invoicing_list_emailonly_scalar {
3216   my $self = shift;
3217   warn "$me invoicing_list_emailonly_scalar called"
3218     if $DEBUG;
3219   join(', ', $self->invoicing_list_emailonly);
3220 }
3221
3222 =item referral_custnum_cust_main
3223
3224 Returns the customer who referred this customer (or the empty string, if
3225 this customer was not referred).
3226
3227 Note the difference with referral_cust_main method: This method,
3228 referral_custnum_cust_main returns the single customer (if any) who referred
3229 this customer, while referral_cust_main returns an array of customers referred
3230 BY this customer.
3231
3232 =cut
3233
3234 sub referral_custnum_cust_main {
3235   my $self = shift;
3236   return '' unless $self->referral_custnum;
3237   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3238 }
3239
3240 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3241
3242 Returns an array of customers referred by this customer (referral_custnum set
3243 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
3244 customers referred by customers referred by this customer and so on, inclusive.
3245 The default behavior is DEPTH 1 (no recursion).
3246
3247 Note the difference with referral_custnum_cust_main method: This method,
3248 referral_cust_main, returns an array of customers referred BY this customer,
3249 while referral_custnum_cust_main returns the single customer (if any) who
3250 referred this customer.
3251
3252 =cut
3253
3254 sub referral_cust_main {
3255   my $self = shift;
3256   my $depth = @_ ? shift : 1;
3257   my $exclude = @_ ? shift : {};
3258
3259   my @cust_main =
3260     map { $exclude->{$_->custnum}++; $_; }
3261       grep { ! $exclude->{ $_->custnum } }
3262         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3263
3264   if ( $depth > 1 ) {
3265     push @cust_main,
3266       map { $_->referral_cust_main($depth-1, $exclude) }
3267         @cust_main;
3268   }
3269
3270   @cust_main;
3271 }
3272
3273 =item referral_cust_main_ncancelled
3274
3275 Same as referral_cust_main, except only returns customers with uncancelled
3276 packages.
3277
3278 =cut
3279
3280 sub referral_cust_main_ncancelled {
3281   my $self = shift;
3282   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3283 }
3284
3285 =item referral_cust_pkg [ DEPTH ]
3286
3287 Like referral_cust_main, except returns a flat list of all unsuspended (and
3288 uncancelled) packages for each customer.  The number of items in this list may
3289 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3290
3291 =cut
3292
3293 sub referral_cust_pkg {
3294   my $self = shift;
3295   my $depth = @_ ? shift : 1;
3296
3297   map { $_->unsuspended_pkgs }
3298     grep { $_->unsuspended_pkgs }
3299       $self->referral_cust_main($depth);
3300 }
3301
3302 =item referring_cust_main
3303
3304 Returns the single cust_main record for the customer who referred this customer
3305 (referral_custnum), or false.
3306
3307 =cut
3308
3309 sub referring_cust_main {
3310   my $self = shift;
3311   return '' unless $self->referral_custnum;
3312   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3313 }
3314
3315 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3316
3317 Applies a credit to this customer.  If there is an error, returns the error,
3318 otherwise returns false.
3319
3320 REASON can be a text string, an FS::reason object, or a scalar reference to
3321 a reasonnum.  If a text string, it will be automatically inserted as a new
3322 reason, and a 'reason_type' option must be passed to indicate the
3323 FS::reason_type for the new reason.
3324
3325 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3326
3327 Any other options are passed to FS::cust_credit::insert.
3328
3329 =cut
3330
3331 sub credit {
3332   my( $self, $amount, $reason, %options ) = @_;
3333
3334   my $cust_credit = new FS::cust_credit {
3335     'custnum' => $self->custnum,
3336     'amount'  => $amount,
3337   };
3338
3339   if ( ref($reason) ) {
3340
3341     if ( ref($reason) eq 'SCALAR' ) {
3342       $cust_credit->reasonnum( $$reason );
3343     } else {
3344       $cust_credit->reasonnum( $reason->reasonnum );
3345     }
3346
3347   } else {
3348     $cust_credit->set('reason', $reason)
3349   }
3350
3351   for (qw( addlinfo eventnum )) {
3352     $cust_credit->$_( delete $options{$_} )
3353       if exists($options{$_});
3354   }
3355
3356   $cust_credit->insert(%options);
3357
3358 }
3359
3360 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3361
3362 Creates a one-time charge for this customer.  If there is an error, returns
3363 the error, otherwise returns false.
3364
3365 New-style, with a hashref of options:
3366
3367   my $error = $cust_main->charge(
3368                                   {
3369                                     'amount'     => 54.32,
3370                                     'quantity'   => 1,
3371                                     'start_date' => str2time('7/4/2009'),
3372                                     'pkg'        => 'Description',
3373                                     'comment'    => 'Comment',
3374                                     'additional' => [], #extra invoice detail
3375                                     'classnum'   => 1,  #pkg_class
3376
3377                                     'setuptax'   => '', # or 'Y' for tax exempt
3378
3379                                     'locationnum'=> 1234, # optional
3380
3381                                     #internal taxation
3382                                     'taxclass'   => 'Tax class',
3383
3384                                     #vendor taxation
3385                                     'taxproduct' => 2,  #part_pkg_taxproduct
3386                                     'override'   => {}, #XXX describe
3387
3388                                     #will be filled in with the new object
3389                                     'cust_pkg_ref' => \$cust_pkg,
3390
3391                                     #generate an invoice immediately
3392                                     'bill_now' => 0,
3393                                     'invoice_terms' => '', #with these terms
3394                                   }
3395                                 );
3396
3397 Old-style:
3398
3399   my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3400
3401 =cut
3402
3403 sub charge {
3404   my $self = shift;
3405   my ( $amount, $quantity, $start_date, $classnum );
3406   my ( $pkg, $comment, $additional );
3407   my ( $setuptax, $taxclass );   #internal taxes
3408   my ( $taxproduct, $override ); #vendor (CCH) taxes
3409   my $no_auto = '';
3410   my $cust_pkg_ref = '';
3411   my ( $bill_now, $invoice_terms ) = ( 0, '' );
3412   my $locationnum;
3413   if ( ref( $_[0] ) ) {
3414     $amount     = $_[0]->{amount};
3415     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3416     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3417     $no_auto    = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3418     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3419     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
3420                                            : '$'. sprintf("%.2f",$amount);
3421     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3422     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3423     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3424     $additional = $_[0]->{additional} || [];
3425     $taxproduct = $_[0]->{taxproductnum};
3426     $override   = { '' => $_[0]->{tax_override} };
3427     $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3428     $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3429     $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3430     $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3431   } else {
3432     $amount     = shift;
3433     $quantity   = 1;
3434     $start_date = '';
3435     $pkg        = @_ ? shift : 'One-time charge';
3436     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
3437     $setuptax   = '';
3438     $taxclass   = @_ ? shift : '';
3439     $additional = [];
3440   }
3441
3442   local $SIG{HUP} = 'IGNORE';
3443   local $SIG{INT} = 'IGNORE';
3444   local $SIG{QUIT} = 'IGNORE';
3445   local $SIG{TERM} = 'IGNORE';
3446   local $SIG{TSTP} = 'IGNORE';
3447   local $SIG{PIPE} = 'IGNORE';
3448
3449   my $oldAutoCommit = $FS::UID::AutoCommit;
3450   local $FS::UID::AutoCommit = 0;
3451   my $dbh = dbh;
3452
3453   my $part_pkg = new FS::part_pkg ( {
3454     'pkg'           => $pkg,
3455     'comment'       => $comment,
3456     'plan'          => 'flat',
3457     'freq'          => 0,
3458     'disabled'      => 'Y',
3459     'classnum'      => ( $classnum ? $classnum : '' ),
3460     'setuptax'      => $setuptax,
3461     'taxclass'      => $taxclass,
3462     'taxproductnum' => $taxproduct,
3463   } );
3464
3465   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3466                         ( 0 .. @$additional - 1 )
3467                   ),
3468                   'additional_count' => scalar(@$additional),
3469                   'setup_fee' => $amount,
3470                 );
3471
3472   my $error = $part_pkg->insert( options       => \%options,
3473                                  tax_overrides => $override,
3474                                );
3475   if ( $error ) {
3476     $dbh->rollback if $oldAutoCommit;
3477     return $error;
3478   }
3479
3480   my $pkgpart = $part_pkg->pkgpart;
3481   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3482   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3483     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3484     $error = $type_pkgs->insert;
3485     if ( $error ) {
3486       $dbh->rollback if $oldAutoCommit;
3487       return $error;
3488     }
3489   }
3490
3491   my $cust_pkg = new FS::cust_pkg ( {
3492     'custnum'    => $self->custnum,
3493     'pkgpart'    => $pkgpart,
3494     'quantity'   => $quantity,
3495     'start_date' => $start_date,
3496     'no_auto'    => $no_auto,
3497     'locationnum'=> $locationnum,
3498   } );
3499
3500   $error = $cust_pkg->insert;
3501   if ( $error ) {
3502     $dbh->rollback if $oldAutoCommit;
3503     return $error;
3504   } elsif ( $cust_pkg_ref ) {
3505     ${$cust_pkg_ref} = $cust_pkg;
3506   }
3507
3508   if ( $bill_now ) {
3509     my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3510                              'pkg_list'      => [ $cust_pkg ],
3511                            );
3512     if ( $error ) {
3513       $dbh->rollback if $oldAutoCommit;
3514       return $error;
3515     }
3516   }
3517
3518   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3519   return '';
3520
3521 }
3522
3523 #=item charge_postal_fee
3524 #
3525 #Applies a one time charge this customer.  If there is an error,
3526 #returns the error, returns the cust_pkg charge object or false
3527 #if there was no charge.
3528 #
3529 #=cut
3530 #
3531 # This should be a customer event.  For that to work requires that bill
3532 # also be a customer event.
3533
3534 sub charge_postal_fee {
3535   my $self = shift;
3536
3537   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3538   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3539
3540   my $cust_pkg = new FS::cust_pkg ( {
3541     'custnum'  => $self->custnum,
3542     'pkgpart'  => $pkgpart,
3543     'quantity' => 1,
3544   } );
3545
3546   my $error = $cust_pkg->insert;
3547   $error ? $error : $cust_pkg;
3548 }
3549
3550 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3551
3552 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3553
3554 Optionally, a list or hashref of additional arguments to the qsearch call can
3555 be passed.
3556
3557 =cut
3558
3559 sub cust_bill {
3560   my $self = shift;
3561   my $opt = ref($_[0]) ? shift : { @_ };
3562
3563   #return $self->num_cust_bill unless wantarray || keys %$opt;
3564
3565   $opt->{'table'} = 'cust_bill';
3566   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3567   $opt->{'hashref'}{'custnum'} = $self->custnum;
3568   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3569
3570   map { $_ } #behavior of sort undefined in scalar context
3571     sort { $a->_date <=> $b->_date }
3572       qsearch($opt);
3573 }
3574
3575 =item open_cust_bill
3576
3577 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3578 customer.
3579
3580 =cut
3581
3582 sub open_cust_bill {
3583   my $self = shift;
3584
3585   $self->cust_bill(
3586     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3587     #@_
3588   );
3589
3590 }
3591
3592 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3593
3594 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3595
3596 =cut
3597
3598 sub legacy_cust_bill {
3599   my $self = shift;
3600
3601   #return $self->num_legacy_cust_bill unless wantarray;
3602
3603   map { $_ } #behavior of sort undefined in scalar context
3604     sort { $a->_date <=> $b->_date }
3605       qsearch({ 'table'    => 'legacy_cust_bill',
3606                 'hashref'  => { 'custnum' => $self->custnum, },
3607                 'order_by' => 'ORDER BY _date ASC',
3608              });
3609 }
3610
3611 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3612
3613 Returns all the statements (see L<FS::cust_statement>) for this customer.
3614
3615 Optionally, a list or hashref of additional arguments to the qsearch call can
3616 be passed.
3617
3618 =cut
3619
3620 =item cust_bill_void
3621
3622 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3623
3624 =cut
3625
3626 sub cust_bill_void {
3627   my $self = shift;
3628
3629   map { $_ } #return $self->num_cust_bill_void unless wantarray;
3630   sort { $a->_date <=> $b->_date }
3631     qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3632 }
3633
3634 sub cust_statement {
3635   my $self = shift;
3636   my $opt = ref($_[0]) ? shift : { @_ };
3637
3638   #return $self->num_cust_statement unless wantarray || keys %$opt;
3639
3640   $opt->{'table'} = 'cust_statement';
3641   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3642   $opt->{'hashref'}{'custnum'} = $self->custnum;
3643   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3644
3645   map { $_ } #behavior of sort undefined in scalar context
3646     sort { $a->_date <=> $b->_date }
3647       qsearch($opt);
3648 }
3649
3650 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3651
3652 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3653
3654 Optionally, a list or hashref of additional arguments to the qsearch call can
3655 be passed following the SVCDB.
3656
3657 =cut
3658
3659 sub svc_x {
3660   my $self = shift;
3661   my $svcdb = shift;
3662   if ( ! $svcdb =~ /^svc_\w+$/ ) {
3663     warn "$me svc_x requires a svcdb";
3664     return;
3665   }
3666   my $opt = ref($_[0]) ? shift : { @_ };
3667
3668   $opt->{'table'} = $svcdb;
3669   $opt->{'addl_from'} =
3670     'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3671     ($opt->{'addl_from'} || '');
3672
3673   my $custnum = $self->custnum;
3674   $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3675   my $where = "cust_pkg.custnum = $custnum";
3676
3677   my $extra_sql = $opt->{'extra_sql'} || '';
3678   if ( keys %{ $opt->{'hashref'} } ) {
3679     $extra_sql = " AND $where $extra_sql";
3680   }
3681   else {
3682     if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3683       $extra_sql = "WHERE $where AND $1";
3684     }
3685     else {
3686       $extra_sql = "WHERE $where $extra_sql";
3687     }
3688   }
3689   $opt->{'extra_sql'} = $extra_sql;
3690
3691   qsearch($opt);
3692 }
3693
3694 # required for use as an eventtable;
3695 sub svc_acct {
3696   my $self = shift;
3697   $self->svc_x('svc_acct', @_);
3698 }
3699
3700 =item cust_credit
3701
3702 Returns all the credits (see L<FS::cust_credit>) for this customer.
3703
3704 =cut
3705
3706 sub cust_credit {
3707   my $self = shift;
3708   map { $_ } #return $self->num_cust_credit unless wantarray;
3709   sort { $a->_date <=> $b->_date }
3710     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3711 }
3712
3713 =item cust_credit_pkgnum
3714
3715 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3716 package when using experimental package balances.
3717
3718 =cut
3719
3720 sub cust_credit_pkgnum {
3721   my( $self, $pkgnum ) = @_;
3722   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3723   sort { $a->_date <=> $b->_date }
3724     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3725                               'pkgnum'  => $pkgnum,
3726                             }
3727     );
3728 }
3729
3730 =item cust_pay
3731
3732 Returns all the payments (see L<FS::cust_pay>) for this customer.
3733
3734 =cut
3735
3736 sub cust_pay {
3737   my $self = shift;
3738   return $self->num_cust_pay unless wantarray;
3739   sort { $a->_date <=> $b->_date }
3740     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3741 }
3742
3743 =item num_cust_pay
3744
3745 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
3746 called automatically when the cust_pay method is used in a scalar context.
3747
3748 =cut
3749
3750 sub num_cust_pay {
3751   my $self = shift;
3752   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3753   my $sth = dbh->prepare($sql) or die dbh->errstr;
3754   $sth->execute($self->custnum) or die $sth->errstr;
3755   $sth->fetchrow_arrayref->[0];
3756 }
3757
3758 =item cust_pay_pkgnum
3759
3760 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3761 package when using experimental package balances.
3762
3763 =cut
3764
3765 sub cust_pay_pkgnum {
3766   my( $self, $pkgnum ) = @_;
3767   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3768   sort { $a->_date <=> $b->_date }
3769     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3770                            'pkgnum'  => $pkgnum,
3771                          }
3772     );
3773 }
3774
3775 =item cust_pay_void
3776
3777 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3778
3779 =cut
3780
3781 sub cust_pay_void {
3782   my $self = shift;
3783   map { $_ } #return $self->num_cust_pay_void unless wantarray;
3784   sort { $a->_date <=> $b->_date }
3785     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3786 }
3787
3788 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3789
3790 Returns all batched payments (see L<FS::cust_pay_batch>) for this customer.
3791
3792 Optionally, a list or hashref of additional arguments to the qsearch call can
3793 be passed.
3794
3795 =cut
3796
3797 sub cust_pay_batch {
3798   my $self = shift;
3799   my $opt = ref($_[0]) ? shift : { @_ };
3800
3801   #return $self->num_cust_statement unless wantarray || keys %$opt;
3802
3803   $opt->{'table'} = 'cust_pay_batch';
3804   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3805   $opt->{'hashref'}{'custnum'} = $self->custnum;
3806   $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
3807
3808   map { $_ } #behavior of sort undefined in scalar context
3809     sort { $a->paybatchnum <=> $b->paybatchnum }
3810       qsearch($opt);
3811 }
3812
3813 =item cust_pay_pending
3814
3815 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3816 (without status "done").
3817
3818 =cut
3819
3820 sub cust_pay_pending {
3821   my $self = shift;
3822   return $self->num_cust_pay_pending unless wantarray;
3823   sort { $a->_date <=> $b->_date }
3824     qsearch( 'cust_pay_pending', {
3825                                    'custnum' => $self->custnum,
3826                                    'status'  => { op=>'!=', value=>'done' },
3827                                  },
3828            );
3829 }
3830
3831 =item cust_pay_pending_attempt
3832
3833 Returns all payment attempts / declined payments for this customer, as pending
3834 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3835 a corresponding payment (see L<FS::cust_pay>).
3836
3837 =cut
3838
3839 sub cust_pay_pending_attempt {
3840   my $self = shift;
3841   return $self->num_cust_pay_pending_attempt unless wantarray;
3842   sort { $a->_date <=> $b->_date }
3843     qsearch( 'cust_pay_pending', {
3844                                    'custnum' => $self->custnum,
3845                                    'status'  => 'done',
3846                                    'paynum'  => '',
3847                                  },
3848            );
3849 }
3850