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