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     my $i_cust_contact =
1513       qsearchs('cust_contact', {
1514                                  contactnum  => $implicit_contact->contactnum,
1515                                  custnum     => $self->custnum,
1516                                }
1517       );
1518     $implicit_contact->set($_, $i_cust_contact->$_)
1519       foreach qw( classnum selfservice_access comment );
1520
1521     my $error;
1522     if ( $implicit_contact->contactnum ) {
1523       $error = $implicit_contact->replace;
1524     } elsif ( length($email) ) { # don't create a new contact if not needed
1525       $error = $implicit_contact->insert;
1526     }
1527
1528     if ( $error ) {
1529       $dbh->rollback if $oldAutoCommit;
1530       return "$error (adding email address $email)";
1531     }
1532
1533   }
1534
1535   # replace the customer record
1536   my $error = $self->SUPER::replace($old);
1537
1538   if ( $error ) {
1539     $dbh->rollback if $oldAutoCommit;
1540     return $error;
1541   }
1542
1543   # now move packages to the new service location
1544   $self->set('ship_location', ''); #flush cache
1545   if ( $old->ship_locationnum and # should only be null during upgrade...
1546        $old->ship_locationnum != $self->ship_locationnum ) {
1547     $error = $old->ship_location->move_to($self->ship_location, move_pkgs => $options{'move_pkgs'});
1548     if ( $error ) {
1549       $dbh->rollback if $oldAutoCommit;
1550       return $error;
1551     }
1552   }
1553   # don't move packages based on the billing location, but
1554   # disable it if it's no longer in use
1555   if ( $old->bill_locationnum and
1556        $old->bill_locationnum != $self->bill_locationnum ) {
1557     $error = $old->bill_location->disable_if_unused;
1558     if ( $error ) {
1559       $dbh->rollback if $oldAutoCommit;
1560       return $error;
1561     }
1562   }
1563
1564   if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1565
1566     #this could be more efficient than deleting and re-inserting, if it matters
1567     foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1568       my $error = $cust_tag->delete;
1569       if ( $error ) {
1570         $dbh->rollback if $oldAutoCommit;
1571         return $error;
1572       }
1573     }
1574     foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1575       my $cust_tag = new FS::cust_tag { 'tagnum'  => $tagnum,
1576                                         'custnum' => $self->custnum };
1577       my $error = $cust_tag->insert;
1578       if ( $error ) {
1579         $dbh->rollback if $oldAutoCommit;
1580         return $error;
1581       }
1582     }
1583
1584   }
1585
1586   my $tax_exemption = delete $options{'tax_exemption'};
1587   if ( $tax_exemption ) {
1588
1589     $tax_exemption = { map { $_ => '' } @$tax_exemption }
1590       if ref($tax_exemption) eq 'ARRAY';
1591
1592     my %cust_main_exemption =
1593       map { $_->taxname => $_ }
1594           qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1595
1596     foreach my $taxname ( keys %$tax_exemption ) {
1597
1598       if ( $cust_main_exemption{$taxname} &&
1599            $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname}
1600          )
1601       {
1602         delete $cust_main_exemption{$taxname};
1603         next;
1604       }
1605
1606       my $cust_main_exemption = new FS::cust_main_exemption {
1607         'custnum'       => $self->custnum,
1608         'taxname'       => $taxname,
1609         'exempt_number' => $tax_exemption->{$taxname},
1610       };
1611       my $error = $cust_main_exemption->insert;
1612       if ( $error ) {
1613         $dbh->rollback if $oldAutoCommit;
1614         return "inserting cust_main_exemption (transaction rolled back): $error";
1615       }
1616     }
1617
1618     foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1619       my $error = $cust_main_exemption->delete;
1620       if ( $error ) {
1621         $dbh->rollback if $oldAutoCommit;
1622         return "deleting cust_main_exemption (transaction rolled back): $error";
1623       }
1624     }
1625
1626   }
1627
1628   if ( my $cust_payby_params = delete $options{'cust_payby_params'} ) {
1629
1630     my $error = $self->process_o2m(
1631       'table'         => 'cust_payby',
1632       'fields'        => FS::cust_payby->cgi_cust_payby_fields,
1633       'params'        => $cust_payby_params,
1634       'hash_callback' => \&FS::cust_payby::cgi_hash_callback,
1635     );
1636     if ( $error ) {
1637       $dbh->rollback if $oldAutoCommit;
1638       return $error;
1639     }
1640
1641   }
1642
1643   if ( my $contact_params = delete $options{'contact_params'} ) {
1644
1645     # this can potentially replace contacts that were created by the
1646     # invoicing list argument, but the UI shouldn't allow both of them
1647     # to be specified
1648
1649     my $error = $self->process_o2m(
1650       'table'         => 'contact',
1651       'fields'        => FS::contact->cgi_contact_fields,
1652       'params'        => $contact_params,
1653     );
1654     if ( $error ) {
1655       $dbh->rollback if $oldAutoCommit;
1656       return $error;
1657     }
1658
1659   }
1660
1661   unless ( $import || $skip_fuzzyfiles ) {
1662     $error = $self->queue_fuzzyfiles_update;
1663     if ( $error ) {
1664       $dbh->rollback if $oldAutoCommit;
1665       return "updating fuzzy search cache: $error";
1666     }
1667   }
1668
1669   # tax district update in cust_location
1670
1671   # cust_main exports!
1672
1673   my $export_args = $options{'export_args'} || [];
1674
1675   my @part_export =
1676     map qsearch( 'part_export', {exportnum=>$_} ),
1677       $conf->config('cust_main-exports'); #, $agentnum
1678
1679   foreach my $part_export ( @part_export ) {
1680     my $error = $part_export->export_replace( $self, $old, @$export_args);
1681     if ( $error ) {
1682       $dbh->rollback if $oldAutoCommit;
1683       return "exporting to ". $part_export->exporttype.
1684              " (transaction rolled back): $error";
1685     }
1686   }
1687
1688   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1689   '';
1690
1691 }
1692
1693 =item queue_fuzzyfiles_update
1694
1695 Used by insert & replace to update the fuzzy search cache
1696
1697 =cut
1698
1699 use FS::cust_main::Search;
1700 sub queue_fuzzyfiles_update {
1701   my $self = shift;
1702
1703   local $SIG{HUP} = 'IGNORE';
1704   local $SIG{INT} = 'IGNORE';
1705   local $SIG{QUIT} = 'IGNORE';
1706   local $SIG{TERM} = 'IGNORE';
1707   local $SIG{TSTP} = 'IGNORE';
1708   local $SIG{PIPE} = 'IGNORE';
1709
1710   my $oldAutoCommit = $FS::UID::AutoCommit;
1711   local $FS::UID::AutoCommit = 0;
1712   my $dbh = dbh;
1713
1714   foreach my $field ( 'first', 'last', 'company', 'ship_company' ) {
1715     my $queue = new FS::queue {
1716       'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1717     };
1718     my @args = "cust_main.$field", $self->get($field);
1719     my $error = $queue->insert( @args );
1720     if ( $error ) {
1721       $dbh->rollback if $oldAutoCommit;
1722       return "queueing job (transaction rolled back): $error";
1723     }
1724   }
1725
1726   my @locations = ();
1727   push @locations, $self->bill_location if $self->bill_locationnum;
1728   push @locations, $self->ship_location if @locations && $self->has_ship_address;
1729   foreach my $location (@locations) {
1730     my $queue = new FS::queue {
1731       'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1732     };
1733     my @args = 'cust_location.address1', $location->address1;
1734     my $error = $queue->insert( @args );
1735     if ( $error ) {
1736       $dbh->rollback if $oldAutoCommit;
1737       return "queueing job (transaction rolled back): $error";
1738     }
1739   }
1740
1741   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1742   '';
1743
1744 }
1745
1746 =item check
1747
1748 Checks all fields to make sure this is a valid customer record.  If there is
1749 an error, returns the error, otherwise returns false.  Called by the insert
1750 and replace methods.
1751
1752 =cut
1753
1754 sub check {
1755   my $self = shift;
1756
1757   warn "$me check BEFORE: \n". $self->_dump
1758     if $DEBUG > 2;
1759
1760   my $error =
1761     $self->ut_numbern('custnum')
1762     || $self->ut_number('agentnum')
1763     || $self->ut_textn('agent_custid')
1764     || $self->ut_number('refnum')
1765     || $self->ut_foreign_keyn('bill_locationnum', 'cust_location','locationnum')
1766     || $self->ut_foreign_keyn('ship_locationnum', 'cust_location','locationnum')
1767     || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1768     || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum')
1769     || $self->ut_foreign_keyn('taxstatusnum', 'tax_status', 'taxstatusnum')
1770     || $self->ut_textn('custbatch')
1771     || $self->ut_name('last')
1772     || $self->ut_name('first')
1773     || $self->ut_snumbern('signupdate')
1774     || $self->ut_snumbern('birthdate')
1775     || $self->ut_namen('spouse_last')
1776     || $self->ut_namen('spouse_first')
1777     || $self->ut_snumbern('spouse_birthdate')
1778     || $self->ut_snumbern('anniversary_date')
1779     || $self->ut_textn('company')
1780     || $self->ut_textn('ship_company')
1781     || $self->ut_anything('comments')
1782     || $self->ut_numbern('referral_custnum')
1783     || $self->ut_textn('stateid')
1784     || $self->ut_textn('stateid_state')
1785     || $self->ut_textn('invoice_terms')
1786     || $self->ut_floatn('cdr_termination_percentage')
1787     || $self->ut_floatn('credit_limit')
1788     || $self->ut_numbern('billday')
1789     || $self->ut_numbern('prorate_day')
1790     || $self->ut_flag('force_prorate_day')
1791     || $self->ut_flag('edit_subject')
1792     || $self->ut_flag('calling_list_exempt')
1793     || $self->ut_flag('invoice_noemail')
1794     || $self->ut_flag('message_noemail')
1795     || $self->ut_enum('locale', [ '', FS::Locales->locales ])
1796     || $self->ut_currencyn('currency')
1797     || $self->ut_textn('po_number')
1798     || $self->ut_enum('complimentary', [ '', 'Y' ])
1799     || $self->ut_flag('invoice_ship_address')
1800     || $self->ut_flag('invoice_dest')
1801   ;
1802
1803   foreach (qw(company ship_company)) {
1804     my $company = $self->get($_);
1805     $company =~ s/^\s+//;
1806     $company =~ s/\s+$//;
1807     $company =~ s/\s+/ /g;
1808     $self->set($_, $company);
1809   }
1810
1811   #barf.  need message catalogs.  i18n.  etc.
1812   $error .= "Please select an advertising source."
1813     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1814   return $error if $error;
1815
1816   my $agent = qsearchs( 'agent', { 'agentnum' => $self->agentnum } )
1817     or return "Unknown agent";
1818
1819   if ( $self->currency ) {
1820     my $agent_currency = qsearchs( 'agent_currency', {
1821       'agentnum' => $agent->agentnum,
1822       'currency' => $self->currency,
1823     })
1824       or return "Agent ". $agent->agent.
1825                 " not permitted to offer ".  $self->currency. " invoicing";
1826   }
1827
1828   return "Unknown refnum"
1829     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1830
1831   return "Unknown referring custnum: ". $self->referral_custnum
1832     unless ! $self->referral_custnum
1833            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1834
1835   if ( $self->ss eq '' ) {
1836     $self->ss('');
1837   } else {
1838     my $ss = $self->ss;
1839     $ss =~ s/\D//g;
1840     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1841       or return "Illegal social security number: ". $self->ss;
1842     $self->ss("$1-$2-$3");
1843   }
1844
1845   #turn off invoice_ship_address if ship & bill are the same
1846   if ($self->bill_locationnum eq $self->ship_locationnum) {
1847     $self->invoice_ship_address('');
1848   }
1849
1850   # cust_main_county verification now handled by cust_location check
1851
1852   $error =
1853        $self->ut_phonen('daytime', $self->country)
1854     || $self->ut_phonen('night',   $self->country)
1855     || $self->ut_phonen('fax',     $self->country)
1856     || $self->ut_phonen('mobile',  $self->country)
1857   ;
1858   return $error if $error;
1859
1860   if ( $conf->exists('cust_main-require_phone', $self->agentnum)
1861        && ! $import
1862        && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
1863      ) {
1864
1865     my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1866                           ? 'Day Phone'
1867                           : FS::Msgcat::_gettext('daytime');
1868     my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1869                         ? 'Night Phone'
1870                         : FS::Msgcat::_gettext('night');
1871
1872     my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
1873                         ? 'Mobile Phone'
1874                         : FS::Msgcat::_gettext('mobile');
1875
1876     return "$daytime_label, $night_label or $mobile_label is required"
1877
1878   }
1879
1880   return "Please select an invoicing locale"
1881     if ! $self->locale
1882     && ! $self->custnum
1883     && $conf->exists('cust_main-require_locale');
1884
1885   return "Please select a customer class"
1886     if ! $self->classnum
1887     && $conf->exists('cust_main-require_classnum');
1888
1889   foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
1890     $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1891     $self->$flag($1);
1892   }
1893
1894   $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
1895
1896   warn "$me check AFTER: \n". $self->_dump
1897     if $DEBUG > 2;
1898
1899   $self->SUPER::check;
1900 }
1901
1902 sub check_payinfo_cardtype {
1903   my $self = shift;
1904
1905   return '' unless $self->payby =~ /^(CARD|DCRD)$/;
1906
1907   my $payinfo = $self->payinfo;
1908   $payinfo =~ s/\D//g;
1909
1910   return '' if $self->tokenized($payinfo); #token
1911
1912   my %bop_card_types = map { $_=>1 } values %{ card_types() };
1913   my $cardtype = cardtype($payinfo);
1914
1915   return "$cardtype not accepted" unless $bop_card_types{$cardtype};
1916
1917   '';
1918
1919 }
1920
1921 =item replace_check
1922
1923 Additional checks for replace only.
1924
1925 =cut
1926
1927 sub replace_check {
1928   my ($new,$old) = @_;
1929   #preserve old value if global config is set
1930   if ($old && $conf->exists('invoice-ship_address')) {
1931     $new->invoice_ship_address($old->invoice_ship_address);
1932   }
1933   return '';
1934 }
1935
1936 =item addr_fields
1937
1938 Returns a list of fields which have ship_ duplicates.
1939
1940 =cut
1941
1942 sub addr_fields {
1943   qw( last first company
1944       locationname
1945       address1 address2 city county state zip country
1946       latitude longitude
1947       daytime night fax mobile
1948     );
1949 }
1950
1951 =item has_ship_address
1952
1953 Returns true if this customer record has a separate shipping address.
1954
1955 =cut
1956
1957 sub has_ship_address {
1958   my $self = shift;
1959   $self->bill_locationnum != $self->ship_locationnum;
1960 }
1961
1962 =item location_hash
1963
1964 Returns a list of key/value pairs, with the following keys: address1,
1965 adddress2, city, county, state, zip, country, district, and geocode.  The
1966 shipping address is used if present.
1967
1968 =cut
1969
1970 sub location_hash {
1971   my $self = shift;
1972   $self->ship_location->location_hash;
1973 }
1974
1975 =item cust_location
1976
1977 Returns all locations (see L<FS::cust_location>) for this customer.
1978
1979 =cut
1980
1981 sub cust_location {
1982   my $self = shift;
1983   qsearch({
1984     'table'   => 'cust_location',
1985     'hashref' => { 'custnum'     => $self->custnum,
1986                    'prospectnum' => '',
1987                  },
1988     'order_by' => 'ORDER BY country, LOWER(state), LOWER(city), LOWER(county), LOWER(address1), LOWER(address2)',
1989   });
1990 }
1991
1992 =item cust_contact
1993
1994 Returns all contact associations (see L<FS::cust_contact>) for this customer.
1995
1996 =cut
1997
1998 sub cust_contact {
1999   my $self = shift;
2000   qsearch('cust_contact', { 'custnum' => $self->custnum } );
2001 }
2002
2003 =item cust_payby PAYBY
2004
2005 Returns all payment methods (see L<FS::cust_payby>) for this customer.
2006
2007 If one or more PAYBY are specified, returns only payment methods for specified PAYBY.
2008 Does not validate PAYBY.
2009
2010 =cut
2011
2012 sub cust_payby {
2013   my $self = shift;
2014   my @payby = @_;
2015   my $search = {
2016     'table'    => 'cust_payby',
2017     'hashref'  => { 'custnum' => $self->custnum },
2018     'order_by' => "ORDER BY payby IN ('CARD','CHEK') DESC, weight ASC",
2019   };
2020   $search->{'extra_sql'} = ' AND payby IN ( '.
2021                                join(',', map dbh->quote($_), @payby).
2022                              ' ) '
2023     if @payby;
2024
2025   qsearch($search);
2026 }
2027
2028 =item has_cust_payby_auto
2029
2030 Returns true if customer has an automatic payment method ('CARD' or 'CHEK')
2031
2032 =cut
2033
2034 sub has_cust_payby_auto {
2035   my $self = shift;
2036   scalar( qsearch({
2037     'table'     => 'cust_payby',
2038     'hashref'   => { 'custnum' => $self->custnum, },
2039     'extra_sql' => " AND payby IN ( 'CARD', 'CHEK' ) ",
2040     'order_by'  => 'LIMIT 1',
2041   }) );
2042
2043 }
2044
2045 =item unsuspend
2046
2047 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2048 and L<FS::cust_pkg>) for this customer, except those on hold.
2049
2050 Returns a list: an empty list on success or a list of errors.
2051
2052 =cut
2053
2054 sub unsuspend {
2055   my $self = shift;
2056   grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs;
2057 }
2058
2059 =item release_hold
2060
2061 Unsuspends all suspended packages in the on-hold state (those without setup
2062 dates) for this customer.
2063
2064 =cut
2065
2066 sub release_hold {
2067   my $self = shift;
2068   grep { (!$_->setup) && $_->unsuspend } $self->suspended_pkgs;
2069 }
2070
2071 =item suspend
2072
2073 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2074
2075 Returns a list: an empty list on success or a list of errors.
2076
2077 =cut
2078
2079 sub suspend {
2080   my $self = shift;
2081   grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2082 }
2083
2084 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2085
2086 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2087 PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref instead
2088 of a list of pkgparts; the hashref has the following keys:
2089
2090 =over 4
2091
2092 =item pkgparts - listref of pkgparts
2093
2094 =item (other options are passed to the suspend method)
2095
2096 =back
2097
2098
2099 Returns a list: an empty list on success or a list of errors.
2100
2101 =cut
2102
2103 sub suspend_if_pkgpart {
2104   my $self = shift;
2105   my (@pkgparts, %opt);
2106   if (ref($_[0]) eq 'HASH'){
2107     @pkgparts = @{$_[0]{pkgparts}};
2108     %opt      = %{$_[0]};
2109   }else{
2110     @pkgparts = @_;
2111   }
2112   grep { $_->suspend(%opt) }
2113     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2114       $self->unsuspended_pkgs;
2115 }
2116
2117 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2118
2119 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2120 given PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref
2121 instead of a list of pkgparts; the hashref has the following keys:
2122
2123 =over 4
2124
2125 =item pkgparts - listref of pkgparts
2126
2127 =item (other options are passed to the suspend method)
2128
2129 =back
2130
2131 Returns a list: an empty list on success or a list of errors.
2132
2133 =cut
2134
2135 sub suspend_unless_pkgpart {
2136   my $self = shift;
2137   my (@pkgparts, %opt);
2138   if (ref($_[0]) eq 'HASH'){
2139     @pkgparts = @{$_[0]{pkgparts}};
2140     %opt      = %{$_[0]};
2141   }else{
2142     @pkgparts = @_;
2143   }
2144   grep { $_->suspend(%opt) }
2145     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2146       $self->unsuspended_pkgs;
2147 }
2148
2149 =item cancel [ OPTION => VALUE ... ]
2150
2151 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2152 The cancellation time will be now.
2153
2154 =back
2155
2156 Always returns a list: an empty list on success or a list of errors.
2157
2158 =cut
2159
2160 sub cancel {
2161   my $self = shift;
2162   my %opt = @_;
2163   warn "$me cancel called on customer ". $self->custnum. " with options ".
2164        join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2165     if $DEBUG;
2166   my @pkgs = $self->ncancelled_pkgs;
2167
2168   $self->cancel_pkgs( %opt, 'cust_pkg' => \@pkgs );
2169 }
2170
2171 =item cancel_pkgs OPTIONS
2172
2173 Cancels a specified list of packages. OPTIONS can include:
2174
2175 =over 4
2176
2177 =item cust_pkg - an arrayref of the packages. Required.
2178
2179 =item time - the cancellation time, used to calculate final bills and
2180 unused-time credits if any. Will be passed through to the bill() and
2181 FS::cust_pkg::cancel() methods.
2182
2183 =item quiet - can be set true to supress email cancellation notices.
2184
2185 =item reason - can be set to a cancellation reason (see L<FS:reason>), either a
2186 reasonnum of an existing reason, or passing a hashref will create a new reason.
2187 The hashref should have the following keys:
2188 typenum - Reason type (see L<FS::reason_type>)
2189 reason - Text of the new reason.
2190
2191 =item cust_pkg_reason - can be an arrayref of L<FS::cust_pkg_reason> objects
2192 for the individual packages, parallel to the C<cust_pkg> argument. The
2193 reason and reason_otaker arguments will be taken from those objects.
2194
2195 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2196
2197 =item nobill - can be set true to skip billing if it might otherwise be done.
2198
2199 =cut
2200
2201 sub cancel_pkgs {
2202   my( $self, %opt ) = @_;
2203
2204   # we're going to cancel services, which is not reversible
2205   die "cancel_pkgs cannot be run inside a transaction"
2206     if $FS::UID::AutoCommit == 0;
2207
2208   local $FS::UID::AutoCommit = 0;
2209
2210   return ( 'access denied' )
2211     unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2212
2213   if ( $opt{'ban'} ) {
2214
2215     foreach my $cust_payby ( $self->cust_payby ) {
2216
2217       #well, if they didn't get decrypted on search, then we don't have to
2218       # try again... queue a job for the server that does have decryption
2219       # capability if we're in a paranoid multi-server implementation?
2220       return ( "Can't (yet) ban encrypted credit cards" )
2221         if $cust_payby->is_encrypted($cust_payby->payinfo);
2222
2223       my $ban = new FS::banned_pay $cust_payby->_new_banned_pay_hashref;
2224       my $error = $ban->insert;
2225       if ($error) {
2226         dbh->rollback;
2227         return ( $error );
2228       }
2229
2230     }
2231
2232   }
2233
2234   my @pkgs = @{ delete $opt{'cust_pkg'} };
2235   my $cancel_time = $opt{'time'} || time;
2236
2237   # bill all packages first, so we don't lose usage, service counts for
2238   # bulk billing, etc.
2239   if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2240     $opt{nobill} = 1;
2241     my $error = $self->bill( 'pkg_list' => [ @pkgs ],
2242                              'cancel'   => 1,
2243                              'time'     => $cancel_time );
2244     if ($error) {
2245       warn "Error billing during cancel, custnum ". $self->custnum. ": $error";
2246       dbh->rollback;
2247       return ( "Error billing during cancellation: $error" );
2248     }
2249   }
2250   dbh->commit;
2251
2252   my @errors;
2253   # try to cancel each service, the same way we would for individual packages,
2254   # but in cancel weight order.
2255   my @cust_svc = map { $_->cust_svc } @pkgs;
2256   my @sorted_cust_svc =
2257     map  { $_->[0] }
2258     sort { $a->[1] <=> $b->[1] }
2259     map  { [ $_, $_->svc_x ? $_->svc_x->table_info->{'cancel_weight'} : -1 ]; } @cust_svc
2260   ;
2261   warn "$me removing ".scalar(@sorted_cust_svc)." service(s) for customer ".
2262     $self->custnum."\n"
2263     if $DEBUG;
2264   foreach my $cust_svc (@sorted_cust_svc) {
2265     my $part_svc = $cust_svc->part_svc;
2266     next if ( defined($part_svc) and $part_svc->preserve );
2267     # immediate cancel, no date option
2268     # transactionize individually
2269     my $error = try { $cust_svc->cancel } catch { $_ };
2270     if ( $error ) {
2271       dbh->rollback;
2272       push @errors, $error;
2273     } else {
2274       dbh->commit;
2275     }
2276   }
2277   if (@errors) {
2278     return @errors;
2279   }
2280
2281   warn "$me cancelling ". scalar(@pkgs) ." package(s) for customer ".
2282     $self->custnum. "\n"
2283     if $DEBUG;
2284
2285   my @cprs;
2286   if ($opt{'cust_pkg_reason'}) {
2287     @cprs = @{ delete $opt{'cust_pkg_reason'} };
2288   }
2289   my $null_reason;
2290   foreach (@pkgs) {
2291     my %lopt = %opt;
2292     if (@cprs) {
2293       my $cpr = shift @cprs;
2294       if ( $cpr ) {
2295         $lopt{'reason'}        = $cpr->reasonnum;
2296         $lopt{'reason_otaker'} = $cpr->otaker;
2297       } else {
2298         warn "no reason found when canceling package ".$_->pkgnum."\n";
2299         # we're not actually required to pass a reason to cust_pkg::cancel,
2300         # but if we're getting to this point, something has gone awry.
2301         $null_reason ||= FS::reason->new_or_existing(
2302           reason  => 'unknown reason',
2303           type    => 'Cancel Reason',
2304           class   => 'C',
2305         );
2306         $lopt{'reason'} = $null_reason->reasonnum;
2307         $lopt{'reason_otaker'} = $FS::CurrentUser::CurrentUser->username;
2308       }
2309     }
2310     my $error = $_->cancel(%lopt);
2311     if ( $error ) {
2312       dbh->rollback;
2313       push @errors, 'pkgnum '.$_->pkgnum.': '.$error;
2314     } else {
2315       dbh->commit;
2316     }
2317   }
2318
2319   return @errors;
2320 }
2321
2322 sub _banned_pay_hashref {
2323   die 'cust_main->_banned_pay_hashref deprecated';
2324
2325   my $self = shift;
2326
2327   my %payby2ban = (
2328     'CARD' => 'CARD',
2329     'DCRD' => 'CARD',
2330     'CHEK' => 'CHEK',
2331     'DCHK' => 'CHEK'
2332   );
2333
2334   {
2335     'payby'   => $payby2ban{$self->payby},
2336     'payinfo' => $self->payinfo,
2337     #don't ever *search* on reason! #'reason'  =>
2338   };
2339 }
2340
2341 =item notes
2342
2343 Returns all notes (see L<FS::cust_main_note>) for this customer.
2344
2345 =cut
2346
2347 sub notes {
2348   my($self,$orderby_classnum) = (shift,shift);
2349   my $orderby = "sticky DESC, _date DESC";
2350   $orderby = "classnum ASC, $orderby" if $orderby_classnum;
2351   qsearch( 'cust_main_note',
2352            { 'custnum' => $self->custnum },
2353            '',
2354            "ORDER BY $orderby",
2355          );
2356 }
2357
2358 =item agent
2359
2360 Returns the agent (see L<FS::agent>) for this customer.
2361
2362 =item agent_name
2363
2364 Returns the agent name (see L<FS::agent>) for this customer.
2365
2366 =cut
2367
2368 sub agent_name {
2369   my $self = shift;
2370   $self->agent->agent;
2371 }
2372
2373 =item cust_tag
2374
2375 Returns any tags associated with this customer, as FS::cust_tag objects,
2376 or an empty list if there are no tags.
2377
2378 =item part_tag
2379
2380 Returns any tags associated with this customer, as FS::part_tag objects,
2381 or an empty list if there are no tags.
2382
2383 =cut
2384
2385 sub part_tag {
2386   my $self = shift;
2387   map $_->part_tag, $self->cust_tag;
2388 }
2389
2390
2391 =item cust_class
2392
2393 Returns the customer class, as an FS::cust_class object, or the empty string
2394 if there is no customer class.
2395
2396 =item categoryname
2397
2398 Returns the customer category name, or the empty string if there is no customer
2399 category.
2400
2401 =cut
2402
2403 sub categoryname {
2404   my $self = shift;
2405   my $cust_class = $self->cust_class;
2406   $cust_class
2407     ? $cust_class->categoryname
2408     : '';
2409 }
2410
2411 =item classname
2412
2413 Returns the customer class name, or the empty string if there is no customer
2414 class.
2415
2416 =cut
2417
2418 sub classname {
2419   my $self = shift;
2420   my $cust_class = $self->cust_class;
2421   $cust_class
2422     ? $cust_class->classname
2423     : '';
2424 }
2425
2426 =item tax_status
2427
2428 Returns the external tax status, as an FS::tax_status object, or the empty
2429 string if there is no tax status.
2430
2431 =cut
2432
2433 sub tax_status {
2434   my $self = shift;
2435   if ( $self->taxstatusnum ) {
2436     qsearchs('tax_status', { 'taxstatusnum' => $self->taxstatusnum } );
2437   } else {
2438     return '';
2439   }
2440 }
2441
2442 =item taxstatus
2443
2444 Returns the tax status code if there is one.
2445
2446 =cut
2447
2448 sub taxstatus {
2449   my $self = shift;
2450   my $tax_status = $self->tax_status;
2451   $tax_status
2452     ? $tax_status->taxstatus
2453     : '';
2454 }
2455
2456 =item BILLING METHODS
2457
2458 Documentation on billing methods has been moved to
2459 L<FS::cust_main::Billing>.
2460
2461 =item REALTIME BILLING METHODS
2462
2463 Documentation on realtime billing methods has been moved to
2464 L<FS::cust_main::Billing_Realtime>.
2465
2466 =item remove_cvv
2467
2468 Removes the I<paycvv> field from the database directly.
2469
2470 If there is an error, returns the error, otherwise returns false.
2471
2472 DEPRECATED.  Use L</remove_cvv_from_cust_payby> instead.
2473
2474 =cut
2475
2476 sub remove_cvv {
2477   die 'cust_main->remove_cvv deprecated';
2478   my $self = shift;
2479   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2480     or return dbh->errstr;
2481   $sth->execute($self->custnum)
2482     or return $sth->errstr;
2483   $self->paycvv('');
2484   '';
2485 }
2486
2487 =item total_owed
2488
2489 Returns the total owed for this customer on all invoices
2490 (see L<FS::cust_bill/owed>).
2491
2492 =cut
2493
2494 sub total_owed {
2495   my $self = shift;
2496   $self->total_owed_date(2145859200); #12/31/2037
2497 }
2498
2499 =item total_owed_date TIME
2500
2501 Returns the total owed for this customer on all invoices with date earlier than
2502 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2503 see L<Time::Local> and L<Date::Parse> for conversion functions.
2504
2505 =cut
2506
2507 sub total_owed_date {
2508   my $self = shift;
2509   my $time = shift;
2510
2511   my $custnum = $self->custnum;
2512
2513   my $owed_sql = FS::cust_bill->owed_sql;
2514
2515   my $sql = "
2516     SELECT SUM($owed_sql) FROM cust_bill
2517       WHERE custnum = $custnum
2518         AND _date <= $time
2519   ";
2520
2521   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2522
2523 }
2524
2525 =item total_owed_pkgnum PKGNUM
2526
2527 Returns the total owed on all invoices for this customer's specific package
2528 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2529
2530 =cut
2531
2532 sub total_owed_pkgnum {
2533   my( $self, $pkgnum ) = @_;
2534   $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2535 }
2536
2537 =item total_owed_date_pkgnum TIME PKGNUM
2538
2539 Returns the total owed for this customer's specific package when using
2540 experimental package balances on all invoices with date earlier than
2541 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2542 see L<Time::Local> and L<Date::Parse> for conversion functions.
2543
2544 =cut
2545
2546 sub total_owed_date_pkgnum {
2547   my( $self, $time, $pkgnum ) = @_;
2548
2549   my $total_bill = 0;
2550   foreach my $cust_bill (
2551     grep { $_->_date <= $time }
2552       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2553   ) {
2554     $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2555   }
2556   sprintf( "%.2f", $total_bill );
2557
2558 }
2559
2560 =item total_paid
2561
2562 Returns the total amount of all payments.
2563
2564 =cut
2565
2566 sub total_paid {
2567   my $self = shift;
2568   my $total = 0;
2569   $total += $_->paid foreach $self->cust_pay;
2570   sprintf( "%.2f", $total );
2571 }
2572
2573 =item total_unapplied_credits
2574
2575 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2576 customer.  See L<FS::cust_credit/credited>.
2577
2578 =item total_credited
2579
2580 Old name for total_unapplied_credits.  Don't use.
2581
2582 =cut
2583
2584 sub total_credited {
2585   #carp "total_credited deprecated, use total_unapplied_credits";
2586   shift->total_unapplied_credits(@_);
2587 }
2588
2589 sub total_unapplied_credits {
2590   my $self = shift;
2591
2592   my $custnum = $self->custnum;
2593
2594   my $unapplied_sql = FS::cust_credit->unapplied_sql;
2595
2596   my $sql = "
2597     SELECT SUM($unapplied_sql) FROM cust_credit
2598       WHERE custnum = $custnum
2599   ";
2600
2601   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2602
2603 }
2604
2605 =item total_unapplied_credits_pkgnum PKGNUM
2606
2607 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2608 customer.  See L<FS::cust_credit/credited>.
2609
2610 =cut
2611
2612 sub total_unapplied_credits_pkgnum {
2613   my( $self, $pkgnum ) = @_;
2614   my $total_credit = 0;
2615   $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2616   sprintf( "%.2f", $total_credit );
2617 }
2618
2619
2620 =item total_unapplied_payments
2621
2622 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2623 See L<FS::cust_pay/unapplied>.
2624
2625 =cut
2626
2627 sub total_unapplied_payments {
2628   my $self = shift;
2629
2630   my $custnum = $self->custnum;
2631
2632   my $unapplied_sql = FS::cust_pay->unapplied_sql;
2633
2634   my $sql = "
2635     SELECT SUM($unapplied_sql) FROM cust_pay
2636       WHERE custnum = $custnum
2637   ";
2638
2639   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2640
2641 }
2642
2643 =item total_unapplied_payments_pkgnum PKGNUM
2644
2645 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2646 specific package when using experimental package balances.  See
2647 L<FS::cust_pay/unapplied>.
2648
2649 =cut
2650
2651 sub total_unapplied_payments_pkgnum {
2652   my( $self, $pkgnum ) = @_;
2653   my $total_unapplied = 0;
2654   $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2655   sprintf( "%.2f", $total_unapplied );
2656 }
2657
2658
2659 =item total_unapplied_refunds
2660
2661 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2662 customer.  See L<FS::cust_refund/unapplied>.
2663
2664 =cut
2665
2666 sub total_unapplied_refunds {
2667   my $self = shift;
2668   my $custnum = $self->custnum;
2669
2670   my $unapplied_sql = FS::cust_refund->unapplied_sql;
2671
2672   my $sql = "
2673     SELECT SUM($unapplied_sql) FROM cust_refund
2674       WHERE custnum = $custnum
2675   ";
2676
2677   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2678
2679 }
2680
2681 =item balance
2682
2683 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2684 total_unapplied_credits minus total_unapplied_payments).
2685
2686 =cut
2687
2688 sub balance {
2689   my $self = shift;
2690   $self->balance_date_range;
2691 }
2692
2693 =item balance_date TIME
2694
2695 Returns the balance for this customer, only considering invoices with date
2696 earlier than TIME (total_owed_date minus total_credited minus
2697 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
2698 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
2699 functions.
2700
2701 =cut
2702
2703 sub balance_date {
2704   my $self = shift;
2705   $self->balance_date_range(shift);
2706 }
2707
2708 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2709
2710 Returns the balance for this customer, optionally considering invoices with
2711 date earlier than START_TIME, and not later than END_TIME
2712 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2713
2714 Times are specified as SQL fragments or numeric
2715 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
2716 L<Date::Parse> for conversion functions.  The empty string can be passed
2717 to disable that time constraint completely.
2718
2719 Accepts the same options as L<balance_date_sql>:
2720
2721 =over 4
2722
2723 =item unapplied_date
2724
2725 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)
2726
2727 =item cutoff
2728
2729 An absolute cutoff time.  Payments, credits, and refunds I<applied> after this
2730 time will be ignored.  Note that START_TIME and END_TIME only limit the date
2731 range for invoices and I<unapplied> payments, credits, and refunds.
2732
2733 =back
2734
2735 =cut
2736
2737 sub balance_date_range {
2738   my $self = shift;
2739   my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2740             ') FROM cust_main WHERE custnum='. $self->custnum;
2741   sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2742 }
2743
2744 =item balance_pkgnum PKGNUM
2745
2746 Returns the balance for this customer's specific package when using
2747 experimental package balances (total_owed plus total_unrefunded, minus
2748 total_unapplied_credits minus total_unapplied_payments)
2749
2750 =cut
2751
2752 sub balance_pkgnum {
2753   my( $self, $pkgnum ) = @_;
2754
2755   sprintf( "%.2f",
2756       $self->total_owed_pkgnum($pkgnum)
2757 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2758 #    + $self->total_unapplied_refunds_pkgnum($pkgnum)
2759     - $self->total_unapplied_credits_pkgnum($pkgnum)
2760     - $self->total_unapplied_payments_pkgnum($pkgnum)
2761   );
2762 }
2763
2764 =item payment_info
2765
2766 Returns a hash of useful information for making a payment.
2767
2768 =over 4
2769
2770 =item balance
2771
2772 Current balance.
2773
2774 =item payby
2775
2776 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2777 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2778 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2779
2780 =back
2781
2782 For credit card transactions:
2783
2784 =over 4
2785
2786 =item card_type 1
2787
2788 =item payname
2789
2790 Exact name on card
2791
2792 =back
2793
2794 For electronic check transactions:
2795
2796 =over 4
2797
2798 =item stateid_state
2799
2800 =back
2801
2802 =cut
2803
2804 #XXX i need to be updated for 4.x+
2805 sub payment_info {
2806   my $self = shift;
2807
2808   my %return = ();
2809
2810   $return{balance} = $self->balance;
2811
2812   $return{payname} = $self->payname
2813                      || ( $self->first. ' '. $self->get('last') );
2814
2815   $return{$_} = $self->bill_location->$_
2816     for qw(address1 address2 city state zip);
2817
2818   $return{payby} = $self->payby;
2819   $return{stateid_state} = $self->stateid_state;
2820
2821   if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
2822     $return{card_type} = cardtype($self->payinfo);
2823     $return{payinfo} = $self->paymask;
2824
2825     @return{'month', 'year'} = $self->paydate_monthyear;
2826
2827   }
2828
2829   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2830     my ($payinfo1, $payinfo2) = split '@', $self->paymask;
2831     $return{payinfo1} = $payinfo1;
2832     $return{payinfo2} = $payinfo2;
2833     $return{paytype}  = $self->paytype;
2834     $return{paystate} = $self->paystate;
2835
2836   }
2837
2838   #doubleclick protection
2839   my $_date = time;
2840   $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
2841
2842   %return;
2843
2844 }
2845
2846 =item paydate_epoch
2847
2848 Returns the next payment expiration date for this customer. If they have no
2849 payment methods that will expire, returns 0.
2850
2851 =cut
2852
2853 sub paydate_epoch {
2854   my $self = shift;
2855   # filter out the ones that individually return 0, but then return 0 if
2856   # there are no results
2857   my @epochs = grep { $_ > 0 } map { $_->paydate_epoch } $self->cust_payby;
2858   min( @epochs ) || 0;
2859 }
2860
2861 =item paydate_epoch_sql
2862
2863 Returns an SQL expression to get the next payment expiration date for a
2864 customer. Returns 2143260000 (2037-12-01) if there are no payment expiration
2865 dates, so that it's safe to test for "will it expire before date X" for any
2866 date up to then.
2867
2868 =cut
2869
2870 sub paydate_epoch_sql {
2871   my $class = shift;
2872   my $paydate = FS::cust_payby->paydate_epoch_sql;
2873   "(SELECT COALESCE(MIN($paydate), 2143260000) FROM cust_payby WHERE cust_payby.custnum = cust_main.custnum)";
2874 }
2875
2876 sub tax_exemption {
2877   my( $self, $taxname ) = @_;
2878
2879   qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
2880                                      'taxname' => $taxname,
2881                                    },
2882           );
2883 }
2884
2885 =item cust_main_exemption
2886
2887 =item invoicing_list
2888
2889 Returns a list of email addresses (with svcnum entries expanded), and the word
2890 'POST' if the customer receives postal invoices.
2891
2892 =cut
2893
2894 sub invoicing_list {
2895   my( $self, $arrayref ) = @_;
2896
2897   if ( $arrayref ) {
2898     warn "FS::cust_main::invoicing_list(ARRAY) is no longer supported.";
2899   }
2900
2901   my @emails = $self->invoicing_list_emailonly;
2902   push @emails, 'POST' if $self->get('postal_invoice');
2903
2904   @emails;
2905 }
2906
2907 =item check_invoicing_list ARRAYREF
2908
2909 Checks these arguements as valid input for the invoicing_list method.  If there
2910 is an error, returns the error, otherwise returns false.
2911
2912 =cut
2913
2914 sub check_invoicing_list {
2915   my( $self, $arrayref ) = @_;
2916
2917   foreach my $address ( @$arrayref ) {
2918
2919     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
2920       return 'Can\'t add FAX invoice destination with a blank FAX number.';
2921     }
2922
2923     my $cust_main_invoice = new FS::cust_main_invoice ( {
2924       'custnum' => $self->custnum,
2925       'dest'    => $address,
2926     } );
2927     my $error = $self->custnum
2928                 ? $cust_main_invoice->check
2929                 : $cust_main_invoice->checkdest
2930     ;
2931     return $error if $error;
2932
2933   }
2934
2935   return "Email address required"
2936     if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
2937     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
2938
2939   '';
2940 }
2941
2942 =item all_emails
2943
2944 Returns the email addresses of all accounts provisioned for this customer.
2945
2946 =cut
2947
2948 sub all_emails {
2949   my $self = shift;
2950   my %list;
2951   foreach my $cust_pkg ( $self->all_pkgs ) {
2952     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2953     my @svc_acct =
2954       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2955         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2956           @cust_svc;
2957     $list{$_}=1 foreach map { $_->email } @svc_acct;
2958   }
2959   keys %list;
2960 }
2961
2962 =item invoicing_list_addpost
2963
2964 Adds postal invoicing to this customer.  If this customer is already configured
2965 to receive postal invoices, does nothing.
2966
2967 =cut
2968
2969 sub invoicing_list_addpost {
2970   my $self = shift;
2971   if ( $self->get('postal_invoice') eq '' ) {
2972     $self->set('postal_invoice', 'Y');
2973     my $error = $self->replace;
2974     warn $error if $error; # should fail harder, but this is traditional
2975   }
2976 }
2977
2978 =item invoicing_list_emailonly
2979
2980 Returns the list of email invoice recipients (invoicing_list without non-email
2981 destinations such as POST and FAX).
2982
2983 =cut
2984
2985 sub invoicing_list_emailonly {
2986   my $self = shift;
2987   warn "$me invoicing_list_emailonly called"
2988     if $DEBUG;
2989   return () if !$self->custnum; # not yet inserted
2990   return map { $_->emailaddress }
2991     qsearch({
2992         table     => 'cust_contact',
2993         select    => 'emailaddress',
2994         addl_from => ' JOIN contact USING (contactnum) '.
2995                      ' JOIN contact_email USING (contactnum)',
2996         hashref   => { 'custnum' => $self->custnum, },
2997         extra_sql => q( AND cust_contact.invoice_dest = 'Y'),
2998     });
2999 }
3000
3001 =item invoicing_list_emailonly_scalar
3002
3003 Returns the list of email invoice recipients (invoicing_list without non-email
3004 destinations such as POST and FAX) as a comma-separated scalar.
3005
3006 =cut
3007
3008 sub invoicing_list_emailonly_scalar {
3009   my $self = shift;
3010   warn "$me invoicing_list_emailonly_scalar called"
3011     if $DEBUG;
3012   join(', ', $self->invoicing_list_emailonly);
3013 }
3014
3015 =item contact_list [ CLASSNUM, ... ]
3016
3017 Returns a list of contacts (L<FS::contact> objects) for the customer. If
3018 a list of contact classnums is given, returns only contacts in those
3019 classes. If the pseudo-classnum 'invoice' is given, returns contacts that
3020 are marked as invoice destinations. If '0' is given, also returns contacts
3021 with no class.
3022
3023 If no arguments are given, returns all contacts for the customer.
3024
3025 =cut
3026
3027 sub contact_list {
3028   my $self = shift;
3029   my $search = {
3030     table       => 'contact',
3031     select      => 'contact.*, cust_contact.invoice_dest',
3032     addl_from   => ' JOIN cust_contact USING (contactnum)',
3033     extra_sql   => ' WHERE cust_contact.custnum = '.$self->custnum,
3034   };
3035
3036   my @orwhere;
3037   my @classnums;
3038   foreach (@_) {
3039     if ( $_ eq 'invoice' ) {
3040       push @orwhere, 'cust_contact.invoice_dest = \'Y\'';
3041     } elsif ( $_ eq '0' ) {
3042       push @orwhere, 'cust_contact.classnum is null';
3043     } elsif ( /^\d+$/ ) {
3044       push @classnums, $_;
3045     } else {
3046       die "bad classnum argument '$_'";
3047     }
3048   }
3049
3050   if (@classnums) {
3051     push @orwhere, 'cust_contact.classnum IN ('.join(',', @classnums).')';
3052   }
3053   if (@orwhere) {
3054     $search->{extra_sql} .= ' AND (' .
3055                             join(' OR ', map "( $_ )", @orwhere) .
3056                             ')';
3057   }
3058
3059   qsearch($search);
3060 }
3061
3062 =item contact_list_email [ CLASSNUM, ... ]
3063
3064 Same as L</contact_list>, but returns email destinations instead of contact
3065 objects.
3066
3067 =cut
3068
3069 sub contact_list_email {
3070   my $self = shift;
3071   my @contacts = $self->contact_list(@_);
3072   my @emails;
3073   foreach my $contact (@contacts) {
3074     foreach my $contact_email ($contact->contact_email) {
3075       push @emails,  Email::Address->new( $contact->firstlast,
3076                                           $contact_email->emailaddress
3077                      )->format;
3078     }
3079   }
3080   @emails;
3081 }
3082
3083 =item referral_custnum_cust_main
3084
3085 Returns the customer who referred this customer (or the empty string, if
3086 this customer was not referred).
3087
3088 Note the difference with referral_cust_main method: This method,
3089 referral_custnum_cust_main returns the single customer (if any) who referred
3090 this customer, while referral_cust_main returns an array of customers referred
3091 BY this customer.
3092
3093 =cut
3094
3095 sub referral_custnum_cust_main {
3096   my $self = shift;
3097   return '' unless $self->referral_custnum;
3098   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3099 }
3100
3101 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3102
3103 Returns an array of customers referred by this customer (referral_custnum set
3104 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
3105 customers referred by customers referred by this customer and so on, inclusive.
3106 The default behavior is DEPTH 1 (no recursion).
3107
3108 Note the difference with referral_custnum_cust_main method: This method,
3109 referral_cust_main, returns an array of customers referred BY this customer,
3110 while referral_custnum_cust_main returns the single customer (if any) who
3111 referred this customer.
3112
3113 =cut
3114
3115 sub referral_cust_main {
3116   my $self = shift;
3117   my $depth = @_ ? shift : 1;
3118   my $exclude = @_ ? shift : {};
3119
3120   my @cust_main =
3121     map { $exclude->{$_->custnum}++; $_; }
3122       grep { ! $exclude->{ $_->custnum } }
3123         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3124
3125   if ( $depth > 1 ) {
3126     push @cust_main,
3127       map { $_->referral_cust_main($depth-1, $exclude) }
3128         @cust_main;
3129   }
3130
3131   @cust_main;
3132 }
3133
3134 =item referral_cust_main_ncancelled
3135
3136 Same as referral_cust_main, except only returns customers with uncancelled
3137 packages.
3138
3139 =cut
3140
3141 sub referral_cust_main_ncancelled {
3142   my $self = shift;
3143   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3144 }
3145
3146 =item referral_cust_pkg [ DEPTH ]
3147
3148 Like referral_cust_main, except returns a flat list of all unsuspended (and
3149 uncancelled) packages for each customer.  The number of items in this list may
3150 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3151
3152 =cut
3153
3154 sub referral_cust_pkg {
3155   my $self = shift;
3156   my $depth = @_ ? shift : 1;
3157
3158   map { $_->unsuspended_pkgs }
3159     grep { $_->unsuspended_pkgs }
3160       $self->referral_cust_main($depth);
3161 }
3162
3163 =item referring_cust_main
3164
3165 Returns the single cust_main record for the customer who referred this customer
3166 (referral_custnum), or false.
3167
3168 =cut
3169
3170 sub referring_cust_main {
3171   my $self = shift;
3172   return '' unless $self->referral_custnum;
3173   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3174 }
3175
3176 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3177
3178 Applies a credit to this customer.  If there is an error, returns the error,
3179 otherwise returns false.
3180
3181 REASON can be a text string, an FS::reason object, or a scalar reference to
3182 a reasonnum.  If a text string, it will be automatically inserted as a new
3183 reason, and a 'reason_type' option must be passed to indicate the
3184 FS::reason_type for the new reason.
3185
3186 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3187 Likewise for I<eventnum>, I<commission_agentnum>, I<commission_salesnum> and
3188 I<commission_pkgnum>.
3189
3190 Any other options are passed to FS::cust_credit::insert.
3191
3192 =cut
3193
3194 sub credit {
3195   my( $self, $amount, $reason, %options ) = @_;
3196
3197   my $cust_credit = new FS::cust_credit {
3198     'custnum' => $self->custnum,
3199     'amount'  => $amount,
3200   };
3201
3202   if ( ref($reason) ) {
3203
3204     if ( ref($reason) eq 'SCALAR' ) {
3205       $cust_credit->reasonnum( $$reason );
3206     } else {
3207       $cust_credit->reasonnum( $reason->reasonnum );
3208     }
3209
3210   } else {
3211     $cust_credit->set('reason', $reason)
3212   }
3213
3214   $cust_credit->$_( delete $options{$_} )
3215     foreach grep exists($options{$_}),
3216               qw( addlinfo eventnum ),
3217               map "commission_$_", qw( agentnum salesnum pkgnum );
3218
3219   $cust_credit->insert(%options);
3220
3221 }
3222
3223 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3224
3225 Creates a one-time charge for this customer.  If there is an error, returns
3226 the error, otherwise returns false.
3227
3228 New-style, with a hashref of options:
3229
3230   my $error = $cust_main->charge(
3231                                   {
3232                                     'amount'     => 54.32,
3233                                     'quantity'   => 1,
3234                                     'start_date' => str2time('7/4/2009'),
3235                                     'pkg'        => 'Description',
3236                                     'comment'    => 'Comment',
3237                                     'additional' => [], #extra invoice detail
3238                                     'classnum'   => 1,  #pkg_class
3239
3240                                     'setuptax'   => '', # or 'Y' for tax exempt
3241
3242                                     'locationnum'=> 1234, # optional
3243
3244                                     #internal taxation
3245                                     'taxclass'   => 'Tax class',
3246
3247                                     #vendor taxation
3248                                     'taxproduct' => 2,  #part_pkg_taxproduct
3249                                     'override'   => {}, #XXX describe
3250
3251                                     #will be filled in with the new object
3252                                     'cust_pkg_ref' => \$cust_pkg,
3253
3254                                     #generate an invoice immediately
3255                                     'bill_now' => 0,
3256                                     'invoice_terms' => '', #with these terms
3257                                   }
3258                                 );
3259
3260 Old-style:
3261
3262   my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3263
3264 =cut
3265
3266 #super false laziness w/quotation::charge
3267 sub charge {
3268   my $self = shift;
3269   my ( $amount, $setup_cost, $quantity, $start_date, $classnum );
3270   my ( $pkg, $comment, $additional );
3271   my ( $setuptax, $taxclass );   #internal taxes
3272   my ( $taxproduct, $override ); #vendor (CCH) taxes
3273   my $no_auto = '';
3274   my $separate_bill = '';
3275   my $cust_pkg_ref = '';
3276   my ( $bill_now, $invoice_terms ) = ( 0, '' );
3277   my $locationnum;
3278   my ( $discountnum, $discountnum_amount, $discountnum_percent ) = ( '','','' );
3279   if ( ref( $_[0] ) ) {
3280     $amount     = $_[0]->{amount};
3281     $setup_cost = $_[0]->{setup_cost};
3282     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3283     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3284     $no_auto    = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3285     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3286     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
3287                                            : '$'. sprintf("%.2f",$amount);
3288     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3289     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3290     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3291     $additional = $_[0]->{additional} || [];
3292     $taxproduct = $_[0]->{taxproductnum};
3293     $override   = { '' => $_[0]->{tax_override} };
3294     $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3295     $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3296     $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3297     $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3298     $separate_bill = $_[0]->{separate_bill} || '';
3299     $discountnum = $_[0]->{setup_discountnum};
3300     $discountnum_amount = $_[0]->{setup_discountnum_amount};
3301     $discountnum_percent = $_[0]->{setup_discountnum_percent};
3302   } else { # yuck
3303     $amount     = shift;
3304     $setup_cost = '';
3305     $quantity   = 1;
3306     $start_date = '';
3307     $pkg        = @_ ? shift : 'One-time charge';
3308     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
3309     $setuptax   = '';
3310     $taxclass   = @_ ? shift : '';
3311     $additional = [];
3312   }
3313
3314   local $SIG{HUP} = 'IGNORE';
3315   local $SIG{INT} = 'IGNORE';
3316   local $SIG{QUIT} = 'IGNORE';
3317   local $SIG{TERM} = 'IGNORE';
3318   local $SIG{TSTP} = 'IGNORE';
3319   local $SIG{PIPE} = 'IGNORE';
3320
3321   my $oldAutoCommit = $FS::UID::AutoCommit;
3322   local $FS::UID::AutoCommit = 0;
3323   my $dbh = dbh;
3324
3325   my $part_pkg = new FS::part_pkg ( {
3326     'pkg'           => $pkg,
3327     'comment'       => $comment,
3328     'plan'          => 'flat',
3329     'freq'          => 0,
3330     'disabled'      => 'Y',
3331     'classnum'      => ( $classnum ? $classnum : '' ),
3332     'setuptax'      => $setuptax,
3333     'taxclass'      => $taxclass,
3334     'taxproductnum' => $taxproduct,
3335     'setup_cost'    => $setup_cost,
3336   } );
3337
3338   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3339                         ( 0 .. @$additional - 1 )
3340                   ),
3341                   'additional_count' => scalar(@$additional),
3342                   'setup_fee' => $amount,
3343                 );
3344
3345   my $error = $part_pkg->insert( options       => \%options,
3346                                  tax_overrides => $override,
3347                                );
3348   if ( $error ) {
3349     $dbh->rollback if $oldAutoCommit;
3350     return $error;
3351   }
3352
3353   my $pkgpart = $part_pkg->pkgpart;
3354   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3355   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3356     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3357     $error = $type_pkgs->insert;
3358     if ( $error ) {
3359       $dbh->rollback if $oldAutoCommit;
3360       return $error;
3361     }
3362   }
3363
3364   my $cust_pkg = new FS::cust_pkg ( {
3365     'custnum'                   => $self->custnum,
3366     'pkgpart'                   => $pkgpart,
3367     'quantity'                  => $quantity,
3368     'start_date'                => $start_date,
3369     'no_auto'                   => $no_auto,
3370     'separate_bill'             => $separate_bill,
3371     'locationnum'               => $locationnum,
3372     'setup_discountnum'         => $discountnum,
3373     'setup_discountnum_amount'  => $discountnum_amount,
3374     'setup_discountnum_percent' => $discountnum_percent,
3375   } );
3376
3377   $error = $cust_pkg->insert;
3378   if ( $error ) {
3379     $dbh->rollback if $oldAutoCommit;
3380     return $error;
3381   } elsif ( $cust_pkg_ref ) {
3382     ${$cust_pkg_ref} = $cust_pkg;
3383   }
3384
3385   if ( $bill_now ) {
3386     my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3387                              'pkg_list'      => [ $cust_pkg ],
3388                            );
3389     if ( $error ) {
3390       $dbh->rollback if $oldAutoCommit;
3391       return $error;
3392     }
3393   }
3394
3395   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3396   return '';
3397
3398 }
3399
3400 #=item charge_postal_fee
3401 #
3402 #Applies a one time charge this customer.  If there is an error,
3403 #returns the error, returns the cust_pkg charge object or false
3404 #if there was no charge.
3405 #
3406 #=cut
3407 #
3408 # This should be a customer event.  For that to work requires that bill
3409 # also be a customer event.
3410
3411 sub charge_postal_fee {
3412   my $self = shift;
3413
3414   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3415   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3416
3417   my $cust_pkg = new FS::cust_pkg ( {
3418     'custnum'  => $self->custnum,
3419     'pkgpart'  => $pkgpart,
3420     'quantity' => 1,
3421   } );
3422
3423   my $error = $cust_pkg->insert;
3424   $error ? $error : $cust_pkg;
3425 }
3426
3427 =item num_cust_attachment_deleted
3428
3429 Returns the number of deleted attachments for this customer (see
3430 L<FS::num_cust_attachment>).
3431
3432 =cut
3433
3434 sub num_cust_attachments_deleted {
3435   my $self = shift;
3436   $self->scalar_sql(
3437     " SELECT COUNT(*) FROM cust_attachment ".
3438       " WHERE custnum = ? AND disabled IS NOT NULL AND disabled > 0",
3439     $self->custnum
3440   );
3441 }
3442
3443 =item max_invnum
3444
3445 Returns the most recent invnum (invoice number) for this customer.
3446
3447 =cut
3448
3449 sub max_invnum {
3450   my $self = shift;
3451   $self->scalar_sql(
3452     " SELECT MAX(invnum) FROM cust_bill WHERE custnum = ?",
3453     $self->custnum
3454   );
3455 }
3456
3457 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3458
3459 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3460
3461 Optionally, a list or hashref of additional arguments to the qsearch call can
3462 be passed.
3463
3464 =cut
3465
3466 sub cust_bill {
3467   my $self = shift;
3468   my $opt = ref($_[0]) ? shift : { @_ };
3469
3470   #return $self->num_cust_bill unless wantarray || keys %$opt;
3471
3472   $opt->{'table'} = 'cust_bill';
3473   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3474   $opt->{'hashref'}{'custnum'} = $self->custnum;
3475   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3476
3477   map { $_ } #behavior of sort undefined in scalar context
3478     sort { $a->_date <=> $b->_date }
3479       qsearch($opt);
3480 }
3481
3482 =item open_cust_bill
3483
3484 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3485 customer.
3486
3487 =cut
3488
3489 sub open_cust_bill {
3490   my $self = shift;
3491
3492   $self->cust_bill(
3493     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3494     #@_
3495   );
3496
3497 }
3498
3499 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3500
3501 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3502
3503 =cut
3504
3505 sub legacy_cust_bill {
3506   my $self = shift;
3507
3508   #return $self->num_legacy_cust_bill unless wantarray;
3509
3510   map { $_ } #behavior of sort undefined in scalar context
3511     sort { $a->_date <=> $b->_date }
3512       qsearch({ 'table'    => 'legacy_cust_bill',
3513                 'hashref'  => { 'custnum' => $self->custnum, },
3514                 'order_by' => 'ORDER BY _date ASC',
3515              });
3516 }
3517
3518 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3519
3520 Returns all the statements (see L<FS::cust_statement>) for this customer.
3521
3522 Optionally, a list or hashref of additional arguments to the qsearch call can
3523 be passed.
3524
3525 =cut
3526
3527 =item cust_bill_void
3528
3529 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3530
3531 =cut
3532
3533 sub cust_bill_void {
3534   my $self = shift;
3535
3536   map { $_ } #return $self->num_cust_bill_void unless wantarray;
3537   sort { $a->_date <=> $b->_date }
3538     qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3539 }
3540
3541 sub cust_statement {
3542   my $self = shift;
3543   my $opt = ref($_[0]) ? shift : { @_ };
3544
3545   #return $self->num_cust_statement unless wantarray || keys %$opt;
3546
3547   $opt->{'table'} = 'cust_statement';
3548   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3549   $opt->{'hashref'}{'custnum'} = $self->custnum;
3550   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3551
3552   map { $_ } #behavior of sort undefined in scalar context
3553     sort { $a->_date <=> $b->_date }
3554       qsearch($opt);
3555 }
3556
3557 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3558
3559 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3560
3561 Optionally, a list or hashref of additional arguments to the qsearch call can
3562 be passed following the SVCDB.
3563
3564 =cut
3565
3566 sub svc_x {
3567   my $self = shift;
3568   my $svcdb = shift;
3569   if ( ! $svcdb =~ /^svc_\w+$/ ) {
3570     warn "$me svc_x requires a svcdb";
3571     return;
3572   }
3573   my $opt = ref($_[0]) ? shift : { @_ };
3574
3575   $opt->{'table'} = $svcdb;
3576   $opt->{'addl_from'} =
3577     'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3578     ($opt->{'addl_from'} || '');
3579
3580   my $custnum = $self->custnum;
3581   $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3582   my $where = "cust_pkg.custnum = $custnum";
3583
3584   my $extra_sql = $opt->{'extra_sql'} || '';
3585   if ( keys %{ $opt->{'hashref'} } ) {
3586     $extra_sql = " AND $where $extra_sql";
3587   }
3588   else {
3589     if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3590       $extra_sql = "WHERE $where AND $1";
3591     }
3592     else {
3593       $extra_sql = "WHERE $where $extra_sql";
3594     }
3595   }
3596   $opt->{'extra_sql'} = $extra_sql;
3597
3598   qsearch($opt);
3599 }
3600
3601 # required for use as an eventtable;
3602 sub svc_acct {
3603   my $self = shift;
3604   $self->svc_x('svc_acct', @_);
3605 }
3606
3607 =item cust_credit
3608
3609 Returns all the credits (see L<FS::cust_credit>) for this customer.
3610
3611 =cut
3612
3613 sub cust_credit {
3614   my $self = shift;
3615
3616   #return $self->num_cust_credit unless wantarray;
3617
3618   map { $_ } #behavior of sort undefined in scalar context
3619     sort { $a->_date <=> $b->_date }
3620       qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3621 }
3622
3623 =item cust_credit_pkgnum
3624
3625 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3626 package when using experimental package balances.
3627
3628 =cut
3629
3630 sub cust_credit_pkgnum {
3631   my( $self, $pkgnum ) = @_;
3632   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3633   sort { $a->_date <=> $b->_date }
3634     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3635                               'pkgnum'  => $pkgnum,
3636                             }
3637     );
3638 }
3639
3640 =item cust_credit_void
3641
3642 Returns all voided credits (see L<FS::cust_credit_void>) for this customer.
3643
3644 =cut
3645
3646 sub cust_credit_void {
3647   my $self = shift;
3648   map { $_ }
3649   sort { $a->_date <=> $b->_date }
3650     qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } )
3651 }
3652
3653 =item cust_pay
3654
3655 Returns all the payments (see L<FS::cust_pay>) for this customer.
3656
3657 =cut
3658
3659 sub cust_pay {
3660   my $self = shift;
3661   my $opt = ref($_[0]) ? shift : { @_ };
3662
3663   return $self->num_cust_pay unless wantarray || keys %$opt;
3664
3665   $opt->{'table'} = 'cust_pay';
3666   $opt->{'hashref'}{'custnum'} = $self->custnum;
3667
3668   map { $_ } #behavior of sort undefined in scalar context
3669     sort { $a->_date <=> $b->_date }
3670       qsearch($opt);
3671
3672 }
3673
3674 =item num_cust_pay
3675
3676 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
3677 called automatically when the cust_pay method is used in a scalar context.
3678
3679 =cut
3680
3681 sub num_cust_pay {
3682   my $self = shift;
3683   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3684   my $sth = dbh->prepare($sql) or die dbh->errstr;
3685   $sth->execute($self->custnum) or die $sth->errstr;
3686   $sth->fetchrow_arrayref->[0];
3687 }
3688
3689 =item unapplied_cust_pay
3690
3691 Returns all the unapplied payments (see L<FS::cust_pay>) for this customer.
3692
3693 =cut
3694
3695 sub unapplied_cust_pay {
3696   my $self = shift;
3697
3698   $self->cust_pay(
3699     'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0',
3700     #@_
3701   );
3702
3703 }
3704
3705 =item cust_pay_pkgnum
3706
3707 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3708 package when using experimental package balances.
3709
3710 =cut
3711
3712 sub cust_pay_pkgnum {
3713   my( $self, $pkgnum ) = @_;
3714   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3715   sort { $a->_date <=> $b->_date }
3716     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3717                            'pkgnum'  => $pkgnum,
3718                          }
3719     );
3720 }
3721
3722 =item cust_pay_void
3723
3724 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3725
3726 =cut
3727
3728 sub cust_pay_void {
3729   my $self = shift;
3730   map { $_ } #return $self->num_cust_pay_void unless wantarray;
3731   sort { $a->_date <=> $b->_date }
3732     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3733 }
3734
3735 =item cust_pay_pending
3736
3737 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3738 (without status "done").
3739
3740 =cut
3741
3742 sub cust_pay_pending {
3743   my $self = shift;
3744   return $self->num_cust_pay_pending unless wantarray;
3745   sort { $a->_date <=> $b->_date }
3746     qsearch( 'cust_pay_pending', {
3747                                    'custnum' => $self->custnum,
3748                                    'status'  => { op=>'!=', value=>'done' },
3749                                  },
3750            );
3751 }
3752
3753 =item cust_pay_pending_attempt
3754
3755 Returns all payment attempts / declined payments for this customer, as pending
3756 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3757 a corresponding payment (see L<FS::cust_pay>).
3758
3759 =cut
3760
3761 sub cust_pay_pending_attempt {
3762   my $self = shift;
3763   return $self->num_cust_pay_pending_attempt unless wantarray;
3764   sort { $a->_date <=> $b->_date }
3765     qsearch( 'cust_pay_pending', {
3766                                    'custnum' => $self->custnum,
3767                                    'status'  => 'done',
3768                                    'paynum'  => '',
3769                                  },
3770            );
3771 }
3772
3773 =item num_cust_pay_pending
3774
3775 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3776 customer (without status "done").  Also called automatically when the
3777 cust_pay_pending method is used in a scalar context.
3778
3779 =cut
3780
3781 sub num_cust_pay_pending {
3782   my $self = shift;
3783   $self->scalar_sql(
3784     " SELECT COUNT(*) FROM cust_pay_pending ".
3785       " WHERE custnum = ? AND status != 'done' ",
3786     $self->custnum
3787   );
3788 }
3789
3790 =item num_cust_pay_pending_attempt
3791
3792 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3793 customer, with status "done" but without a corresp.  Also called automatically when the
3794 cust_pay_pending method is used in a scalar context.
3795
3796 =cut
3797
3798 sub num_cust_pay_pending_attempt {
3799   my $self = shift;
3800   $self->scalar_sql(
3801     " SELECT COUNT(*) FROM cust_pay_pending ".
3802       " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3803     $self->custnum
3804   );
3805 }
3806
3807 =item cust_refund
3808
3809 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3810
3811 =cut
3812
3813 sub cust_refund {
3814   my $self = shift;
3815   map { $_ } #return $self->num_cust_refund unless wantarray;
3816   sort { $a->_date <=> $b->_date }
3817     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3818 }
3819
3820 =item display_custnum
3821
3822 Returns the displayed customer number for this customer: agent_custid if
3823 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3824
3825 =cut
3826
3827 sub display_custnum {
3828   my $self = shift;
3829
3830   return $self->agent_custid
3831     if $default_agent_custid && $self->agent_custid;
3832
3833   my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
3834
3835   if ( $prefix ) {
3836     return $prefix .
3837            sprintf('%0'.($custnum_display_length||8).'d', $self->custnum)
3838   } elsif ( $custnum_display_length ) {
3839     return sprintf('%0'.$custnum_display_length.'d', $self->custnum);
3840   } else {
3841     return $self->custnum;
3842   }
3843 }
3844
3845 =item name
3846
3847 Returns a name string for this customer, either "Company (Last, First)" or
3848 "Last, First".
3849
3850 =cut
3851
3852 sub name {
3853   my $self = shift;
3854   my $name = $self->contact;
3855   $name = $self->company. " ($name)" if $self->company;
3856   $name;
3857 }
3858
3859 =item service_contact
3860
3861 Returns the L<FS::contact> object for this customer that has the 'Service'
3862 contact class, or undef if there is no such contact.  Deprecated; don't use
3863 this in new code.
3864
3865 =cut
3866
3867 sub service_contact {
3868   my $self = shift;
3869   if ( !exists($self->{service_contact}) ) {
3870     my $classnum = $self->scalar_sql(
3871       'SELECT classnum FROM contact_class WHERE classname = \'Service\''
3872     ) || 0; #if it's zero, qsearchs will return nothing
3873     my $cust_contact = qsearchs('cust_contact', {
3874         'classnum' => $classnum,
3875         'custnum'  => $self->custnum,
3876     });
3877     $self->{service_contact} = $cust_contact->contact if $cust_contact;
3878   }
3879   $self->{service_contact};
3880 }
3881
3882 =item ship_name
3883
3884 Returns a name string for this (service/shipping) contact, either
3885 "Company (Last, First)" or "Last, First".
3886
3887 =cut
3888
3889 sub ship_name {
3890   my $self = shift;
3891
3892   my $name = $self->ship_contact;
3893   $name = $self->company. " ($name)" if $self->company;
3894   $name;
3895 }
3896
3897 =item name_short
3898
3899 Returns a name string for this customer, either "Company" or "First Last".
3900
3901 =cut
3902
3903 sub name_short {
3904   my $self = shift;
3905   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
3906 }
3907
3908 =item ship_name_short
3909
3910 Returns a name string for this (service/shipping) contact, either "Company"
3911 or "First Last".
3912
3913 =cut
3914
3915 sub ship_name_short {
3916   my $self = shift;
3917   $self->service_contact
3918     ? $self->ship_contact_firstlast
3919     : $self->name_short
3920 }
3921
3922 =item contact
3923
3924 Returns this customer's full (billing) contact name only, "Last, First"
3925
3926 =cut
3927
3928 sub contact {
3929   my $self = shift;
3930   $self->get('last'). ', '. $self->first;
3931 }
3932
3933 =item ship_contact
3934
3935 Returns this customer's full (shipping) contact name only, "Last, First"
3936
3937 =cut
3938
3939 sub ship_contact {
3940   my $self = shift;
3941   my $contact = $self->service_contact || $self;
3942   $contact->get('last') . ', ' . $contact->get('first');
3943 }
3944
3945 =item contact_firstlast
3946
3947 Returns this customers full (billing) contact name only, "First Last".
3948
3949 =cut
3950
3951 sub contact_firstlast {
3952   my $self = shift;
3953   $self->first. ' '. $self->get('last');
3954 }
3955
3956 =item ship_contact_firstlast
3957
3958 Returns this customer's full (shipping) contact name only, "First Last".
3959
3960 =cut
3961
3962 sub ship_contact_firstlast {
3963   my $self = shift;
3964   my $contact = $self->service_contact || $self;
3965   $contact->get('first') . ' '. $contact->get('last');
3966 }
3967
3968 sub bill_country_full {
3969   my $self = shift;
3970   $self->bill_location->country_full;
3971 }
3972
3973 sub ship_country_full {
3974   my $self = shift;
3975   $self->ship_location->country_full;
3976 }
3977
3978 =item county_state_county [ PREFIX ]
3979
3980 Returns a string consisting of just the county, state and country.
3981
3982 =cut
3983
3984 sub county_state_country {
3985   my $self = shift;
3986   my $locationnum;
3987   if ( @_ && $_[0] && $self->has_ship_address ) {
3988     $locationnum = $self->ship_locationnum;
3989   } else {
3990     $locationnum = $self->bill_locationnum;
3991   }
3992   my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
3993   $cust_location->county_state_country;
3994 }
3995
3996 =item geocode DATA_VENDOR
3997
3998 Returns a value for the customer location as encoded by DATA_VENDOR.
3999 Currently this only makes sense for "CCH" as DATA_VENDOR.
4000
4001 =cut
4002
4003 =item cust_status
4004
4005 =item status
4006
4007 Returns a status string for this customer, currently:
4008
4009 =over 4
4010
4011 =item prospect
4012
4013 No packages have ever been ordered.  Displayed as "No packages".
4014
4015 =item ordered
4016
4017 Recurring packages all are new (not yet billed).
4018
4019 =item active
4020
4021 One or more recurring packages is active.
4022
4023 =item inactive
4024
4025 No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled).
4026
4027 =item suspended
4028
4029 All non-cancelled recurring packages are suspended.
4030
4031 =item cancelled
4032
4033 All recurring packages are cancelled.
4034
4035 =back
4036
4037 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4038 cust_main-status_module configuration option.
4039
4040 =cut
4041
4042 sub status { shift->cust_status(@_); }
4043
4044 sub cust_status {
4045   my $self = shift;
4046   return $self->hashref->{cust_status} if $self->hashref->{cust_status};
4047   for my $status ( FS::cust_main->statuses() ) {
4048     my $method = $status.'_sql';
4049     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4050     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4051     $sth->execute( ($self->custnum) x $numnum )
4052       or die "Error executing 'SELECT $sql': ". $sth->errstr;
4053     if ( $sth->fetchrow_arrayref->[0] ) {
4054       $self->hashref->{cust_status} = $status;
4055       return $status;
4056     }
4057   }
4058 }
4059
4060 =item is_status_delay_cancel
4061
4062 Returns true if customer status is 'suspended'
4063 and all suspended cust_pkg return true for
4064 cust_pkg->is_status_delay_cancel.
4065
4066 This is not a real status, this only meant for hacking display
4067 values, because otherwise treating the customer as suspended is
4068 really the whole point of the delay_cancel option.
4069
4070 =cut
4071
4072 sub is_status_delay_cancel {
4073   my ($self) = @_;
4074   return 0 unless $self->status eq 'suspended';
4075   foreach my $cust_pkg ($self->ncancelled_pkgs) {
4076     return 0 unless $cust_pkg->is_status_delay_cancel;
4077   }
4078   return 1;
4079 }
4080
4081 =item ucfirst_cust_status
4082
4083 =item ucfirst_status
4084
4085 Deprecated, use the cust_status_label method instead.
4086
4087 Returns the status with the first character capitalized.
4088
4089 =cut
4090
4091 sub ucfirst_status {
4092   carp "ucfirst_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
4093   local($ucfirst_nowarn) = 1;
4094   shift->ucfirst_cust_status(@_);
4095 }
4096
4097 sub ucfirst_cust_status {
4098   carp "ucfirst_cust_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
4099   my $self = shift;
4100   ucfirst($self->cust_status);
4101 }
4102
4103 =item cust_status_label
4104
4105 =item status_label
4106
4107 Returns the display label for this status.
4108
4109 =cut
4110
4111 sub status_label { shift->cust_status_label(@_); }
4112
4113 sub cust_status_label {
4114   my $self = shift;
4115   __PACKAGE__->statuslabels->{$self->cust_status};
4116 }
4117
4118 =item statuscolor
4119
4120 Returns a hex triplet color string for this customer's status.
4121
4122 =cut
4123
4124 sub statuscolor { shift->cust_statuscolor(@_); }
4125
4126 sub cust_statuscolor {
4127   my $self = shift;
4128   __PACKAGE__->statuscolors->{$self->cust_status};
4129 }
4130
4131 =item tickets [ STATUS ]
4132
4133 Returns an array of hashes representing the customer's RT tickets.
4134
4135 An optional status (or arrayref or hashref of statuses) may be specified.
4136
4137 =cut
4138
4139 sub tickets {
4140   my $self = shift;
4141   my $status = ( @_ && $_[0] ) ? shift : '';
4142
4143   my $num = $conf->config('cust_main-max_tickets') || 10;
4144   my @tickets = ();
4145
4146   if ( $conf->config('ticket_system') ) {
4147     unless ( $conf->config('ticket_system-custom_priority_field') ) {
4148
4149       @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
4150                                                         $num,
4151                                                         undef,
4152                                                         $status,
4153                                                       )
4154                   };
4155
4156     } else {
4157
4158       foreach my $priority (
4159         $conf->config('ticket_system-custom_priority_field-values'), ''
4160       ) {
4161         last if scalar(@tickets) >= $num;
4162         push @tickets,
4163           @{ FS::TicketSystem->customer_tickets( $self->custnum,
4164                                                  $num - scalar(@tickets),
4165                                                  $priority,
4166                                                  $status,
4167                                                )
4168            };
4169       }
4170     }
4171   }
4172   (@tickets);
4173 }
4174
4175 =item appointments [ STATUS ]
4176
4177 Returns an array of hashes representing the customer's RT tickets which
4178 are appointments.
4179
4180 =cut
4181
4182 sub appointments {
4183   my $self = shift;
4184   my $status = ( @_ && $_[0] ) ? shift : '';
4185
4186   return () unless $conf->config('ticket_system');
4187
4188   my $queueid = $conf->config('ticket_system-appointment-queueid');
4189
4190   @{ FS::TicketSystem->customer_tickets( $self->custnum,
4191                                          99,
4192                                          undef,
4193                                          $status,
4194                                          $queueid,
4195                                        )
4196   };
4197 }
4198
4199 # Return services representing svc_accts in customer support packages
4200 sub support_services {
4201   my $self = shift;
4202   my %packages = map { $_ => 1 } $conf->config('support_packages');
4203
4204   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4205     grep { $_->part_svc->svcdb eq 'svc_acct' }
4206     map { $_->cust_svc }
4207     grep { exists $packages{ $_->pkgpart } }
4208     $self->ncancelled_pkgs;
4209
4210 }
4211
4212 # Return a list of latitude/longitude for one of the services (if any)
4213 sub service_coordinates {
4214   my $self = shift;
4215
4216   my @svc_X =
4217     grep { $_->latitude && $_->longitude }
4218     map { $_->svc_x }
4219     map { $_->cust_svc }
4220     $self->ncancelled_pkgs;
4221
4222   scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4223 }
4224
4225 =item masked FIELD
4226
4227 Returns a masked version of the named field
4228
4229 =cut
4230
4231 sub masked {
4232 my ($self,$field) = @_;
4233
4234 # Show last four
4235
4236 'x'x(length($self->getfield($field))-4).
4237   substr($self->getfield($field), (length($self->getfield($field))-4));
4238
4239 }
4240
4241 =item payment_history
4242
4243 Returns an array of hashrefs standardizing information from cust_bill, cust_pay,
4244 cust_credit and cust_refund objects.  Each hashref has the following fields:
4245
4246 I<type> - one of 'Line item', 'Invoice', 'Payment', 'Credit', 'Refund' or 'Previous'
4247
4248 I<date> - value of _date field, unix timestamp
4249
4250 I<date_pretty> - user-friendly date
4251
4252 I<description> - user-friendly description of item
4253
4254 I<amount> - impact of item on user's balance
4255 (positive for Invoice/Refund/Line item, negative for Payment/Credit.)
4256 Not to be confused with the native 'amount' field in cust_credit, see below.
4257
4258 I<amount_pretty> - includes money char
4259
4260 I<balance> - customer balance, chronologically as of this item
4261
4262 I<balance_pretty> - includes money char
4263
4264 I<charged> - amount charged for cust_bill (Invoice or Line item) records, undef for other types
4265
4266 I<paid> - amount paid for cust_pay records, undef for other types
4267
4268 I<credit> - amount credited for cust_credit records, undef for other types.
4269 Literally the 'amount' field from cust_credit, renamed here to avoid confusion.
4270
4271 I<refund> - amount refunded for cust_refund records, undef for other types
4272
4273 The four table-specific keys always have positive values, whether they reflect charges or payments.
4274
4275 The following options may be passed to this method:
4276
4277 I<line_items> - if true, returns charges ('Line item') rather than invoices
4278
4279 I<start_date> - unix timestamp, only include records on or after.
4280 If specified, an item of type 'Previous' will also be included.
4281 It does not have table-specific fields.
4282
4283 I<end_date> - unix timestamp, only include records before
4284
4285 I<reverse_sort> - order from newest to oldest (default is oldest to newest)
4286
4287 I<conf> - optional already-loaded FS::Conf object.
4288
4289 =cut
4290
4291 # Caution: this gets used by FS::ClientAPI::MyAccount::billing_history,
4292 # and also for sending customer statements, which should both be kept customer-friendly.
4293 # If you add anything that shouldn't be passed on through the API or exposed
4294 # to customers, add a new option to include it, don't include it by default
4295 sub payment_history {
4296   my $self = shift;
4297   my $opt = ref($_[0]) ? $_[0] : { @_ };
4298
4299   my $conf = $$opt{'conf'} || new FS::Conf;
4300   my $money_char = $conf->config("money_char") || '$',
4301
4302   #first load entire history,
4303   #need previous to calculate previous balance
4304   #loading after end_date shouldn't hurt too much?
4305   my @history = ();
4306   if ( $$opt{'line_items'} ) {
4307
4308     foreach my $cust_bill ( $self->cust_bill ) {
4309
4310       push @history, {
4311         'type'        => 'Line item',
4312         'description' => $_->desc( $self->locale ).
4313                            ( $_->sdate && $_->edate
4314                                ? ' '. time2str('%d-%b-%Y', $_->sdate).
4315                                  ' To '. time2str('%d-%b-%Y', $_->edate)
4316                                : ''
4317                            ),
4318         'amount'      => sprintf('%.2f', $_->setup + $_->recur ),
4319         'charged'     => sprintf('%.2f', $_->setup + $_->recur ),
4320         'date'        => $cust_bill->_date,
4321         'date_pretty' => $self->time2str_local('short', $cust_bill->_date ),
4322       }
4323         foreach $cust_bill->cust_bill_pkg;
4324
4325     }
4326
4327   } else {
4328
4329     push @history, {
4330                      'type'        => 'Invoice',
4331                      'description' => 'Invoice #'. $_->display_invnum,
4332                      'amount'      => sprintf('%.2f', $_->charged ),
4333                      'charged'     => sprintf('%.2f', $_->charged ),
4334                      'date'        => $_->_date,
4335                      'date_pretty' => $self->time2str_local('short', $_->_date ),
4336                    }
4337       foreach $self->cust_bill;
4338
4339   }
4340
4341   push @history, {
4342                    'type'        => 'Payment',
4343                    'description' => 'Payment', #XXX type
4344                    'amount'      => sprintf('%.2f', 0 - $_->paid ),
4345                    'paid'        => sprintf('%.2f', $_->paid ),
4346                    'date'        => $_->_date,
4347                    'date_pretty' => $self->time2str_local('short', $_->_date ),
4348                  }
4349     foreach $self->cust_pay;
4350
4351   push @history, {
4352                    'type'        => 'Credit',
4353                    'description' => 'Credit', #more info?
4354                    'amount'      => sprintf('%.2f', 0 -$_->amount ),
4355                    'credit'      => sprintf('%.2f', $_->amount ),
4356                    'date'        => $_->_date,
4357                    'date_pretty' => $self->time2str_local('short', $_->_date ),
4358                  }
4359     foreach $self->cust_credit;
4360
4361   push @history, {
4362                    'type'        => 'Refund',
4363                    'description' => 'Refund', #more info?  type, like payment?
4364                    'amount'      => $_->refund,
4365                    'refund'      => $_->refund,
4366                    'date'        => $_->_date,
4367                    'date_pretty' => $self->time2str_local('short', $_->_date ),
4368                  }
4369     foreach $self->cust_refund;
4370
4371   #put it all in chronological order
4372   @history = sort { $a->{'date'} <=> $b->{'date'} } @history;
4373
4374   #calculate balance, filter items outside date range
4375   my $previous = 0;
4376   my $balance = 0;
4377   my @out = ();
4378   foreach my $item (@history) {
4379     last if $$opt{'end_date'} && ($$item{'date'} >= $$opt{'end_date'});
4380     $balance += $$item{'amount'};
4381     if ($$opt{'start_date'} && ($$item{'date'} < $$opt{'start_date'})) {
4382       $previous += $$item{'amount'};
4383       next;
4384     }
4385     $$item{'balance'} = sprintf("%.2f",$balance);
4386     foreach my $key ( qw(amount balance) ) {
4387       $$item{$key.'_pretty'} = money_pretty($$item{$key});
4388     }
4389     push(@out,$item);
4390   }
4391
4392   # start with previous balance, if there was one
4393   if ($previous) {
4394     my $item = {
4395       'type'        => 'Previous',
4396       'description' => 'Previous balance',
4397       'amount'      => sprintf("%.2f",$previous),
4398       'balance'     => sprintf("%.2f",$previous),
4399       'date'        => $$opt{'start_date'},
4400       'date_pretty' => $self->time2str_local('short', $$opt{'start_date'} ),
4401     };
4402     #false laziness with above
4403     foreach my $key ( qw(amount balance) ) {
4404       $$item{$key.'_pretty'} = $$item{$key};
4405       $$item{$key.'_pretty'} =~ s/^(-?)/$1$money_char/;
4406     }
4407     unshift(@out,$item);
4408   }
4409
4410   @out = reverse @history if $$opt{'reverse_sort'};
4411
4412   return @out;
4413 }
4414
4415 =item save_cust_payby
4416
4417 Saves a new cust_payby for this customer, replacing an existing entry only
4418 in select circumstances.  Does not validate input.
4419
4420 If auto is specified, marks this as the customer's primary method, or the
4421 specified weight.  Existing payment methods have their weight incremented as
4422 appropriate.
4423
4424 If bill_location is specified with auto, also sets location in cust_main.
4425
4426 Will not insert complete duplicates of existing records, or records in which the
4427 only difference from an existing record is to turn off automatic payment (will
4428 return without error.)  Will replace existing records in which the only difference
4429 is to add a value to a previously empty preserved field and/or turn on automatic payment.
4430 Fields marked as preserved are optional, and existing values will not be overwritten with
4431 blanks when replacing.
4432
4433 Accepts the following named parameters:
4434
4435 =over 4
4436
4437 =item payment_payby
4438
4439 either CARD or CHEK
4440
4441 =item auto
4442
4443 save as an automatic payment type (CARD/CHEK if true, DCRD/DCHK if false)
4444
4445 =item weight
4446
4447 optional, set higher than 1 for secondary, etc.
4448
4449 =item payinfo
4450
4451 required
4452
4453 =item paymask
4454
4455 optional, but should be specified for anything that might be tokenized, will be preserved when replacing
4456
4457 =item payname
4458
4459 required
4460
4461 =item payip
4462
4463 optional, will be preserved when replacing
4464
4465 =item paydate
4466
4467 CARD only, required
4468
4469 =item bill_location
4470
4471 CARD only, required, FS::cust_location object
4472
4473 =item paystart_month
4474
4475 CARD only, optional, will be preserved when replacing
4476
4477 =item paystart_year
4478
4479 CARD only, optional, will be preserved when replacing
4480
4481 =item payissue
4482
4483 CARD only, optional, will be preserved when replacing
4484
4485 =item paycvv
4486
4487 CARD only, only used if conf cvv-save is set appropriately
4488
4489 =item paytype
4490
4491 CHEK only
4492
4493 =item paystate
4494
4495 CHEK only
4496
4497 =item saved_cust_payby
4498
4499 scalar reference, for returning saved object
4500
4501 =back
4502
4503 =cut
4504
4505 #The code for this option is in place, but it's not currently used
4506 #
4507 # =item replace
4508 #
4509 # existing cust_payby object to be replaced (must match custnum)
4510
4511 # stateid/stateid_state/ss are not currently supported in cust_payby,
4512 # might not even work properly in 4.x, but will need to work here if ever added
4513
4514 sub save_cust_payby {
4515   my $self = shift;
4516   my %opt = @_;
4517
4518   my $old = $opt{'replace'};
4519   my $new = new FS::cust_payby { $old ? $old->hash : () };
4520   return "Customer number does not match" if $new->custnum and $new->custnum != $self->custnum;
4521   $new->set( 'custnum' => $self->custnum );
4522
4523   my $payby = $opt{'payment_payby'};
4524   return "Bad payby" unless grep(/^$payby$/,('CARD','CHEK'));
4525
4526   # don't allow turning off auto when replacing
4527   $opt{'auto'} ||= 1 if $old and $old->payby !~ /^D/;
4528
4529   my @check_existing; # payby relevant to this payment_payby
4530
4531   # set payby based on auto
4532   if ( $payby eq 'CARD' ) {
4533     $new->set( 'payby' => ( $opt{'auto'} ? 'CARD' : 'DCRD' ) );
4534     @check_existing = qw( CARD DCRD );
4535   } elsif ( $payby eq 'CHEK' ) {
4536     $new->set( 'payby' => ( $opt{'auto'} ? 'CHEK' : 'DCHK' ) );
4537     @check_existing = qw( CHEK DCHK );
4538   }
4539
4540   $new->set( 'weight' => $opt{'auto'} ? $opt{'weight'} : '' );
4541
4542   # basic fields
4543   $new->payinfo($opt{'payinfo'}); # sets default paymask, but not if it's already tokenized
4544   $new->paymask($opt{'paymask'}) if $opt{'paymask'}; # in case it's been tokenized, override with loaded paymask
4545   $new->set( 'payname' => $opt{'payname'} );
4546   $new->set( 'payip' => $opt{'payip'} ); # will be preserved below
4547
4548   my $conf = new FS::Conf;
4549
4550   # compare to FS::cust_main::realtime_bop - check both to make sure working correctly
4551   if ( $payby eq 'CARD' &&
4552        ( (grep { $_ eq cardtype($opt{'payinfo'}) } $conf->config('cvv-save'))
4553          || $conf->exists('business-onlinepayment-verification')
4554        )
4555   ) {
4556     $new->set( 'paycvv' => $opt{'paycvv'} );
4557   } else {
4558     $new->set( 'paycvv' => '');
4559   }
4560
4561   local $SIG{HUP} = 'IGNORE';
4562   local $SIG{INT} = 'IGNORE';
4563   local $SIG{QUIT} = 'IGNORE';
4564   local $SIG{TERM} = 'IGNORE';
4565   local $SIG{TSTP} = 'IGNORE';
4566   local $SIG{PIPE} = 'IGNORE';
4567
4568   my $oldAutoCommit = $FS::UID::AutoCommit;
4569   local $FS::UID::AutoCommit = 0;
4570   my $dbh = dbh;
4571
4572   # set fields specific to payment_payby
4573   if ( $payby eq 'CARD' ) {
4574     if ($opt{'bill_location'}) {
4575       $opt{'bill_location'}->set('custnum' => $self->custnum);
4576       my $error = $opt{'bill_location'}->find_or_insert;
4577       if ( $error ) {
4578         $dbh->rollback if $oldAutoCommit;
4579         return $error;
4580       }
4581       $new->set( 'locationnum' => $opt{'bill_location'}->locationnum );
4582     }
4583     foreach my $field ( qw( paydate paystart_month paystart_year payissue ) ) {
4584       $new->set( $field => $opt{$field} );
4585     }
4586   } else {
4587     foreach my $field ( qw(paytype paystate) ) {
4588       $new->set( $field => $opt{$field} );
4589     }
4590   }
4591
4592   # other cust_payby to compare this to
4593   my @existing = $self->cust_payby(@check_existing);
4594
4595   # fields that can overwrite blanks with values, but not values with blanks
4596   my @preserve = qw( paymask locationnum paystart_month paystart_year payissue payip );
4597
4598   my $skip_cust_payby = 0; # true if we don't need to save or reweight cust_payby
4599   unless ($old) {
4600     # generally, we don't want to overwrite existing cust_payby with this,
4601     # but we can replace if we're only marking it auto or adding a preserved field
4602     # and we can avoid saving a total duplicate or merely turning off auto
4603 PAYBYLOOP:
4604     foreach my $cust_payby (@existing) {
4605       # check fields that absolutely should not change
4606       foreach my $field ($new->fields) {
4607         next if grep(/^$field$/, qw( custpaybynum payby weight ) );
4608         next if grep(/^$field$/, @preserve );
4609         next PAYBYLOOP unless $new->get($field) eq $cust_payby->get($field);
4610       }
4611       # now check fields that can replace if one value is blank
4612       my $replace = 0;
4613       foreach my $field (@preserve) {
4614         if (
4615           ( $new->get($field) and !$cust_payby->get($field) ) or
4616           ( $cust_payby->get($field) and !$new->get($field) )
4617         ) {
4618           # prevention of overwriting values with blanks happens farther below
4619           $replace = 1;
4620         } elsif ( $new->get($field) ne $cust_payby->get($field) ) {
4621           next PAYBYLOOP;
4622         }
4623       }
4624       unless ( $replace ) {
4625         # nearly identical, now check weight
4626         if ($new->get('weight') eq $cust_payby->get('weight') or !$new->get('weight')) {
4627           # ignore identical cust_payby, and ignore attempts to turn off auto
4628           # no need to save or re-weight cust_payby (but still need to update/commit $self)
4629           $skip_cust_payby = 1;
4630           last PAYBYLOOP;
4631         }
4632         # otherwise, only change is to mark this as primary
4633       }
4634       # if we got this far, we're definitely replacing
4635       $old = $cust_payby;
4636       last PAYBYLOOP;
4637     } #PAYBYLOOP
4638   }
4639
4640   if ($old) {
4641     $new->set( 'custpaybynum' => $old->custpaybynum );
4642     # don't turn off automatic payment (but allow it to be turned on)
4643     if ($new->payby =~ /^D/ and $new->payby ne $old->payby) {
4644       $opt{'auto'} = 1;
4645       $new->set( 'payby' => $old->payby );
4646       $new->set( 'weight' => 1 );
4647     }
4648     # make sure we're not overwriting values with blanks
4649     foreach my $field (@preserve) {
4650       if ( $old->get($field) and !$new->get($field) ) {
4651         $new->set( $field => $old->get($field) );
4652       }
4653     }
4654   }
4655
4656   # only overwrite cust_main bill_location if auto
4657   if ($opt{'auto'} && $opt{'bill_location'}) {
4658     $self->set('bill_location' => $opt{'bill_location'});
4659     my $error = $self->replace;
4660     if ( $error ) {
4661       $dbh->rollback if $oldAutoCommit;
4662       return $error;
4663     }
4664   }
4665
4666   # done with everything except reweighting and saving cust_payby
4667   # still need to commit changes to cust_main and cust_location
4668   if ($skip_cust_payby) {
4669     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4670     return '';
4671   }
4672
4673   # re-weight existing primary cust_pay for this payby
4674   if ($opt{'auto'}) {
4675     foreach my $cust_payby (@existing) {
4676       # relies on cust_payby return order
4677       last unless $cust_payby->payby !~ /^D/;
4678       last if $cust_payby->weight > 1;
4679       next if $new->custpaybynum eq $cust_payby->custpaybynum;
4680       next if $cust_payby->weight < ($opt{'weight'} || 1);
4681       $cust_payby->weight( $cust_payby->weight + 1 );
4682       my $error = $cust_payby->replace;
4683       if ( $error ) {
4684         $dbh->rollback if $oldAutoCommit;
4685         return "Error reweighting cust_payby: $error";
4686       }
4687     }
4688   }
4689
4690   # finally, save cust_payby
4691   my $error = $old ? $new->replace($old) : $new->insert;
4692   if ( $error ) {
4693     $dbh->rollback if $oldAutoCommit;
4694     return $error;
4695   }
4696
4697   ${$opt{'saved_cust_payby'}} = $new
4698     if $opt{'saved_cust_payby'};
4699
4700   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4701   '';
4702
4703 }
4704
4705 =item remove_cvv_from_cust_payby PAYINFO
4706
4707 Removes paycvv from associated cust_payby with matching PAYINFO.
4708
4709 =cut
4710
4711 sub remove_cvv_from_cust_payby {
4712   my ($self,$payinfo) = @_;
4713
4714   my $oldAutoCommit = $FS::UID::AutoCommit;
4715   local $FS::UID::AutoCommit = 0;
4716   my $dbh = dbh;
4717
4718   foreach my $cust_payby ( qsearch('cust_payby',{ custnum => $self->custnum }) ) {
4719     next unless $cust_payby->payinfo eq $payinfo; # can't qsearch on payinfo
4720     $cust_payby->paycvv('');
4721     my $error = $cust_payby->replace;
4722     if ($error) {
4723       $dbh->rollback if $oldAutoCommit;
4724       return $error;
4725     }
4726   }
4727
4728   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4729   '';
4730 }
4731
4732 =back
4733
4734 =head1 CLASS METHODS
4735
4736 =over 4
4737
4738 =item statuses
4739
4740 Class method that returns the list of possible status strings for customers
4741 (see L<the status method|/status>).  For example:
4742
4743   @statuses = FS::cust_main->statuses();
4744
4745 =cut
4746
4747 sub statuses {
4748   my $self = shift;
4749   keys %{ $self->statuscolors };
4750 }
4751
4752 =item cust_status_sql
4753
4754 Returns an SQL fragment to determine the status of a cust_main record, as a
4755 string.
4756
4757 =cut
4758
4759 sub cust_status_sql {
4760   my $sql = 'CASE';
4761   for my $status ( FS::cust_main->statuses() ) {
4762     my $method = $status.'_sql';
4763     $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4764   }
4765   $sql .= ' END';
4766   return $sql;
4767 }
4768
4769
4770 =item prospect_sql
4771
4772 Returns an SQL expression identifying prospective cust_main records (customers
4773 with no packages ever ordered)
4774
4775 =cut
4776
4777 use vars qw($select_count_pkgs);
4778 $select_count_pkgs =
4779   "SELECT COUNT(*) FROM cust_pkg
4780     WHERE cust_pkg.custnum = cust_main.custnum";
4781
4782 sub select_count_pkgs_sql {
4783   $select_count_pkgs;
4784 }
4785
4786 sub prospect_sql {
4787   " 0 = ( $select_count_pkgs ) ";
4788 }
4789
4790 =item ordered_sql
4791
4792 Returns an SQL expression identifying ordered cust_main records (customers with
4793 no active packages, but recurring packages not yet setup or one time charges
4794 not yet billed).
4795
4796 =cut
4797
4798 sub ordered_sql {
4799   FS::cust_main->none_active_sql.
4800   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4801 }
4802
4803 =item active_sql
4804
4805 Returns an SQL expression identifying active cust_main records (customers with
4806 active recurring packages).
4807
4808 =cut
4809
4810 sub active_sql {
4811   " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4812 }
4813
4814 =item none_active_sql
4815
4816 Returns an SQL expression identifying cust_main records with no active
4817 recurring packages.  This includes customers of status prospect, ordered,
4818 inactive, and suspended.
4819
4820 =cut
4821
4822 sub none_active_sql {
4823   " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4824 }
4825
4826 =item inactive_sql
4827
4828 Returns an SQL expression identifying inactive cust_main records (customers with
4829 no active recurring packages, but otherwise unsuspended/uncancelled).
4830
4831 =cut
4832
4833 sub inactive_sql {
4834   FS::cust_main->none_active_sql.
4835   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4836 }
4837
4838 =item susp_sql
4839 =item suspended_sql
4840
4841 Returns an SQL expression identifying suspended cust_main records.
4842
4843 =cut
4844
4845
4846 sub suspended_sql { susp_sql(@_); }
4847 sub susp_sql {
4848   FS::cust_main->none_active_sql.
4849   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4850 }
4851
4852 =item cancel_sql
4853 =item cancelled_sql
4854
4855 Returns an SQL expression identifying cancelled cust_main records.
4856
4857 =cut
4858
4859 sub cancel_sql { shift->cancelled_sql(@_); }
4860
4861 =item uncancel_sql
4862 =item uncancelled_sql
4863
4864 Returns an SQL expression identifying un-cancelled cust_main records.
4865
4866 =cut
4867
4868 sub uncancelled_sql { uncancel_sql(@_); }
4869 sub uncancel_sql {
4870   my $self = shift;
4871   "( NOT (".$self->cancelled_sql.") )"; #sensitive to cust_main-status_module
4872 }
4873
4874 =item balance_sql
4875
4876 Returns an SQL fragment to retreive the balance.
4877
4878 =cut
4879
4880 sub balance_sql { "
4881     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4882         WHERE cust_bill.custnum   = cust_main.custnum     )
4883   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
4884         WHERE cust_pay.custnum    = cust_main.custnum     )
4885   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
4886         WHERE cust_credit.custnum = cust_main.custnum     )
4887   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
4888         WHERE cust_refund.custnum = cust_main.custnum     )
4889 "; }
4890
4891 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4892
4893 Returns an SQL fragment to retreive the balance for this customer, optionally
4894 considering invoices with date earlier than START_TIME, and not
4895 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4896 total_unapplied_payments).
4897
4898 Times are specified as SQL fragments or numeric
4899 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4900 L<Date::Parse> for conversion functions.  The empty string can be passed
4901 to disable that time constraint completely.
4902
4903 Available options are:
4904
4905 =over 4
4906
4907 =item unapplied_date
4908
4909 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)
4910
4911 =item total
4912
4913 (unused.  obsolete?)
4914 set to true to remove all customer comparison clauses, for totals
4915
4916 =item where
4917
4918 (unused.  obsolete?)
4919 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4920
4921 =item join
4922
4923 (unused.  obsolete?)
4924 JOIN clause (typically used with the total option)
4925
4926 =item cutoff
4927
4928 An absolute cutoff time.  Payments, credits, and refunds I<applied> after this
4929 time will be ignored.  Note that START_TIME and END_TIME only limit the date
4930 range for invoices and I<unapplied> payments, credits, and refunds.
4931
4932 =back
4933
4934 =cut
4935
4936 sub balance_date_sql {
4937   my( $class, $start, $end, %opt ) = @_;
4938
4939   my $cutoff = $opt{'cutoff'};
4940
4941   my $owed         = FS::cust_bill->owed_sql($cutoff);
4942   my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4943   my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4944   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4945
4946   my $j = $opt{'join'} || '';
4947
4948   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
4949   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4950   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4951   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
4952
4953   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
4954     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4955     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4956     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
4957   ";
4958
4959 }
4960
4961 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4962
4963 Returns an SQL fragment to retreive the total unapplied payments for this
4964 customer, only considering payments with date earlier than START_TIME, and
4965 optionally not later than END_TIME.
4966
4967 Times are specified as SQL fragments or numeric
4968 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4969 L<Date::Parse> for conversion functions.  The empty string can be passed
4970 to disable that time constraint completely.
4971
4972 Available options are:
4973
4974 =cut
4975
4976 sub unapplied_payments_date_sql {
4977   my( $class, $start, $end, %opt ) = @_;
4978
4979   my $cutoff = $opt{'cutoff'};
4980
4981   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4982
4983   my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4984                                                           'unapplied_date'=>1 );
4985
4986   " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4987 }
4988
4989 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4990
4991 Helper method for balance_date_sql; name (and usage) subject to change
4992 (suggestions welcome).
4993
4994 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4995 cust_refund, cust_credit or cust_pay).
4996
4997 If TABLE is "cust_bill" or the unapplied_date option is true, only
4998 considers records with date earlier than START_TIME, and optionally not
4999 later than END_TIME .
5000
5001 =cut
5002
5003 sub _money_table_where {
5004   my( $class, $table, $start, $end, %opt ) = @_;
5005
5006   my @where = ();
5007   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
5008   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
5009     push @where, "$table._date <= $start" if defined($start) && length($start);
5010     push @where, "$table._date >  $end"   if defined($end)   && length($end);
5011   }
5012   push @where, @{$opt{'where'}} if $opt{'where'};
5013   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
5014
5015   $where;
5016
5017 }
5018
5019 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
5020 use FS::cust_main::Search;
5021 sub search {
5022   my $class = shift;
5023   FS::cust_main::Search->search(@_);
5024 }
5025
5026 =back
5027
5028 =head1 SUBROUTINES
5029
5030 =over 4
5031
5032 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5033
5034 Generates a templated notification to the customer (see L<Text::Template>).
5035
5036 OPTIONS is a hash and may include
5037
5038 I<extra_fields> - a hashref of name/value pairs which will be substituted
5039    into the template.  These values may override values mentioned below
5040    and those from the customer record.
5041
5042 I<template_text> - if present, ignores TEMPLATE_NAME and uses the provided text
5043
5044 The following variables are available in the template instead of or in addition
5045 to the fields of the customer record.
5046
5047 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
5048
5049 =cut
5050
5051 # a lot like cust_bill::print_latex
5052 sub generate_letter {
5053   my ($self, $template, %options) = @_;
5054
5055   warn "Template $template does not exist" && return
5056     unless $conf->exists($template) || $options{'template_text'};
5057
5058   my $template_source = $options{'template_text'}
5059                         ? [ $options{'template_text'} ]
5060                         : [ map "$_\n", $conf->config($template) ];
5061
5062   my $letter_template = new Text::Template
5063                         ( TYPE       => 'ARRAY',
5064                           SOURCE     => $template_source,
5065                           DELIMITERS => [ '[@--', '--@]' ],
5066                         )
5067     or die "can't create new Text::Template object: Text::Template::ERROR";
5068
5069   $letter_template->compile()
5070     or die "can't compile template: Text::Template::ERROR";
5071
5072   my %letter_data = map { $_ => $self->$_ } $self->fields;
5073
5074   for (keys %{$options{extra_fields}}){
5075     $letter_data{$_} = $options{extra_fields}->{$_};
5076   }
5077
5078   unless(exists($letter_data{returnaddress})){
5079     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
5080                                                   $self->agent_template)
5081                      );
5082     if ( length($retadd) ) {
5083       $letter_data{returnaddress} = $retadd;
5084     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
5085       $letter_data{returnaddress} =
5086         join( "\n", map { s/( {2,})/'~' x length($1)/eg;
5087                           s/$/\\\\\*/;
5088                           $_;
5089                         }
5090                     ( $conf->config('company_name', $self->agentnum),
5091                       $conf->config('company_address', $self->agentnum),
5092                     )
5093         );
5094     } else {
5095       $letter_data{returnaddress} = '~';
5096     }
5097   }
5098
5099   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
5100
5101   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
5102
5103   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
5104
5105   my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5106                            DIR      => $dir,
5107                            SUFFIX   => '.eps',
5108                            UNLINK   => 0,
5109                          ) or die "can't open temp file: $!\n";
5110   print $lh $conf->config_binary('logo.eps', $self->agentnum)
5111     or die "can't write temp file: $!\n";
5112   close $lh;
5113   $letter_data{'logo_file'} = $lh->filename;
5114
5115   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5116                            DIR      => $dir,
5117                            SUFFIX   => '.tex',
5118                            UNLINK   => 0,
5119                          ) or die "can't open temp file: $!\n";
5120
5121   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
5122   close $fh;
5123   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
5124   return ($1, $letter_data{'logo_file'});
5125
5126 }
5127
5128 =item print_ps TEMPLATE
5129
5130 Returns an postscript letter filled in from TEMPLATE, as a scalar.
5131
5132 =cut
5133
5134 sub print_ps {
5135   my $self = shift;
5136   my($file, $lfile) = $self->generate_letter(@_);
5137   my $ps = FS::Misc::generate_ps($file);
5138   unlink($file.'.tex');
5139   unlink($lfile);
5140
5141   $ps;
5142 }
5143
5144 =item print TEMPLATE
5145
5146 Prints the filled in template.
5147
5148 TEMPLATE is the name of a L<Text::Template> to fill in and print.
5149
5150 =cut
5151
5152 sub queueable_print {
5153   my %opt = @_;
5154
5155   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
5156     or die "invalid customer number: " . $opt{custnum};
5157
5158 #do not backport this change to 3.x
5159 #  my $error = $self->print( { 'template' => $opt{template} } );
5160   my $error = $self->print( $opt{'template'} );
5161   die $error if $error;
5162 }
5163
5164 sub print {
5165   my ($self, $template) = (shift, shift);
5166   do_print(
5167     [ $self->print_ps($template) ],
5168     'agentnum' => $self->agentnum,
5169   );
5170 }
5171
5172 #these three subs should just go away once agent stuff is all config overrides
5173
5174 sub agent_template {
5175   my $self = shift;
5176   $self->_agent_plandata('agent_templatename');
5177 }
5178
5179 sub agent_invoice_from {
5180   my $self = shift;
5181   $self->_agent_plandata('agent_invoice_from');
5182 }
5183
5184 sub _agent_plandata {
5185   my( $self, $option ) = @_;
5186
5187   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
5188   #agent-specific Conf
5189
5190   use FS::part_event::Condition;
5191
5192   my $agentnum = $self->agentnum;
5193
5194   my $regexp = regexp_sql();
5195
5196   my $part_event_option =
5197     qsearchs({
5198       'select'    => 'part_event_option.*',
5199       'table'     => 'part_event_option',
5200       'addl_from' => q{
5201         LEFT JOIN part_event USING ( eventpart )
5202         LEFT JOIN part_event_option AS peo_agentnum
5203           ON ( part_event.eventpart = peo_agentnum.eventpart
5204                AND peo_agentnum.optionname = 'agentnum'
5205                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
5206              )
5207         LEFT JOIN part_event_condition
5208           ON ( part_event.eventpart = part_event_condition.eventpart
5209                AND part_event_condition.conditionname = 'cust_bill_age'
5210              )
5211         LEFT JOIN part_event_condition_option
5212           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
5213                AND part_event_condition_option.optionname = 'age'
5214              )
5215       },
5216       #'hashref'   => { 'optionname' => $option },
5217       #'hashref'   => { 'part_event_option.optionname' => $option },
5218       'extra_sql' =>
5219         " WHERE part_event_option.optionname = ". dbh->quote($option).
5220         " AND action = 'cust_bill_send_agent' ".
5221         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
5222         " AND peo_agentnum.optionname = 'agentnum' ".
5223         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
5224         " ORDER BY
5225            CASE WHEN part_event_condition_option.optionname IS NULL
5226            THEN -1
5227            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
5228         " END
5229           , part_event.weight".
5230         " LIMIT 1"
5231     });
5232
5233   unless ( $part_event_option ) {
5234     return $self->agent->invoice_template || ''
5235       if $option eq 'agent_templatename';
5236     return '';
5237   }
5238
5239   $part_event_option->optionvalue;
5240
5241 }
5242
5243 sub process_o2m_qsearch {
5244   my $self = shift;
5245   my $table = shift;
5246   return qsearch($table, @_) unless $table eq 'contact';
5247
5248   my $hashref = shift;
5249   my %hash = %$hashref;
5250   ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
5251     or die 'guru meditation #4343';
5252
5253   qsearch({ 'table'     => 'contact',
5254             'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
5255             'hashref'   => \%hash,
5256             'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
5257                            " cust_contact.custnum = $custnum "
5258          });
5259 }
5260
5261 sub process_o2m_qsearchs {
5262   my $self = shift;
5263   my $table = shift;
5264   return qsearchs($table, @_) unless $table eq 'contact';
5265
5266   my $hashref = shift;
5267   my %hash = %$hashref;
5268   ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
5269     or die 'guru meditation #2121';
5270
5271   qsearchs({ 'table'     => 'contact',
5272              'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
5273              'hashref'   => \%hash,
5274              'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
5275                             " cust_contact.custnum = $custnum "
5276           });
5277 }
5278
5279 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5280
5281 Subroutine (not a method), designed to be called from the queue.
5282
5283 Takes a list of options and values.
5284
5285 Pulls up the customer record via the custnum option and calls bill_and_collect.
5286
5287 =cut
5288
5289 sub queued_bill {
5290   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5291
5292   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5293   warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5294
5295   #without this errors don't get rolled back
5296   $args{'fatal'} = 1; # runs from job queue, will be caught
5297
5298   $cust_main->bill_and_collect( %args );
5299 }
5300
5301 =item queued_collect 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5302
5303 Like queued_bill, but instead of C<bill_and_collect>, just runs the
5304 C<collect> part.  This is used in batch tax calculation, where invoice
5305 generation and collection events have to be completely separated.
5306
5307 =cut
5308
5309 sub queued_collect {
5310   my (%args) = @_;
5311   my $cust_main = FS::cust_main->by_key($args{'custnum'});
5312
5313   $cust_main->collect(%args);
5314 }
5315
5316 sub process_bill_and_collect {
5317   my $job = shift;
5318   my $param = shift;
5319   my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5320       or die "custnum '$param->{custnum}' not found!\n";
5321   $param->{'job'}   = $job;
5322   $param->{'fatal'} = 1; # runs from job queue, will be caught
5323   $param->{'retry'} = 1;
5324
5325   $cust_main->bill_and_collect( %$param );
5326 }
5327
5328 #starting to take quite a while for big dbs
5329 #   (JRNL: journaled so it only happens once per database)
5330 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
5331 # JRNL seq scan of cust_main on signupdate... index signupdate?  will that help?
5332 # JRNL seq scan of cust_main on paydate... index on substrings?  maybe set an
5333 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
5334 # JRNL leading/trailing spaces in first, last, company
5335 # JRNL migrate to cust_payby
5336 # - otaker upgrade?  journal and call it good?  (double check to make sure
5337 #    we're not still setting otaker here)
5338 #
5339 #only going to get worse with new location stuff...
5340
5341 sub _upgrade_data { #class method
5342   my ($class, %opts) = @_;
5343
5344   my @statements = ();
5345
5346   #this seems to be the only expensive one.. why does it take so long?
5347   unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
5348     push @statements,
5349       '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';
5350     FS::upgrade_journal->set_done('cust_main__signupdate');
5351   }
5352
5353   my $t = time;
5354   foreach my $sql ( @statements ) {
5355     my $sth = dbh->prepare($sql) or die dbh->errstr;
5356     $sth->execute or die $sth->errstr;
5357     #warn ( (time - $t). " seconds\n" );
5358     #$t = time;
5359   }
5360
5361   local($ignore_expired_card) = 1;
5362   local($ignore_banned_card) = 1;
5363   local($skip_fuzzyfiles) = 1;
5364   local($import) = 1; #prevent automatic geocoding (need its own variable?)
5365
5366   FS::cust_main::Location->_upgrade_data(%opts);
5367
5368   unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
5369
5370     foreach my $cust_main ( qsearch({
5371       'table'     => 'cust_main',
5372       'hashref'   => {},
5373       'extra_sql' => 'WHERE '.
5374                        join(' OR ',
5375                          map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '%  %'",
5376                            qw( first last company )
5377                        ),
5378     }) ) {
5379       my $error = $cust_main->replace;
5380       die $error if $error;
5381     }
5382
5383     FS::upgrade_journal->set_done('cust_main__trimspaces');
5384
5385   }
5386
5387   $class->_upgrade_otaker(%opts);
5388
5389   # turn on encryption as part of regular upgrade, so all new records are immediately encrypted
5390   # existing records will be encrypted in queueable_upgrade (below)
5391   unless ($conf->exists('encryptionpublickey') || $conf->exists('encryptionprivatekey')) {
5392     eval "use FS::Setup";
5393     die $@ if $@;
5394     FS::Setup::enable_encryption();
5395   }
5396
5397 }
5398
5399 sub queueable_upgrade {
5400   my $class = shift;
5401
5402   ### encryption gets turned on in _upgrade_data, above
5403
5404   eval "use FS::upgrade_journal";
5405   die $@ if $@;
5406
5407   # prior to 2013 (commit f16665c9) payinfo was stored in history if not
5408   # encrypted, clear that out before encrypting/tokenizing anything else
5409   if (!FS::upgrade_journal->is_done('clear_payinfo_history')) {
5410     foreach my $table (qw(
5411       cust_payby cust_pay_pending cust_pay cust_pay_void cust_refund
5412     )) {
5413       my $sql =
5414         'UPDATE h_'.$table.' SET payinfo = NULL WHERE payinfo IS NOT NULL';
5415       my $sth = dbh->prepare($sql) or die dbh->errstr;
5416       $sth->execute or die $sth->errstr;
5417     }
5418     FS::upgrade_journal->set_done('clear_payinfo_history');
5419   }
5420
5421   # fix Tokenized paycardtype and encrypt old records
5422   if (    ! FS::upgrade_journal->is_done('paycardtype_Tokenized')
5423        || ! FS::upgrade_journal->is_done('encryption_check')
5424      )
5425   {
5426
5427     # allow replacement of closed cust_pay/cust_refund records
5428     local $FS::payinfo_Mixin::allow_closed_replace = 1;
5429
5430     # because it looks like nothing's changing
5431     local $FS::Record::no_update_diff = 1;
5432
5433     # commit everything immediately
5434     local $FS::UID::AutoCommit = 1;
5435
5436     # encrypt what's there
5437     foreach my $table (qw(
5438       cust_payby cust_pay_pending cust_pay cust_pay_void cust_refund
5439     )) {
5440       my $tclass = 'FS::'.$table;
5441       my $lastrecnum = 0;
5442       my @recnums = ();
5443       while (
5444         my $recnum = _upgrade_next_recnum(dbh,$table,\$lastrecnum,\@recnums)
5445       ) {
5446         my $record = $tclass->by_key($recnum);
5447         next unless $record; # small chance it's been deleted, that's ok
5448         next unless grep { $record->payby eq $_ } @FS::Record::encrypt_payby;
5449         # window for possible conflict is practically nonexistant,
5450         #   but just in case...
5451         $record = $record->select_for_update;
5452         if (!$record->custnum && $table eq 'cust_pay_pending') {
5453           $record->set('custnum_pending',1);
5454         }
5455         $record->paycardtype('') if $record->paycardtype eq 'Tokenized';
5456
5457         local($ignore_expired_card) = 1;
5458         local($ignore_banned_card) = 1;
5459         local($skip_fuzzyfiles) = 1;
5460         local($import) = 1;#prevent automatic geocoding (need its own variable?)
5461
5462         my $error = $record->replace;
5463         die "Error replacing $table ".$record->get($record->primary_key).": $error" if $error;
5464       }
5465     }
5466
5467     FS::upgrade_journal->set_done('paycardtype_Tokenized');
5468     FS::upgrade_journal->set_done('encryption_check') if $conf->exists('encryption');
5469   }
5470
5471   # now that everything's encrypted, tokenize...
5472   FS::cust_main::Billing_Realtime::token_check(@_);
5473 }
5474
5475 # not entirely false laziness w/ Billing_Realtime::_token_check_next_recnum
5476 # cust_payby might get deleted while this runs
5477 # not a method!
5478 sub _upgrade_next_recnum {
5479   my ($dbh,$table,$lastrecnum,$recnums) = @_;
5480   my $recnum = shift @$recnums;
5481   return $recnum if $recnum;
5482   my $tclass = 'FS::'.$table;
5483   my $paycardtypecheck = ($table ne 'cust_pay_pending') ? q( OR paycardtype = 'Tokenized') : '';
5484   my $sql = 'SELECT '.$tclass->primary_key.
5485             ' FROM '.$table.
5486             ' WHERE '.$tclass->primary_key.' > '.$$lastrecnum.
5487             "   AND payby IN ( 'CARD', 'DCRD', 'CHEK', 'DCHK' ) ".
5488             "   AND ( length(payinfo) < 80$paycardtypecheck ) ".
5489             ' ORDER BY '.$tclass->primary_key.' LIMIT 500';
5490   my $sth = $dbh->prepare($sql) or die $dbh->errstr;
5491   $sth->execute() or die $sth->errstr;
5492   my @recnums;
5493   while (my $rec = $sth->fetchrow_hashref) {
5494     push @$recnums, $rec->{$tclass->primary_key};
5495   }
5496   $sth->finish();
5497   $$lastrecnum = $$recnums[-1];
5498   return shift @$recnums;
5499 }
5500
5501 =back
5502
5503 =head1 BUGS
5504
5505 The delete method.
5506
5507 The delete method should possibly take an FS::cust_main object reference
5508 instead of a scalar customer number.
5509
5510 Bill and collect options should probably be passed as references instead of a
5511 list.
5512
5513 There should probably be a configuration file with a list of allowed credit
5514 card types.
5515
5516 No multiple currency support (probably a larger project than just this module).
5517
5518 Birthdates rely on negative epoch values.
5519
5520 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5521
5522 =head1 SEE ALSO
5523
5524 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5525 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5526 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
5527
5528 =cut
5529
5530 1;
5531