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 the pseudo-classnum 'invoice' is given, returns contacts that
3371 are marked as invoice destinations. If '0' is given, also returns contacts
3372 with no class.
3373
3374 If no arguments are given, returns all contacts for the customer.
3375
3376 =cut
3377
3378 sub contact_list {
3379   my $self = shift;
3380   my $search = {
3381     table       => 'contact',
3382     select      => 'contact.*, cust_contact.invoice_dest',
3383     addl_from   => ' JOIN cust_contact USING (contactnum)',
3384     extra_sql   => ' WHERE cust_contact.custnum = '.$self->custnum,
3385   };
3386
3387   my @orwhere;
3388   my @classnums;
3389   foreach (@_) {
3390     if ( $_ eq 'invoice' ) {
3391       push @orwhere, 'cust_contact.invoice_dest = \'Y\'';
3392     } elsif ( $_ eq '0' ) {
3393       push @orwhere, 'cust_contact.classnum is null';
3394     } elsif ( /^\d+$/ ) {
3395       push @classnums, $_;
3396     } else {
3397       die "bad classnum argument '$_'";
3398     }
3399   }
3400
3401   if (@classnums) {
3402     push @orwhere, 'cust_contact.classnum IN ('.join(',', @classnums).')';
3403   }
3404   if (@orwhere) {
3405     $search->{extra_sql} .= ' AND (' .
3406                             join(' OR ', map "( $_ )", @orwhere) .
3407                             ')';
3408   }
3409
3410   qsearch($search);
3411 }
3412
3413 =item contact_list_email [ CLASSNUM, ... ]
3414
3415 Same as L</contact_list>, but returns email destinations instead of contact
3416 objects.
3417
3418 =cut
3419
3420 sub contact_list_email {
3421   my $self = shift;
3422   my @contacts = $self->contact_list(@_);
3423   my @emails;
3424   foreach my $contact (@contacts) {
3425     foreach my $contact_email ($contact->contact_email) {
3426       push @emails,
3427         $contact->firstlast . ' <' . $contact_email->emailaddress . '>';
3428     }
3429   }
3430   @emails;
3431 }
3432
3433 =item referral_custnum_cust_main
3434
3435 Returns the customer who referred this customer (or the empty string, if
3436 this customer was not referred).
3437
3438 Note the difference with referral_cust_main method: This method,
3439 referral_custnum_cust_main returns the single customer (if any) who referred
3440 this customer, while referral_cust_main returns an array of customers referred
3441 BY this customer.
3442
3443 =cut
3444
3445 sub referral_custnum_cust_main {
3446   my $self = shift;
3447   return '' unless $self->referral_custnum;
3448   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3449 }
3450
3451 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3452
3453 Returns an array of customers referred by this customer (referral_custnum set
3454 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
3455 customers referred by customers referred by this customer and so on, inclusive.
3456 The default behavior is DEPTH 1 (no recursion).
3457
3458 Note the difference with referral_custnum_cust_main method: This method,
3459 referral_cust_main, returns an array of customers referred BY this customer,
3460 while referral_custnum_cust_main returns the single customer (if any) who
3461 referred this customer.
3462
3463 =cut
3464
3465 sub referral_cust_main {
3466   my $self = shift;
3467   my $depth = @_ ? shift : 1;
3468   my $exclude = @_ ? shift : {};
3469
3470   my @cust_main =
3471     map { $exclude->{$_->custnum}++; $_; }
3472       grep { ! $exclude->{ $_->custnum } }
3473         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3474
3475   if ( $depth > 1 ) {
3476     push @cust_main,
3477       map { $_->referral_cust_main($depth-1, $exclude) }
3478         @cust_main;
3479   }
3480
3481   @cust_main;
3482 }
3483
3484 =item referral_cust_main_ncancelled
3485
3486 Same as referral_cust_main, except only returns customers with uncancelled
3487 packages.
3488
3489 =cut
3490
3491 sub referral_cust_main_ncancelled {
3492   my $self = shift;
3493   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3494 }
3495
3496 =item referral_cust_pkg [ DEPTH ]
3497
3498 Like referral_cust_main, except returns a flat list of all unsuspended (and
3499 uncancelled) packages for each customer.  The number of items in this list may
3500 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3501
3502 =cut
3503
3504 sub referral_cust_pkg {
3505   my $self = shift;
3506   my $depth = @_ ? shift : 1;
3507
3508   map { $_->unsuspended_pkgs }
3509     grep { $_->unsuspended_pkgs }
3510       $self->referral_cust_main($depth);
3511 }
3512
3513 =item referring_cust_main
3514
3515 Returns the single cust_main record for the customer who referred this customer
3516 (referral_custnum), or false.
3517
3518 =cut
3519
3520 sub referring_cust_main {
3521   my $self = shift;
3522   return '' unless $self->referral_custnum;
3523   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3524 }
3525
3526 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3527
3528 Applies a credit to this customer.  If there is an error, returns the error,
3529 otherwise returns false.
3530
3531 REASON can be a text string, an FS::reason object, or a scalar reference to
3532 a reasonnum.  If a text string, it will be automatically inserted as a new
3533 reason, and a 'reason_type' option must be passed to indicate the
3534 FS::reason_type for the new reason.
3535
3536 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3537 Likewise for I<eventnum>, I<commission_agentnum>, I<commission_salesnum> and
3538 I<commission_pkgnum>.
3539
3540 Any other options are passed to FS::cust_credit::insert.
3541
3542 =cut
3543
3544 sub credit {
3545   my( $self, $amount, $reason, %options ) = @_;
3546
3547   my $cust_credit = new FS::cust_credit {
3548     'custnum' => $self->custnum,
3549     'amount'  => $amount,
3550   };
3551
3552   if ( ref($reason) ) {
3553
3554     if ( ref($reason) eq 'SCALAR' ) {
3555       $cust_credit->reasonnum( $$reason );
3556     } else {
3557       $cust_credit->reasonnum( $reason->reasonnum );
3558     }
3559
3560   } else {
3561     $cust_credit->set('reason', $reason)
3562   }
3563
3564   $cust_credit->$_( delete $options{$_} )
3565     foreach grep exists($options{$_}),
3566               qw( addlinfo eventnum ),
3567               map "commission_$_", qw( agentnum salesnum pkgnum );
3568
3569   $cust_credit->insert(%options);
3570
3571 }
3572
3573 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3574
3575 Creates a one-time charge for this customer.  If there is an error, returns
3576 the error, otherwise returns false.
3577
3578 New-style, with a hashref of options:
3579
3580   my $error = $cust_main->charge(
3581                                   {
3582                                     'amount'     => 54.32,
3583                                     'quantity'   => 1,
3584                                     'start_date' => str2time('7/4/2009'),
3585                                     'pkg'        => 'Description',
3586                                     'comment'    => 'Comment',
3587                                     'additional' => [], #extra invoice detail
3588                                     'classnum'   => 1,  #pkg_class
3589
3590                                     'setuptax'   => '', # or 'Y' for tax exempt
3591
3592                                     'locationnum'=> 1234, # optional
3593
3594                                     #internal taxation
3595                                     'taxclass'   => 'Tax class',
3596
3597                                     #vendor taxation
3598                                     'taxproduct' => 2,  #part_pkg_taxproduct
3599                                     'override'   => {}, #XXX describe
3600
3601                                     #will be filled in with the new object
3602                                     'cust_pkg_ref' => \$cust_pkg,
3603
3604                                     #generate an invoice immediately
3605                                     'bill_now' => 0,
3606                                     'invoice_terms' => '', #with these terms
3607                                   }
3608                                 );
3609
3610 Old-style:
3611
3612   my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3613
3614 =cut
3615
3616 #super false laziness w/quotation::charge
3617 sub charge {
3618   my $self = shift;
3619   my ( $amount, $setup_cost, $quantity, $start_date, $classnum );
3620   my ( $pkg, $comment, $additional );
3621   my ( $setuptax, $taxclass );   #internal taxes
3622   my ( $taxproduct, $override ); #vendor (CCH) taxes
3623   my $no_auto = '';
3624   my $separate_bill = '';
3625   my $cust_pkg_ref = '';
3626   my ( $bill_now, $invoice_terms ) = ( 0, '' );
3627   my $locationnum;
3628   if ( ref( $_[0] ) ) {
3629     $amount     = $_[0]->{amount};
3630     $setup_cost = $_[0]->{setup_cost};
3631     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3632     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3633     $no_auto    = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3634     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3635     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
3636                                            : '$'. sprintf("%.2f",$amount);
3637     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3638     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3639     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3640     $additional = $_[0]->{additional} || [];
3641     $taxproduct = $_[0]->{taxproductnum};
3642     $override   = { '' => $_[0]->{tax_override} };
3643     $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3644     $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3645     $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3646     $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3647     $separate_bill = $_[0]->{separate_bill} || '';
3648   } else { # yuck
3649     $amount     = shift;
3650     $setup_cost = '';
3651     $quantity   = 1;
3652     $start_date = '';
3653     $pkg        = @_ ? shift : 'One-time charge';
3654     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
3655     $setuptax   = '';
3656     $taxclass   = @_ ? shift : '';
3657     $additional = [];
3658   }
3659
3660   local $SIG{HUP} = 'IGNORE';
3661   local $SIG{INT} = 'IGNORE';
3662   local $SIG{QUIT} = 'IGNORE';
3663   local $SIG{TERM} = 'IGNORE';
3664   local $SIG{TSTP} = 'IGNORE';
3665   local $SIG{PIPE} = 'IGNORE';
3666
3667   my $oldAutoCommit = $FS::UID::AutoCommit;
3668   local $FS::UID::AutoCommit = 0;
3669   my $dbh = dbh;
3670
3671   my $part_pkg = new FS::part_pkg ( {
3672     'pkg'           => $pkg,
3673     'comment'       => $comment,
3674     'plan'          => 'flat',
3675     'freq'          => 0,
3676     'disabled'      => 'Y',
3677     'classnum'      => ( $classnum ? $classnum : '' ),
3678     'setuptax'      => $setuptax,
3679     'taxclass'      => $taxclass,
3680     'taxproductnum' => $taxproduct,
3681     'setup_cost'    => $setup_cost,
3682   } );
3683
3684   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3685                         ( 0 .. @$additional - 1 )
3686                   ),
3687                   'additional_count' => scalar(@$additional),
3688                   'setup_fee' => $amount,
3689                 );
3690
3691   my $error = $part_pkg->insert( options       => \%options,
3692                                  tax_overrides => $override,
3693                                );
3694   if ( $error ) {
3695     $dbh->rollback if $oldAutoCommit;
3696     return $error;
3697   }
3698
3699   my $pkgpart = $part_pkg->pkgpart;
3700   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3701   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3702     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3703     $error = $type_pkgs->insert;
3704     if ( $error ) {
3705       $dbh->rollback if $oldAutoCommit;
3706       return $error;
3707     }
3708   }
3709
3710   my $cust_pkg = new FS::cust_pkg ( {
3711     'custnum'    => $self->custnum,
3712     'pkgpart'    => $pkgpart,
3713     'quantity'   => $quantity,
3714     'start_date' => $start_date,
3715     'no_auto'    => $no_auto,
3716     'separate_bill' => $separate_bill,
3717     'locationnum'=> $locationnum,
3718   } );
3719
3720   $error = $cust_pkg->insert;
3721   if ( $error ) {
3722     $dbh->rollback if $oldAutoCommit;
3723     return $error;
3724   } elsif ( $cust_pkg_ref ) {
3725     ${$cust_pkg_ref} = $cust_pkg;
3726   }
3727
3728   if ( $bill_now ) {
3729     my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3730                              'pkg_list'      => [ $cust_pkg ],
3731                            );
3732     if ( $error ) {
3733       $dbh->rollback if $oldAutoCommit;
3734       return $error;
3735     }
3736   }
3737
3738   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3739   return '';
3740
3741 }
3742
3743 #=item charge_postal_fee
3744 #
3745 #Applies a one time charge this customer.  If there is an error,
3746 #returns the error, returns the cust_pkg charge object or false
3747 #if there was no charge.
3748 #
3749 #=cut
3750 #
3751 # This should be a customer event.  For that to work requires that bill
3752 # also be a customer event.
3753
3754 sub charge_postal_fee {
3755   my $self = shift;
3756
3757   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3758   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3759
3760   my $cust_pkg = new FS::cust_pkg ( {
3761     'custnum'  => $self->custnum,
3762     'pkgpart'  => $pkgpart,
3763     'quantity' => 1,
3764   } );
3765
3766   my $error = $cust_pkg->insert;
3767   $error ? $error : $cust_pkg;
3768 }
3769
3770 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3771
3772 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3773
3774 Optionally, a list or hashref of additional arguments to the qsearch call can
3775 be passed.
3776
3777 =cut
3778
3779 sub cust_bill {
3780   my $self = shift;
3781   my $opt = ref($_[0]) ? shift : { @_ };
3782
3783   #return $self->num_cust_bill unless wantarray || keys %$opt;
3784
3785   $opt->{'table'} = 'cust_bill';
3786   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3787   $opt->{'hashref'}{'custnum'} = $self->custnum;
3788   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3789
3790   map { $_ } #behavior of sort undefined in scalar context
3791     sort { $a->_date <=> $b->_date }
3792       qsearch($opt);
3793 }
3794
3795 =item open_cust_bill
3796
3797 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3798 customer.
3799
3800 =cut
3801
3802 sub open_cust_bill {
3803   my $self = shift;
3804
3805   $self->cust_bill(
3806     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3807     #@_
3808   );
3809
3810 }
3811
3812 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3813
3814 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3815
3816 =cut
3817
3818 sub legacy_cust_bill {
3819   my $self = shift;
3820
3821   #return $self->num_legacy_cust_bill unless wantarray;
3822
3823   map { $_ } #behavior of sort undefined in scalar context
3824     sort { $a->_date <=> $b->_date }
3825       qsearch({ 'table'    => 'legacy_cust_bill',
3826                 'hashref'  => { 'custnum' => $self->custnum, },
3827                 'order_by' => 'ORDER BY _date ASC',
3828              });
3829 }
3830
3831 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3832
3833 Returns all the statements (see L<FS::cust_statement>) for this customer.
3834
3835 Optionally, a list or hashref of additional arguments to the qsearch call can
3836 be passed.
3837
3838 =cut
3839
3840 =item cust_bill_void
3841
3842 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3843
3844 =cut
3845
3846 sub cust_bill_void {
3847   my $self = shift;
3848
3849   map { $_ } #return $self->num_cust_bill_void unless wantarray;
3850   sort { $a->_date <=> $b->_date }
3851     qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3852 }
3853
3854 sub cust_statement {
3855   my $self = shift;
3856   my $opt = ref($_[0]) ? shift : { @_ };
3857
3858   #return $self->num_cust_statement unless wantarray || keys %$opt;
3859
3860   $opt->{'table'} = 'cust_statement';
3861   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3862   $opt->{'hashref'}{'custnum'} = $self->custnum;
3863   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3864
3865   map { $_ } #behavior of sort undefined in scalar context
3866     sort { $a->_date <=> $b->_date }
3867       qsearch($opt);
3868 }
3869
3870 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3871
3872 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3873
3874 Optionally, a list or hashref of additional arguments to the qsearch call can
3875 be passed following the SVCDB.
3876
3877 =cut
3878
3879 sub svc_x {
3880   my $self = shift;
3881   my $svcdb = shift;
3882   if ( ! $svcdb =~ /^svc_\w+$/ ) {
3883     warn "$me svc_x requires a svcdb";
3884     return;
3885   }
3886   my $opt = ref($_[0]) ? shift : { @_ };
3887
3888   $opt->{'table'} = $svcdb;
3889   $opt->{'addl_from'} =
3890     'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3891     ($opt->{'addl_from'} || '');
3892
3893   my $custnum = $self->custnum;
3894   $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3895   my $where = "cust_pkg.custnum = $custnum";
3896
3897   my $extra_sql = $opt->{'extra_sql'} || '';
3898   if ( keys %{ $opt->{'hashref'} } ) {
3899     $extra_sql = " AND $where $extra_sql";
3900   }
3901   else {
3902     if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3903       $extra_sql = "WHERE $where AND $1";
3904     }
3905     else {
3906       $extra_sql = "WHERE $where $extra_sql";
3907     }
3908   }
3909   $opt->{'extra_sql'} = $extra_sql;
3910
3911   qsearch($opt);
3912 }
3913
3914 # required for use as an eventtable;
3915 sub svc_acct {
3916   my $self = shift;
3917   $self->svc_x('svc_acct', @_);
3918 }
3919
3920 =item cust_credit
3921
3922 Returns all the credits (see L<FS::cust_credit>) for this customer.
3923
3924 =cut
3925
3926 sub cust_credit {
3927   my $self = shift;
3928   map { $_ } #return $self->num_cust_credit unless wantarray;
3929   sort { $a->_date <=> $b->_date }
3930     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3931 }
3932
3933 =item cust_credit_pkgnum
3934
3935 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3936 package when using experimental package balances.
3937
3938 =cut
3939
3940 sub cust_credit_pkgnum {
3941   my( $self, $pkgnum ) = @_;
3942   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3943   sort { $a->_date <=> $b->_date }
3944     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3945                               'pkgnum'  => $pkgnum,
3946                             }
3947     );
3948 }
3949
3950 =item cust_credit_void
3951
3952 Returns all voided credits (see L<FS::cust_credit_void>) for this customer.
3953
3954 =cut
3955
3956 sub cust_credit_void {
3957   my $self = shift;
3958   map { $_ }
3959   sort { $a->_date <=> $b->_date }
3960     qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } )
3961 }
3962
3963 =item cust_pay
3964
3965 Returns all the payments (see L<FS::cust_pay>) for this customer.
3966
3967 =cut
3968
3969 sub cust_pay {
3970   my $self = shift;
3971   my $opt = ref($_[0]) ? shift : { @_ };
3972
3973   return $self->num_cust_pay unless wantarray || keys %$opt;
3974
3975   $opt->{'table'} = 'cust_pay';
3976   $opt->{'hashref'}{'custnum'} = $self->custnum;
3977
3978   map { $_ } #behavior of sort undefined in scalar context
3979     sort { $a->_date <=> $b->_date }
3980       qsearch($opt);
3981
3982 }
3983
3984 =item num_cust_pay
3985
3986 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
3987 called automatically when the cust_pay method is used in a scalar context.
3988
3989 =cut
3990
3991 sub num_cust_pay {
3992   my $self = shift;
3993   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3994   my $sth = dbh->prepare($sql) or die dbh->errstr;
3995   $sth->execute($self->custnum) or die $sth->errstr;
3996   $sth->fetchrow_arrayref->[0];
3997 }
3998
3999 =item unapplied_cust_pay
4000
4001 Returns all the unapplied payments (see L<FS::cust_pay>) for this customer.
4002
4003 =cut
4004
4005 sub unapplied_cust_pay {
4006   my $self = shift;
4007
4008   $self->cust_pay(
4009     'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0',
4010     #@_
4011   );
4012
4013 }
4014
4015 =item cust_pay_pkgnum
4016
4017 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
4018 package when using experimental package balances.
4019
4020 =cut
4021
4022 sub cust_pay_pkgnum {
4023   my( $self, $pkgnum ) = @_;
4024   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
4025   sort { $a->_date <=> $b->_date }
4026     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
4027                            'pkgnum'  => $pkgnum,
4028                          }
4029     );
4030 }
4031
4032 =item cust_pay_void
4033
4034 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
4035
4036 =cut
4037
4038 sub cust_pay_void {
4039   my $self = shift;
4040   map { $_ } #return $self->num_cust_pay_void unless wantarray;
4041   sort { $a->_date <=> $b->_date }
4042     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
4043 }
4044
4045 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
4046
4047 Returns all batched payments (see L<FS::cust_pay_batch>) for this customer.
4048
4049 Optionally, a list or hashref of additional arguments to the qsearch call can
4050 be passed.
4051
4052 =cut
4053
4054 sub cust_pay_batch {
4055   my $self = shift;
4056   my $opt = ref($_[0]) ? shift : { @_ };
4057
4058   #return $self->num_cust_statement unless wantarray || keys %$opt;
4059
4060   $opt->{'table'} = 'cust_pay_batch';
4061   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
4062   $opt->{'hashref'}{'custnum'} = $self->custnum;
4063   $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
4064
4065   map { $_ } #behavior of sort undefined in scalar context
4066     sort { $a->paybatchnum <=> $b->paybatchnum }
4067       qsearch($opt);
4068 }
4069
4070 =item cust_pay_pending
4071
4072 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
4073 (without status "done").
4074
4075 =cut
4076
4077 sub cust_pay_pending {
4078   my $self = shift;
4079   return $self->num_cust_pay_pending unless wantarray;
4080   sort { $a->_date <=> $b->_date }
4081     qsearch( 'cust_pay_pending', {
4082                                    'custnum' => $self->custnum,
4083                                    'status'  => { op=>'!=', value=>'done' },
4084                                  },
4085            );
4086 }
4087
4088 =item cust_pay_pending_attempt
4089
4090 Returns all payment attempts / declined payments for this customer, as pending
4091 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
4092 a corresponding payment (see L<FS::cust_pay>).
4093
4094 =cut
4095
4096 sub cust_pay_pending_attempt {
4097   my $self = shift;
4098   return $self->num_cust_pay_pending_attempt unless wantarray;
4099   sort { $a->_date <=> $b->_date }
4100     qsearch( 'cust_pay_pending', {
4101                                    'custnum' => $self->custnum,
4102                                    'status'  => 'done',
4103                                    'paynum'  => '',
4104                                  },
4105            );
4106 }
4107
4108 =item num_cust_pay_pending
4109
4110 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
4111 customer (without status "done").  Also called automatically when the
4112 cust_pay_pending method is used in a scalar context.
4113
4114 =cut
4115
4116 sub num_cust_pay_pending {
4117   my $self = shift;
4118   $self->scalar_sql(
4119     " SELECT COUNT(*) FROM cust_pay_pending ".
4120       " WHERE custnum = ? AND status != 'done' ",
4121     $self->custnum
4122   );
4123 }
4124
4125 =item num_cust_pay_pending_attempt
4126
4127 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
4128 customer, with status "done" but without a corresp.  Also called automatically when the
4129 cust_pay_pending method is used in a scalar context.
4130
4131 =cut
4132
4133 sub num_cust_pay_pending_attempt {
4134   my $self = shift;
4135   $self->scalar_sql(
4136     " SELECT COUNT(*) FROM cust_pay_pending ".
4137       " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
4138     $self->custnum
4139   );
4140 }
4141
4142 =item cust_refund
4143
4144 Returns all the refunds (see L<FS::cust_refund>) for this customer.
4145
4146 =cut
4147
4148 sub cust_refund {
4149   my $self = shift;
4150   map { $_ } #return $self->num_cust_refund unless wantarray;
4151   sort { $a->_date <=> $b->_date }
4152     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
4153 }
4154
4155 =item display_custnum
4156
4157 Returns the displayed customer number for this customer: agent_custid if
4158 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
4159
4160 =cut
4161
4162 sub display_custnum {
4163   my $self = shift;
4164
4165   return $self->agent_custid
4166     if $default_agent_custid && $self->agent_custid;
4167
4168   my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
4169
4170   if ( $prefix ) {
4171     return $prefix .
4172            sprintf('%0'.($custnum_display_length||8).'d', $self->custnum)
4173   } elsif ( $custnum_display_length ) {
4174     return sprintf('%0'.$custnum_display_length.'d', $self->custnum);
4175   } else {
4176     return $self->custnum;
4177   }
4178 }
4179
4180 =item name
4181
4182 Returns a name string for this customer, either "Company (Last, First)" or
4183 "Last, First".
4184
4185 =cut
4186
4187 sub name {
4188   my $self = shift;
4189   my $name = $self->contact;
4190   $name = $self->company. " ($name)" if $self->company;
4191   $name;
4192 }
4193
4194 =item service_contact
4195
4196 Returns the L<FS::contact> object for this customer that has the 'Service'
4197 contact class, or undef if there is no such contact.  Deprecated; don't use
4198 this in new code.
4199
4200 =cut
4201
4202 sub service_contact {
4203   my $self = shift;
4204   if ( !exists($self->{service_contact}) ) {
4205     my $classnum = $self->scalar_sql(
4206       'SELECT classnum FROM contact_class WHERE classname = \'Service\''
4207     ) || 0; #if it's zero, qsearchs will return nothing
4208     $self->{service_contact} = qsearchs('contact', {
4209         'classnum' => $classnum, 'custnum' => $self->custnum
4210       }) || undef;
4211   }
4212   $self->{service_contact};
4213 }
4214
4215 =item ship_name
4216
4217 Returns a name string for this (service/shipping) contact, either
4218 "Company (Last, First)" or "Last, First".
4219
4220 =cut
4221
4222 sub ship_name {
4223   my $self = shift;
4224
4225   my $name = $self->ship_contact;
4226   $name = $self->company. " ($name)" if $self->company;
4227   $name;
4228 }
4229
4230 =item name_short
4231
4232 Returns a name string for this customer, either "Company" or "First Last".
4233
4234 =cut
4235
4236 sub name_short {
4237   my $self = shift;
4238   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
4239 }
4240
4241 =item ship_name_short
4242
4243 Returns a name string for this (service/shipping) contact, either "Company"
4244 or "First Last".
4245
4246 =cut
4247
4248 sub ship_name_short {
4249   my $self = shift;
4250   $self->service_contact
4251     ? $self->ship_contact_firstlast
4252     : $self->name_short
4253 }
4254
4255 =item contact
4256
4257 Returns this customer's full (billing) contact name only, "Last, First"
4258
4259 =cut
4260
4261 sub contact {
4262   my $self = shift;
4263   $self->get('last'). ', '. $self->first;
4264 }
4265
4266 =item ship_contact
4267
4268 Returns this customer's full (shipping) contact name only, "Last, First"
4269
4270 =cut
4271
4272 sub ship_contact {
4273   my $self = shift;
4274   my $contact = $self->service_contact || $self;
4275   $contact->get('last') . ', ' . $contact->get('first');
4276 }
4277
4278 =item contact_firstlast
4279
4280 Returns this customers full (billing) contact name only, "First Last".
4281
4282 =cut
4283
4284 sub contact_firstlast {
4285   my $self = shift;
4286   $self->first. ' '. $self->get('last');
4287 }
4288
4289 =item ship_contact_firstlast
4290
4291 Returns this customer's full (shipping) contact name only, "First Last".
4292
4293 =cut
4294
4295 sub ship_contact_firstlast {
4296   my $self = shift;
4297   my $contact = $self->service_contact || $self;
4298   $contact->get('first') . ' '. $contact->get('last');
4299 }
4300
4301 sub bill_country_full {
4302   my $self = shift;
4303   $self->bill_location->country_full;
4304 }
4305
4306 sub ship_country_full {
4307   my $self = shift;
4308   $self->ship_location->country_full;
4309 }
4310
4311 =item county_state_county [ PREFIX ]
4312
4313 Returns a string consisting of just the county, state and country.
4314
4315 =cut
4316
4317 sub county_state_country {
4318   my $self = shift;
4319   my $locationnum;
4320   if ( @_ && $_[0] && $self->has_ship_address ) {
4321     $locationnum = $self->ship_locationnum;
4322   } else {
4323     $locationnum = $self->bill_locationnum;
4324   }
4325   my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
4326   $cust_location->county_state_country;
4327 }
4328
4329 =item geocode DATA_VENDOR
4330
4331 Returns a value for the customer location as encoded by DATA_VENDOR.
4332 Currently this only makes sense for "CCH" as DATA_VENDOR.
4333
4334 =cut
4335
4336 =item cust_status
4337
4338 =item status
4339
4340 Returns a status string for this customer, currently:
4341
4342 =over 4
4343
4344 =item prospect - No packages have ever been ordered
4345
4346 =item ordered - Recurring packages all are new (not yet billed).
4347
4348 =item active - One or more recurring packages is active
4349
4350 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4351
4352 =item suspended - All non-cancelled recurring packages are suspended
4353
4354 =item cancelled - All recurring packages are cancelled
4355
4356 =back
4357
4358 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4359 cust_main-status_module configuration option.
4360
4361 =cut
4362
4363 sub status { shift->cust_status(@_); }
4364
4365 sub cust_status {
4366   my $self = shift;
4367   return $self->hashref->{cust_status} if $self->hashref->{cust_status};
4368   for my $status ( FS::cust_main->statuses() ) {
4369     my $method = $status.'_sql';
4370     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4371     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4372     $sth->execute( ($self->custnum) x $numnum )
4373       or die "Error executing 'SELECT $sql': ". $sth->errstr;
4374     if ( $sth->fetchrow_arrayref->[0] ) {
4375       $self->hashref->{cust_status} = $status;
4376       return $status;
4377     }
4378   }
4379 }
4380
4381 =item is_status_delay_cancel
4382
4383 Returns true if customer status is 'suspended'
4384 and all suspended cust_pkg return true for
4385 cust_pkg->is_status_delay_cancel.
4386
4387 This is not a real status, this only meant for hacking display
4388 values, because otherwise treating the customer as suspended is
4389 really the whole point of the delay_cancel option.
4390
4391 =cut
4392
4393 sub is_status_delay_cancel {
4394   my ($self) = @_;
4395   return 0 unless $self->status eq 'suspended';
4396   foreach my $cust_pkg ($self->ncancelled_pkgs) {
4397     return 0 unless $cust_pkg->is_status_delay_cancel;
4398   }
4399   return 1;
4400 }
4401
4402 =item ucfirst_cust_status
4403
4404 =item ucfirst_status
4405
4406 Returns the status with the first character capitalized.
4407
4408 =cut
4409
4410 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4411
4412 sub ucfirst_cust_status {
4413   my $self = shift;
4414   ucfirst($self->cust_status);
4415 }
4416
4417 =item statuscolor
4418
4419 Returns a hex triplet color string for this customer's status.
4420
4421 =cut
4422
4423 sub statuscolor { shift->cust_statuscolor(@_); }
4424
4425 sub cust_statuscolor {
4426   my $self = shift;
4427   __PACKAGE__->statuscolors->{$self->cust_status};
4428 }
4429
4430 =item tickets [ STATUS ]
4431
4432 Returns an array of hashes representing the customer's RT tickets.
4433
4434 An optional status (or arrayref or hashref of statuses) may be specified.
4435
4436 =cut
4437
4438 sub tickets {
4439   my $self = shift;
4440   my $status = ( @_ && $_[0] ) ? shift : '';
4441
4442   my $num = $conf->config('cust_main-max_tickets') || 10;
4443   my @tickets = ();
4444
4445   if ( $conf->config('ticket_system') ) {
4446     unless ( $conf->config('ticket_system-custom_priority_field') ) {
4447
4448       @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
4449                                                         $num,
4450                                                         undef,
4451                                                         $status,
4452                                                       )
4453                   };
4454
4455     } else {
4456
4457       foreach my $priority (
4458         $conf->config('ticket_system-custom_priority_field-values'), ''
4459       ) {
4460         last if scalar(@tickets) >= $num;
4461         push @tickets,
4462           @{ FS::TicketSystem->customer_tickets( $self->custnum,
4463                                                  $num - scalar(@tickets),
4464                                                  $priority,
4465                                                  $status,
4466                                                )
4467            };
4468       }
4469     }
4470   }
4471   (@tickets);
4472 }
4473
4474 =item appointments [ STATUS ]
4475
4476 Returns an array of hashes representing the customer's RT tickets which
4477 are appointments.
4478
4479 =cut
4480
4481 sub appointments {
4482   my $self = shift;
4483   my $status = ( @_ && $_[0] ) ? shift : '';
4484
4485   return () unless $conf->config('ticket_system');
4486
4487   my $queueid = $conf->config('ticket_system-appointment-queueid');
4488
4489   @{ FS::TicketSystem->customer_tickets( $self->custnum,
4490                                          99,
4491                                          undef,
4492                                          $status,
4493                                          $queueid,
4494                                        )
4495   };
4496 }
4497
4498 # Return services representing svc_accts in customer support packages
4499 sub support_services {
4500   my $self = shift;
4501   my %packages = map { $_ => 1 } $conf->config('support_packages');
4502
4503   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4504     grep { $_->part_svc->svcdb eq 'svc_acct' }
4505     map { $_->cust_svc }
4506     grep { exists $packages{ $_->pkgpart } }
4507     $self->ncancelled_pkgs;
4508
4509 }
4510
4511 # Return a list of latitude/longitude for one of the services (if any)
4512 sub service_coordinates {
4513   my $self = shift;
4514
4515   my @svc_X =
4516     grep { $_->latitude && $_->longitude }
4517     map { $_->svc_x }
4518     map { $_->cust_svc }
4519     $self->ncancelled_pkgs;
4520
4521   scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4522 }
4523
4524 =item masked FIELD
4525
4526 Returns a masked version of the named field
4527
4528 =cut
4529
4530 sub masked {
4531 my ($self,$field) = @_;
4532
4533 # Show last four
4534
4535 'x'x(length($self->getfield($field))-4).
4536   substr($self->getfield($field), (length($self->getfield($field))-4));
4537
4538 }
4539
4540 =item payment_history
4541
4542 Returns an array of hashrefs standardizing information from cust_bill, cust_pay,
4543 cust_credit and cust_refund objects.  Each hashref has the following fields:
4544
4545 I<type> - one of 'Line item', 'Invoice', 'Payment', 'Credit', 'Refund' or 'Previous'
4546
4547 I<date> - value of _date field, unix timestamp
4548
4549 I<date_pretty> - user-friendly date
4550
4551 I<description> - user-friendly description of item
4552
4553 I<amount> - impact of item on user's balance
4554 (positive for Invoice/Refund/Line item, negative for Payment/Credit.)
4555 Not to be confused with the native 'amount' field in cust_credit, see below.
4556
4557 I<amount_pretty> - includes money char
4558
4559 I<balance> - customer balance, chronologically as of this item
4560
4561 I<balance_pretty> - includes money char
4562
4563 I<charged> - amount charged for cust_bill (Invoice or Line item) records, undef for other types
4564
4565 I<paid> - amount paid for cust_pay records, undef for other types
4566
4567 I<credit> - amount credited for cust_credit records, undef for other types.
4568 Literally the 'amount' field from cust_credit, renamed here to avoid confusion.
4569
4570 I<refund> - amount refunded for cust_refund records, undef for other types
4571
4572 The four table-specific keys always have positive values, whether they reflect charges or payments.
4573
4574 The following options may be passed to this method:
4575
4576 I<line_items> - if true, returns charges ('Line item') rather than invoices
4577
4578 I<start_date> - unix timestamp, only include records on or after.
4579 If specified, an item of type 'Previous' will also be included.
4580 It does not have table-specific fields.
4581
4582 I<end_date> - unix timestamp, only include records before
4583
4584 I<reverse_sort> - order from newest to oldest (default is oldest to newest)
4585
4586 I<conf> - optional already-loaded FS::Conf object.
4587
4588 =cut
4589
4590 # Caution: this gets used by FS::ClientAPI::MyAccount::billing_history,
4591 # and also for sending customer statements, which should both be kept customer-friendly.
4592 # If you add anything that shouldn't be passed on through the API or exposed
4593 # to customers, add a new option to include it, don't include it by default
4594 sub payment_history {
4595   my $self = shift;
4596   my $opt = ref($_[0]) ? $_[0] : { @_ };
4597
4598   my $conf = $$opt{'conf'} || new FS::Conf;
4599   my $money_char = $conf->config("money_char") || '$',
4600
4601   #first load entire history,
4602   #need previous to calculate previous balance
4603   #loading after end_date shouldn't hurt too much?
4604   my @history = ();
4605   if ( $$opt{'line_items'} ) {
4606
4607     foreach my $cust_bill ( $self->cust_bill ) {
4608
4609       push @history, {
4610         'type'        => 'Line item',
4611         'description' => $_->desc( $self->locale ).
4612                            ( $_->sdate && $_->edate
4613                                ? ' '. time2str('%d-%b-%Y', $_->sdate).
4614                                  ' To '. time2str('%d-%b-%Y', $_->edate)
4615                                : ''
4616                            ),
4617         'amount'      => sprintf('%.2f', $_->setup + $_->recur ),
4618         'charged'     => sprintf('%.2f', $_->setup + $_->recur ),
4619         'date'        => $cust_bill->_date,
4620         'date_pretty' => $self->time2str_local('short', $cust_bill->_date ),
4621       }
4622         foreach $cust_bill->cust_bill_pkg;
4623
4624     }
4625
4626   } else {
4627
4628     push @history, {
4629                      'type'        => 'Invoice',
4630                      'description' => 'Invoice #'. $_->display_invnum,
4631                      'amount'      => sprintf('%.2f', $_->charged ),
4632                      'charged'     => sprintf('%.2f', $_->charged ),
4633                      'date'        => $_->_date,
4634                      'date_pretty' => $self->time2str_local('short', $_->_date ),
4635                    }
4636       foreach $self->cust_bill;
4637
4638   }
4639
4640   push @history, {
4641                    'type'        => 'Payment',
4642                    'description' => 'Payment', #XXX type
4643                    'amount'      => sprintf('%.2f', 0 - $_->paid ),
4644                    'paid'        => sprintf('%.2f', $_->paid ),
4645                    'date'        => $_->_date,
4646                    'date_pretty' => $self->time2str_local('short', $_->_date ),
4647                  }
4648     foreach $self->cust_pay;
4649
4650   push @history, {
4651                    'type'        => 'Credit',
4652                    'description' => 'Credit', #more info?
4653                    'amount'      => sprintf('%.2f', 0 -$_->amount ),
4654                    'credit'      => sprintf('%.2f', $_->amount ),
4655                    'date'        => $_->_date,
4656                    'date_pretty' => $self->time2str_local('short', $_->_date ),
4657                  }
4658     foreach $self->cust_credit;
4659
4660   push @history, {
4661                    'type'        => 'Refund',
4662                    'description' => 'Refund', #more info?  type, like payment?
4663                    'amount'      => $_->refund,
4664                    'refund'      => $_->refund,
4665                    'date'        => $_->_date,
4666                    'date_pretty' => $self->time2str_local('short', $_->_date ),
4667                  }
4668     foreach $self->cust_refund;
4669
4670   #put it all in chronological order
4671   @history = sort { $a->{'date'} <=> $b->{'date'} } @history;
4672
4673   #calculate balance, filter items outside date range
4674   my $previous = 0;
4675   my $balance = 0;
4676   my @out = ();
4677   foreach my $item (@history) {
4678     last if $$opt{'end_date'} && ($$item{'date'} >= $$opt{'end_date'});
4679     $balance += $$item{'amount'};
4680     if ($$opt{'start_date'} && ($$item{'date'} < $$opt{'start_date'})) {
4681       $previous += $$item{'amount'};
4682       next;
4683     }
4684     $$item{'balance'} = sprintf("%.2f",$balance);
4685     foreach my $key ( qw(amount balance) ) {
4686       $$item{$key.'_pretty'} = money_pretty($$item{$key});
4687     }
4688     push(@out,$item);
4689   }
4690
4691   # start with previous balance, if there was one
4692   if ($previous) {
4693     my $item = {
4694       'type'        => 'Previous',
4695       'description' => 'Previous balance',
4696       'amount'      => sprintf("%.2f",$previous),
4697       'balance'     => sprintf("%.2f",$previous),
4698       'date'        => $$opt{'start_date'},
4699       'date_pretty' => $self->time2str_local('short', $$opt{'start_date'} ),
4700     };
4701     #false laziness with above
4702     foreach my $key ( qw(amount balance) ) {
4703       $$item{$key.'_pretty'} = $$item{$key};
4704       $$item{$key.'_pretty'} =~ s/^(-?)/$1$money_char/;
4705     }
4706     unshift(@out,$item);
4707   }
4708
4709   @out = reverse @history if $$opt{'reverse_sort'};
4710
4711   return @out;
4712 }
4713
4714 =back
4715
4716 =head1 CLASS METHODS
4717
4718 =over 4
4719
4720 =item statuses
4721
4722 Class method that returns the list of possible status strings for customers
4723 (see L<the status method|/status>).  For example:
4724
4725   @statuses = FS::cust_main->statuses();
4726
4727 =cut
4728
4729 sub statuses {
4730   my $self = shift;
4731   keys %{ $self->statuscolors };
4732 }
4733
4734 =item cust_status_sql
4735
4736 Returns an SQL fragment to determine the status of a cust_main record, as a
4737 string.
4738
4739 =cut
4740
4741 sub cust_status_sql {
4742   my $sql = 'CASE';
4743   for my $status ( FS::cust_main->statuses() ) {
4744     my $method = $status.'_sql';
4745     $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4746   }
4747   $sql .= ' END';
4748   return $sql;
4749 }
4750
4751
4752 =item prospect_sql
4753
4754 Returns an SQL expression identifying prospective cust_main records (customers
4755 with no packages ever ordered)
4756
4757 =cut
4758
4759 use vars qw($select_count_pkgs);
4760 $select_count_pkgs =
4761   "SELECT COUNT(*) FROM cust_pkg
4762     WHERE cust_pkg.custnum = cust_main.custnum";
4763
4764 sub select_count_pkgs_sql {
4765   $select_count_pkgs;
4766 }
4767
4768 sub prospect_sql {
4769   " 0 = ( $select_count_pkgs ) ";
4770 }
4771
4772 =item ordered_sql
4773
4774 Returns an SQL expression identifying ordered cust_main records (customers with
4775 no active packages, but recurring packages not yet setup or one time charges
4776 not yet billed).
4777
4778 =cut
4779
4780 sub ordered_sql {
4781   FS::cust_main->none_active_sql.
4782   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4783 }
4784
4785 =item active_sql
4786
4787 Returns an SQL expression identifying active cust_main records (customers with
4788 active recurring packages).
4789
4790 =cut
4791
4792 sub active_sql {
4793   " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4794 }
4795
4796 =item none_active_sql
4797
4798 Returns an SQL expression identifying cust_main records with no active
4799 recurring packages.  This includes customers of status prospect, ordered,
4800 inactive, and suspended.
4801
4802 =cut
4803
4804 sub none_active_sql {
4805   " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4806 }
4807
4808 =item inactive_sql
4809
4810 Returns an SQL expression identifying inactive cust_main records (customers with
4811 no active recurring packages, but otherwise unsuspended/uncancelled).
4812
4813 =cut
4814
4815 sub inactive_sql {
4816   FS::cust_main->none_active_sql.
4817   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4818 }
4819
4820 =item susp_sql
4821 =item suspended_sql
4822
4823 Returns an SQL expression identifying suspended cust_main records.
4824
4825 =cut
4826
4827
4828 sub suspended_sql { susp_sql(@_); }
4829 sub susp_sql {
4830   FS::cust_main->none_active_sql.
4831   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4832 }
4833
4834 =item cancel_sql
4835 =item cancelled_sql
4836
4837 Returns an SQL expression identifying cancelled cust_main records.
4838
4839 =cut
4840
4841 sub cancel_sql { shift->cancelled_sql(@_); }
4842
4843 =item uncancel_sql
4844 =item uncancelled_sql
4845
4846 Returns an SQL expression identifying un-cancelled cust_main records.
4847
4848 =cut
4849
4850 sub uncancelled_sql { uncancel_sql(@_); }
4851 sub uncancel_sql { "
4852   ( 0 < ( $select_count_pkgs
4853                    AND ( cust_pkg.cancel IS NULL
4854                          OR cust_pkg.cancel = 0
4855                        )
4856         )
4857     OR 0 = ( $select_count_pkgs )
4858   )
4859 "; }
4860
4861 =item balance_sql
4862
4863 Returns an SQL fragment to retreive the balance.
4864
4865 =cut
4866
4867 sub balance_sql { "
4868     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4869         WHERE cust_bill.custnum   = cust_main.custnum     )
4870   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
4871         WHERE cust_pay.custnum    = cust_main.custnum     )
4872   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
4873         WHERE cust_credit.custnum = cust_main.custnum     )
4874   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
4875         WHERE cust_refund.custnum = cust_main.custnum     )
4876 "; }
4877
4878 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4879
4880 Returns an SQL fragment to retreive the balance for this customer, optionally
4881 considering invoices with date earlier than START_TIME, and not
4882 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4883 total_unapplied_payments).
4884
4885 Times are specified as SQL fragments or numeric
4886 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4887 L<Date::Parse> for conversion functions.  The empty string can be passed
4888 to disable that time constraint completely.
4889
4890 Available options are:
4891
4892 =over 4
4893
4894 =item unapplied_date
4895
4896 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)
4897
4898 =item total
4899
4900 (unused.  obsolete?)
4901 set to true to remove all customer comparison clauses, for totals
4902
4903 =item where
4904
4905 (unused.  obsolete?)
4906 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4907
4908 =item join
4909
4910 (unused.  obsolete?)
4911 JOIN clause (typically used with the total option)
4912
4913 =item cutoff
4914
4915 An absolute cutoff time.  Payments, credits, and refunds I<applied> after this
4916 time will be ignored.  Note that START_TIME and END_TIME only limit the date
4917 range for invoices and I<unapplied> payments, credits, and refunds.
4918
4919 =back
4920
4921 =cut
4922
4923 sub balance_date_sql {
4924   my( $class, $start, $end, %opt ) = @_;
4925
4926   my $cutoff = $opt{'cutoff'};
4927
4928   my $owed         = FS::cust_bill->owed_sql($cutoff);
4929   my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4930   my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4931   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4932
4933   my $j = $opt{'join'} || '';
4934
4935   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
4936   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4937   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4938   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
4939
4940   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
4941     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4942     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4943     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
4944   ";
4945
4946 }
4947
4948 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4949
4950 Returns an SQL fragment to retreive the total unapplied payments for this
4951 customer, only considering payments with date earlier than START_TIME, and
4952 optionally not later than END_TIME.
4953
4954 Times are specified as SQL fragments or numeric
4955 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4956 L<Date::Parse> for conversion functions.  The empty string can be passed
4957 to disable that time constraint completely.
4958
4959 Available options are:
4960
4961 =cut
4962
4963 sub unapplied_payments_date_sql {
4964   my( $class, $start, $end, %opt ) = @_;
4965
4966   my $cutoff = $opt{'cutoff'};
4967
4968   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4969
4970   my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4971                                                           'unapplied_date'=>1 );
4972
4973   " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4974 }
4975
4976 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4977
4978 Helper method for balance_date_sql; name (and usage) subject to change
4979 (suggestions welcome).
4980
4981 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4982 cust_refund, cust_credit or cust_pay).
4983
4984 If TABLE is "cust_bill" or the unapplied_date option is true, only
4985 considers records with date earlier than START_TIME, and optionally not
4986 later than END_TIME .
4987
4988 =cut
4989
4990 sub _money_table_where {
4991   my( $class, $table, $start, $end, %opt ) = @_;
4992
4993   my @where = ();
4994   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4995   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4996     push @where, "$table._date <= $start" if defined($start) && length($start);
4997     push @where, "$table._date >  $end"   if defined($end)   && length($end);
4998   }
4999   push @where, @{$opt{'where'}} if $opt{'where'};
5000   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
5001
5002   $where;
5003
5004 }
5005
5006 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
5007 use FS::cust_main::Search;
5008 sub search {
5009   my $class = shift;
5010   FS::cust_main::Search->search(@_);
5011 }
5012
5013 =back
5014
5015 =head1 SUBROUTINES
5016
5017 =over 4
5018
5019 =item batch_charge
5020
5021 =cut
5022
5023 sub batch_charge {
5024   my $param = shift;
5025   #warn join('-',keys %$param);
5026   my $fh = $param->{filehandle};
5027   my $agentnum = $param->{agentnum};
5028   my $format = $param->{format};
5029
5030   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
5031
5032   my @fields;
5033   if ( $format eq 'simple' ) {
5034     @fields = qw( custnum agent_custid amount pkg );
5035   } else {
5036     die "unknown format $format";
5037   }
5038
5039   eval "use Text::CSV_XS;";
5040   die $@ if $@;
5041
5042   my $csv = new Text::CSV_XS;
5043   #warn $csv;
5044   #warn $fh;
5045
5046   my $imported = 0;
5047   #my $columns;
5048
5049   local $SIG{HUP} = 'IGNORE';
5050   local $SIG{INT} = 'IGNORE';
5051   local $SIG{QUIT} = 'IGNORE';
5052   local $SIG{TERM} = 'IGNORE';
5053   local $SIG{TSTP} = 'IGNORE';
5054   local $SIG{PIPE} = 'IGNORE';
5055
5056   my $oldAutoCommit = $FS::UID::AutoCommit;
5057   local $FS::UID::AutoCommit = 0;
5058   my $dbh = dbh;
5059
5060   #while ( $columns = $csv->getline($fh) ) {
5061   my $line;
5062   while ( defined($line=<$fh>) ) {
5063
5064     $csv->parse($line) or do {
5065       $dbh->rollback if $oldAutoCommit;
5066       return "can't parse: ". $csv->error_input();
5067     };
5068
5069     my @columns = $csv->fields();
5070     #warn join('-',@columns);
5071
5072     my %row = ();
5073     foreach my $field ( @fields ) {
5074       $row{$field} = shift @columns;
5075     }
5076
5077     if ( $row{custnum} && $row{agent_custid} ) {
5078       dbh->rollback if $oldAutoCommit;
5079       return "can't specify custnum with agent_custid $row{agent_custid}";
5080     }
5081
5082     my %hash = ();
5083     if ( $row{agent_custid} && $agentnum ) {
5084       %hash = ( 'agent_custid' => $row{agent_custid},
5085                 'agentnum'     => $agentnum,
5086               );
5087     }
5088
5089     if ( $row{custnum} ) {
5090       %hash = ( 'custnum' => $row{custnum} );
5091     }
5092
5093     unless ( scalar(keys %hash) ) {
5094       $dbh->rollback if $oldAutoCommit;
5095       return "can't find customer without custnum or agent_custid and agentnum";
5096     }
5097
5098     my $cust_main = qsearchs('cust_main', { %hash } );
5099     unless ( $cust_main ) {
5100       $dbh->rollback if $oldAutoCommit;
5101       my $custnum = $row{custnum} || $row{agent_custid};
5102       return "unknown custnum $custnum";
5103     }
5104
5105     if ( $row{'amount'} > 0 ) {
5106       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
5107       if ( $error ) {
5108         $dbh->rollback if $oldAutoCommit;
5109         return $error;
5110       }
5111       $imported++;
5112     } elsif ( $row{'amount'} < 0 ) {
5113       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
5114                                       $row{'pkg'}                         );
5115       if ( $error ) {
5116         $dbh->rollback if $oldAutoCommit;
5117         return $error;
5118       }
5119       $imported++;
5120     } else {
5121       #hmm?
5122     }
5123
5124   }
5125
5126   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5127
5128   return "Empty file!" unless $imported;
5129
5130   ''; #no error
5131
5132 }
5133
5134 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5135
5136 Deprecated.  Use event notification and message templates
5137 (L<FS::msg_template>) instead.
5138
5139 Sends a templated email notification to the customer (see L<Text::Template>).
5140
5141 OPTIONS is a hash and may include
5142
5143 I<from> - the email sender (default is invoice_from)
5144
5145 I<to> - comma-separated scalar or arrayref of recipients
5146    (default is invoicing_list)
5147
5148 I<subject> - The subject line of the sent email notification
5149    (default is "Notice from company_name")
5150
5151 I<extra_fields> - a hashref of name/value pairs which will be substituted
5152    into the template
5153
5154 The following variables are vavailable in the template.
5155
5156 I<$first> - the customer first name
5157 I<$last> - the customer last name
5158 I<$company> - the customer company
5159 I<$payby> - a description of the method of payment for the customer
5160             # would be nice to use FS::payby::shortname
5161 I<$payinfo> - the account information used to collect for this customer
5162 I<$expdate> - the expiration of the customer payment in seconds from epoch
5163
5164 =cut
5165
5166 sub notify {
5167   my ($self, $template, %options) = @_;
5168
5169   return unless $conf->exists($template);
5170
5171   my $from = $conf->invoice_from_full($self->agentnum)
5172     if $conf->exists('invoice_from', $self->agentnum);
5173   $from = $options{from} if exists($options{from});
5174
5175   my $to = join(',', $self->invoicing_list_emailonly);
5176   $to = $options{to} if exists($options{to});
5177
5178   my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
5179     if $conf->exists('company_name', $self->agentnum);
5180   $subject = $options{subject} if exists($options{subject});
5181
5182   my $notify_template = new Text::Template (TYPE => 'ARRAY',
5183                                             SOURCE => [ map "$_\n",
5184                                               $conf->config($template)]
5185                                            )
5186     or die "can't create new Text::Template object: Text::Template::ERROR";
5187   $notify_template->compile()
5188     or die "can't compile template: Text::Template::ERROR";
5189
5190   $FS::notify_template::_template::company_name =
5191     $conf->config('company_name', $self->agentnum);
5192   $FS::notify_template::_template::company_address =
5193     join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
5194
5195   my $paydate = $self->paydate || '2037-12-31';
5196   $FS::notify_template::_template::first = $self->first;
5197   $FS::notify_template::_template::last = $self->last;
5198   $FS::notify_template::_template::company = $self->company;
5199   $FS::notify_template::_template::payinfo = $self->mask_payinfo;
5200   my $payby = $self->payby;
5201   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5202   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5203
5204   #credit cards expire at the end of the month/year of their exp date
5205   if ($payby eq 'CARD' || $payby eq 'DCRD') {
5206     $FS::notify_template::_template::payby = 'credit card';
5207     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5208     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5209     $expire_time--;
5210   }elsif ($payby eq 'COMP') {
5211     $FS::notify_template::_template::payby = 'complimentary account';
5212   }else{
5213     $FS::notify_template::_template::payby = 'current method';
5214   }
5215   $FS::notify_template::_template::expdate = $expire_time;
5216
5217   for (keys %{$options{extra_fields}}){
5218     no strict "refs";
5219     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
5220   }
5221
5222   send_email(from => $from,
5223              to => $to,
5224              subject => $subject,
5225              body => $notify_template->fill_in( PACKAGE =>
5226                                                 'FS::notify_template::_template'                                              ),
5227             );
5228
5229 }
5230
5231 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5232
5233 Generates a templated notification to the customer (see L<Text::Template>).
5234
5235 OPTIONS is a hash and may include
5236
5237 I<extra_fields> - a hashref of name/value pairs which will be substituted
5238    into the template.  These values may override values mentioned below
5239    and those from the customer record.
5240
5241 I<template_text> - if present, ignores TEMPLATE_NAME and uses the provided text
5242
5243 The following variables are available in the template instead of or in addition
5244 to the fields of the customer record.
5245
5246 I<$payby> - a description of the method of payment for the customer
5247             # would be nice to use FS::payby::shortname
5248 I<$payinfo> - the masked account information used to collect for this customer
5249 I<$expdate> - the expiration of the customer payment method in seconds from epoch
5250 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
5251
5252 =cut
5253
5254 # a lot like cust_bill::print_latex
5255 sub generate_letter {
5256   my ($self, $template, %options) = @_;
5257
5258   warn "Template $template does not exist" && return
5259     unless $conf->exists($template) || $options{'template_text'};
5260
5261   my $template_source = $options{'template_text'}
5262                         ? [ $options{'template_text'} ]
5263                         : [ map "$_\n", $conf->config($template) ];
5264
5265   my $letter_template = new Text::Template
5266                         ( TYPE       => 'ARRAY',
5267                           SOURCE     => $template_source,
5268                           DELIMITERS => [ '[@--', '--@]' ],
5269                         )
5270     or die "can't create new Text::Template object: Text::Template::ERROR";
5271
5272   $letter_template->compile()
5273     or die "can't compile template: Text::Template::ERROR";
5274
5275   my %letter_data = map { $_ => $self->$_ } $self->fields;
5276   $letter_data{payinfo} = $self->mask_payinfo;
5277
5278   #my $paydate = $self->paydate || '2037-12-31';
5279   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
5280
5281   my $payby = $self->payby;
5282   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5283   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5284
5285   #credit cards expire at the end of the month/year of their exp date
5286   if ($payby eq 'CARD' || $payby eq 'DCRD') {
5287     $letter_data{payby} = 'credit card';
5288     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5289     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5290     $expire_time--;
5291   }elsif ($payby eq 'COMP') {
5292     $letter_data{payby} = 'complimentary account';
5293   }else{
5294     $letter_data{payby} = 'current method';
5295   }
5296   $letter_data{expdate} = $expire_time;
5297
5298   for (keys %{$options{extra_fields}}){
5299     $letter_data{$_} = $options{extra_fields}->{$_};
5300   }
5301
5302   unless(exists($letter_data{returnaddress})){
5303     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
5304                                                   $self->agent_template)
5305                      );
5306     if ( length($retadd) ) {
5307       $letter_data{returnaddress} = $retadd;
5308     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
5309       $letter_data{returnaddress} =
5310         join( "\n", map { s/( {2,})/'~' x length($1)/eg;
5311                           s/$/\\\\\*/;
5312                           $_;
5313                         }
5314                     ( $conf->config('company_name', $self->agentnum),
5315                       $conf->config('company_address', $self->agentnum),
5316                     )
5317         );
5318     } else {
5319       $letter_data{returnaddress} = '~';
5320     }
5321   }
5322
5323   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
5324
5325   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
5326
5327   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
5328
5329   my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5330                            DIR      => $dir,
5331                            SUFFIX   => '.eps',
5332                            UNLINK   => 0,
5333                          ) or die "can't open temp file: $!\n";
5334   print $lh $conf->config_binary('logo.eps', $self->agentnum)
5335     or die "can't write temp file: $!\n";
5336   close $lh;
5337   $letter_data{'logo_file'} = $lh->filename;
5338
5339   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5340                            DIR      => $dir,
5341                            SUFFIX   => '.tex',
5342                            UNLINK   => 0,
5343                          ) or die "can't open temp file: $!\n";
5344
5345   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
5346   close $fh;
5347   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
5348   return ($1, $letter_data{'logo_file'});
5349
5350 }
5351
5352 =item print_ps TEMPLATE
5353
5354 Returns an postscript letter filled in from TEMPLATE, as a scalar.
5355
5356 =cut
5357
5358 sub print_ps {
5359   my $self = shift;
5360   my($file, $lfile) = $self->generate_letter(@_);
5361   my $ps = FS::Misc::generate_ps($file);
5362   unlink($file.'.tex');
5363   unlink($lfile);
5364
5365   $ps;
5366 }
5367
5368 =item print TEMPLATE
5369
5370 Prints the filled in template.
5371
5372 TEMPLATE is the name of a L<Text::Template> to fill in and print.
5373
5374 =cut
5375
5376 sub queueable_print {
5377   my %opt = @_;
5378
5379   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
5380     or die "invalid customer number: " . $opt{custnum};
5381
5382   my $error = $self->print( { 'template' => $opt{template} } );
5383   die $error if $error;
5384 }
5385
5386 sub print {
5387   my ($self, $template) = (shift, shift);
5388   do_print(
5389     [ $self->print_ps($template) ],
5390     'agentnum' => $self->agentnum,
5391   );
5392 }
5393
5394 #these three subs should just go away once agent stuff is all config overrides
5395
5396 sub agent_template {
5397   my $self = shift;
5398   $self->_agent_plandata('agent_templatename');
5399 }
5400
5401 sub agent_invoice_from {
5402   my $self = shift;
5403   $self->_agent_plandata('agent_invoice_from');
5404 }
5405
5406 sub _agent_plandata {
5407   my( $self, $option ) = @_;
5408
5409   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
5410   #agent-specific Conf
5411
5412   use FS::part_event::Condition;
5413
5414   my $agentnum = $self->agentnum;
5415
5416   my $regexp = regexp_sql();
5417
5418   my $part_event_option =
5419     qsearchs({
5420       'select'    => 'part_event_option.*',
5421       'table'     => 'part_event_option',
5422       'addl_from' => q{
5423         LEFT JOIN part_event USING ( eventpart )
5424         LEFT JOIN part_event_option AS peo_agentnum
5425           ON ( part_event.eventpart = peo_agentnum.eventpart
5426                AND peo_agentnum.optionname = 'agentnum'
5427                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
5428              )
5429         LEFT JOIN part_event_condition
5430           ON ( part_event.eventpart = part_event_condition.eventpart
5431                AND part_event_condition.conditionname = 'cust_bill_age'
5432              )
5433         LEFT JOIN part_event_condition_option
5434           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
5435                AND part_event_condition_option.optionname = 'age'
5436              )
5437       },
5438       #'hashref'   => { 'optionname' => $option },
5439       #'hashref'   => { 'part_event_option.optionname' => $option },
5440       'extra_sql' =>
5441         " WHERE part_event_option.optionname = ". dbh->quote($option).
5442         " AND action = 'cust_bill_send_agent' ".
5443         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
5444         " AND peo_agentnum.optionname = 'agentnum' ".
5445         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
5446         " ORDER BY
5447            CASE WHEN part_event_condition_option.optionname IS NULL
5448            THEN -1
5449            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
5450         " END
5451           , part_event.weight".
5452         " LIMIT 1"
5453     });
5454
5455   unless ( $part_event_option ) {
5456     return $self->agent->invoice_template || ''
5457       if $option eq 'agent_templatename';
5458     return '';
5459   }
5460
5461   $part_event_option->optionvalue;
5462
5463 }
5464
5465 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5466
5467 Subroutine (not a method), designed to be called from the queue.
5468
5469 Takes a list of options and values.
5470
5471 Pulls up the customer record via the custnum option and calls bill_and_collect.
5472
5473 =cut
5474
5475 sub queued_bill {
5476   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5477
5478   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5479   warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5480
5481   #without this errors don't get rolled back
5482   $args{'fatal'} = 1; # runs from job queue, will be caught
5483
5484   $cust_main->bill_and_collect( %args );
5485 }
5486
5487 sub process_bill_and_collect {
5488   my $job = shift;
5489   my $param = thaw(decode_base64(shift));
5490   my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5491       or die "custnum '$param->{custnum}' not found!\n";
5492   $param->{'job'}   = $job;
5493   $param->{'fatal'} = 1; # runs from job queue, will be caught
5494   $param->{'retry'} = 1;
5495
5496   $cust_main->bill_and_collect( %$param );
5497 }
5498
5499 #starting to take quite a while for big dbs
5500 #   (JRNL: journaled so it only happens once per database)
5501 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
5502 # JRNL seq scan of cust_main on signupdate... index signupdate?  will that help?
5503 # JRNL seq scan of cust_main on paydate... index on substrings?  maybe set an
5504 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
5505 # JRNL leading/trailing spaces in first, last, company
5506 # - otaker upgrade?  journal and call it good?  (double check to make sure
5507 #    we're not still setting otaker here)
5508 #
5509 #only going to get worse with new location stuff...
5510
5511 sub _upgrade_data { #class method
5512   my ($class, %opts) = @_;
5513
5514   my @statements = (
5515     'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
5516   );
5517
5518   #this seems to be the only expensive one.. why does it take so long?
5519   unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
5520     push @statements,
5521       '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';
5522     FS::upgrade_journal->set_done('cust_main__signupdate');
5523   }
5524
5525   unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) {
5526
5527     # fix yyyy-m-dd formatted paydates
5528     if ( driver_name =~ /^mysql/i ) {
5529       push @statements,
5530       "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5531     } else { # the SQL standard
5532       push @statements,
5533       "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5534     }
5535     FS::upgrade_journal->set_done('cust_main__paydate');
5536   }
5537
5538   unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) {
5539
5540     push @statements, #fix the weird BILL with a cc# in payinfo problem
5541       #DCRD to be safe
5542       "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
5543
5544     FS::upgrade_journal->set_done('cust_main__payinfo');
5545
5546   }
5547
5548   my $t = time;
5549   foreach my $sql ( @statements ) {
5550     my $sth = dbh->prepare($sql) or die dbh->errstr;
5551     $sth->execute or die $sth->errstr;
5552     #warn ( (time - $t). " seconds\n" );
5553     #$t = time;
5554   }
5555
5556   local($ignore_expired_card) = 1;
5557   local($ignore_banned_card) = 1;
5558   local($skip_fuzzyfiles) = 1;
5559   local($import) = 1; #prevent automatic geocoding (need its own variable?)
5560
5561   FS::cust_main::Location->_upgrade_data(%opts);
5562
5563   unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
5564
5565     foreach my $cust_main ( qsearch({
5566       'table'     => 'cust_main',
5567       'hashref'   => {},
5568       'extra_sql' => 'WHERE '.
5569                        join(' OR ',
5570                          map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '%  %'",
5571                            qw( first last company )
5572                        ),
5573     }) ) {
5574       my $error = $cust_main->replace;
5575       die $error if $error;
5576     }
5577
5578     FS::upgrade_journal->set_done('cust_main__trimspaces');
5579
5580   }
5581
5582   $class->_upgrade_otaker(%opts);
5583
5584 }
5585
5586 =back
5587
5588 =head1 BUGS
5589
5590 The delete method.
5591
5592 The delete method should possibly take an FS::cust_main object reference
5593 instead of a scalar customer number.
5594
5595 Bill and collect options should probably be passed as references instead of a
5596 list.
5597
5598 There should probably be a configuration file with a list of allowed credit
5599 card types.
5600
5601 No multiple currency support (probably a larger project than just this module).
5602
5603 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5604
5605 Birthdates rely on negative epoch values.
5606
5607 The payby for card/check batches is broken.  With mixed batching, bad
5608 things will happen.
5609
5610 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5611
5612 =head1 SEE ALSO
5613
5614 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5615 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5616 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
5617
5618 =cut
5619
5620 1;
5621