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