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