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