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