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