FS/FS/cust_main.pm

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