FS/FS/cust_main.pm

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