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