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