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