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