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   if ( ref( $_[0] ) ) {
3271     $amount     = $_[0]->{amount};
3272     $setup_cost = $_[0]->{setup_cost};
3273     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3274     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3275     $no_auto    = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3276     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3277     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
3278                                            : '$'. sprintf("%.2f",$amount);
3279     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3280     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3281     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3282     $additional = $_[0]->{additional} || [];
3283     $taxproduct = $_[0]->{taxproductnum};
3284     $override   = { '' => $_[0]->{tax_override} };
3285     $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3286     $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3287     $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3288     $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3289     $separate_bill = $_[0]->{separate_bill} || '';
3290   } else { # yuck
3291     $amount     = shift;
3292     $setup_cost = '';
3293     $quantity   = 1;
3294     $start_date = '';
3295     $pkg        = @_ ? shift : 'One-time charge';
3296     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
3297     $setuptax   = '';
3298     $taxclass   = @_ ? shift : '';
3299     $additional = [];
3300   }
3301
3302   local $SIG{HUP} = 'IGNORE';
3303   local $SIG{INT} = 'IGNORE';
3304   local $SIG{QUIT} = 'IGNORE';
3305   local $SIG{TERM} = 'IGNORE';
3306   local $SIG{TSTP} = 'IGNORE';
3307   local $SIG{PIPE} = 'IGNORE';
3308
3309   my $oldAutoCommit = $FS::UID::AutoCommit;
3310   local $FS::UID::AutoCommit = 0;
3311   my $dbh = dbh;
3312
3313   my $part_pkg = new FS::part_pkg ( {
3314     'pkg'           => $pkg,
3315     'comment'       => $comment,
3316     'plan'          => 'flat',
3317     'freq'          => 0,
3318     'disabled'      => 'Y',
3319     'classnum'      => ( $classnum ? $classnum : '' ),
3320     'setuptax'      => $setuptax,
3321     'taxclass'      => $taxclass,
3322     'taxproductnum' => $taxproduct,
3323     'setup_cost'    => $setup_cost,
3324   } );
3325
3326   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3327                         ( 0 .. @$additional - 1 )
3328                   ),
3329                   'additional_count' => scalar(@$additional),
3330                   'setup_fee' => $amount,
3331                 );
3332
3333   my $error = $part_pkg->insert( options       => \%options,
3334                                  tax_overrides => $override,
3335                                );
3336   if ( $error ) {
3337     $dbh->rollback if $oldAutoCommit;
3338     return $error;
3339   }
3340
3341   my $pkgpart = $part_pkg->pkgpart;
3342   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3343   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3344     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3345     $error = $type_pkgs->insert;
3346     if ( $error ) {
3347       $dbh->rollback if $oldAutoCommit;
3348       return $error;
3349     }
3350   }
3351
3352   my $cust_pkg = new FS::cust_pkg ( {
3353     'custnum'    => $self->custnum,
3354     'pkgpart'    => $pkgpart,
3355     'quantity'   => $quantity,
3356     'start_date' => $start_date,
3357     'no_auto'    => $no_auto,
3358     'separate_bill' => $separate_bill,
3359     'locationnum'=> $locationnum,
3360   } );
3361
3362   $error = $cust_pkg->insert;
3363   if ( $error ) {
3364     $dbh->rollback if $oldAutoCommit;
3365     return $error;
3366   } elsif ( $cust_pkg_ref ) {
3367     ${$cust_pkg_ref} = $cust_pkg;
3368   }
3369
3370   if ( $bill_now ) {
3371     my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3372                              'pkg_list'      => [ $cust_pkg ],
3373                            );
3374     if ( $error ) {
3375       $dbh->rollback if $oldAutoCommit;
3376       return $error;
3377     }
3378   }
3379
3380   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3381   return '';
3382
3383 }
3384
3385 #=item charge_postal_fee
3386 #
3387 #Applies a one time charge this customer.  If there is an error,
3388 #returns the error, returns the cust_pkg charge object or false
3389 #if there was no charge.
3390 #
3391 #=cut
3392 #
3393 # This should be a customer event.  For that to work requires that bill
3394 # also be a customer event.
3395
3396 sub charge_postal_fee {
3397   my $self = shift;
3398
3399   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3400   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3401
3402   my $cust_pkg = new FS::cust_pkg ( {
3403     'custnum'  => $self->custnum,
3404     'pkgpart'  => $pkgpart,
3405     'quantity' => 1,
3406   } );
3407
3408   my $error = $cust_pkg->insert;
3409   $error ? $error : $cust_pkg;
3410 }
3411
3412 =item num_cust_attachment_deleted
3413
3414 Returns the number of deleted attachments for this customer (see
3415 L<FS::num_cust_attachment>).
3416
3417 =cut
3418
3419 sub num_cust_attachments_deleted {
3420   my $self = shift;
3421   $self->scalar_sql(
3422     " SELECT COUNT(*) FROM cust_attachment ".
3423       " WHERE custnum = ? AND disabled IS NOT NULL AND disabled > 0",
3424     $self->custnum
3425   );
3426 }
3427
3428 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3429
3430 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3431
3432 Optionally, a list or hashref of additional arguments to the qsearch call can
3433 be passed.
3434
3435 =cut
3436
3437 sub cust_bill {
3438   my $self = shift;
3439   my $opt = ref($_[0]) ? shift : { @_ };
3440
3441   #return $self->num_cust_bill unless wantarray || keys %$opt;
3442
3443   $opt->{'table'} = 'cust_bill';
3444   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3445   $opt->{'hashref'}{'custnum'} = $self->custnum;
3446   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3447
3448   map { $_ } #behavior of sort undefined in scalar context
3449     sort { $a->_date <=> $b->_date }
3450       qsearch($opt);
3451 }
3452
3453 =item open_cust_bill
3454
3455 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3456 customer.
3457
3458 =cut
3459
3460 sub open_cust_bill {
3461   my $self = shift;
3462
3463   $self->cust_bill(
3464     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3465     #@_
3466   );
3467
3468 }
3469
3470 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3471
3472 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3473
3474 =cut
3475
3476 sub legacy_cust_bill {
3477   my $self = shift;
3478
3479   #return $self->num_legacy_cust_bill unless wantarray;
3480
3481   map { $_ } #behavior of sort undefined in scalar context
3482     sort { $a->_date <=> $b->_date }
3483       qsearch({ 'table'    => 'legacy_cust_bill',
3484                 'hashref'  => { 'custnum' => $self->custnum, },
3485                 'order_by' => 'ORDER BY _date ASC',
3486              });
3487 }
3488
3489 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3490
3491 Returns all the statements (see L<FS::cust_statement>) for this customer.
3492
3493 Optionally, a list or hashref of additional arguments to the qsearch call can
3494 be passed.
3495
3496 =cut
3497
3498 =item cust_bill_void
3499
3500 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3501
3502 =cut
3503
3504 sub cust_bill_void {
3505   my $self = shift;
3506
3507   map { $_ } #return $self->num_cust_bill_void unless wantarray;
3508   sort { $a->_date <=> $b->_date }
3509     qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3510 }
3511
3512 sub cust_statement {
3513   my $self = shift;
3514   my $opt = ref($_[0]) ? shift : { @_ };
3515
3516   #return $self->num_cust_statement unless wantarray || keys %$opt;
3517
3518   $opt->{'table'} = 'cust_statement';
3519   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3520   $opt->{'hashref'}{'custnum'} = $self->custnum;
3521   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3522
3523   map { $_ } #behavior of sort undefined in scalar context
3524     sort { $a->_date <=> $b->_date }
3525       qsearch($opt);
3526 }
3527
3528 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3529
3530 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3531
3532 Optionally, a list or hashref of additional arguments to the qsearch call can
3533 be passed following the SVCDB.
3534
3535 =cut
3536
3537 sub svc_x {
3538   my $self = shift;
3539   my $svcdb = shift;
3540   if ( ! $svcdb =~ /^svc_\w+$/ ) {
3541     warn "$me svc_x requires a svcdb";
3542     return;
3543   }
3544   my $opt = ref($_[0]) ? shift : { @_ };
3545
3546   $opt->{'table'} = $svcdb;
3547   $opt->{'addl_from'} =
3548     'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3549     ($opt->{'addl_from'} || '');
3550
3551   my $custnum = $self->custnum;
3552   $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3553   my $where = "cust_pkg.custnum = $custnum";
3554
3555   my $extra_sql = $opt->{'extra_sql'} || '';
3556   if ( keys %{ $opt->{'hashref'} } ) {
3557     $extra_sql = " AND $where $extra_sql";
3558   }
3559   else {
3560     if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3561       $extra_sql = "WHERE $where AND $1";
3562     }
3563     else {
3564       $extra_sql = "WHERE $where $extra_sql";
3565     }
3566   }
3567   $opt->{'extra_sql'} = $extra_sql;
3568
3569   qsearch($opt);
3570 }
3571
3572 # required for use as an eventtable;
3573 sub svc_acct {
3574   my $self = shift;
3575   $self->svc_x('svc_acct', @_);
3576 }
3577
3578 =item cust_credit
3579
3580 Returns all the credits (see L<FS::cust_credit>) for this customer.
3581
3582 =cut
3583
3584 sub cust_credit {
3585   my $self = shift;
3586
3587   #return $self->num_cust_credit unless wantarray;
3588
3589   map { $_ } #behavior of sort undefined in scalar context
3590     sort { $a->_date <=> $b->_date }
3591       qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3592 }
3593
3594 =item cust_credit_pkgnum
3595
3596 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3597 package when using experimental package balances.
3598
3599 =cut
3600
3601 sub cust_credit_pkgnum {
3602   my( $self, $pkgnum ) = @_;
3603   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3604   sort { $a->_date <=> $b->_date }
3605     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3606                               'pkgnum'  => $pkgnum,
3607                             }
3608     );
3609 }
3610
3611 =item cust_credit_void
3612
3613 Returns all voided credits (see L<FS::cust_credit_void>) for this customer.
3614
3615 =cut
3616
3617 sub cust_credit_void {
3618   my $self = shift;
3619   map { $_ }
3620   sort { $a->_date <=> $b->_date }
3621     qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } )
3622 }
3623
3624 =item cust_pay
3625
3626 Returns all the payments (see L<FS::cust_pay>) for this customer.
3627
3628 =cut
3629
3630 sub cust_pay {
3631   my $self = shift;
3632   my $opt = ref($_[0]) ? shift : { @_ };
3633
3634   return $self->num_cust_pay unless wantarray || keys %$opt;
3635
3636   $opt->{'table'} = 'cust_pay';
3637   $opt->{'hashref'}{'custnum'} = $self->custnum;
3638
3639   map { $_ } #behavior of sort undefined in scalar context
3640     sort { $a->_date <=> $b->_date }
3641       qsearch($opt);
3642
3643 }
3644
3645 =item num_cust_pay
3646
3647 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
3648 called automatically when the cust_pay method is used in a scalar context.
3649
3650 =cut
3651
3652 sub num_cust_pay {
3653   my $self = shift;
3654   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3655   my $sth = dbh->prepare($sql) or die dbh->errstr;
3656   $sth->execute($self->custnum) or die $sth->errstr;
3657   $sth->fetchrow_arrayref->[0];
3658 }
3659
3660 =item unapplied_cust_pay
3661
3662 Returns all the unapplied payments (see L<FS::cust_pay>) for this customer.
3663
3664 =cut
3665
3666 sub unapplied_cust_pay {
3667   my $self = shift;
3668
3669   $self->cust_pay(
3670     'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0',
3671     #@_
3672   );
3673
3674 }
3675
3676 =item cust_pay_pkgnum
3677
3678 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3679 package when using experimental package balances.
3680
3681 =cut
3682
3683 sub cust_pay_pkgnum {
3684   my( $self, $pkgnum ) = @_;
3685   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3686   sort { $a->_date <=> $b->_date }
3687     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3688                            'pkgnum'  => $pkgnum,
3689                          }
3690     );
3691 }
3692
3693 =item cust_pay_void
3694
3695 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3696
3697 =cut
3698
3699 sub cust_pay_void {
3700   my $self = shift;
3701   map { $_ } #return $self->num_cust_pay_void unless wantarray;
3702   sort { $a->_date <=> $b->_date }
3703     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3704 }
3705
3706 =item cust_pay_pending
3707
3708 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3709 (without status "done").
3710
3711 =cut
3712
3713 sub cust_pay_pending {
3714   my $self = shift;
3715   return $self->num_cust_pay_pending unless wantarray;
3716   sort { $a->_date <=> $b->_date }
3717     qsearch( 'cust_pay_pending', {
3718                                    'custnum' => $self->custnum,
3719                                    'status'  => { op=>'!=', value=>'done' },
3720                                  },
3721            );
3722 }
3723
3724 =item cust_pay_pending_attempt
3725
3726 Returns all payment attempts / declined payments for this customer, as pending
3727 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3728 a corresponding payment (see L<FS::cust_pay>).
3729
3730 =cut
3731
3732 sub cust_pay_pending_attempt {
3733   my $self = shift;
3734   return $self->num_cust_pay_pending_attempt unless wantarray;
3735   sort { $a->_date <=> $b->_date }
3736     qsearch( 'cust_pay_pending', {
3737                                    'custnum' => $self->custnum,
3738                                    'status'  => 'done',
3739                                    'paynum'  => '',
3740                                  },
3741            );
3742 }
3743
3744 =item num_cust_pay_pending
3745
3746 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3747 customer (without status "done").  Also called automatically when the
3748 cust_pay_pending method is used in a scalar context.
3749
3750 =cut
3751
3752 sub num_cust_pay_pending {
3753   my $self = shift;
3754   $self->scalar_sql(
3755     " SELECT COUNT(*) FROM cust_pay_pending ".
3756       " WHERE custnum = ? AND status != 'done' ",
3757     $self->custnum
3758   );
3759 }
3760
3761 =item num_cust_pay_pending_attempt
3762
3763 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3764 customer, with status "done" but without a corresp.  Also called automatically when the
3765 cust_pay_pending method is used in a scalar context.
3766
3767 =cut
3768
3769 sub num_cust_pay_pending_attempt {
3770   my $self = shift;
3771   $self->scalar_sql(
3772     " SELECT COUNT(*) FROM cust_pay_pending ".
3773       " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3774     $self->custnum
3775   );
3776 }
3777
3778 =item cust_refund
3779
3780 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3781
3782 =cut
3783
3784 sub cust_refund {
3785   my $self = shift;
3786   map { $_ } #return $self->num_cust_refund unless wantarray;
3787   sort { $a->_date <=> $b->_date }
3788     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3789 }
3790
3791 =item display_custnum
3792
3793 Returns the displayed customer number for this customer: agent_custid if
3794 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3795
3796 =cut
3797
3798 sub display_custnum {
3799   my $self = shift;
3800
3801   return $self->agent_custid
3802     if $default_agent_custid && $self->agent_custid;
3803
3804   my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
3805
3806   if ( $prefix ) {
3807     return $prefix .
3808            sprintf('%0'.($custnum_display_length||8).'d', $self->custnum)
3809   } elsif ( $custnum_display_length ) {
3810     return sprintf('%0'.$custnum_display_length.'d', $self->custnum);
3811   } else {
3812     return $self->custnum;
3813   }
3814 }
3815
3816 =item name
3817
3818 Returns a name string for this customer, either "Company (Last, First)" or
3819 "Last, First".
3820
3821 =cut
3822
3823 sub name {
3824   my $self = shift;
3825   my $name = $self->contact;
3826   $name = $self->company. " ($name)" if $self->company;
3827   $name;
3828 }
3829
3830 =item service_contact
3831
3832 Returns the L<FS::contact> object for this customer that has the 'Service'
3833 contact class, or undef if there is no such contact.  Deprecated; don't use
3834 this in new code.
3835
3836 =cut
3837
3838 sub service_contact {
3839   my $self = shift;
3840   if ( !exists($self->{service_contact}) ) {
3841     my $classnum = $self->scalar_sql(
3842       'SELECT classnum FROM contact_class WHERE classname = \'Service\''
3843     ) || 0; #if it's zero, qsearchs will return nothing
3844     my $cust_contact = qsearchs('cust_contact', {
3845         'classnum' => $classnum,
3846         'custnum'  => $self->custnum,
3847     });
3848     $self->{service_contact} = $cust_contact->contact if $cust_contact;
3849   }
3850   $self->{service_contact};
3851 }
3852
3853 =item ship_name
3854
3855 Returns a name string for this (service/shipping) contact, either
3856 "Company (Last, First)" or "Last, First".
3857
3858 =cut
3859
3860 sub ship_name {
3861   my $self = shift;
3862
3863   my $name = $self->ship_contact;
3864   $name = $self->company. " ($name)" if $self->company;
3865   $name;
3866 }
3867
3868 =item name_short
3869
3870 Returns a name string for this customer, either "Company" or "First Last".
3871
3872 =cut
3873
3874 sub name_short {
3875   my $self = shift;
3876   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
3877 }
3878
3879 =item ship_name_short
3880
3881 Returns a name string for this (service/shipping) contact, either "Company"
3882 or "First Last".
3883
3884 =cut
3885
3886 sub ship_name_short {
3887   my $self = shift;
3888   $self->service_contact
3889     ? $self->ship_contact_firstlast
3890     : $self->name_short
3891 }
3892
3893 =item contact
3894
3895 Returns this customer's full (billing) contact name only, "Last, First"
3896
3897 =cut
3898
3899 sub contact {
3900   my $self = shift;
3901   $self->get('last'). ', '. $self->first;
3902 }
3903
3904 =item ship_contact
3905
3906 Returns this customer's full (shipping) contact name only, "Last, First"
3907
3908 =cut
3909
3910 sub ship_contact {
3911   my $self = shift;
3912   my $contact = $self->service_contact || $self;
3913   $contact->get('last') . ', ' . $contact->get('first');
3914 }
3915
3916 =item contact_firstlast
3917
3918 Returns this customers full (billing) contact name only, "First Last".
3919
3920 =cut
3921
3922 sub contact_firstlast {
3923   my $self = shift;
3924   $self->first. ' '. $self->get('last');
3925 }
3926
3927 =item ship_contact_firstlast
3928
3929 Returns this customer's full (shipping) contact name only, "First Last".
3930
3931 =cut
3932
3933 sub ship_contact_firstlast {
3934   my $self = shift;
3935   my $contact = $self->service_contact || $self;
3936   $contact->get('first') . ' '. $contact->get('last');
3937 }
3938
3939 sub bill_country_full {
3940   my $self = shift;
3941   $self->bill_location->country_full;
3942 }
3943
3944 sub ship_country_full {
3945   my $self = shift;
3946   $self->ship_location->country_full;
3947 }
3948
3949 =item county_state_county [ PREFIX ]
3950
3951 Returns a string consisting of just the county, state and country.
3952
3953 =cut
3954
3955 sub county_state_country {
3956   my $self = shift;
3957   my $locationnum;
3958   if ( @_ && $_[0] && $self->has_ship_address ) {
3959     $locationnum = $self->ship_locationnum;
3960   } else {
3961     $locationnum = $self->bill_locationnum;
3962   }
3963   my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
3964   $cust_location->county_state_country;
3965 }
3966
3967 =item geocode DATA_VENDOR
3968
3969 Returns a value for the customer location as encoded by DATA_VENDOR.
3970 Currently this only makes sense for "CCH" as DATA_VENDOR.
3971
3972 =cut
3973
3974 =item cust_status
3975
3976 =item status
3977
3978 Returns a status string for this customer, currently:
3979
3980 =over 4
3981
3982 =item prospect
3983
3984 No packages have ever been ordered.  Displayed as "No packages".
3985
3986 =item ordered
3987
3988 Recurring packages all are new (not yet billed).
3989
3990 =item active
3991
3992 One or more recurring packages is active.
3993
3994 =item inactive
3995
3996 No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled).
3997
3998 =item suspended
3999
4000 All non-cancelled recurring packages are suspended.
4001
4002 =item cancelled
4003
4004 All recurring packages are cancelled.
4005
4006 =back
4007
4008 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4009 cust_main-status_module configuration option.
4010
4011 =cut
4012
4013 sub status { shift->cust_status(@_); }
4014
4015 sub cust_status {
4016   my $self = shift;
4017   return $self->hashref->{cust_status} if $self->hashref->{cust_status};
4018   for my $status ( FS::cust_main->statuses() ) {
4019     my $method = $status.'_sql';
4020     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4021     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4022     $sth->execute( ($self->custnum) x $numnum )
4023       or die "Error executing 'SELECT $sql': ". $sth->errstr;
4024     if ( $sth->fetchrow_arrayref->[0] ) {
4025       $self->hashref->{cust_status} = $status;
4026       return $status;
4027     }
4028   }
4029 }
4030
4031 =item is_status_delay_cancel
4032
4033 Returns true if customer status is 'suspended'
4034 and all suspended cust_pkg return true for
4035 cust_pkg->is_status_delay_cancel.
4036
4037 This is not a real status, this only meant for hacking display
4038 values, because otherwise treating the customer as suspended is
4039 really the whole point of the delay_cancel option.
4040
4041 =cut
4042
4043 sub is_status_delay_cancel {
4044   my ($self) = @_;
4045   return 0 unless $self->status eq 'suspended';
4046   foreach my $cust_pkg ($self->ncancelled_pkgs) {
4047     return 0 unless $cust_pkg->is_status_delay_cancel;
4048   }
4049   return 1;
4050 }
4051
4052 =item ucfirst_cust_status
4053
4054 =item ucfirst_status
4055
4056 Deprecated, use the cust_status_label method instead.
4057
4058 Returns the status with the first character capitalized.
4059
4060 =cut
4061
4062 sub ucfirst_status {
4063   carp "ucfirst_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
4064   local($ucfirst_nowarn) = 1;
4065   shift->ucfirst_cust_status(@_);
4066 }
4067
4068 sub ucfirst_cust_status {
4069   carp "ucfirst_cust_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
4070   my $self = shift;
4071   ucfirst($self->cust_status);
4072 }
4073
4074 =item cust_status_label
4075
4076 =item status_label
4077
4078 Returns the display label for this status.
4079
4080 =cut
4081
4082 sub status_label { shift->cust_status_label(@_); }
4083
4084 sub cust_status_label {
4085   my $self = shift;
4086   __PACKAGE__->statuslabels->{$self->cust_status};
4087 }
4088
4089 =item statuscolor
4090
4091 Returns a hex triplet color string for this customer's status.
4092
4093 =cut
4094
4095 sub statuscolor { shift->cust_statuscolor(@_); }
4096
4097 sub cust_statuscolor {
4098   my $self = shift;
4099   __PACKAGE__->statuscolors->{$self->cust_status};
4100 }
4101
4102 =item tickets [ STATUS ]
4103
4104 Returns an array of hashes representing the customer's RT tickets.
4105
4106 An optional status (or arrayref or hashref of statuses) may be specified.
4107
4108 =cut
4109
4110 sub tickets {
4111   my $self = shift;
4112   my $status = ( @_ && $_[0] ) ? shift : '';
4113
4114   my $num = $conf->config('cust_main-max_tickets') || 10;
4115   my @tickets = ();
4116
4117   if ( $conf->config('ticket_system') ) {
4118     unless ( $conf->config('ticket_system-custom_priority_field') ) {
4119
4120       @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
4121                                                         $num,
4122                                                         undef,
4123                                                         $status,
4124                                                       )
4125                   };
4126
4127     } else {
4128
4129       foreach my $priority (
4130         $conf->config('ticket_system-custom_priority_field-values'), ''
4131       ) {
4132         last if scalar(@tickets) >= $num;
4133         push @tickets,
4134           @{ FS::TicketSystem->customer_tickets( $self->custnum,
4135                                                  $num - scalar(@tickets),
4136                                                  $priority,
4137                                                  $status,
4138                                                )
4139            };
4140       }
4141     }
4142   }
4143   (@tickets);
4144 }
4145
4146 =item appointments [ STATUS ]
4147
4148 Returns an array of hashes representing the customer's RT tickets which
4149 are appointments.
4150
4151 =cut
4152
4153 sub appointments {
4154   my $self = shift;
4155   my $status = ( @_ && $_[0] ) ? shift : '';
4156
4157   return () unless $conf->config('ticket_system');
4158
4159   my $queueid = $conf->config('ticket_system-appointment-queueid');
4160
4161   @{ FS::TicketSystem->customer_tickets( $self->custnum,
4162                                          99,
4163                                          undef,
4164                                          $status,
4165                                          $queueid,
4166                                        )
4167   };
4168 }
4169
4170 # Return services representing svc_accts in customer support packages
4171 sub support_services {
4172   my $self = shift;
4173   my %packages = map { $_ => 1 } $conf->config('support_packages');
4174
4175   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4176     grep { $_->part_svc->svcdb eq 'svc_acct' }
4177     map { $_->cust_svc }
4178     grep { exists $packages{ $_->pkgpart } }
4179     $self->ncancelled_pkgs;
4180
4181 }
4182
4183 # Return a list of latitude/longitude for one of the services (if any)
4184 sub service_coordinates {
4185   my $self = shift;
4186
4187   my @svc_X =
4188     grep { $_->latitude && $_->longitude }
4189     map { $_->svc_x }
4190     map { $_->cust_svc }
4191     $self->ncancelled_pkgs;
4192
4193   scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4194 }
4195
4196 =item masked FIELD
4197
4198 Returns a masked version of the named field
4199
4200 =cut
4201
4202 sub masked {
4203 my ($self,$field) = @_;
4204
4205 # Show last four
4206
4207 'x'x(length($self->getfield($field))-4).
4208   substr($self->getfield($field), (length($self->getfield($field))-4));
4209
4210 }
4211
4212 =item payment_history
4213
4214 Returns an array of hashrefs standardizing information from cust_bill, cust_pay,
4215 cust_credit and cust_refund objects.  Each hashref has the following fields:
4216
4217 I<type> - one of 'Line item', 'Invoice', 'Payment', 'Credit', 'Refund' or 'Previous'
4218
4219 I<date> - value of _date field, unix timestamp
4220
4221 I<date_pretty> - user-friendly date
4222
4223 I<description> - user-friendly description of item
4224
4225 I<amount> - impact of item on user's balance
4226 (positive for Invoice/Refund/Line item, negative for Payment/Credit.)
4227 Not to be confused with the native 'amount' field in cust_credit, see below.
4228
4229 I<amount_pretty> - includes money char
4230
4231 I<balance> - customer balance, chronologically as of this item
4232
4233 I<balance_pretty> - includes money char
4234
4235 I<charged> - amount charged for cust_bill (Invoice or Line item) records, undef for other types
4236
4237 I<paid> - amount paid for cust_pay records, undef for other types
4238
4239 I<credit> - amount credited for cust_credit records, undef for other types.
4240 Literally the 'amount' field from cust_credit, renamed here to avoid confusion.
4241
4242 I<refund> - amount refunded for cust_refund records, undef for other types
4243
4244 The four table-specific keys always have positive values, whether they reflect charges or payments.
4245
4246 The following options may be passed to this method:
4247
4248 I<line_items> - if true, returns charges ('Line item') rather than invoices
4249
4250 I<start_date> - unix timestamp, only include records on or after.
4251 If specified, an item of type 'Previous' will also be included.
4252 It does not have table-specific fields.
4253
4254 I<end_date> - unix timestamp, only include records before
4255
4256 I<reverse_sort> - order from newest to oldest (default is oldest to newest)
4257
4258 I<conf> - optional already-loaded FS::Conf object.
4259
4260 =cut
4261
4262 # Caution: this gets used by FS::ClientAPI::MyAccount::billing_history,
4263 # and also for sending customer statements, which should both be kept customer-friendly.
4264 # If you add anything that shouldn't be passed on through the API or exposed
4265 # to customers, add a new option to include it, don't include it by default
4266 sub payment_history {
4267   my $self = shift;
4268   my $opt = ref($_[0]) ? $_[0] : { @_ };
4269
4270   my $conf = $$opt{'conf'} || new FS::Conf;
4271   my $money_char = $conf->config("money_char") || '$',
4272
4273   #first load entire history,
4274   #need previous to calculate previous balance
4275   #loading after end_date shouldn't hurt too much?
4276   my @history = ();
4277   if ( $$opt{'line_items'} ) {
4278
4279     foreach my $cust_bill ( $self->cust_bill ) {
4280
4281       push @history, {
4282         'type'        => 'Line item',
4283         'description' => $_->desc( $self->locale ).
4284                            ( $_->sdate && $_->edate
4285                                ? ' '. time2str('%d-%b-%Y', $_->sdate).
4286                                  ' To '. time2str('%d-%b-%Y', $_->edate)
4287                                : ''
4288                            ),
4289         'amount'      => sprintf('%.2f', $_->setup + $_->recur ),
4290         'charged'     => sprintf('%.2f', $_->setup + $_->recur ),
4291         'date'        => $cust_bill->_date,
4292         'date_pretty' => $self->time2str_local('short', $cust_bill->_date ),
4293       }
4294         foreach $cust_bill->cust_bill_pkg;
4295
4296     }
4297
4298   } else {
4299
4300     push @history, {
4301                      'type'        => 'Invoice',
4302                      'description' => 'Invoice #'. $_->display_invnum,
4303                      'amount'      => sprintf('%.2f', $_->charged ),
4304                      'charged'     => sprintf('%.2f', $_->charged ),
4305                      'date'        => $_->_date,
4306                      'date_pretty' => $self->time2str_local('short', $_->_date ),
4307                    }
4308       foreach $self->cust_bill;
4309
4310   }
4311
4312   push @history, {
4313                    'type'        => 'Payment',
4314                    'description' => 'Payment', #XXX type
4315                    'amount'      => sprintf('%.2f', 0 - $_->paid ),
4316                    'paid'        => sprintf('%.2f', $_->paid ),
4317                    'date'        => $_->_date,
4318                    'date_pretty' => $self->time2str_local('short', $_->_date ),
4319                  }
4320     foreach $self->cust_pay;
4321
4322   push @history, {
4323                    'type'        => 'Credit',
4324                    'description' => 'Credit', #more info?
4325                    'amount'      => sprintf('%.2f', 0 -$_->amount ),
4326                    'credit'      => sprintf('%.2f', $_->amount ),
4327                    'date'        => $_->_date,
4328                    'date_pretty' => $self->time2str_local('short', $_->_date ),
4329                  }
4330     foreach $self->cust_credit;
4331
4332   push @history, {
4333                    'type'        => 'Refund',
4334                    'description' => 'Refund', #more info?  type, like payment?
4335                    'amount'      => $_->refund,
4336                    'refund'      => $_->refund,
4337                    'date'        => $_->_date,
4338                    'date_pretty' => $self->time2str_local('short', $_->_date ),
4339                  }
4340     foreach $self->cust_refund;
4341
4342   #put it all in chronological order
4343   @history = sort { $a->{'date'} <=> $b->{'date'} } @history;
4344
4345   #calculate balance, filter items outside date range
4346   my $previous = 0;
4347   my $balance = 0;
4348   my @out = ();
4349   foreach my $item (@history) {
4350     last if $$opt{'end_date'} && ($$item{'date'} >= $$opt{'end_date'});
4351     $balance += $$item{'amount'};
4352     if ($$opt{'start_date'} && ($$item{'date'} < $$opt{'start_date'})) {
4353       $previous += $$item{'amount'};
4354       next;
4355     }
4356     $$item{'balance'} = sprintf("%.2f",$balance);
4357     foreach my $key ( qw(amount balance) ) {
4358       $$item{$key.'_pretty'} = money_pretty($$item{$key});
4359     }
4360     push(@out,$item);
4361   }
4362
4363   # start with previous balance, if there was one
4364   if ($previous) {
4365     my $item = {
4366       'type'        => 'Previous',
4367       'description' => 'Previous balance',
4368       'amount'      => sprintf("%.2f",$previous),
4369       'balance'     => sprintf("%.2f",$previous),
4370       'date'        => $$opt{'start_date'},
4371       'date_pretty' => $self->time2str_local('short', $$opt{'start_date'} ),
4372     };
4373     #false laziness with above
4374     foreach my $key ( qw(amount balance) ) {
4375       $$item{$key.'_pretty'} = $$item{$key};
4376       $$item{$key.'_pretty'} =~ s/^(-?)/$1$money_char/;
4377     }
4378     unshift(@out,$item);
4379   }
4380
4381   @out = reverse @history if $$opt{'reverse_sort'};
4382
4383   return @out;
4384 }
4385
4386 =item save_cust_payby
4387
4388 Saves a new cust_payby for this customer, replacing an existing entry only
4389 in select circumstances.  Does not validate input.
4390
4391 If auto is specified, marks this as the customer's primary method, or the
4392 specified weight.  Existing payment methods have their weight incremented as
4393 appropriate.
4394
4395 If bill_location is specified with auto, also sets location in cust_main.
4396
4397 Will not insert complete duplicates of existing records, or records in which the
4398 only difference from an existing record is to turn off automatic payment (will
4399 return without error.)  Will replace existing records in which the only difference
4400 is to add a value to a previously empty preserved field and/or turn on automatic payment.
4401 Fields marked as preserved are optional, and existing values will not be overwritten with
4402 blanks when replacing.
4403
4404 Accepts the following named parameters:
4405
4406 =over 4
4407
4408 =item payment_payby
4409
4410 either CARD or CHEK
4411
4412 =item auto
4413
4414 save as an automatic payment type (CARD/CHEK if true, DCRD/DCHK if false)
4415
4416 =item weight
4417
4418 optional, set higher than 1 for secondary, etc.
4419
4420 =item payinfo
4421
4422 required
4423
4424 =item paymask
4425
4426 optional, but should be specified for anything that might be tokenized, will be preserved when replacing
4427
4428 =item payname
4429
4430 required
4431
4432 =item payip
4433
4434 optional, will be preserved when replacing
4435
4436 =item paydate
4437
4438 CARD only, required
4439
4440 =item bill_location
4441
4442 CARD only, required, FS::cust_location object
4443
4444 =item paystart_month
4445
4446 CARD only, optional, will be preserved when replacing
4447
4448 =item paystart_year
4449
4450 CARD only, optional, will be preserved when replacing
4451
4452 =item payissue
4453
4454 CARD only, optional, will be preserved when replacing
4455
4456 =item paycvv
4457
4458 CARD only, only used if conf cvv-save is set appropriately
4459
4460 =item paytype
4461
4462 CHEK only
4463
4464 =item paystate
4465
4466 CHEK only
4467
4468 =item saved_cust_payby
4469
4470 scalar reference, for returning saved object
4471
4472 =back
4473
4474 =cut
4475
4476 #The code for this option is in place, but it's not currently used
4477 #
4478 # =item replace
4479 #
4480 # existing cust_payby object to be replaced (must match custnum)
4481
4482 # stateid/stateid_state/ss are not currently supported in cust_payby,
4483 # might not even work properly in 4.x, but will need to work here if ever added
4484
4485 sub save_cust_payby {
4486   my $self = shift;
4487   my %opt = @_;
4488
4489   my $old = $opt{'replace'};
4490   my $new = new FS::cust_payby { $old ? $old->hash : () };
4491   return "Customer number does not match" if $new->custnum and $new->custnum != $self->custnum;
4492   $new->set( 'custnum' => $self->custnum );
4493
4494   my $payby = $opt{'payment_payby'};
4495   return "Bad payby" unless grep(/^$payby$/,('CARD','CHEK'));
4496
4497   # don't allow turning off auto when replacing
4498   $opt{'auto'} ||= 1 if $old and $old->payby !~ /^D/;
4499
4500   my @check_existing; # payby relevant to this payment_payby
4501
4502   # set payby based on auto
4503   if ( $payby eq 'CARD' ) {
4504     $new->set( 'payby' => ( $opt{'auto'} ? 'CARD' : 'DCRD' ) );
4505     @check_existing = qw( CARD DCRD );
4506   } elsif ( $payby eq 'CHEK' ) {
4507     $new->set( 'payby' => ( $opt{'auto'} ? 'CHEK' : 'DCHK' ) );
4508     @check_existing = qw( CHEK DCHK );
4509   }
4510
4511   $new->set( 'weight' => $opt{'auto'} ? $opt{'weight'} : '' );
4512
4513   # basic fields
4514   $new->payinfo($opt{'payinfo'}); # sets default paymask, but not if it's already tokenized
4515   $new->paymask($opt{'paymask'}) if $opt{'paymask'}; # in case it's been tokenized, override with loaded paymask
4516   $new->set( 'payname' => $opt{'payname'} );
4517   $new->set( 'payip' => $opt{'payip'} ); # will be preserved below
4518
4519   my $conf = new FS::Conf;
4520
4521   # compare to FS::cust_main::realtime_bop - check both to make sure working correctly
4522   if ( $payby eq 'CARD' &&
4523        ( (grep { $_ eq cardtype($opt{'payinfo'}) } $conf->config('cvv-save'))
4524          || $conf->exists('business-onlinepayment-verification')
4525        )
4526   ) {
4527     $new->set( 'paycvv' => $opt{'paycvv'} );
4528   } else {
4529     $new->set( 'paycvv' => '');
4530   }
4531
4532   local $SIG{HUP} = 'IGNORE';
4533   local $SIG{INT} = 'IGNORE';
4534   local $SIG{QUIT} = 'IGNORE';
4535   local $SIG{TERM} = 'IGNORE';
4536   local $SIG{TSTP} = 'IGNORE';
4537   local $SIG{PIPE} = 'IGNORE';
4538
4539   my $oldAutoCommit = $FS::UID::AutoCommit;
4540   local $FS::UID::AutoCommit = 0;
4541   my $dbh = dbh;
4542
4543   # set fields specific to payment_payby
4544   if ( $payby eq 'CARD' ) {
4545     if ($opt{'bill_location'}) {
4546       $opt{'bill_location'}->set('custnum' => $self->custnum);
4547       my $error = $opt{'bill_location'}->find_or_insert;
4548       if ( $error ) {
4549         $dbh->rollback if $oldAutoCommit;
4550         return $error;
4551       }
4552       $new->set( 'locationnum' => $opt{'bill_location'}->locationnum );
4553     }
4554     foreach my $field ( qw( paydate paystart_month paystart_year payissue ) ) {
4555       $new->set( $field => $opt{$field} );
4556     }
4557   } else {
4558     foreach my $field ( qw(paytype paystate) ) {
4559       $new->set( $field => $opt{$field} );
4560     }
4561   }
4562
4563   # other cust_payby to compare this to
4564   my @existing = $self->cust_payby(@check_existing);
4565
4566   # fields that can overwrite blanks with values, but not values with blanks
4567   my @preserve = qw( paymask locationnum paystart_month paystart_year payissue payip );
4568
4569   my $skip_cust_payby = 0; # true if we don't need to save or reweight cust_payby
4570   unless ($old) {
4571     # generally, we don't want to overwrite existing cust_payby with this,
4572     # but we can replace if we're only marking it auto or adding a preserved field
4573     # and we can avoid saving a total duplicate or merely turning off auto
4574 PAYBYLOOP:
4575     foreach my $cust_payby (@existing) {
4576       # check fields that absolutely should not change
4577       foreach my $field ($new->fields) {
4578         next if grep(/^$field$/, qw( custpaybynum payby weight ) );
4579         next if grep(/^$field$/, @preserve );
4580         next PAYBYLOOP unless $new->get($field) eq $cust_payby->get($field);
4581       }
4582       # now check fields that can replace if one value is blank
4583       my $replace = 0;
4584       foreach my $field (@preserve) {
4585         if (
4586           ( $new->get($field) and !$cust_payby->get($field) ) or
4587           ( $cust_payby->get($field) and !$new->get($field) )
4588         ) {
4589           # prevention of overwriting values with blanks happens farther below
4590           $replace = 1;
4591         } elsif ( $new->get($field) ne $cust_payby->get($field) ) {
4592           next PAYBYLOOP;
4593         }
4594       }
4595       unless ( $replace ) {
4596         # nearly identical, now check weight
4597         if ($new->get('weight') eq $cust_payby->get('weight') or !$new->get('weight')) {
4598           # ignore identical cust_payby, and ignore attempts to turn off auto
4599           # no need to save or re-weight cust_payby (but still need to update/commit $self)
4600           $skip_cust_payby = 1;
4601           last PAYBYLOOP;
4602         }
4603         # otherwise, only change is to mark this as primary
4604       }
4605       # if we got this far, we're definitely replacing
4606       $old = $cust_payby;
4607       last PAYBYLOOP;
4608     } #PAYBYLOOP
4609   }
4610
4611   if ($old) {
4612     $new->set( 'custpaybynum' => $old->custpaybynum );
4613     # don't turn off automatic payment (but allow it to be turned on)
4614     if ($new->payby =~ /^D/ and $new->payby ne $old->payby) {
4615       $opt{'auto'} = 1;
4616       $new->set( 'payby' => $old->payby );
4617       $new->set( 'weight' => 1 );
4618     }
4619     # make sure we're not overwriting values with blanks
4620     foreach my $field (@preserve) {
4621       if ( $old->get($field) and !$new->get($field) ) {
4622         $new->set( $field => $old->get($field) );
4623       }
4624     }
4625   }
4626
4627   # only overwrite cust_main bill_location if auto
4628   if ($opt{'auto'} && $opt{'bill_location'}) {
4629     $self->set('bill_location' => $opt{'bill_location'});
4630     my $error = $self->replace;
4631     if ( $error ) {
4632       $dbh->rollback if $oldAutoCommit;
4633       return $error;
4634     }
4635   }
4636
4637   # done with everything except reweighting and saving cust_payby
4638   # still need to commit changes to cust_main and cust_location
4639   if ($skip_cust_payby) {
4640     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4641     return '';
4642   }
4643
4644   # re-weight existing primary cust_pay for this payby
4645   if ($opt{'auto'}) {
4646     foreach my $cust_payby (@existing) {
4647       # relies on cust_payby return order
4648       last unless $cust_payby->payby !~ /^D/;
4649       last if $cust_payby->weight > 1;
4650       next if $new->custpaybynum eq $cust_payby->custpaybynum;
4651       next if $cust_payby->weight < ($opt{'weight'} || 1);
4652       $cust_payby->weight( $cust_payby->weight + 1 );
4653       my $error = $cust_payby->replace;
4654       if ( $error ) {
4655         $dbh->rollback if $oldAutoCommit;
4656         return "Error reweighting cust_payby: $error";
4657       }
4658     }
4659   }
4660
4661   # finally, save cust_payby
4662   my $error = $old ? $new->replace($old) : $new->insert;
4663   if ( $error ) {
4664     $dbh->rollback if $oldAutoCommit;
4665     return $error;
4666   }
4667
4668   ${$opt{'saved_cust_payby'}} = $new
4669     if $opt{'saved_cust_payby'};
4670
4671   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4672   '';
4673
4674 }
4675
4676 =item remove_cvv_from_cust_payby PAYINFO
4677
4678 Removes paycvv from associated cust_payby with matching PAYINFO.
4679
4680 =cut
4681
4682 sub remove_cvv_from_cust_payby {
4683   my ($self,$payinfo) = @_;
4684
4685   my $oldAutoCommit = $FS::UID::AutoCommit;
4686   local $FS::UID::AutoCommit = 0;
4687   my $dbh = dbh;
4688
4689   foreach my $cust_payby ( qsearch('cust_payby',{ custnum => $self->custnum }) ) {
4690     next unless $cust_payby->payinfo eq $payinfo; # can't qsearch on payinfo
4691     $cust_payby->paycvv('');
4692     my $error = $cust_payby->replace;
4693     if ($error) {
4694       $dbh->rollback if $oldAutoCommit;
4695       return $error;
4696     }
4697   }
4698
4699   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4700   '';
4701 }
4702
4703 =back
4704
4705 =head1 CLASS METHODS
4706
4707 =over 4
4708
4709 =item statuses
4710
4711 Class method that returns the list of possible status strings for customers
4712 (see L<the status method|/status>).  For example:
4713
4714   @statuses = FS::cust_main->statuses();
4715
4716 =cut
4717
4718 sub statuses {
4719   my $self = shift;
4720   keys %{ $self->statuscolors };
4721 }
4722
4723 =item cust_status_sql
4724
4725 Returns an SQL fragment to determine the status of a cust_main record, as a
4726 string.
4727
4728 =cut
4729
4730 sub cust_status_sql {
4731   my $sql = 'CASE';
4732   for my $status ( FS::cust_main->statuses() ) {
4733     my $method = $status.'_sql';
4734     $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4735   }
4736   $sql .= ' END';
4737   return $sql;
4738 }
4739
4740
4741 =item prospect_sql
4742
4743 Returns an SQL expression identifying prospective cust_main records (customers
4744 with no packages ever ordered)
4745
4746 =cut
4747
4748 use vars qw($select_count_pkgs);
4749 $select_count_pkgs =
4750   "SELECT COUNT(*) FROM cust_pkg
4751     WHERE cust_pkg.custnum = cust_main.custnum";
4752
4753 sub select_count_pkgs_sql {
4754   $select_count_pkgs;
4755 }
4756
4757 sub prospect_sql {
4758   " 0 = ( $select_count_pkgs ) ";
4759 }
4760
4761 =item ordered_sql
4762
4763 Returns an SQL expression identifying ordered cust_main records (customers with
4764 no active packages, but recurring packages not yet setup or one time charges
4765 not yet billed).
4766
4767 =cut
4768
4769 sub ordered_sql {
4770   FS::cust_main->none_active_sql.
4771   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4772 }
4773
4774 =item active_sql
4775
4776 Returns an SQL expression identifying active cust_main records (customers with
4777 active recurring packages).
4778
4779 =cut
4780
4781 sub active_sql {
4782   " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4783 }
4784
4785 =item none_active_sql
4786
4787 Returns an SQL expression identifying cust_main records with no active
4788 recurring packages.  This includes customers of status prospect, ordered,
4789 inactive, and suspended.
4790
4791 =cut
4792
4793 sub none_active_sql {
4794   " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4795 }
4796
4797 =item inactive_sql
4798
4799 Returns an SQL expression identifying inactive cust_main records (customers with
4800 no active recurring packages, but otherwise unsuspended/uncancelled).
4801
4802 =cut
4803
4804 sub inactive_sql {
4805   FS::cust_main->none_active_sql.
4806   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4807 }
4808
4809 =item susp_sql
4810 =item suspended_sql
4811
4812 Returns an SQL expression identifying suspended cust_main records.
4813
4814 =cut
4815
4816
4817 sub suspended_sql { susp_sql(@_); }
4818 sub susp_sql {
4819   FS::cust_main->none_active_sql.
4820   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4821 }
4822
4823 =item cancel_sql
4824 =item cancelled_sql
4825
4826 Returns an SQL expression identifying cancelled cust_main records.
4827
4828 =cut
4829
4830 sub cancel_sql { shift->cancelled_sql(@_); }
4831
4832 =item uncancel_sql
4833 =item uncancelled_sql
4834
4835 Returns an SQL expression identifying un-cancelled cust_main records.
4836
4837 =cut
4838
4839 sub uncancelled_sql { uncancel_sql(@_); }
4840 sub uncancel_sql {
4841   my $self = shift;
4842   "( NOT (".$self->cancelled_sql.") )"; #sensitive to cust_main-status_module
4843 }
4844
4845 =item balance_sql
4846
4847 Returns an SQL fragment to retreive the balance.
4848
4849 =cut
4850
4851 sub balance_sql { "
4852     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4853         WHERE cust_bill.custnum   = cust_main.custnum     )
4854   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
4855         WHERE cust_pay.custnum    = cust_main.custnum     )
4856   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
4857         WHERE cust_credit.custnum = cust_main.custnum     )
4858   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
4859         WHERE cust_refund.custnum = cust_main.custnum     )
4860 "; }
4861
4862 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4863
4864 Returns an SQL fragment to retreive the balance for this customer, optionally
4865 considering invoices with date earlier than START_TIME, and not
4866 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4867 total_unapplied_payments).
4868
4869 Times are specified as SQL fragments or numeric
4870 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4871 L<Date::Parse> for conversion functions.  The empty string can be passed
4872 to disable that time constraint completely.
4873
4874 Available options are:
4875
4876 =over 4
4877
4878 =item unapplied_date
4879
4880 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)
4881
4882 =item total
4883
4884 (unused.  obsolete?)
4885 set to true to remove all customer comparison clauses, for totals
4886
4887 =item where
4888
4889 (unused.  obsolete?)
4890 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4891
4892 =item join
4893
4894 (unused.  obsolete?)
4895 JOIN clause (typically used with the total option)
4896
4897 =item cutoff
4898
4899 An absolute cutoff time.  Payments, credits, and refunds I<applied> after this
4900 time will be ignored.  Note that START_TIME and END_TIME only limit the date
4901 range for invoices and I<unapplied> payments, credits, and refunds.
4902
4903 =back
4904
4905 =cut
4906
4907 sub balance_date_sql {
4908   my( $class, $start, $end, %opt ) = @_;
4909
4910   my $cutoff = $opt{'cutoff'};
4911
4912   my $owed         = FS::cust_bill->owed_sql($cutoff);
4913   my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4914   my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4915   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4916
4917   my $j = $opt{'join'} || '';
4918
4919   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
4920   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4921   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4922   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
4923
4924   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
4925     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4926     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4927     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
4928   ";
4929
4930 }
4931
4932 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4933
4934 Returns an SQL fragment to retreive the total unapplied payments for this
4935 customer, only considering payments with date earlier than START_TIME, and
4936 optionally not later than END_TIME.
4937
4938 Times are specified as SQL fragments or numeric
4939 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4940 L<Date::Parse> for conversion functions.  The empty string can be passed
4941 to disable that time constraint completely.
4942
4943 Available options are:
4944
4945 =cut
4946
4947 sub unapplied_payments_date_sql {
4948   my( $class, $start, $end, %opt ) = @_;
4949
4950   my $cutoff = $opt{'cutoff'};
4951
4952   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4953
4954   my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4955                                                           'unapplied_date'=>1 );
4956
4957   " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4958 }
4959
4960 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4961
4962 Helper method for balance_date_sql; name (and usage) subject to change
4963 (suggestions welcome).
4964
4965 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4966 cust_refund, cust_credit or cust_pay).
4967
4968 If TABLE is "cust_bill" or the unapplied_date option is true, only
4969 considers records with date earlier than START_TIME, and optionally not
4970 later than END_TIME .
4971
4972 =cut
4973
4974 sub _money_table_where {
4975   my( $class, $table, $start, $end, %opt ) = @_;
4976
4977   my @where = ();
4978   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4979   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4980     push @where, "$table._date <= $start" if defined($start) && length($start);
4981     push @where, "$table._date >  $end"   if defined($end)   && length($end);
4982   }
4983   push @where, @{$opt{'where'}} if $opt{'where'};
4984   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4985
4986   $where;
4987
4988 }
4989
4990 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4991 use FS::cust_main::Search;
4992 sub search {
4993   my $class = shift;
4994   FS::cust_main::Search->search(@_);
4995 }
4996
4997 =back
4998
4999 =head1 SUBROUTINES
5000
5001 =over 4
5002
5003 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5004
5005 Generates a templated notification to the customer (see L<Text::Template>).
5006
5007 OPTIONS is a hash and may include
5008
5009 I<extra_fields> - a hashref of name/value pairs which will be substituted
5010    into the template.  These values may override values mentioned below
5011    and those from the customer record.
5012
5013 I<template_text> - if present, ignores TEMPLATE_NAME and uses the provided text
5014
5015 The following variables are available in the template instead of or in addition
5016 to the fields of the customer record.
5017
5018 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
5019
5020 =cut
5021
5022 # a lot like cust_bill::print_latex
5023 sub generate_letter {
5024   my ($self, $template, %options) = @_;
5025
5026   warn "Template $template does not exist" && return
5027     unless $conf->exists($template) || $options{'template_text'};
5028
5029   my $template_source = $options{'template_text'}
5030                         ? [ $options{'template_text'} ]
5031                         : [ map "$_\n", $conf->config($template) ];
5032
5033   my $letter_template = new Text::Template
5034                         ( TYPE       => 'ARRAY',
5035                           SOURCE     => $template_source,
5036                           DELIMITERS => [ '[@--', '--@]' ],
5037                         )
5038     or die "can't create new Text::Template object: Text::Template::ERROR";
5039
5040   $letter_template->compile()
5041     or die "can't compile template: Text::Template::ERROR";
5042
5043   my %letter_data = map { $_ => $self->$_ } $self->fields;
5044
5045   for (keys %{$options{extra_fields}}){
5046     $letter_data{$_} = $options{extra_fields}->{$_};
5047   }
5048
5049   unless(exists($letter_data{returnaddress})){
5050     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
5051                                                   $self->agent_template)
5052                      );
5053     if ( length($retadd) ) {
5054       $letter_data{returnaddress} = $retadd;
5055     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
5056       $letter_data{returnaddress} =
5057         join( "\n", map { s/( {2,})/'~' x length($1)/eg;
5058                           s/$/\\\\\*/;
5059                           $_;
5060                         }
5061                     ( $conf->config('company_name', $self->agentnum),
5062                       $conf->config('company_address', $self->agentnum),
5063                     )
5064         );
5065     } else {
5066       $letter_data{returnaddress} = '~';
5067     }
5068   }
5069
5070   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
5071
5072   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
5073
5074   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
5075
5076   my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5077                            DIR      => $dir,
5078                            SUFFIX   => '.eps',
5079                            UNLINK   => 0,
5080                          ) or die "can't open temp file: $!\n";
5081   print $lh $conf->config_binary('logo.eps', $self->agentnum)
5082     or die "can't write temp file: $!\n";
5083   close $lh;
5084   $letter_data{'logo_file'} = $lh->filename;
5085
5086   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5087                            DIR      => $dir,
5088                            SUFFIX   => '.tex',
5089                            UNLINK   => 0,
5090                          ) or die "can't open temp file: $!\n";
5091
5092   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
5093   close $fh;
5094   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
5095   return ($1, $letter_data{'logo_file'});
5096
5097 }
5098
5099 =item print_ps TEMPLATE
5100
5101 Returns an postscript letter filled in from TEMPLATE, as a scalar.
5102
5103 =cut
5104
5105 sub print_ps {
5106   my $self = shift;
5107   my($file, $lfile) = $self->generate_letter(@_);
5108   my $ps = FS::Misc::generate_ps($file);
5109   unlink($file.'.tex');
5110   unlink($lfile);
5111
5112   $ps;
5113 }
5114
5115 =item print TEMPLATE
5116
5117 Prints the filled in template.
5118
5119 TEMPLATE is the name of a L<Text::Template> to fill in and print.
5120
5121 =cut
5122
5123 sub queueable_print {
5124   my %opt = @_;
5125
5126   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
5127     or die "invalid customer number: " . $opt{custnum};
5128
5129 #do not backport this change to 3.x
5130 #  my $error = $self->print( { 'template' => $opt{template} } );
5131   my $error = $self->print( $opt{'template'} );
5132   die $error if $error;
5133 }
5134
5135 sub print {
5136   my ($self, $template) = (shift, shift);
5137   do_print(
5138     [ $self->print_ps($template) ],
5139     'agentnum' => $self->agentnum,
5140   );
5141 }
5142
5143 #these three subs should just go away once agent stuff is all config overrides
5144
5145 sub agent_template {
5146   my $self = shift;
5147   $self->_agent_plandata('agent_templatename');
5148 }
5149
5150 sub agent_invoice_from {
5151   my $self = shift;
5152   $self->_agent_plandata('agent_invoice_from');
5153 }
5154
5155 sub _agent_plandata {
5156   my( $self, $option ) = @_;
5157
5158   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
5159   #agent-specific Conf
5160
5161   use FS::part_event::Condition;
5162
5163   my $agentnum = $self->agentnum;
5164
5165   my $regexp = regexp_sql();
5166
5167   my $part_event_option =
5168     qsearchs({
5169       'select'    => 'part_event_option.*',
5170       'table'     => 'part_event_option',
5171       'addl_from' => q{
5172         LEFT JOIN part_event USING ( eventpart )
5173         LEFT JOIN part_event_option AS peo_agentnum
5174           ON ( part_event.eventpart = peo_agentnum.eventpart
5175                AND peo_agentnum.optionname = 'agentnum'
5176                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
5177              )
5178         LEFT JOIN part_event_condition
5179           ON ( part_event.eventpart = part_event_condition.eventpart
5180                AND part_event_condition.conditionname = 'cust_bill_age'
5181              )
5182         LEFT JOIN part_event_condition_option
5183           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
5184                AND part_event_condition_option.optionname = 'age'
5185              )
5186       },
5187       #'hashref'   => { 'optionname' => $option },
5188       #'hashref'   => { 'part_event_option.optionname' => $option },
5189       'extra_sql' =>
5190         " WHERE part_event_option.optionname = ". dbh->quote($option).
5191         " AND action = 'cust_bill_send_agent' ".
5192         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
5193         " AND peo_agentnum.optionname = 'agentnum' ".
5194         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
5195         " ORDER BY
5196            CASE WHEN part_event_condition_option.optionname IS NULL
5197            THEN -1
5198            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
5199         " END
5200           , part_event.weight".
5201         " LIMIT 1"
5202     });
5203
5204   unless ( $part_event_option ) {
5205     return $self->agent->invoice_template || ''
5206       if $option eq 'agent_templatename';
5207     return '';
5208   }
5209
5210   $part_event_option->optionvalue;
5211
5212 }
5213
5214 sub process_o2m_qsearch {
5215   my $self = shift;
5216   my $table = shift;
5217   return qsearch($table, @_) unless $table eq 'contact';
5218
5219   my $hashref = shift;
5220   my %hash = %$hashref;
5221   ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
5222     or die 'guru meditation #4343';
5223
5224   qsearch({ 'table'     => 'contact',
5225             'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
5226             'hashref'   => \%hash,
5227             'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
5228                            " cust_contact.custnum = $custnum "
5229          });
5230 }
5231
5232 sub process_o2m_qsearchs {
5233   my $self = shift;
5234   my $table = shift;
5235   return qsearchs($table, @_) unless $table eq 'contact';
5236
5237   my $hashref = shift;
5238   my %hash = %$hashref;
5239   ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
5240     or die 'guru meditation #2121';
5241
5242   qsearchs({ 'table'     => 'contact',
5243              'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
5244              'hashref'   => \%hash,
5245              'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
5246                             " cust_contact.custnum = $custnum "
5247           });
5248 }
5249
5250 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5251
5252 Subroutine (not a method), designed to be called from the queue.
5253
5254 Takes a list of options and values.
5255
5256 Pulls up the customer record via the custnum option and calls bill_and_collect.
5257
5258 =cut
5259
5260 sub queued_bill {
5261   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5262
5263   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5264   warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5265
5266   #without this errors don't get rolled back
5267   $args{'fatal'} = 1; # runs from job queue, will be caught
5268
5269   $cust_main->bill_and_collect( %args );
5270 }
5271
5272 =item queued_collect 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5273
5274 Like queued_bill, but instead of C<bill_and_collect>, just runs the
5275 C<collect> part.  This is used in batch tax calculation, where invoice
5276 generation and collection events have to be completely separated.
5277
5278 =cut
5279
5280 sub queued_collect {
5281   my (%args) = @_;
5282   my $cust_main = FS::cust_main->by_key($args{'custnum'});
5283
5284   $cust_main->collect(%args);
5285 }
5286
5287 sub process_bill_and_collect {
5288   my $job = shift;
5289   my $param = shift;
5290   my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5291       or die "custnum '$param->{custnum}' not found!\n";
5292   $param->{'job'}   = $job;
5293   $param->{'fatal'} = 1; # runs from job queue, will be caught
5294   $param->{'retry'} = 1;
5295
5296   $cust_main->bill_and_collect( %$param );
5297 }
5298
5299 #starting to take quite a while for big dbs
5300 #   (JRNL: journaled so it only happens once per database)
5301 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
5302 # JRNL seq scan of cust_main on signupdate... index signupdate?  will that help?
5303 # JRNL seq scan of cust_main on paydate... index on substrings?  maybe set an
5304 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
5305 # JRNL leading/trailing spaces in first, last, company
5306 # JRNL migrate to cust_payby
5307 # - otaker upgrade?  journal and call it good?  (double check to make sure
5308 #    we're not still setting otaker here)
5309 #
5310 #only going to get worse with new location stuff...
5311
5312 sub _upgrade_data { #class method
5313   my ($class, %opts) = @_;
5314
5315   my @statements = ();
5316
5317   #this seems to be the only expensive one.. why does it take so long?
5318   unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
5319     push @statements,
5320       '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';
5321     FS::upgrade_journal->set_done('cust_main__signupdate');
5322   }
5323
5324   my $t = time;
5325   foreach my $sql ( @statements ) {
5326     my $sth = dbh->prepare($sql) or die dbh->errstr;
5327     $sth->execute or die $sth->errstr;
5328     #warn ( (time - $t). " seconds\n" );
5329     #$t = time;
5330   }
5331
5332   local($ignore_expired_card) = 1;
5333   local($ignore_banned_card) = 1;
5334   local($skip_fuzzyfiles) = 1;
5335   local($import) = 1; #prevent automatic geocoding (need its own variable?)
5336
5337   FS::cust_main::Location->_upgrade_data(%opts);
5338
5339   unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
5340
5341     foreach my $cust_main ( qsearch({
5342       'table'     => 'cust_main',
5343       'hashref'   => {},
5344       'extra_sql' => 'WHERE '.
5345                        join(' OR ',
5346                          map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '%  %'",
5347                            qw( first last company )
5348                        ),
5349     }) ) {
5350       my $error = $cust_main->replace;
5351       die $error if $error;
5352     }
5353
5354     FS::upgrade_journal->set_done('cust_main__trimspaces');
5355
5356   }
5357
5358   $class->_upgrade_otaker(%opts);
5359
5360   # turn on encryption as part of regular upgrade, so all new records are immediately encrypted
5361   # existing records will be encrypted in queueable_upgrade (below)
5362   unless ($conf->exists('encryptionpublickey') || $conf->exists('encryptionprivatekey')) {
5363     eval "use FS::Setup";
5364     die $@ if $@;
5365     FS::Setup::enable_encryption();
5366   }
5367
5368 }
5369
5370 sub queueable_upgrade {
5371   my $class = shift;
5372
5373   ### encryption gets turned on in _upgrade_data, above
5374
5375   eval "use FS::upgrade_journal";
5376   die $@ if $@;
5377
5378   # prior to 2013 (commit f16665c9) payinfo was stored in history if not
5379   # encrypted, clear that out before encrypting/tokenizing anything else
5380   if (!FS::upgrade_journal->is_done('clear_payinfo_history')) {
5381     foreach my $table (qw(
5382       cust_payby cust_pay_pending cust_pay cust_pay_void cust_refund
5383     )) {
5384       my $sql =
5385         'UPDATE h_'.$table.' SET payinfo = NULL WHERE payinfo IS NOT NULL';
5386       my $sth = dbh->prepare($sql) or die dbh->errstr;
5387       $sth->execute or die $sth->errstr;
5388     }
5389     FS::upgrade_journal->set_done('clear_payinfo_history');
5390   }
5391
5392   # fix Tokenized paycardtype and encrypt old records
5393   if (    ! FS::upgrade_journal->is_done('paycardtype_Tokenized')
5394        || ! FS::upgrade_journal->is_done('encryption_check')
5395      )
5396   {
5397
5398     # allow replacement of closed cust_pay/cust_refund records
5399     local $FS::payinfo_Mixin::allow_closed_replace = 1;
5400
5401     # because it looks like nothing's changing
5402     local $FS::Record::no_update_diff = 1;
5403
5404     # commit everything immediately
5405     local $FS::UID::AutoCommit = 1;
5406
5407     # encrypt what's there
5408     foreach my $table (qw(
5409       cust_payby cust_pay_pending cust_pay cust_pay_void cust_refund
5410     )) {
5411       my $tclass = 'FS::'.$table;
5412       my $lastrecnum = 0;
5413       my @recnums = ();
5414       while (
5415         my $recnum = _upgrade_next_recnum(dbh,$table,\$lastrecnum,\@recnums)
5416       ) {
5417         my $record = $tclass->by_key($recnum);
5418         next unless $record; # small chance it's been deleted, that's ok
5419         next unless grep { $record->payby eq $_ } @FS::Record::encrypt_payby;
5420         # window for possible conflict is practically nonexistant,
5421         #   but just in case...
5422         $record = $record->select_for_update;
5423         if (!$record->custnum && $table eq 'cust_pay_pending') {
5424           $record->set('custnum_pending',1);
5425         }
5426         $record->paycardtype('') if $record->paycardtype eq 'Tokenized';
5427
5428         local($ignore_expired_card) = 1;
5429         local($ignore_banned_card) = 1;
5430         local($skip_fuzzyfiles) = 1;
5431         local($import) = 1;#prevent automatic geocoding (need its own variable?)
5432
5433         my $error = $record->replace;
5434         die "Error replacing $table ".$record->get($record->primary_key).": $error" if $error;
5435       }
5436     }
5437
5438     FS::upgrade_journal->set_done('paycardtype_Tokenized');
5439     FS::upgrade_journal->set_done('encryption_check') if $conf->exists('encryption');
5440   }
5441
5442   # now that everything's encrypted, tokenize...
5443   FS::cust_main::Billing_Realtime::token_check(@_);
5444 }
5445
5446 # not entirely false laziness w/ Billing_Realtime::_token_check_next_recnum
5447 # cust_payby might get deleted while this runs
5448 # not a method!
5449 sub _upgrade_next_recnum {
5450   my ($dbh,$table,$lastrecnum,$recnums) = @_;
5451   my $recnum = shift @$recnums;
5452   return $recnum if $recnum;
5453   my $tclass = 'FS::'.$table;
5454   my $sql = 'SELECT '.$tclass->primary_key.
5455             ' FROM '.$table.
5456             ' WHERE '.$tclass->primary_key.' > '.$$lastrecnum.
5457             "   AND payby IN ( 'CARD', 'DCRD', 'CHEK', 'DCHK' ) ".
5458             "   AND ( length(payinfo) < 80 OR paycardtype = 'Tokenized' ) ".
5459             ' ORDER BY '.$tclass->primary_key.' LIMIT 500';
5460   my $sth = $dbh->prepare($sql) or die $dbh->errstr;
5461   $sth->execute() or die $sth->errstr;
5462   my @recnums;
5463   while (my $rec = $sth->fetchrow_hashref) {
5464     push @$recnums, $rec->{$tclass->primary_key};
5465   }
5466   $sth->finish();
5467   $$lastrecnum = $$recnums[-1];
5468   return shift @$recnums;
5469 }
5470
5471 =back
5472
5473 =head1 BUGS
5474
5475 The delete method.
5476
5477 The delete method should possibly take an FS::cust_main object reference
5478 instead of a scalar customer number.
5479
5480 Bill and collect options should probably be passed as references instead of a
5481 list.
5482
5483 There should probably be a configuration file with a list of allowed credit
5484 card types.
5485
5486 No multiple currency support (probably a larger project than just this module).
5487
5488 Birthdates rely on negative epoch values.
5489
5490 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5491
5492 =head1 SEE ALSO
5493
5494 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5495 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5496 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
5497
5498 =cut
5499
5500 1;
5501