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