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