FS/FS/cust_main.pm

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