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|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 = "_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 sub charge {
3078   my $self = shift;
3079   my ( $amount, $setup_cost, $quantity, $start_date, $classnum );
3080   my ( $pkg, $comment, $additional );
3081   my ( $setuptax, $taxclass );   #internal taxes
3082   my ( $taxproduct, $override ); #vendor (CCH) taxes
3083   my $no_auto = '';
3084   my $cust_pkg_ref = '';
3085   my ( $bill_now, $invoice_terms ) = ( 0, '' );
3086   my $locationnum;
3087   if ( ref( $_[0] ) ) {
3088     $amount     = $_[0]->{amount};
3089     $setup_cost = $_[0]->{setup_cost};
3090     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3091     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3092     $no_auto    = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3093     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3094     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
3095                                            : '$'. sprintf("%.2f",$amount);
3096     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3097     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3098     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3099     $additional = $_[0]->{additional} || [];
3100     $taxproduct = $_[0]->{taxproductnum};
3101     $override   = { '' => $_[0]->{tax_override} };
3102     $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3103     $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3104     $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3105     $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3106   } else {
3107     $amount     = shift;
3108     $setup_cost = '';
3109     $quantity   = 1;
3110     $start_date = '';
3111     $pkg        = @_ ? shift : 'One-time charge';
3112     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
3113     $setuptax   = '';
3114     $taxclass   = @_ ? shift : '';
3115     $additional = [];
3116   }
3117
3118   local $SIG{HUP} = 'IGNORE';
3119   local $SIG{INT} = 'IGNORE';
3120   local $SIG{QUIT} = 'IGNORE';
3121   local $SIG{TERM} = 'IGNORE';
3122   local $SIG{TSTP} = 'IGNORE';
3123   local $SIG{PIPE} = 'IGNORE';
3124
3125   my $oldAutoCommit = $FS::UID::AutoCommit;
3126   local $FS::UID::AutoCommit = 0;
3127   my $dbh = dbh;
3128
3129   my $part_pkg = new FS::part_pkg ( {
3130     'pkg'           => $pkg,
3131     'comment'       => $comment,
3132     'plan'          => 'flat',
3133     'freq'          => 0,
3134     'disabled'      => 'Y',
3135     'classnum'      => ( $classnum ? $classnum : '' ),
3136     'setuptax'      => $setuptax,
3137     'taxclass'      => $taxclass,
3138     'taxproductnum' => $taxproduct,
3139     'setup_cost'    => $setup_cost,
3140   } );
3141
3142   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3143                         ( 0 .. @$additional - 1 )
3144                   ),
3145                   'additional_count' => scalar(@$additional),
3146                   'setup_fee' => $amount,
3147                 );
3148
3149   my $error = $part_pkg->insert( options       => \%options,
3150                                  tax_overrides => $override,
3151                                );
3152   if ( $error ) {
3153     $dbh->rollback if $oldAutoCommit;
3154     return $error;
3155   }
3156
3157   my $pkgpart = $part_pkg->pkgpart;
3158   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3159   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3160     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3161     $error = $type_pkgs->insert;
3162     if ( $error ) {
3163       $dbh->rollback if $oldAutoCommit;
3164       return $error;
3165     }
3166   }
3167
3168   my $cust_pkg = new FS::cust_pkg ( {
3169     'custnum'    => $self->custnum,
3170     'pkgpart'    => $pkgpart,
3171     'quantity'   => $quantity,
3172     'start_date' => $start_date,
3173     'no_auto'    => $no_auto,
3174     'locationnum'=> $locationnum,
3175   } );
3176
3177   $error = $cust_pkg->insert;
3178   if ( $error ) {
3179     $dbh->rollback if $oldAutoCommit;
3180     return $error;
3181   } elsif ( $cust_pkg_ref ) {
3182     ${$cust_pkg_ref} = $cust_pkg;
3183   }
3184
3185   if ( $bill_now ) {
3186     my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3187                              'pkg_list'      => [ $cust_pkg ],
3188                            );
3189     if ( $error ) {
3190       $dbh->rollback if $oldAutoCommit;
3191       return $error;
3192     }
3193   }
3194
3195   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3196   return '';
3197
3198 }
3199
3200 #=item charge_postal_fee
3201 #
3202 #Applies a one time charge this customer.  If there is an error,
3203 #returns the error, returns the cust_pkg charge object or false
3204 #if there was no charge.
3205 #
3206 #=cut
3207 #
3208 # This should be a customer event.  For that to work requires that bill
3209 # also be a customer event.
3210
3211 sub charge_postal_fee {
3212   my $self = shift;
3213
3214   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3215   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3216
3217   my $cust_pkg = new FS::cust_pkg ( {
3218     'custnum'  => $self->custnum,
3219     'pkgpart'  => $pkgpart,
3220     'quantity' => 1,
3221   } );
3222
3223   my $error = $cust_pkg->insert;
3224   $error ? $error : $cust_pkg;
3225 }
3226
3227 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3228
3229 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3230
3231 Optionally, a list or hashref of additional arguments to the qsearch call can
3232 be passed.
3233
3234 =cut
3235
3236 sub cust_bill {
3237   my $self = shift;
3238   my $opt = ref($_[0]) ? shift : { @_ };
3239
3240   #return $self->num_cust_bill unless wantarray || keys %$opt;
3241
3242   $opt->{'table'} = 'cust_bill';
3243   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3244   $opt->{'hashref'}{'custnum'} = $self->custnum;
3245   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3246
3247   map { $_ } #behavior of sort undefined in scalar context
3248     sort { $a->_date <=> $b->_date }
3249       qsearch($opt);
3250 }
3251
3252 =item open_cust_bill
3253
3254 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3255 customer.
3256
3257 =cut
3258
3259 sub open_cust_bill {
3260   my $self = shift;
3261
3262   $self->cust_bill(
3263     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3264     #@_
3265   );
3266
3267 }
3268
3269 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3270
3271 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3272
3273 =cut
3274
3275 sub legacy_cust_bill {
3276   my $self = shift;
3277
3278   #return $self->num_legacy_cust_bill unless wantarray;
3279
3280   map { $_ } #behavior of sort undefined in scalar context
3281     sort { $a->_date <=> $b->_date }
3282       qsearch({ 'table'    => 'legacy_cust_bill',
3283                 'hashref'  => { 'custnum' => $self->custnum, },
3284                 'order_by' => 'ORDER BY _date ASC',
3285              });
3286 }
3287
3288 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3289
3290 Returns all the statements (see L<FS::cust_statement>) for this customer.
3291
3292 Optionally, a list or hashref of additional arguments to the qsearch call can
3293 be passed.
3294
3295 =cut
3296
3297 =item cust_bill_void
3298
3299 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3300
3301 =cut
3302
3303 sub cust_bill_void {
3304   my $self = shift;
3305
3306   map { $_ } #return $self->num_cust_bill_void unless wantarray;
3307   sort { $a->_date <=> $b->_date }
3308     qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3309 }
3310
3311 sub cust_statement {
3312   my $self = shift;
3313   my $opt = ref($_[0]) ? shift : { @_ };
3314
3315   #return $self->num_cust_statement unless wantarray || keys %$opt;
3316
3317   $opt->{'table'} = 'cust_statement';
3318   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3319   $opt->{'hashref'}{'custnum'} = $self->custnum;
3320   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3321
3322   map { $_ } #behavior of sort undefined in scalar context
3323     sort { $a->_date <=> $b->_date }
3324       qsearch($opt);
3325 }
3326
3327 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3328
3329 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3330
3331 Optionally, a list or hashref of additional arguments to the qsearch call can
3332 be passed following the SVCDB.
3333
3334 =cut
3335
3336 sub svc_x {
3337   my $self = shift;
3338   my $svcdb = shift;
3339   if ( ! $svcdb =~ /^svc_\w+$/ ) {
3340     warn "$me svc_x requires a svcdb";
3341     return;
3342   }
3343   my $opt = ref($_[0]) ? shift : { @_ };
3344
3345   $opt->{'table'} = $svcdb;
3346   $opt->{'addl_from'} =
3347     'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3348     ($opt->{'addl_from'} || '');
3349
3350   my $custnum = $self->custnum;
3351   $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3352   my $where = "cust_pkg.custnum = $custnum";
3353
3354   my $extra_sql = $opt->{'extra_sql'} || '';
3355   if ( keys %{ $opt->{'hashref'} } ) {
3356     $extra_sql = " AND $where $extra_sql";
3357   }
3358   else {
3359     if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3360       $extra_sql = "WHERE $where AND $1";
3361     }
3362     else {
3363       $extra_sql = "WHERE $where $extra_sql";
3364     }
3365   }
3366   $opt->{'extra_sql'} = $extra_sql;
3367
3368   qsearch($opt);
3369 }
3370
3371 # required for use as an eventtable;
3372 sub svc_acct {
3373   my $self = shift;
3374   $self->svc_x('svc_acct', @_);
3375 }
3376
3377 =item cust_credit
3378
3379 Returns all the credits (see L<FS::cust_credit>) for this customer.
3380
3381 =cut
3382
3383 sub cust_credit {
3384   my $self = shift;
3385   map { $_ } #return $self->num_cust_credit unless wantarray;
3386   sort { $a->_date <=> $b->_date }
3387     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3388 }
3389
3390 =item cust_credit_pkgnum
3391
3392 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3393 package when using experimental package balances.
3394
3395 =cut
3396
3397 sub cust_credit_pkgnum {
3398   my( $self, $pkgnum ) = @_;
3399   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3400   sort { $a->_date <=> $b->_date }
3401     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3402                               'pkgnum'  => $pkgnum,
3403                             }
3404     );
3405 }
3406
3407 =item cust_credit_void
3408
3409 Returns all voided credits (see L<FS::cust_credit_void>) for this customer.
3410
3411 =cut
3412
3413 sub cust_credit_void {
3414   my $self = shift;
3415   map { $_ }
3416   sort { $a->_date <=> $b->_date }
3417     qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } )
3418 }
3419
3420 =item cust_pay
3421
3422 Returns all the payments (see L<FS::cust_pay>) for this customer.
3423
3424 =cut
3425
3426 sub cust_pay {
3427   my $self = shift;
3428   my $opt = ref($_[0]) ? shift : { @_ };
3429
3430   return $self->num_cust_pay unless wantarray || keys %$opt;
3431
3432   $opt->{'table'} = 'cust_pay';
3433   $opt->{'hashref'}{'custnum'} = $self->custnum;
3434
3435   map { $_ } #behavior of sort undefined in scalar context
3436     sort { $a->_date <=> $b->_date }
3437       qsearch($opt);
3438
3439 }
3440
3441 =item num_cust_pay
3442
3443 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
3444 called automatically when the cust_pay method is used in a scalar context.
3445
3446 =cut
3447
3448 sub num_cust_pay {
3449   my $self = shift;
3450   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3451   my $sth = dbh->prepare($sql) or die dbh->errstr;
3452   $sth->execute($self->custnum) or die $sth->errstr;
3453   $sth->fetchrow_arrayref->[0];
3454 }
3455
3456 =item unapplied_cust_pay
3457
3458 Returns all the unapplied payments (see L<FS::cust_pay>) for this customer.
3459
3460 =cut
3461
3462 sub unapplied_cust_pay {
3463   my $self = shift;
3464
3465   $self->cust_pay(
3466     'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0',
3467     #@_
3468   );
3469
3470 }
3471
3472 =item cust_pay_pkgnum
3473
3474 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3475 package when using experimental package balances.
3476
3477 =cut
3478
3479 sub cust_pay_pkgnum {
3480   my( $self, $pkgnum ) = @_;
3481   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3482   sort { $a->_date <=> $b->_date }
3483     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3484                            'pkgnum'  => $pkgnum,
3485                          }
3486     );
3487 }
3488
3489 =item cust_pay_void
3490
3491 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3492
3493 =cut
3494
3495 sub cust_pay_void {
3496   my $self = shift;
3497   map { $_ } #return $self->num_cust_pay_void unless wantarray;
3498   sort { $a->_date <=> $b->_date }
3499     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3500 }
3501
3502 =item cust_pay_pending
3503
3504 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3505 (without status "done").
3506
3507 =cut
3508
3509 sub cust_pay_pending {
3510   my $self = shift;
3511   return $self->num_cust_pay_pending unless wantarray;
3512   sort { $a->_date <=> $b->_date }
3513     qsearch( 'cust_pay_pending', {
3514                                    'custnum' => $self->custnum,
3515                                    'status'  => { op=>'!=', value=>'done' },
3516                                  },
3517            );
3518 }
3519
3520 =item cust_pay_pending_attempt
3521
3522 Returns all payment attempts / declined payments for this customer, as pending
3523 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3524 a corresponding payment (see L<FS::cust_pay>).
3525
3526 =cut
3527
3528 sub cust_pay_pending_attempt {
3529   my $self = shift;
3530   return $self->num_cust_pay_pending_attempt unless wantarray;
3531   sort { $a->_date <=> $b->_date }
3532     qsearch( 'cust_pay_pending', {
3533                                    'custnum' => $self->custnum,
3534                                    'status'  => 'done',
3535                                    'paynum'  => '',
3536                                  },
3537            );
3538 }
3539
3540 =item num_cust_pay_pending
3541
3542 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3543 customer (without status "done").  Also called automatically when the
3544 cust_pay_pending method is used in a scalar context.
3545
3546 =cut
3547
3548 sub num_cust_pay_pending {
3549   my $self = shift;
3550   $self->scalar_sql(
3551     " SELECT COUNT(*) FROM cust_pay_pending ".
3552       " WHERE custnum = ? AND status != 'done' ",
3553     $self->custnum
3554   );
3555 }
3556
3557 =item num_cust_pay_pending_attempt
3558
3559 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3560 customer, with status "done" but without a corresp.  Also called automatically when the
3561 cust_pay_pending method is used in a scalar context.
3562
3563 =cut
3564
3565 sub num_cust_pay_pending_attempt {
3566   my $self = shift;
3567   $self->scalar_sql(
3568     " SELECT COUNT(*) FROM cust_pay_pending ".
3569       " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3570     $self->custnum
3571   );
3572 }
3573
3574 =item cust_refund
3575
3576 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3577
3578 =cut
3579
3580 sub cust_refund {
3581   my $self = shift;
3582   map { $_ } #return $self->num_cust_refund unless wantarray;
3583   sort { $a->_date <=> $b->_date }
3584     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3585 }
3586
3587 =item display_custnum
3588
3589 Returns the displayed customer number for this customer: agent_custid if
3590 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3591
3592 =cut
3593
3594 sub display_custnum {
3595   my $self = shift;
3596
3597   my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
3598   if ( my $special = $conf->config('cust_main-custnum-display_special') ) {
3599     if ( $special eq 'CoStAg' ) {
3600       $prefix = uc( join('',
3601         $self->country,
3602         ($self->state =~ /^(..)/),
3603         $prefix || ($self->agent->agent =~ /^(..)/)
3604       ) );
3605     }
3606     elsif ( $special eq 'CoStCl' ) {
3607       $prefix = uc( join('',
3608         $self->country,
3609         ($self->state =~ /^(..)/),
3610         ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__')
3611       ) );
3612     }
3613     # add any others here if needed
3614   }
3615
3616   my $length = $conf->config('cust_main-custnum-display_length');
3617   if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
3618     return $self->agent_custid;
3619   } elsif ( $prefix ) {
3620     $length = 8 if !defined($length);
3621     return $prefix .
3622            sprintf('%0'.$length.'d', $self->custnum)
3623   } elsif ( $length ) {
3624     return sprintf('%0'.$length.'d', $self->custnum);
3625   } else {
3626     return $self->custnum;
3627   }
3628 }
3629
3630 =item name
3631
3632 Returns a name string for this customer, either "Company (Last, First)" or
3633 "Last, First".
3634
3635 =cut
3636
3637 sub name {
3638   my $self = shift;
3639   my $name = $self->contact;
3640   $name = $self->company. " ($name)" if $self->company;
3641   $name;
3642 }
3643
3644 =item service_contact
3645
3646 Returns the L<FS::contact> object for this customer that has the 'Service'
3647 contact class, or undef if there is no such contact.  Deprecated; don't use
3648 this in new code.
3649
3650 =cut
3651
3652 sub service_contact {
3653   my $self = shift;
3654   if ( !exists($self->{service_contact}) ) {
3655     my $classnum = $self->scalar_sql(
3656       'SELECT classnum FROM contact_class WHERE classname = \'Service\''
3657     ) || 0; #if it's zero, qsearchs will return nothing
3658     $self->{service_contact} = qsearchs('contact', {
3659         'classnum' => $classnum, 'custnum' => $self->custnum
3660       }) || undef;
3661   }
3662   $self->{service_contact};
3663 }
3664
3665 =item ship_name
3666
3667 Returns a name string for this (service/shipping) contact, either
3668 "Company (Last, First)" or "Last, First".
3669
3670 =cut
3671
3672 sub ship_name {
3673   my $self = shift;
3674
3675   my $name = $self->ship_contact;
3676   $name = $self->company. " ($name)" if $self->company;
3677   $name;
3678 }
3679
3680 =item name_short
3681
3682 Returns a name string for this customer, either "Company" or "First Last".
3683
3684 =cut
3685
3686 sub name_short {
3687   my $self = shift;
3688   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
3689 }
3690
3691 =item ship_name_short
3692
3693 Returns a name string for this (service/shipping) contact, either "Company"
3694 or "First Last".
3695
3696 =cut
3697
3698 sub ship_name_short {
3699   my $self = shift;
3700   $self->service_contact
3701     ? $self->ship_contact_firstlast
3702     : $self->name_short
3703 }
3704
3705 =item contact
3706
3707 Returns this customer's full (billing) contact name only, "Last, First"
3708
3709 =cut
3710
3711 sub contact {
3712   my $self = shift;
3713   $self->get('last'). ', '. $self->first;
3714 }
3715
3716 =item ship_contact
3717
3718 Returns this customer's full (shipping) contact name only, "Last, First"
3719
3720 =cut
3721
3722 sub ship_contact {
3723   my $self = shift;
3724   my $contact = $self->service_contact || $self;
3725   $contact->get('last') . ', ' . $contact->get('first');
3726 }
3727
3728 =item contact_firstlast
3729
3730 Returns this customers full (billing) contact name only, "First Last".
3731
3732 =cut
3733
3734 sub contact_firstlast {
3735   my $self = shift;
3736   $self->first. ' '. $self->get('last');
3737 }
3738
3739 =item ship_contact_firstlast
3740
3741 Returns this customer's full (shipping) contact name only, "First Last".
3742
3743 =cut
3744
3745 sub ship_contact_firstlast {
3746   my $self = shift;
3747   my $contact = $self->service_contact || $self;
3748   $contact->get('first') . ' '. $contact->get('last');
3749 }
3750
3751 #XXX this doesn't work in 3.x+
3752 #=item country_full
3753 #
3754 #Returns this customer's full country name
3755 #
3756 #=cut
3757 #
3758 #sub country_full {
3759 #  my $self = shift;
3760 #  code2country($self->country);
3761 #}
3762
3763 sub bill_country_full {
3764   my $self = shift;
3765   code2country($self->bill_location->country);
3766 }
3767
3768 sub ship_country_full {
3769   my $self = shift;
3770   code2country($self->ship_location->country);
3771 }
3772
3773 =item county_state_county [ PREFIX ]
3774
3775 Returns a string consisting of just the county, state and country.
3776
3777 =cut
3778
3779 sub county_state_country {
3780   my $self = shift;
3781   my $locationnum;
3782   if ( @_ && $_[0] && $self->has_ship_address ) {
3783     $locationnum = $self->ship_locationnum;
3784   } else {
3785     $locationnum = $self->bill_locationnum;
3786   }
3787   my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
3788   $cust_location->county_state_country;
3789 }
3790
3791 =item geocode DATA_VENDOR
3792
3793 Returns a value for the customer location as encoded by DATA_VENDOR.
3794 Currently this only makes sense for "CCH" as DATA_VENDOR.
3795
3796 =cut
3797
3798 =item cust_status
3799
3800 =item status
3801
3802 Returns a status string for this customer, currently:
3803
3804 =over 4
3805
3806 =item prospect
3807
3808 No packages have ever been ordered.  Displayed as "No packages".
3809
3810 =item ordered
3811
3812 Recurring packages all are new (not yet billed).
3813
3814 =item active
3815
3816 One or more recurring packages is active.
3817
3818 =item inactive
3819
3820 No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled).
3821
3822 =item suspended
3823
3824 All non-cancelled recurring packages are suspended.
3825
3826 =item cancelled
3827
3828 All recurring packages are cancelled.
3829
3830 =back
3831
3832 Behavior of inactive vs. cancelled edge cases can be adjusted with the
3833 cust_main-status_module configuration option.
3834
3835 =cut
3836
3837 sub status { shift->cust_status(@_); }
3838
3839 sub cust_status {
3840   my $self = shift;
3841   for my $status ( FS::cust_main->statuses() ) {
3842     my $method = $status.'_sql';
3843     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3844     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3845     $sth->execute( ($self->custnum) x $numnum )
3846       or die "Error executing 'SELECT $sql': ". $sth->errstr;
3847     return $status if $sth->fetchrow_arrayref->[0];
3848   }
3849 }
3850
3851 =item ucfirst_cust_status
3852
3853 =item ucfirst_status
3854
3855 Deprecated, use the cust_status_label method instead.
3856
3857 Returns the status with the first character capitalized.
3858
3859 =cut
3860
3861 sub ucfirst_status {
3862   carp "ucfirst_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
3863   local($ucfirst_nowarn) = 1;
3864   shift->ucfirst_cust_status(@_);
3865 }
3866
3867 sub ucfirst_cust_status {
3868   carp "ucfirst_cust_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
3869   my $self = shift;
3870   ucfirst($self->cust_status);
3871 }
3872
3873 =item cust_status_label
3874
3875 =item status_label
3876
3877 Returns the display label for this status.
3878
3879 =cut
3880
3881 sub status_label { shift->cust_status_label(@_); }
3882
3883 sub cust_status_label {
3884   my $self = shift;
3885   __PACKAGE__->statuslabels->{$self->cust_status};
3886 }
3887
3888 =item statuscolor
3889
3890 Returns a hex triplet color string for this customer's status.
3891
3892 =cut
3893
3894 sub statuscolor { shift->cust_statuscolor(@_); }
3895
3896 sub cust_statuscolor {
3897   my $self = shift;
3898   __PACKAGE__->statuscolors->{$self->cust_status};
3899 }
3900
3901 =item tickets [ STATUS ]
3902
3903 Returns an array of hashes representing the customer's RT tickets.
3904
3905 An optional status (or arrayref or hashref of statuses) may be specified.
3906
3907 =cut
3908
3909 sub tickets {
3910   my $self = shift;
3911   my $status = ( @_ && $_[0] ) ? shift : '';
3912
3913   my $num = $conf->config('cust_main-max_tickets') || 10;
3914   my @tickets = ();
3915
3916   if ( $conf->config('ticket_system') ) {
3917     unless ( $conf->config('ticket_system-custom_priority_field') ) {
3918
3919       @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
3920                                                         $num,
3921                                                         undef,
3922                                                         $status,
3923                                                       )
3924                   };
3925
3926     } else {
3927
3928       foreach my $priority (
3929         $conf->config('ticket_system-custom_priority_field-values'), ''
3930       ) {
3931         last if scalar(@tickets) >= $num;
3932         push @tickets,
3933           @{ FS::TicketSystem->customer_tickets( $self->custnum,
3934                                                  $num - scalar(@tickets),
3935                                                  $priority,
3936                                                  $status,
3937                                                )
3938            };
3939       }
3940     }
3941   }
3942   (@tickets);
3943 }
3944
3945 # Return services representing svc_accts in customer support packages
3946 sub support_services {
3947   my $self = shift;
3948   my %packages = map { $_ => 1 } $conf->config('support_packages');
3949
3950   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
3951     grep { $_->part_svc->svcdb eq 'svc_acct' }
3952     map { $_->cust_svc }
3953     grep { exists $packages{ $_->pkgpart } }
3954     $self->ncancelled_pkgs;
3955
3956 }
3957
3958 # Return a list of latitude/longitude for one of the services (if any)
3959 sub service_coordinates {
3960   my $self = shift;
3961
3962   my @svc_X =
3963     grep { $_->latitude && $_->longitude }
3964     map { $_->svc_x }
3965     map { $_->cust_svc }
3966     $self->ncancelled_pkgs;
3967
3968   scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
3969 }
3970
3971 =item masked FIELD
3972
3973 Returns a masked version of the named field
3974
3975 =cut
3976
3977 sub masked {
3978 my ($self,$field) = @_;
3979
3980 # Show last four
3981
3982 'x'x(length($self->getfield($field))-4).
3983   substr($self->getfield($field), (length($self->getfield($field))-4));
3984
3985 }
3986
3987 =back
3988
3989 =head1 CLASS METHODS
3990
3991 =over 4
3992
3993 =item statuses
3994
3995 Class method that returns the list of possible status strings for customers
3996 (see L<the status method|/status>).  For example:
3997
3998   @statuses = FS::cust_main->statuses();
3999
4000 =cut
4001
4002 sub statuses {
4003   my $self = shift;
4004   keys %{ $self->statuscolors };
4005 }
4006
4007 =item cust_status_sql
4008
4009 Returns an SQL fragment to determine the status of a cust_main record, as a
4010 string.
4011
4012 =cut
4013
4014 sub cust_status_sql {
4015   my $sql = 'CASE';
4016   for my $status ( FS::cust_main->statuses() ) {
4017     my $method = $status.'_sql';
4018     $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4019   }
4020   $sql .= ' END';
4021   return $sql;
4022 }
4023
4024
4025 =item prospect_sql
4026
4027 Returns an SQL expression identifying prospective cust_main records (customers
4028 with no packages ever ordered)
4029
4030 =cut
4031
4032 use vars qw($select_count_pkgs);
4033 $select_count_pkgs =
4034   "SELECT COUNT(*) FROM cust_pkg
4035     WHERE cust_pkg.custnum = cust_main.custnum";
4036
4037 sub select_count_pkgs_sql {
4038   $select_count_pkgs;
4039 }
4040
4041 sub prospect_sql {
4042   " 0 = ( $select_count_pkgs ) ";
4043 }
4044
4045 =item ordered_sql
4046
4047 Returns an SQL expression identifying ordered cust_main records (customers with
4048 no active packages, but recurring packages not yet setup or one time charges
4049 not yet billed).
4050
4051 =cut
4052
4053 sub ordered_sql {
4054   FS::cust_main->none_active_sql.
4055   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4056 }
4057
4058 =item active_sql
4059
4060 Returns an SQL expression identifying active cust_main records (customers with
4061 active recurring packages).
4062
4063 =cut
4064
4065 sub active_sql {
4066   " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4067 }
4068
4069 =item none_active_sql
4070
4071 Returns an SQL expression identifying cust_main records with no active
4072 recurring packages.  This includes customers of status prospect, ordered,
4073 inactive, and suspended.
4074
4075 =cut
4076
4077 sub none_active_sql {
4078   " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4079 }
4080
4081 =item inactive_sql
4082
4083 Returns an SQL expression identifying inactive cust_main records (customers with
4084 no active recurring packages, but otherwise unsuspended/uncancelled).
4085
4086 =cut
4087
4088 sub inactive_sql {
4089   FS::cust_main->none_active_sql.
4090   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4091 }
4092
4093 =item susp_sql
4094 =item suspended_sql
4095
4096 Returns an SQL expression identifying suspended cust_main records.
4097
4098 =cut
4099
4100
4101 sub suspended_sql { susp_sql(@_); }
4102 sub susp_sql {
4103   FS::cust_main->none_active_sql.
4104   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4105 }
4106
4107 =item cancel_sql
4108 =item cancelled_sql
4109
4110 Returns an SQL expression identifying cancelled cust_main records.
4111
4112 =cut
4113
4114 sub cancel_sql { shift->cancelled_sql(@_); }
4115
4116 =item uncancel_sql
4117 =item uncancelled_sql
4118
4119 Returns an SQL expression identifying un-cancelled cust_main records.
4120
4121 =cut
4122
4123 sub uncancelled_sql { uncancel_sql(@_); }
4124 sub uncancel_sql { "
4125   ( 0 < ( $select_count_pkgs
4126                    AND ( cust_pkg.cancel IS NULL
4127                          OR cust_pkg.cancel = 0
4128                        )
4129         )
4130     OR 0 = ( $select_count_pkgs )
4131   )
4132 "; }
4133
4134 =item balance_sql
4135
4136 Returns an SQL fragment to retreive the balance.
4137
4138 =cut
4139
4140 sub balance_sql { "
4141     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4142         WHERE cust_bill.custnum   = cust_main.custnum     )
4143   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
4144         WHERE cust_pay.custnum    = cust_main.custnum     )
4145   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
4146         WHERE cust_credit.custnum = cust_main.custnum     )
4147   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
4148         WHERE cust_refund.custnum = cust_main.custnum     )
4149 "; }
4150
4151 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4152
4153 Returns an SQL fragment to retreive the balance for this customer, optionally
4154 considering invoices with date earlier than START_TIME, and not
4155 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4156 total_unapplied_payments).
4157
4158 Times are specified as SQL fragments or numeric
4159 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4160 L<Date::Parse> for conversion functions.  The empty string can be passed
4161 to disable that time constraint completely.
4162
4163 Available options are:
4164
4165 =over 4
4166
4167 =item unapplied_date
4168
4169 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)
4170
4171 =item total
4172
4173 (unused.  obsolete?)
4174 set to true to remove all customer comparison clauses, for totals
4175
4176 =item where
4177
4178 (unused.  obsolete?)
4179 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4180
4181 =item join
4182
4183 (unused.  obsolete?)
4184 JOIN clause (typically used with the total option)
4185
4186 =item cutoff
4187
4188 An absolute cutoff time.  Payments, credits, and refunds I<applied> after this
4189 time will be ignored.  Note that START_TIME and END_TIME only limit the date
4190 range for invoices and I<unapplied> payments, credits, and refunds.
4191
4192 =back
4193
4194 =cut
4195
4196 sub balance_date_sql {
4197   my( $class, $start, $end, %opt ) = @_;
4198
4199   my $cutoff = $opt{'cutoff'};
4200
4201   my $owed         = FS::cust_bill->owed_sql($cutoff);
4202   my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4203   my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4204   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4205
4206   my $j = $opt{'join'} || '';
4207
4208   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
4209   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4210   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4211   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
4212
4213   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
4214     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4215     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4216     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
4217   ";
4218
4219 }
4220
4221 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4222
4223 Returns an SQL fragment to retreive the total unapplied payments for this
4224 customer, only considering payments with date earlier than START_TIME, and
4225 optionally not later than END_TIME.
4226
4227 Times are specified as SQL fragments or numeric
4228 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4229 L<Date::Parse> for conversion functions.  The empty string can be passed
4230 to disable that time constraint completely.
4231
4232 Available options are:
4233
4234 =cut
4235
4236 sub unapplied_payments_date_sql {
4237   my( $class, $start, $end, %opt ) = @_;
4238
4239   my $cutoff = $opt{'cutoff'};
4240
4241   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4242
4243   my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4244                                                           'unapplied_date'=>1 );
4245
4246   " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4247 }
4248
4249 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4250
4251 Helper method for balance_date_sql; name (and usage) subject to change
4252 (suggestions welcome).
4253
4254 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4255 cust_refund, cust_credit or cust_pay).
4256
4257 If TABLE is "cust_bill" or the unapplied_date option is true, only
4258 considers records with date earlier than START_TIME, and optionally not
4259 later than END_TIME .
4260
4261 =cut
4262
4263 sub _money_table_where {
4264   my( $class, $table, $start, $end, %opt ) = @_;
4265
4266   my @where = ();
4267   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4268   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4269     push @where, "$table._date <= $start" if defined($start) && length($start);
4270     push @where, "$table._date >  $end"   if defined($end)   && length($end);
4271   }
4272   push @where, @{$opt{'where'}} if $opt{'where'};
4273   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4274
4275   $where;
4276
4277 }
4278
4279 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4280 use FS::cust_main::Search;
4281 sub search {
4282   my $class = shift;
4283   FS::cust_main::Search->search(@_);
4284 }
4285
4286 =back
4287
4288 =head1 SUBROUTINES
4289
4290 =over 4
4291
4292 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4293
4294 Deprecated.  Use event notification and message templates
4295 (L<FS::msg_template>) instead.
4296
4297 Sends a templated email notification to the customer (see L<Text::Template>).
4298
4299 OPTIONS is a hash and may include
4300
4301 I<from> - the email sender (default is invoice_from)
4302
4303 I<to> - comma-separated scalar or arrayref of recipients
4304    (default is invoicing_list)
4305
4306 I<subject> - The subject line of the sent email notification
4307    (default is "Notice from company_name")
4308
4309 I<extra_fields> - a hashref of name/value pairs which will be substituted
4310    into the template
4311
4312 The following variables are vavailable in the template.
4313
4314 I<$first> - the customer first name
4315 I<$last> - the customer last name
4316 I<$company> - the customer company
4317 I<$payby> - a description of the method of payment for the customer
4318             # would be nice to use FS::payby::shortname
4319 I<$payinfo> - the account information used to collect for this customer
4320 I<$expdate> - the expiration of the customer payment in seconds from epoch
4321
4322 =cut
4323
4324 sub notify {
4325   my ($self, $template, %options) = @_;
4326
4327   return unless $conf->exists($template);
4328
4329   my $from = $conf->config('invoice_from', $self->agentnum)
4330     if $conf->exists('invoice_from', $self->agentnum);
4331   $from = $options{from} if exists($options{from});
4332
4333   my $to = join(',', $self->invoicing_list_emailonly);
4334   $to = $options{to} if exists($options{to});
4335
4336   my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4337     if $conf->exists('company_name', $self->agentnum);
4338   $subject = $options{subject} if exists($options{subject});
4339
4340   my $notify_template = new Text::Template (TYPE => 'ARRAY',
4341                                             SOURCE => [ map "$_\n",
4342                                               $conf->config($template)]
4343                                            )
4344     or die "can't create new Text::Template object: Text::Template::ERROR";
4345   $notify_template->compile()
4346     or die "can't compile template: Text::Template::ERROR";
4347
4348   $FS::notify_template::_template::company_name =
4349     $conf->config('company_name', $self->agentnum);
4350   $FS::notify_template::_template::company_address =
4351     join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4352
4353   my $paydate = $self->paydate || '2037-12-31';
4354   $FS::notify_template::_template::first = $self->first;
4355   $FS::notify_template::_template::last = $self->last;
4356   $FS::notify_template::_template::company = $self->company;
4357   $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4358   my $payby = $self->payby;
4359   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4360   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4361
4362   #credit cards expire at the end of the month/year of their exp date
4363   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4364     $FS::notify_template::_template::payby = 'credit card';
4365     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4366     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4367     $expire_time--;
4368   }elsif ($payby eq 'COMP') {
4369     $FS::notify_template::_template::payby = 'complimentary account';
4370   }else{
4371     $FS::notify_template::_template::payby = 'current method';
4372   }
4373   $FS::notify_template::_template::expdate = $expire_time;
4374
4375   for (keys %{$options{extra_fields}}){
4376     no strict "refs";
4377     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4378   }
4379
4380   send_email(from => $from,
4381              to => $to,
4382              subject => $subject,
4383              body => $notify_template->fill_in( PACKAGE =>
4384                                                 'FS::notify_template::_template'                                              ),
4385             );
4386
4387 }
4388
4389 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4390
4391 Generates a templated notification to the customer (see L<Text::Template>).
4392
4393 OPTIONS is a hash and may include
4394
4395 I<extra_fields> - a hashref of name/value pairs which will be substituted
4396    into the template.  These values may override values mentioned below
4397    and those from the customer record.
4398
4399 The following variables are available in the template instead of or in addition
4400 to the fields of the customer record.
4401
4402 I<$payby> - a description of the method of payment for the customer
4403             # would be nice to use FS::payby::shortname
4404 I<$payinfo> - the masked account information used to collect for this customer
4405 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4406 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4407
4408 =cut
4409
4410 # a lot like cust_bill::print_latex
4411 sub generate_letter {
4412   my ($self, $template, %options) = @_;
4413
4414   return unless $conf->exists($template);
4415
4416   my $letter_template = new Text::Template
4417                         ( TYPE       => 'ARRAY',
4418                           SOURCE     => [ map "$_\n", $conf->config($template)],
4419                           DELIMITERS => [ '[@--', '--@]' ],
4420                         )
4421     or die "can't create new Text::Template object: Text::Template::ERROR";
4422
4423   $letter_template->compile()
4424     or die "can't compile template: Text::Template::ERROR";
4425
4426   my %letter_data = map { $_ => $self->$_ } $self->fields;
4427   $letter_data{payinfo} = $self->mask_payinfo;
4428
4429   #my $paydate = $self->paydate || '2037-12-31';
4430   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4431
4432   my $payby = $self->payby;
4433   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4434   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4435
4436   #credit cards expire at the end of the month/year of their exp date
4437   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4438     $letter_data{payby} = 'credit card';
4439     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4440     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4441     $expire_time--;
4442   }elsif ($payby eq 'COMP') {
4443     $letter_data{payby} = 'complimentary account';
4444   }else{
4445     $letter_data{payby} = 'current method';
4446   }
4447   $letter_data{expdate} = $expire_time;
4448
4449   for (keys %{$options{extra_fields}}){
4450     $letter_data{$_} = $options{extra_fields}->{$_};
4451   }
4452
4453   unless(exists($letter_data{returnaddress})){
4454     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4455                                                   $self->agent_template)
4456                      );
4457     if ( length($retadd) ) {
4458       $letter_data{returnaddress} = $retadd;
4459     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4460       $letter_data{returnaddress} =
4461         join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4462                           s/$/\\\\\*/;
4463                           $_;
4464                         }
4465                     ( $conf->config('company_name', $self->agentnum),
4466                       $conf->config('company_address', $self->agentnum),
4467                     )
4468         );
4469     } else {
4470       $letter_data{returnaddress} = '~';
4471     }
4472   }
4473
4474   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4475
4476   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4477
4478   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4479
4480   my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4481                            DIR      => $dir,
4482                            SUFFIX   => '.eps',
4483                            UNLINK   => 0,
4484                          ) or die "can't open temp file: $!\n";
4485   print $lh $conf->config_binary('logo.eps', $self->agentnum)
4486     or die "can't write temp file: $!\n";
4487   close $lh;
4488   $letter_data{'logo_file'} = $lh->filename;
4489
4490   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4491                            DIR      => $dir,
4492                            SUFFIX   => '.tex',
4493                            UNLINK   => 0,
4494                          ) or die "can't open temp file: $!\n";
4495
4496   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4497   close $fh;
4498   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4499   return ($1, $letter_data{'logo_file'});
4500
4501 }
4502
4503 =item print_ps TEMPLATE
4504
4505 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4506
4507 =cut
4508
4509 sub print_ps {
4510   my $self = shift;
4511   my($file, $lfile) = $self->generate_letter(@_);
4512   my $ps = FS::Misc::generate_ps($file);
4513   unlink($file.'.tex');
4514   unlink($lfile);
4515
4516   $ps;
4517 }
4518
4519 =item print TEMPLATE
4520
4521 Prints the filled in template.
4522
4523 TEMPLATE is the name of a L<Text::Template> to fill in and print.
4524
4525 =cut
4526
4527 sub queueable_print {
4528   my %opt = @_;
4529
4530   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
4531     or die "invalid customer number: " . $opt{custnum};
4532
4533   my $error = $self->print( { 'template' => $opt{template} } );
4534   die $error if $error;
4535 }
4536
4537 sub print {
4538   my ($self, $template) = (shift, shift);
4539   do_print(
4540     [ $self->print_ps($template) ],
4541     'agentnum' => $self->agentnum,
4542   );
4543 }
4544
4545 #these three subs should just go away once agent stuff is all config overrides
4546
4547 sub agent_template {
4548   my $self = shift;
4549   $self->_agent_plandata('agent_templatename');
4550 }
4551
4552 sub agent_invoice_from {
4553   my $self = shift;
4554   $self->_agent_plandata('agent_invoice_from');
4555 }
4556
4557 sub _agent_plandata {
4558   my( $self, $option ) = @_;
4559
4560   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
4561   #agent-specific Conf
4562
4563   use FS::part_event::Condition;
4564
4565   my $agentnum = $self->agentnum;
4566
4567   my $regexp = regexp_sql();
4568
4569   my $part_event_option =
4570     qsearchs({
4571       'select'    => 'part_event_option.*',
4572       'table'     => 'part_event_option',
4573       'addl_from' => q{
4574         LEFT JOIN part_event USING ( eventpart )
4575         LEFT JOIN part_event_option AS peo_agentnum
4576           ON ( part_event.eventpart = peo_agentnum.eventpart
4577                AND peo_agentnum.optionname = 'agentnum'
4578                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
4579              )
4580         LEFT JOIN part_event_condition
4581           ON ( part_event.eventpart = part_event_condition.eventpart
4582                AND part_event_condition.conditionname = 'cust_bill_age'
4583              )
4584         LEFT JOIN part_event_condition_option
4585           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
4586                AND part_event_condition_option.optionname = 'age'
4587              )
4588       },
4589       #'hashref'   => { 'optionname' => $option },
4590       #'hashref'   => { 'part_event_option.optionname' => $option },
4591       'extra_sql' =>
4592         " WHERE part_event_option.optionname = ". dbh->quote($option).
4593         " AND action = 'cust_bill_send_agent' ".
4594         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
4595         " AND peo_agentnum.optionname = 'agentnum' ".
4596         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
4597         " ORDER BY
4598            CASE WHEN part_event_condition_option.optionname IS NULL
4599            THEN -1
4600            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
4601         " END
4602           , part_event.weight".
4603         " LIMIT 1"
4604     });
4605
4606   unless ( $part_event_option ) {
4607     return $self->agent->invoice_template || ''
4608       if $option eq 'agent_templatename';
4609     return '';
4610   }
4611
4612   $part_event_option->optionvalue;
4613
4614 }
4615
4616 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
4617
4618 Subroutine (not a method), designed to be called from the queue.
4619
4620 Takes a list of options and values.
4621
4622 Pulls up the customer record via the custnum option and calls bill_and_collect.
4623
4624 =cut
4625
4626 sub queued_bill {
4627   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
4628
4629   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
4630   warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
4631
4632   #without this errors don't get rolled back
4633   $args{'fatal'} = 1; # runs from job queue, will be caught
4634
4635   $cust_main->bill_and_collect( %args );
4636 }
4637
4638 =item queued_collect 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
4639
4640 Like queued_bill, but instead of C<bill_and_collect>, just runs the
4641 C<collect> part.  This is used in batch tax calculation, where invoice
4642 generation and collection events have to be completely separated.
4643
4644 =cut
4645
4646 sub queued_collect {
4647   my (%args) = @_;
4648   my $cust_main = FS::cust_main->by_key($args{'custnum'});
4649
4650   $cust_main->collect(%args);
4651 }
4652
4653 sub process_bill_and_collect {
4654   my $job = shift;
4655   my $param = shift;
4656   my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
4657       or die "custnum '$param->{custnum}' not found!\n";
4658   $param->{'job'}   = $job;
4659   $param->{'fatal'} = 1; # runs from job queue, will be caught
4660   $param->{'retry'} = 1;
4661
4662   $cust_main->bill_and_collect( %$param );
4663 }
4664
4665 #starting to take quite a while for big dbs
4666 #   (JRNL: journaled so it only happens once per database)
4667 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
4668 # JRNL seq scan of cust_main on signupdate... index signupdate?  will that help?
4669 # JRNL seq scan of cust_main on paydate... index on substrings?  maybe set an
4670 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
4671 # JRNL leading/trailing spaces in first, last, company
4672 # JRNL migrate to cust_payby
4673 # - otaker upgrade?  journal and call it good?  (double check to make sure
4674 #    we're not still setting otaker here)
4675 #
4676 #only going to get worse with new location stuff...
4677
4678 sub _upgrade_data { #class method
4679   my ($class, %opts) = @_;
4680
4681   my @statements = (
4682     'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
4683   );
4684
4685   #this seems to be the only expensive one.. why does it take so long?
4686   unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
4687     push @statements,
4688       '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';
4689     FS::upgrade_journal->set_done('cust_main__signupdate');
4690   }
4691
4692   unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) {
4693
4694     # fix yyyy-m-dd formatted paydates
4695     if ( driver_name =~ /^mysql/i ) {
4696       push @statements,
4697       "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
4698     } else { # the SQL standard
4699       push @statements,
4700       "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
4701     }
4702     FS::upgrade_journal->set_done('cust_main__paydate');
4703   }
4704
4705   unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) {
4706
4707     push @statements, #fix the weird BILL with a cc# in payinfo problem
4708       #DCRD to be safe
4709       "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
4710
4711     FS::upgrade_journal->set_done('cust_main__payinfo');
4712
4713   }
4714
4715   my $t = time;
4716   foreach my $sql ( @statements ) {
4717     my $sth = dbh->prepare($sql) or die dbh->errstr;
4718     $sth->execute or die $sth->errstr;
4719     #warn ( (time - $t). " seconds\n" );
4720     #$t = time;
4721   }
4722
4723   local($ignore_expired_card) = 1;
4724   local($ignore_banned_card) = 1;
4725   local($skip_fuzzyfiles) = 1;
4726   local($import) = 1; #prevent automatic geocoding (need its own variable?)
4727
4728   FS::cust_main::Location->_upgrade_data(%opts);
4729
4730   unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
4731
4732     foreach my $cust_main ( qsearch({
4733       'table'     => 'cust_main',
4734       'hashref'   => {},
4735       'extra_sql' => 'WHERE '.
4736                        join(' OR ',
4737                          map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '%  %'",
4738                            qw( first last company )
4739                        ),
4740     }) ) {
4741       my $error = $cust_main->replace;
4742       die $error if $error;
4743     }
4744
4745     FS::upgrade_journal->set_done('cust_main__trimspaces');
4746
4747   }
4748
4749   unless ( FS::upgrade_journal->is_done('cust_main__cust_payby') ) {
4750
4751     #we don't want to decrypt them, just stuff them as-is into cust_payby
4752     local(@encrypted_fields) = ();
4753
4754     local($FS::cust_payby::ignore_expired_card) = 1;
4755     local($FS::cust_payby::ignore_banned_card) = 1;
4756
4757     my @payfields = qw( payby payinfo paycvv paymask
4758                         paydate paystart_month paystart_year payissue
4759                         payname paystate paytype payip
4760                       );
4761
4762     my $search = new FS::Cursor {
4763       'table'     => 'cust_main',
4764       'extra_sql' => " WHERE ( payby IS NOT NULL AND payby != '' ) ",
4765     };
4766
4767     while (my $cust_main = $search->fetch) {
4768
4769       my $cust_payby = new FS::cust_payby {
4770         'custnum' => $cust_main->custnum,
4771         'weight'  => 1,
4772         map { $_ => $cust_main->$_(); } @payfields
4773       };
4774
4775       my $error = $cust_payby->insert;
4776       die $error if $error;
4777
4778       $cust_main->setfield($_, '') foreach @payfields;
4779       $error = $cust_main->replace;
4780       die $error if $error;
4781
4782     };
4783
4784     FS::upgrade_journal->set_done('cust_main__cust_payby');
4785   }
4786
4787   $class->_upgrade_otaker(%opts);
4788
4789 }
4790
4791 =back
4792
4793 =head1 BUGS
4794
4795 The delete method.
4796
4797 The delete method should possibly take an FS::cust_main object reference
4798 instead of a scalar customer number.
4799
4800 Bill and collect options should probably be passed as references instead of a
4801 list.
4802
4803 There should probably be a configuration file with a list of allowed credit
4804 card types.
4805
4806 No multiple currency support (probably a larger project than just this module).
4807
4808 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4809
4810 Birthdates rely on negative epoch values.
4811
4812 The payby for card/check batches is broken.  With mixed batching, bad
4813 things will happen.
4814
4815 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
4816
4817 =head1 SEE ALSO
4818
4819 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4820 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4821 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
4822
4823 =cut
4824
4825 1;
4826