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