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