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