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