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