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