FS/FS/cust_main.pm

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