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