FS/FS/cust_main.pm

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