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