FS/FS/cust_main.pm

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