FS/FS/cust_main.pm

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