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