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   my $company = $self->company;
1818   $company =~ s/^\s+//;
1819   $company =~ s/\s+$//;
1820   $company =~ s/\s+/ /g;
1821   $self->company($company);
1822
1823   #barf.  need message catalogs.  i18n.  etc.
1824   $error .= "Please select an advertising source."
1825     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1826   return $error if $error;
1827
1828   return "Unknown agent"
1829     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1830
1831   return "Unknown refnum"
1832     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1833
1834   return "Unknown referring custnum: ". $self->referral_custnum
1835     unless ! $self->referral_custnum
1836            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1837
1838   if ( $self->censustract ne '' ) {
1839     $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/
1840       or return "Illegal census tract: ". $self->censustract;
1841
1842     $self->censustract("$1.$2");
1843   }
1844
1845   if ( $self->ss eq '' ) {
1846     $self->ss('');
1847   } else {
1848     my $ss = $self->ss;
1849     $ss =~ s/\D//g;
1850     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1851       or return "Illegal social security number: ". $self->ss;
1852     $self->ss("$1-$2-$3");
1853   }
1854
1855
1856 # bad idea to disable, causes billing to fail because of no tax rates later
1857 # except we don't fail any more
1858   unless ( $import ) {
1859     unless ( qsearch('cust_main_county', {
1860       'country' => $self->country,
1861       'state'   => '',
1862      } ) ) {
1863       return "Unknown state/county/country: ".
1864         $self->state. "/". $self->county. "/". $self->country
1865         unless qsearch('cust_main_county',{
1866           'state'   => $self->state,
1867           'county'  => $self->county,
1868           'country' => $self->country,
1869         } );
1870     }
1871   }
1872
1873   $error =
1874        $self->ut_phonen('daytime', $self->country)
1875     || $self->ut_phonen('night',   $self->country)
1876     || $self->ut_phonen('fax',     $self->country)
1877     || $self->ut_phonen('mobile',  $self->country)
1878   ;
1879   return $error if $error;
1880
1881   unless ( $ignore_illegal_zip ) {
1882     $error = $self->ut_zip('zip', $self->country);
1883     return $error if $error;
1884   }
1885
1886   if ( $conf->exists('cust_main-require_phone', $self->agentnum)
1887        && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
1888      ) {
1889
1890     my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1891                           ? 'Day Phone'
1892                           : FS::Msgcat::_gettext('daytime');
1893     my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1894                         ? 'Night Phone'
1895                         : FS::Msgcat::_gettext('night');
1896
1897     my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
1898                         ? 'Mobile Phone'
1899                         : FS::Msgcat::_gettext('mobile');
1900
1901     return "$daytime_label, $night_label or $mobile_label is required"
1902
1903   }
1904
1905   if ( $self->has_ship_address
1906        && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1907                         $self->addr_fields )
1908      )
1909   {
1910     my $error =
1911       $self->ut_name('ship_last')
1912       || $self->ut_name('ship_first')
1913       || $self->ut_textn('ship_company')
1914       || $self->ut_text('ship_address1')
1915       || $self->ut_textn('ship_address2')
1916       || $self->ut_text('ship_city')
1917       || $self->ut_textn('ship_county')
1918       || $self->ut_textn('ship_state')
1919       || $self->ut_country('ship_country')
1920       || $self->ut_coordn('ship_latitude')
1921       || $self->ut_coordn('ship_longitude')
1922       || $self->ut_enum('ship_coord_auto', [ '', 'Y' ] )
1923     ;
1924     return $error if $error;
1925
1926     $self->set_coord('ship_')
1927       unless $import || ($self->ship_latitude && $self->ship_longitude);
1928
1929     #false laziness with above
1930     unless ( qsearchs('cust_main_county', {
1931       'country' => $self->ship_country,
1932       'state'   => '',
1933      } ) ) {
1934       return "Unknown ship_state/ship_county/ship_country: ".
1935         $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1936         unless qsearch('cust_main_county',{
1937           'state'   => $self->ship_state,
1938           'county'  => $self->ship_county,
1939           'country' => $self->ship_country,
1940         } );
1941     }
1942     #eofalse
1943
1944     $error =
1945          $self->ut_phonen('ship_daytime', $self->ship_country)
1946       || $self->ut_phonen('ship_night',   $self->ship_country)
1947       || $self->ut_phonen('ship_fax',     $self->ship_country)
1948       || $self->ut_phonen('ship_mobile',  $self->ship_country)
1949     ;
1950     return $error if $error;
1951
1952     unless ( $ignore_illegal_zip ) {
1953       $error = $self->ut_zip('ship_zip', $self->ship_country);
1954       return $error if $error;
1955     }
1956     return "Unit # is required."
1957       if $self->ship_address2 =~ /^\s*$/
1958       && $conf->exists('cust_main-require_address2');
1959
1960   } else { # ship_ info eq billing info, so don't store dup info in database
1961
1962     $self->setfield("ship_$_", '')
1963       foreach $self->addr_fields;
1964
1965     return "Unit # is required."
1966       if $self->address2 =~ /^\s*$/
1967       && $conf->exists('cust_main-require_address2');
1968
1969   }
1970
1971   #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1972   #  or return "Illegal payby: ". $self->payby;
1973   #$self->payby($1);
1974   FS::payby->can_payby($self->table, $self->payby)
1975     or return "Illegal payby: ". $self->payby;
1976
1977   $error =    $self->ut_numbern('paystart_month')
1978            || $self->ut_numbern('paystart_year')
1979            || $self->ut_numbern('payissue')
1980            || $self->ut_textn('paytype')
1981   ;
1982   return $error if $error;
1983
1984   if ( $self->payip eq '' ) {
1985     $self->payip('');
1986   } else {
1987     $error = $self->ut_ip('payip');
1988     return $error if $error;
1989   }
1990
1991   # If it is encrypted and the private key is not availaible then we can't
1992   # check the credit card.
1993   my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1994
1995   if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1996
1997     my $payinfo = $self->payinfo;
1998     $payinfo =~ s/\D//g;
1999     $payinfo =~ /^(\d{13,16}|\d{8,9})$/
2000       or return gettext('invalid_card'); # . ": ". $self->payinfo;
2001     $payinfo = $1;
2002     $self->payinfo($payinfo);
2003     validate($payinfo)
2004       or return gettext('invalid_card'); # . ": ". $self->payinfo;
2005
2006     return gettext('unknown_card_type')
2007       if $self->payinfo !~ /^99\d{14}$/ #token
2008       && cardtype($self->payinfo) eq "Unknown";
2009
2010     unless ( $ignore_banned_card ) {
2011       my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
2012       if ( $ban ) {
2013         if ( $ban->bantype eq 'warn' ) {
2014           #or others depending on value of $ban->reason ?
2015           return '_duplicate_card'.
2016                  ': disabled from'. time2str('%a %h %o at %r', $ban->_date).
2017                  ' until '.         time2str('%a %h %o at %r', $ban->_end_date).
2018                  ' (ban# '. $ban->bannum. ')'
2019             unless $self->override_ban_warn;
2020         } else {
2021           return 'Banned credit card: banned on '.
2022                  time2str('%a %h %o at %r', $ban->_date).
2023                  ' by '. $ban->otaker.
2024                  ' (ban# '. $ban->bannum. ')';
2025         }
2026       }
2027     }
2028
2029     if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
2030       if ( cardtype($self->payinfo) eq 'American Express card' ) {
2031         $self->paycvv =~ /^(\d{4})$/
2032           or return "CVV2 (CID) for American Express cards is four digits.";
2033         $self->paycvv($1);
2034       } else {
2035         $self->paycvv =~ /^(\d{3})$/
2036           or return "CVV2 (CVC2/CID) is three digits.";
2037         $self->paycvv($1);
2038       }
2039     } else {
2040       $self->paycvv('');
2041     }
2042
2043     my $cardtype = cardtype($payinfo);
2044     if ( $cardtype =~ /^(Switch|Solo)$/i ) {
2045
2046       return "Start date or issue number is required for $cardtype cards"
2047         unless $self->paystart_month && $self->paystart_year or $self->payissue;
2048
2049       return "Start month must be between 1 and 12"
2050         if $self->paystart_month
2051            and $self->paystart_month < 1 || $self->paystart_month > 12;
2052
2053       return "Start year must be 1990 or later"
2054         if $self->paystart_year
2055            and $self->paystart_year < 1990;
2056
2057       return "Issue number must be beween 1 and 99"
2058         if $self->payissue
2059           and $self->payissue < 1 || $self->payissue > 99;
2060
2061     } else {
2062       $self->paystart_month('');
2063       $self->paystart_year('');
2064       $self->payissue('');
2065     }
2066
2067   } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
2068
2069     my $payinfo = $self->payinfo;
2070     $payinfo =~ s/[^\d\@\.]//g;
2071     if ( $conf->config('echeck-country') eq 'CA' ) {
2072       $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/
2073         or return 'invalid echeck account@branch.bank';
2074       $payinfo = "$1\@$2.$3";
2075     } elsif ( $conf->config('echeck-country') eq 'US' ) {
2076       $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
2077       $payinfo = "$1\@$2";
2078     } else {
2079       $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing';
2080       $payinfo = "$1\@$2";
2081     }
2082     $self->payinfo($payinfo);
2083     $self->paycvv('');
2084
2085     unless ( $ignore_banned_card ) {
2086       my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
2087       if ( $ban ) {
2088         if ( $ban->bantype eq 'warn' ) {
2089           #or others depending on value of $ban->reason ?
2090           return '_duplicate_ach' unless $self->override_ban_warn;
2091         } else {
2092           return 'Banned ACH account: banned on '.
2093                  time2str('%a %h %o at %r', $ban->_date).
2094                  ' by '. $ban->otaker.
2095                  ' (ban# '. $ban->bannum. ')';
2096         }
2097       }
2098     }
2099
2100   } elsif ( $self->payby eq 'LECB' ) {
2101
2102     my $payinfo = $self->payinfo;
2103     $payinfo =~ s/\D//g;
2104     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
2105     $payinfo = $1;
2106     $self->payinfo($payinfo);
2107     $self->paycvv('');
2108
2109   } elsif ( $self->payby eq 'BILL' ) {
2110
2111     $error = $self->ut_textn('payinfo');
2112     return "Illegal P.O. number: ". $self->payinfo if $error;
2113     $self->paycvv('');
2114
2115   } elsif ( $self->payby eq 'COMP' ) {
2116
2117     my $curuser = $FS::CurrentUser::CurrentUser;
2118     if (    ! $self->custnum
2119          && ! $curuser->access_right('Complimentary customer')
2120        )
2121     {
2122       return "You are not permitted to create complimentary accounts."
2123     }
2124
2125     $error = $self->ut_textn('payinfo');
2126     return "Illegal comp account issuer: ". $self->payinfo if $error;
2127     $self->paycvv('');
2128
2129   } elsif ( $self->payby eq 'PREPAY' ) {
2130
2131     my $payinfo = $self->payinfo;
2132     $payinfo =~ s/\W//g; #anything else would just confuse things
2133     $self->payinfo($payinfo);
2134     $error = $self->ut_alpha('payinfo');
2135     return "Illegal prepayment identifier: ". $self->payinfo if $error;
2136     return "Unknown prepayment identifier"
2137       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
2138     $self->paycvv('');
2139
2140   }
2141
2142   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
2143     return "Expiration date required"
2144       unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
2145     $self->paydate('');
2146   } else {
2147     my( $m, $y );
2148     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
2149       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
2150     } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2151       ( $m, $y ) = ( $2, "19$1" );
2152     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2153       ( $m, $y ) = ( $3, "20$2" );
2154     } else {
2155       return "Illegal expiration date: ". $self->paydate;
2156     }
2157     $m = sprintf('%02d',$m);
2158     $self->paydate("$y-$m-01");
2159     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
2160     return gettext('expired_card')
2161       if !$import
2162       && !$ignore_expired_card
2163       && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
2164   }
2165
2166   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
2167        ( ! $conf->exists('require_cardname')
2168          || $self->payby !~ /^(CARD|DCRD)$/  )
2169   ) {
2170     $self->payname( $self->first. " ". $self->getfield('last') );
2171   } else {
2172     $self->payname =~ /^([\w \,\.\-\'\&]+)$/
2173       or return gettext('illegal_name'). " payname: ". $self->payname;
2174     $self->payname($1);
2175   }
2176
2177   return "Please select an invoicing locale"
2178     if ! $self->locale
2179     && ! $self->custnum
2180     && $conf->exists('cust_main-require_locale');
2181
2182   foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
2183     $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
2184     $self->$flag($1);
2185   }
2186
2187   $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
2188
2189   warn "$me check AFTER: \n". $self->_dump
2190     if $DEBUG > 2;
2191
2192   $self->SUPER::check;
2193 }
2194
2195 =item addr_fields
2196
2197 Returns a list of fields which have ship_ duplicates.
2198
2199 =cut
2200
2201 sub addr_fields {
2202   qw( last first company
2203       address1 address2 city county state zip country
2204       latitude longitude
2205       daytime night fax mobile
2206     );
2207 }
2208
2209 =item has_ship_address
2210
2211 Returns true if this customer record has a separate shipping address.
2212
2213 =cut
2214
2215 sub has_ship_address {
2216   my $self = shift;
2217   scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
2218 }
2219
2220 =item location_hash
2221
2222 Returns a list of key/value pairs, with the following keys: address1,
2223 adddress2, city, county, state, zip, country, district, and geocode.  The
2224 shipping address is used if present.
2225
2226 =cut
2227
2228 =item cust_location
2229
2230 Returns all locations (see L<FS::cust_location>) for this customer.
2231
2232 =cut
2233
2234 sub cust_location {
2235   my $self = shift;
2236   qsearch('cust_location', { 'custnum' => $self->custnum } );
2237 }
2238
2239 =item cust_contact
2240
2241 Returns all contacts (see L<FS::contact>) for this customer.
2242
2243 =cut
2244
2245 #already used :/ sub contact {
2246 sub cust_contact {
2247   my $self = shift;
2248   qsearch('contact', { 'custnum' => $self->custnum } );
2249 }
2250
2251 =item unsuspend
2252
2253 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2254 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
2255 on success or a list of errors.
2256
2257 =cut
2258
2259 sub unsuspend {
2260   my $self = shift;
2261   grep { $_->unsuspend } $self->suspended_pkgs;
2262 }
2263
2264 =item suspend
2265
2266 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2267
2268 Returns a list: an empty list on success or a list of errors.
2269
2270 =cut
2271
2272 sub suspend {
2273   my $self = shift;
2274   grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2275 }
2276
2277 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2278
2279 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2280 PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref instead
2281 of a list of pkgparts; the hashref has the following keys:
2282
2283 =over 4
2284
2285 =item pkgparts - listref of pkgparts
2286
2287 =item (other options are passed to the suspend method)
2288
2289 =back
2290
2291
2292 Returns a list: an empty list on success or a list of errors.
2293
2294 =cut
2295
2296 sub suspend_if_pkgpart {
2297   my $self = shift;
2298   my (@pkgparts, %opt);
2299   if (ref($_[0]) eq 'HASH'){
2300     @pkgparts = @{$_[0]{pkgparts}};
2301     %opt      = %{$_[0]};
2302   }else{
2303     @pkgparts = @_;
2304   }
2305   grep { $_->suspend(%opt) }
2306     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2307       $self->unsuspended_pkgs;
2308 }
2309
2310 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2311
2312 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2313 given PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref
2314 instead of a list of pkgparts; the hashref has the following keys:
2315
2316 =over 4
2317
2318 =item pkgparts - listref of pkgparts
2319
2320 =item (other options are passed to the suspend method)
2321
2322 =back
2323
2324 Returns a list: an empty list on success or a list of errors.
2325
2326 =cut
2327
2328 sub suspend_unless_pkgpart {
2329   my $self = shift;
2330   my (@pkgparts, %opt);
2331   if (ref($_[0]) eq 'HASH'){
2332     @pkgparts = @{$_[0]{pkgparts}};
2333     %opt      = %{$_[0]};
2334   }else{
2335     @pkgparts = @_;
2336   }
2337   grep { $_->suspend(%opt) }
2338     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2339       $self->unsuspended_pkgs;
2340 }
2341
2342 =item cancel [ OPTION => VALUE ... ]
2343
2344 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2345
2346 Available options are:
2347
2348 =over 4
2349
2350 =item quiet - can be set true to supress email cancellation notices.
2351
2352 =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.
2353
2354 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2355
2356 =item nobill - can be set true to skip billing if it might otherwise be done.
2357
2358 =back
2359
2360 Always returns a list: an empty list on success or a list of errors.
2361
2362 =cut
2363
2364 # nb that dates are not specified as valid options to this method
2365
2366 sub cancel {
2367   my( $self, %opt ) = @_;
2368
2369   warn "$me cancel called on customer ". $self->custnum. " with options ".
2370        join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2371     if $DEBUG;
2372
2373   return ( 'access denied' )
2374     unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2375
2376   if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2377
2378     #should try decryption (we might have the private key)
2379     # and if not maybe queue a job for the server that does?
2380     return ( "Can't (yet) ban encrypted credit cards" )
2381       if $self->is_encrypted($self->payinfo);
2382
2383     my $ban = new FS::banned_pay $self->_new_banned_pay_hashref;
2384     my $error = $ban->insert;
2385     return ( $error ) if $error;
2386
2387   }
2388
2389   my @pkgs = $self->ncancelled_pkgs;
2390
2391   if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2392     $opt{nobill} = 1;
2393     my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2394     warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2395       if $error;
2396   }
2397
2398   warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2399        scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2400     if $DEBUG;
2401
2402   grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2403 }
2404
2405 sub _banned_pay_hashref {
2406   my $self = shift;
2407
2408   my %payby2ban = (
2409     'CARD' => 'CARD',
2410     'DCRD' => 'CARD',
2411     'CHEK' => 'CHEK',
2412     'DCHK' => 'CHEK'
2413   );
2414
2415   {
2416     'payby'   => $payby2ban{$self->payby},
2417     'payinfo' => $self->payinfo,
2418     #don't ever *search* on reason! #'reason'  =>
2419   };
2420 }
2421
2422 sub _new_banned_pay_hashref {
2423   my $self = shift;
2424   my $hr = $self->_banned_pay_hashref;
2425   $hr->{payinfo} = md5_base64($hr->{payinfo});
2426   $hr;
2427 }
2428
2429 =item notes
2430
2431 Returns all notes (see L<FS::cust_main_note>) for this customer.
2432
2433 =cut
2434
2435 sub notes {
2436   my($self,$orderby_classnum) = (shift,shift);
2437   my $orderby = "_DATE DESC";
2438   $orderby = "CLASSNUM ASC, $orderby" if $orderby_classnum;
2439   qsearch( 'cust_main_note',
2440            { 'custnum' => $self->custnum },
2441            '',
2442            "ORDER BY $orderby",
2443          );
2444 }
2445
2446 =item agent
2447
2448 Returns the agent (see L<FS::agent>) for this customer.
2449
2450 =cut
2451
2452 sub agent {
2453   my $self = shift;
2454   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2455 }
2456
2457 =item agent_name
2458
2459 Returns the agent name (see L<FS::agent>) for this customer.
2460
2461 =cut
2462
2463 sub agent_name {
2464   my $self = shift;
2465   $self->agent->agent;
2466 }
2467
2468 =item cust_tag
2469
2470 Returns any tags associated with this customer, as FS::cust_tag objects,
2471 or an empty list if there are no tags.
2472
2473 =cut
2474
2475 sub cust_tag {
2476   my $self = shift;
2477   qsearch('cust_tag', { 'custnum' => $self->custnum } );
2478 }
2479
2480 =item part_tag
2481
2482 Returns any tags associated with this customer, as FS::part_tag objects,
2483 or an empty list if there are no tags.
2484
2485 =cut
2486
2487 sub part_tag {
2488   my $self = shift;
2489   map $_->part_tag, $self->cust_tag;
2490 }
2491
2492
2493 =item cust_class
2494
2495 Returns the customer class, as an FS::cust_class object, or the empty string
2496 if there is no customer class.
2497
2498 =cut
2499
2500 sub cust_class {
2501   my $self = shift;
2502   if ( $self->classnum ) {
2503     qsearchs('cust_class', { 'classnum' => $self->classnum } );
2504   } else {
2505     return '';
2506   }
2507 }
2508
2509 =item categoryname
2510
2511 Returns the customer category name, or the empty string if there is no customer
2512 category.
2513
2514 =cut
2515
2516 sub categoryname {
2517   my $self = shift;
2518   my $cust_class = $self->cust_class;
2519   $cust_class
2520     ? $cust_class->categoryname
2521     : '';
2522 }
2523
2524 =item classname
2525
2526 Returns the customer class name, or the empty string if there is no customer
2527 class.
2528
2529 =cut
2530
2531 sub classname {
2532   my $self = shift;
2533   my $cust_class = $self->cust_class;
2534   $cust_class
2535     ? $cust_class->classname
2536     : '';
2537 }
2538
2539 =item BILLING METHODS
2540
2541 Documentation on billing methods has been moved to
2542 L<FS::cust_main::Billing>.
2543
2544 =item REALTIME BILLING METHODS
2545
2546 Documentation on realtime billing methods has been moved to
2547 L<FS::cust_main::Billing_Realtime>.
2548
2549 =item remove_cvv
2550
2551 Removes the I<paycvv> field from the database directly.
2552
2553 If there is an error, returns the error, otherwise returns false.
2554
2555 =cut
2556
2557 sub remove_cvv {
2558   my $self = shift;
2559   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2560     or return dbh->errstr;
2561   $sth->execute($self->custnum)
2562     or return $sth->errstr;
2563   $self->paycvv('');
2564   '';
2565 }
2566
2567 =item batch_card OPTION => VALUE...
2568
2569 Adds a payment for this invoice to the pending credit card batch (see
2570 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
2571 runs the payment using a realtime gateway.
2572
2573 =cut
2574
2575 sub batch_card {
2576   my ($self, %options) = @_;
2577
2578   my $amount;
2579   if (exists($options{amount})) {
2580     $amount = $options{amount};
2581   }else{
2582     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
2583   }
2584   return '' unless $amount > 0;
2585
2586   my $invnum = delete $options{invnum};
2587   my $payby = $options{payby} || $self->payby;  #still dubious
2588
2589   if ($options{'realtime'}) {
2590     return $self->realtime_bop( FS::payby->payby2bop($self->payby),
2591                                 $amount,
2592                                 %options,
2593                               );
2594   }
2595
2596   my $oldAutoCommit = $FS::UID::AutoCommit;
2597   local $FS::UID::AutoCommit = 0;
2598   my $dbh = dbh;
2599
2600   #this needs to handle mysql as well as Pg, like svc_acct.pm
2601   #(make it into a common function if folks need to do batching with mysql)
2602   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
2603     or return "Cannot lock pay_batch: " . $dbh->errstr;
2604
2605   my %pay_batch = (
2606     'status' => 'O',
2607     'payby'  => FS::payby->payby2payment($payby),
2608   );
2609   $pay_batch{agentnum} = $self->agentnum if $conf->exists('batch-spoolagent');
2610
2611   my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
2612
2613   unless ( $pay_batch ) {
2614     $pay_batch = new FS::pay_batch \%pay_batch;
2615     my $error = $pay_batch->insert;
2616     if ( $error ) {
2617       $dbh->rollback if $oldAutoCommit;
2618       die "error creating new batch: $error\n";
2619     }
2620   }
2621
2622   my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
2623       'batchnum' => $pay_batch->batchnum,
2624       'custnum'  => $self->custnum,
2625   } );
2626
2627   foreach (qw( address1 address2 city state zip country latitude longitude
2628                payby payinfo paydate payname ))
2629   {
2630     $options{$_} = '' unless exists($options{$_});
2631   }
2632
2633   my $cust_pay_batch = new FS::cust_pay_batch ( {
2634     'batchnum' => $pay_batch->batchnum,
2635     'invnum'   => $invnum || 0,                    # is there a better value?
2636                                                    # this field should be
2637                                                    # removed...
2638                                                    # cust_bill_pay_batch now
2639     'custnum'  => $self->custnum,
2640     'last'     => $self->getfield('last'),
2641     'first'    => $self->getfield('first'),
2642     'address1' => $options{address1} || $self->address1,
2643     'address2' => $options{address2} || $self->address2,
2644     'city'     => $options{city}     || $self->city,
2645     'state'    => $options{state}    || $self->state,
2646     'zip'      => $options{zip}      || $self->zip,
2647     'country'  => $options{country}  || $self->country,
2648     'payby'    => $options{payby}    || $self->payby,
2649     'payinfo'  => $options{payinfo}  || $self->payinfo,
2650     'exp'      => $options{paydate}  || $self->paydate,
2651     'payname'  => $options{payname}  || $self->payname,
2652     'amount'   => $amount,                         # consolidating
2653   } );
2654
2655   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
2656     if $old_cust_pay_batch;
2657
2658   my $error;
2659   if ($old_cust_pay_batch) {
2660     $error = $cust_pay_batch->replace($old_cust_pay_batch)
2661   } else {
2662     $error = $cust_pay_batch->insert;
2663   }
2664
2665   if ( $error ) {
2666     $dbh->rollback if $oldAutoCommit;
2667     die $error;
2668   }
2669
2670   my $unapplied =   $self->total_unapplied_credits
2671                   + $self->total_unapplied_payments
2672                   + $self->in_transit_payments;
2673   foreach my $cust_bill ($self->open_cust_bill) {
2674     #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
2675     my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
2676       'invnum' => $cust_bill->invnum,
2677       'paybatchnum' => $cust_pay_batch->paybatchnum,
2678       'amount' => $cust_bill->owed,
2679       '_date' => time,
2680     };
2681     if ($unapplied >= $cust_bill_pay_batch->amount){
2682       $unapplied -= $cust_bill_pay_batch->amount;
2683       next;
2684     }else{
2685       $cust_bill_pay_batch->amount(sprintf ( "%.2f",
2686                                    $cust_bill_pay_batch->amount - $unapplied ));      $unapplied = 0;
2687     }
2688     $error = $cust_bill_pay_batch->insert;
2689     if ( $error ) {
2690       $dbh->rollback if $oldAutoCommit;
2691       die $error;
2692     }
2693   }
2694
2695   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2696   '';
2697 }
2698
2699 =item total_owed
2700
2701 Returns the total owed for this customer on all invoices
2702 (see L<FS::cust_bill/owed>).
2703
2704 =cut
2705
2706 sub total_owed {
2707   my $self = shift;
2708   $self->total_owed_date(2145859200); #12/31/2037
2709 }
2710
2711 =item total_owed_date TIME
2712
2713 Returns the total owed for this customer on all invoices with date earlier than
2714 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2715 see L<Time::Local> and L<Date::Parse> for conversion functions.
2716
2717 =cut
2718
2719 sub total_owed_date {
2720   my $self = shift;
2721   my $time = shift;
2722
2723   my $custnum = $self->custnum;
2724
2725   my $owed_sql = FS::cust_bill->owed_sql;
2726
2727   my $sql = "
2728     SELECT SUM($owed_sql) FROM cust_bill
2729       WHERE custnum = $custnum
2730         AND _date <= $time
2731   ";
2732
2733   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2734
2735 }
2736
2737 =item total_owed_pkgnum PKGNUM
2738
2739 Returns the total owed on all invoices for this customer's specific package
2740 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2741
2742 =cut
2743
2744 sub total_owed_pkgnum {
2745   my( $self, $pkgnum ) = @_;
2746   $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2747 }
2748
2749 =item total_owed_date_pkgnum TIME PKGNUM
2750
2751 Returns the total owed for this customer's specific package when using
2752 experimental package balances on all invoices with date earlier than
2753 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2754 see L<Time::Local> and L<Date::Parse> for conversion functions.
2755
2756 =cut
2757
2758 sub total_owed_date_pkgnum {
2759   my( $self, $time, $pkgnum ) = @_;
2760
2761   my $total_bill = 0;
2762   foreach my $cust_bill (
2763     grep { $_->_date <= $time }
2764       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2765   ) {
2766     $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2767   }
2768   sprintf( "%.2f", $total_bill );
2769
2770 }
2771
2772 =item total_paid
2773
2774 Returns the total amount of all payments.
2775
2776 =cut
2777
2778 sub total_paid {
2779   my $self = shift;
2780   my $total = 0;
2781   $total += $_->paid foreach $self->cust_pay;
2782   sprintf( "%.2f", $total );
2783 }
2784
2785 =item total_unapplied_credits
2786
2787 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2788 customer.  See L<FS::cust_credit/credited>.
2789
2790 =item total_credited
2791
2792 Old name for total_unapplied_credits.  Don't use.
2793
2794 =cut
2795
2796 sub total_credited {
2797   #carp "total_credited deprecated, use total_unapplied_credits";
2798   shift->total_unapplied_credits(@_);
2799 }
2800
2801 sub total_unapplied_credits {
2802   my $self = shift;
2803
2804   my $custnum = $self->custnum;
2805
2806   my $unapplied_sql = FS::cust_credit->unapplied_sql;
2807
2808   my $sql = "
2809     SELECT SUM($unapplied_sql) FROM cust_credit
2810       WHERE custnum = $custnum
2811   ";
2812
2813   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2814
2815 }
2816
2817 =item total_unapplied_credits_pkgnum PKGNUM
2818
2819 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2820 customer.  See L<FS::cust_credit/credited>.
2821
2822 =cut
2823
2824 sub total_unapplied_credits_pkgnum {
2825   my( $self, $pkgnum ) = @_;
2826   my $total_credit = 0;
2827   $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2828   sprintf( "%.2f", $total_credit );
2829 }
2830
2831
2832 =item total_unapplied_payments
2833
2834 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2835 See L<FS::cust_pay/unapplied>.
2836
2837 =cut
2838
2839 sub total_unapplied_payments {
2840   my $self = shift;
2841
2842   my $custnum = $self->custnum;
2843
2844   my $unapplied_sql = FS::cust_pay->unapplied_sql;
2845
2846   my $sql = "
2847     SELECT SUM($unapplied_sql) FROM cust_pay
2848       WHERE custnum = $custnum
2849   ";
2850
2851   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2852
2853 }
2854
2855 =item total_unapplied_payments_pkgnum PKGNUM
2856
2857 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2858 specific package when using experimental package balances.  See
2859 L<FS::cust_pay/unapplied>.
2860
2861 =cut
2862
2863 sub total_unapplied_payments_pkgnum {
2864   my( $self, $pkgnum ) = @_;
2865   my $total_unapplied = 0;
2866   $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2867   sprintf( "%.2f", $total_unapplied );
2868 }
2869
2870
2871 =item total_unapplied_refunds
2872
2873 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2874 customer.  See L<FS::cust_refund/unapplied>.
2875
2876 =cut
2877
2878 sub total_unapplied_refunds {
2879   my $self = shift;
2880   my $custnum = $self->custnum;
2881
2882   my $unapplied_sql = FS::cust_refund->unapplied_sql;
2883
2884   my $sql = "
2885     SELECT SUM($unapplied_sql) FROM cust_refund
2886       WHERE custnum = $custnum
2887   ";
2888
2889   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2890
2891 }
2892
2893 =item balance
2894
2895 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2896 total_unapplied_credits minus total_unapplied_payments).
2897
2898 =cut
2899
2900 sub balance {
2901   my $self = shift;
2902   $self->balance_date_range;
2903 }
2904
2905 =item balance_date TIME
2906
2907 Returns the balance for this customer, only considering invoices with date
2908 earlier than TIME (total_owed_date minus total_credited minus
2909 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
2910 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
2911 functions.
2912
2913 =cut
2914
2915 sub balance_date {
2916   my $self = shift;
2917   $self->balance_date_range(shift);
2918 }
2919
2920 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2921
2922 Returns the balance for this customer, optionally considering invoices with
2923 date earlier than START_TIME, and not later than END_TIME
2924 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2925
2926 Times are specified as SQL fragments or numeric
2927 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
2928 L<Date::Parse> for conversion functions.  The empty string can be passed
2929 to disable that time constraint completely.
2930
2931 Available options are:
2932
2933 =over 4
2934
2935 =item unapplied_date
2936
2937 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)
2938
2939 =back
2940
2941 =cut
2942
2943 sub balance_date_range {
2944   my $self = shift;
2945   my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2946             ') FROM cust_main WHERE custnum='. $self->custnum;
2947   sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2948 }
2949
2950 =item balance_pkgnum PKGNUM
2951
2952 Returns the balance for this customer's specific package when using
2953 experimental package balances (total_owed plus total_unrefunded, minus
2954 total_unapplied_credits minus total_unapplied_payments)
2955
2956 =cut
2957
2958 sub balance_pkgnum {
2959   my( $self, $pkgnum ) = @_;
2960
2961   sprintf( "%.2f",
2962       $self->total_owed_pkgnum($pkgnum)
2963 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2964 #    + $self->total_unapplied_refunds_pkgnum($pkgnum)
2965     - $self->total_unapplied_credits_pkgnum($pkgnum)
2966     - $self->total_unapplied_payments_pkgnum($pkgnum)
2967   );
2968 }
2969
2970 =item in_transit_payments
2971
2972 Returns the total of requests for payments for this customer pending in
2973 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
2974
2975 =cut
2976
2977 sub in_transit_payments {
2978   my $self = shift;
2979   my $in_transit_payments = 0;
2980   foreach my $pay_batch ( qsearch('pay_batch', {
2981     'status' => 'I',
2982   } ) ) {
2983     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
2984       'batchnum' => $pay_batch->batchnum,
2985       'custnum' => $self->custnum,
2986     } ) ) {
2987       $in_transit_payments += $cust_pay_batch->amount;
2988     }
2989   }
2990   sprintf( "%.2f", $in_transit_payments );
2991 }
2992
2993 =item payment_info
2994
2995 Returns a hash of useful information for making a payment.
2996
2997 =over 4
2998
2999 =item balance
3000
3001 Current balance.
3002
3003 =item payby
3004
3005 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
3006 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
3007 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
3008
3009 =back
3010
3011 For credit card transactions:
3012
3013 =over 4
3014
3015 =item card_type 1
3016
3017 =item payname
3018
3019 Exact name on card
3020
3021 =back
3022
3023 For electronic check transactions:
3024
3025 =over 4
3026
3027 =item stateid_state
3028
3029 =back
3030
3031 =cut
3032
3033 sub payment_info {
3034   my $self = shift;
3035
3036   my %return = ();
3037
3038   $return{balance} = $self->balance;
3039
3040   $return{payname} = $self->payname
3041                      || ( $self->first. ' '. $self->get('last') );
3042
3043   $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
3044
3045   $return{payby} = $self->payby;
3046   $return{stateid_state} = $self->stateid_state;
3047
3048   if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
3049     $return{card_type} = cardtype($self->payinfo);
3050     $return{payinfo} = $self->paymask;
3051
3052     @return{'month', 'year'} = $self->paydate_monthyear;
3053
3054   }
3055
3056   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
3057     my ($payinfo1, $payinfo2) = split '@', $self->paymask;
3058     $return{payinfo1} = $payinfo1;
3059     $return{payinfo2} = $payinfo2;
3060     $return{paytype}  = $self->paytype;
3061     $return{paystate} = $self->paystate;
3062
3063   }
3064
3065   #doubleclick protection
3066   my $_date = time;
3067   $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
3068
3069   %return;
3070
3071 }
3072
3073 =item paydate_monthyear
3074
3075 Returns a two-element list consisting of the month and year of this customer's
3076 paydate (credit card expiration date for CARD customers)
3077
3078 =cut
3079
3080 sub paydate_monthyear {
3081   my $self = shift;
3082   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3083     ( $2, $1 );
3084   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3085     ( $1, $3 );
3086   } else {
3087     ('', '');
3088   }
3089 }
3090
3091 =item paydate_epoch
3092
3093 Returns the exact time in seconds corresponding to the payment method
3094 expiration date.  For CARD/DCRD customers this is the end of the month;
3095 for others (COMP is the only other payby that uses paydate) it's the start.
3096 Returns 0 if the paydate is empty or set to the far future.
3097
3098 =cut
3099
3100 sub paydate_epoch {
3101   my $self = shift;
3102   my ($month, $year) = $self->paydate_monthyear;
3103   return 0 if !$year or $year >= 2037;
3104   if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) {
3105     $month++;
3106     if ( $month == 13 ) {
3107       $month = 1;
3108       $year++;
3109     }
3110     return timelocal(0,0,0,1,$month-1,$year) - 1;
3111   }
3112   else {
3113     return timelocal(0,0,0,1,$month-1,$year);
3114   }
3115 }
3116
3117 =item paydate_epoch_sql
3118
3119 Class method.  Returns an SQL expression to obtain the payment expiration date
3120 as a number of seconds.
3121
3122 =cut
3123
3124 # Special expiration date behavior for non-CARD/DCRD customers has been
3125 # carefully preserved.  Do we really use that?
3126 sub paydate_epoch_sql {
3127   my $class = shift;
3128   my $table = shift || 'cust_main';
3129   my ($case1, $case2);
3130   if ( driver_name eq 'Pg' ) {
3131     $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1";
3132     $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )";
3133   }
3134   elsif ( lc(driver_name) eq 'mysql' ) {
3135     $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1";
3136     $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )";
3137   }
3138   else { return '' }
3139   return "CASE WHEN $table.payby IN('CARD','DCRD')
3140   THEN ($case1)
3141   ELSE ($case2)
3142   END"
3143 }
3144
3145 =item tax_exemption TAXNAME
3146
3147 =cut
3148
3149 sub tax_exemption {
3150   my( $self, $taxname ) = @_;
3151
3152   qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
3153                                      'taxname' => $taxname,
3154                                    },
3155           );
3156 }
3157
3158 =item cust_main_exemption
3159
3160 =cut
3161
3162 sub cust_main_exemption {
3163   my $self = shift;
3164   qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
3165 }
3166
3167 =item invoicing_list [ ARRAYREF ]
3168
3169 If an arguement is given, sets these email addresses as invoice recipients
3170 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
3171 (except as warnings), so use check_invoicing_list first.
3172
3173 Returns a list of email addresses (with svcnum entries expanded).
3174
3175 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
3176 check it without disturbing anything by passing nothing.
3177
3178 This interface may change in the future.
3179
3180 =cut
3181
3182 sub invoicing_list {
3183   my( $self, $arrayref ) = @_;
3184
3185   if ( $arrayref ) {
3186     my @cust_main_invoice;
3187     if ( $self->custnum ) {
3188       @cust_main_invoice =
3189         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3190     } else {
3191       @cust_main_invoice = ();
3192     }
3193     foreach my $cust_main_invoice ( @cust_main_invoice ) {
3194       #warn $cust_main_invoice->destnum;
3195       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3196         #warn $cust_main_invoice->destnum;
3197         my $error = $cust_main_invoice->delete;
3198         warn $error if $error;
3199       }
3200     }
3201     if ( $self->custnum ) {
3202       @cust_main_invoice =
3203         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3204     } else {
3205       @cust_main_invoice = ();
3206     }
3207     my %seen = map { $_->address => 1 } @cust_main_invoice;
3208     foreach my $address ( @{$arrayref} ) {
3209       next if exists $seen{$address} && $seen{$address};
3210       $seen{$address} = 1;
3211       my $cust_main_invoice = new FS::cust_main_invoice ( {
3212         'custnum' => $self->custnum,
3213         'dest'    => $address,
3214       } );
3215       my $error = $cust_main_invoice->insert;
3216       warn $error if $error;
3217     }
3218   }
3219
3220   if ( $self->custnum ) {
3221     map { $_->address }
3222       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3223   } else {
3224     ();
3225   }
3226
3227 }
3228
3229 =item check_invoicing_list ARRAYREF
3230
3231 Checks these arguements as valid input for the invoicing_list method.  If there
3232 is an error, returns the error, otherwise returns false.
3233
3234 =cut
3235
3236 sub check_invoicing_list {
3237   my( $self, $arrayref ) = @_;
3238
3239   foreach my $address ( @$arrayref ) {
3240
3241     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3242       return 'Can\'t add FAX invoice destination with a blank FAX number.';
3243     }
3244
3245     my $cust_main_invoice = new FS::cust_main_invoice ( {
3246       'custnum' => $self->custnum,
3247       'dest'    => $address,
3248     } );
3249     my $error = $self->custnum
3250                 ? $cust_main_invoice->check
3251                 : $cust_main_invoice->checkdest
3252     ;
3253     return $error if $error;
3254
3255   }
3256
3257   return "Email address required"
3258     if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
3259     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
3260
3261   '';
3262 }
3263
3264 =item set_default_invoicing_list
3265
3266 Sets the invoicing list to all accounts associated with this customer,
3267 overwriting any previous invoicing list.
3268
3269 =cut
3270
3271 sub set_default_invoicing_list {
3272   my $self = shift;
3273   $self->invoicing_list($self->all_emails);
3274 }
3275
3276 =item all_emails
3277
3278 Returns the email addresses of all accounts provisioned for this customer.
3279
3280 =cut
3281
3282 sub all_emails {
3283   my $self = shift;
3284   my %list;
3285   foreach my $cust_pkg ( $self->all_pkgs ) {
3286     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3287     my @svc_acct =
3288       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3289         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3290           @cust_svc;
3291     $list{$_}=1 foreach map { $_->email } @svc_acct;
3292   }
3293   keys %list;
3294 }
3295
3296 =item invoicing_list_addpost
3297
3298 Adds postal invoicing to this customer.  If this customer is already configured
3299 to receive postal invoices, does nothing.
3300
3301 =cut
3302
3303 sub invoicing_list_addpost {
3304   my $self = shift;
3305   return if grep { $_ eq 'POST' } $self->invoicing_list;
3306   my @invoicing_list = $self->invoicing_list;
3307   push @invoicing_list, 'POST';
3308   $self->invoicing_list(\@invoicing_list);
3309 }
3310
3311 =item invoicing_list_emailonly
3312
3313 Returns the list of email invoice recipients (invoicing_list without non-email
3314 destinations such as POST and FAX).
3315
3316 =cut
3317
3318 sub invoicing_list_emailonly {
3319   my $self = shift;
3320   warn "$me invoicing_list_emailonly called"
3321     if $DEBUG;
3322   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3323 }
3324
3325 =item invoicing_list_emailonly_scalar
3326
3327 Returns the list of email invoice recipients (invoicing_list without non-email
3328 destinations such as POST and FAX) as a comma-separated scalar.
3329
3330 =cut
3331
3332 sub invoicing_list_emailonly_scalar {
3333   my $self = shift;
3334   warn "$me invoicing_list_emailonly_scalar called"
3335     if $DEBUG;
3336   join(', ', $self->invoicing_list_emailonly);
3337 }
3338
3339 =item referral_custnum_cust_main
3340
3341 Returns the customer who referred this customer (or the empty string, if
3342 this customer was not referred).
3343
3344 Note the difference with referral_cust_main method: This method,
3345 referral_custnum_cust_main returns the single customer (if any) who referred
3346 this customer, while referral_cust_main returns an array of customers referred
3347 BY this customer.
3348
3349 =cut
3350
3351 sub referral_custnum_cust_main {
3352   my $self = shift;
3353   return '' unless $self->referral_custnum;
3354   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3355 }
3356
3357 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3358
3359 Returns an array of customers referred by this customer (referral_custnum set
3360 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
3361 customers referred by customers referred by this customer and so on, inclusive.
3362 The default behavior is DEPTH 1 (no recursion).
3363
3364 Note the difference with referral_custnum_cust_main method: This method,
3365 referral_cust_main, returns an array of customers referred BY this customer,
3366 while referral_custnum_cust_main returns the single customer (if any) who
3367 referred this customer.
3368
3369 =cut
3370
3371 sub referral_cust_main {
3372   my $self = shift;
3373   my $depth = @_ ? shift : 1;
3374   my $exclude = @_ ? shift : {};
3375
3376   my @cust_main =
3377     map { $exclude->{$_->custnum}++; $_; }
3378       grep { ! $exclude->{ $_->custnum } }
3379         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3380
3381   if ( $depth > 1 ) {
3382     push @cust_main,
3383       map { $_->referral_cust_main($depth-1, $exclude) }
3384         @cust_main;
3385   }
3386
3387   @cust_main;
3388 }
3389
3390 =item referral_cust_main_ncancelled
3391
3392 Same as referral_cust_main, except only returns customers with uncancelled
3393 packages.
3394
3395 =cut
3396
3397 sub referral_cust_main_ncancelled {
3398   my $self = shift;
3399   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3400 }
3401
3402 =item referral_cust_pkg [ DEPTH ]
3403
3404 Like referral_cust_main, except returns a flat list of all unsuspended (and
3405 uncancelled) packages for each customer.  The number of items in this list may
3406 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3407
3408 =cut
3409
3410 sub referral_cust_pkg {
3411   my $self = shift;
3412   my $depth = @_ ? shift : 1;
3413
3414   map { $_->unsuspended_pkgs }
3415     grep { $_->unsuspended_pkgs }
3416       $self->referral_cust_main($depth);
3417 }
3418
3419 =item referring_cust_main
3420
3421 Returns the single cust_main record for the customer who referred this customer
3422 (referral_custnum), or false.
3423
3424 =cut
3425
3426 sub referring_cust_main {
3427   my $self = shift;
3428   return '' unless $self->referral_custnum;
3429   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3430 }
3431
3432 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3433
3434 Applies a credit to this customer.  If there is an error, returns the error,
3435 otherwise returns false.
3436
3437 REASON can be a text string, an FS::reason object, or a scalar reference to
3438 a reasonnum.  If a text string, it will be automatically inserted as a new
3439 reason, and a 'reason_type' option must be passed to indicate the
3440 FS::reason_type for the new reason.
3441
3442 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3443
3444 Any other options are passed to FS::cust_credit::insert.
3445
3446 =cut
3447
3448 sub credit {
3449   my( $self, $amount, $reason, %options ) = @_;
3450
3451   my $cust_credit = new FS::cust_credit {
3452     'custnum' => $self->custnum,
3453     'amount'  => $amount,
3454   };
3455
3456   if ( ref($reason) ) {
3457
3458     if ( ref($reason) eq 'SCALAR' ) {
3459       $cust_credit->reasonnum( $$reason );
3460     } else {
3461       $cust_credit->reasonnum( $reason->reasonnum );
3462     }
3463
3464   } else {
3465     $cust_credit->set('reason', $reason)
3466   }
3467
3468   for (qw( addlinfo eventnum )) {
3469     $cust_credit->$_( delete $options{$_} )
3470       if exists($options{$_});
3471   }
3472
3473   $cust_credit->insert(%options);
3474
3475 }
3476
3477 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3478
3479 Creates a one-time charge for this customer.  If there is an error, returns
3480 the error, otherwise returns false.
3481
3482 New-style, with a hashref of options:
3483
3484   my $error = $cust_main->charge(
3485                                   {
3486                                     'amount'     => 54.32,
3487                                     'quantity'   => 1,
3488                                     'start_date' => str2time('7/4/2009'),
3489                                     'pkg'        => 'Description',
3490                                     'comment'    => 'Comment',
3491                                     'additional' => [], #extra invoice detail
3492                                     'classnum'   => 1,  #pkg_class
3493
3494                                     'setuptax'   => '', # or 'Y' for tax exempt
3495
3496                                     #internal taxation
3497                                     'taxclass'   => 'Tax class',
3498
3499                                     #vendor taxation
3500                                     'taxproduct' => 2,  #part_pkg_taxproduct
3501                                     'override'   => {}, #XXX describe
3502
3503                                     #will be filled in with the new object
3504                                     'cust_pkg_ref' => \$cust_pkg,
3505
3506                                     #generate an invoice immediately
3507                                     'bill_now' => 0,
3508                                     'invoice_terms' => '', #with these terms
3509                                   }
3510                                 );
3511
3512 Old-style:
3513
3514   my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3515
3516 =cut
3517
3518 sub charge {
3519   my $self = shift;
3520   my ( $amount, $quantity, $start_date, $classnum );
3521   my ( $pkg, $comment, $additional );
3522   my ( $setuptax, $taxclass );   #internal taxes
3523   my ( $taxproduct, $override ); #vendor (CCH) taxes
3524   my $no_auto = '';
3525   my $cust_pkg_ref = '';
3526   my ( $bill_now, $invoice_terms ) = ( 0, '' );
3527   if ( ref( $_[0] ) ) {
3528     $amount     = $_[0]->{amount};
3529     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3530     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3531     $no_auto    = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3532     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3533     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
3534                                            : '$'. sprintf("%.2f",$amount);
3535     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3536     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3537     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3538     $additional = $_[0]->{additional} || [];
3539     $taxproduct = $_[0]->{taxproductnum};
3540     $override   = { '' => $_[0]->{tax_override} };
3541     $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3542     $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3543     $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3544   } else {
3545     $amount     = shift;
3546     $quantity   = 1;
3547     $start_date = '';
3548     $pkg        = @_ ? shift : 'One-time charge';
3549     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
3550     $setuptax   = '';
3551     $taxclass   = @_ ? shift : '';
3552     $additional = [];
3553   }
3554
3555   local $SIG{HUP} = 'IGNORE';
3556   local $SIG{INT} = 'IGNORE';
3557   local $SIG{QUIT} = 'IGNORE';
3558   local $SIG{TERM} = 'IGNORE';
3559   local $SIG{TSTP} = 'IGNORE';
3560   local $SIG{PIPE} = 'IGNORE';
3561
3562   my $oldAutoCommit = $FS::UID::AutoCommit;
3563   local $FS::UID::AutoCommit = 0;
3564   my $dbh = dbh;
3565
3566   my $part_pkg = new FS::part_pkg ( {
3567     'pkg'           => $pkg,
3568     'comment'       => $comment,
3569     'plan'          => 'flat',
3570     'freq'          => 0,
3571     'disabled'      => 'Y',
3572     'classnum'      => ( $classnum ? $classnum : '' ),
3573     'setuptax'      => $setuptax,
3574     'taxclass'      => $taxclass,
3575     'taxproductnum' => $taxproduct,
3576   } );
3577
3578   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3579                         ( 0 .. @$additional - 1 )
3580                   ),
3581                   'additional_count' => scalar(@$additional),
3582                   'setup_fee' => $amount,
3583                 );
3584
3585   my $error = $part_pkg->insert( options       => \%options,
3586                                  tax_overrides => $override,
3587                                );
3588   if ( $error ) {
3589     $dbh->rollback if $oldAutoCommit;
3590     return $error;
3591   }
3592
3593   my $pkgpart = $part_pkg->pkgpart;
3594   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3595   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3596     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3597     $error = $type_pkgs->insert;
3598     if ( $error ) {
3599       $dbh->rollback if $oldAutoCommit;
3600       return $error;
3601     }
3602   }
3603
3604   my $cust_pkg = new FS::cust_pkg ( {
3605     'custnum'    => $self->custnum,
3606     'pkgpart'    => $pkgpart,
3607     'quantity'   => $quantity,
3608     'start_date' => $start_date,
3609     'no_auto'    => $no_auto,
3610   } );
3611
3612   $error = $cust_pkg->insert;
3613   if ( $error ) {
3614     $dbh->rollback if $oldAutoCommit;
3615     return $error;
3616   } elsif ( $cust_pkg_ref ) {
3617     ${$cust_pkg_ref} = $cust_pkg;
3618   }
3619
3620   if ( $bill_now ) {
3621     my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3622                              'pkg_list'      => [ $cust_pkg ],
3623                            );
3624     if ( $error ) {
3625       $dbh->rollback if $oldAutoCommit;
3626       return $error;
3627     }
3628   }
3629
3630   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3631   return '';
3632
3633 }
3634
3635 #=item charge_postal_fee
3636 #
3637 #Applies a one time charge this customer.  If there is an error,
3638 #returns the error, returns the cust_pkg charge object or false
3639 #if there was no charge.
3640 #
3641 #=cut
3642 #
3643 # This should be a customer event.  For that to work requires that bill
3644 # also be a customer event.
3645
3646 sub charge_postal_fee {
3647   my $self = shift;
3648
3649   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3650   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3651
3652   my $cust_pkg = new FS::cust_pkg ( {
3653     'custnum'  => $self->custnum,
3654     'pkgpart'  => $pkgpart,
3655     'quantity' => 1,
3656   } );
3657
3658   my $error = $cust_pkg->insert;
3659   $error ? $error : $cust_pkg;
3660 }
3661
3662 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3663
3664 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3665
3666 Optionally, a list or hashref of additional arguments to the qsearch call can
3667 be passed.
3668
3669 =cut
3670
3671 sub cust_bill {
3672   my $self = shift;
3673   my $opt = ref($_[0]) ? shift : { @_ };
3674
3675   #return $self->num_cust_bill unless wantarray || keys %$opt;
3676
3677   $opt->{'table'} = 'cust_bill';
3678   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3679   $opt->{'hashref'}{'custnum'} = $self->custnum;
3680   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3681
3682   map { $_ } #behavior of sort undefined in scalar context
3683     sort { $a->_date <=> $b->_date }
3684       qsearch($opt);
3685 }
3686
3687 =item open_cust_bill
3688
3689 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3690 customer.
3691
3692 =cut
3693
3694 sub open_cust_bill {
3695   my $self = shift;
3696
3697   $self->cust_bill(
3698     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3699     #@_
3700   );
3701
3702 }
3703
3704 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3705
3706 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3707
3708 =cut
3709
3710 sub legacy_cust_bill {
3711   my $self = shift;
3712
3713   #return $self->num_legacy_cust_bill unless wantarray;
3714
3715   map { $_ } #behavior of sort undefined in scalar context
3716     sort { $a->_date <=> $b->_date }
3717       qsearch({ 'table'    => 'legacy_cust_bill',
3718                 'hashref'  => { 'custnum' => $self->custnum, },
3719                 'order_by' => 'ORDER BY _date ASC',
3720              });
3721 }
3722
3723 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3724
3725 Returns all the statements (see L<FS::cust_statement>) for this customer.
3726
3727 Optionally, a list or hashref of additional arguments to the qsearch call can
3728 be passed.
3729
3730 =cut
3731
3732 sub cust_statement {
3733   my $self = shift;
3734   my $opt = ref($_[0]) ? shift : { @_ };
3735
3736   #return $self->num_cust_statement unless wantarray || keys %$opt;
3737
3738   $opt->{'table'} = 'cust_statement';
3739   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3740   $opt->{'hashref'}{'custnum'} = $self->custnum;
3741   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3742
3743   map { $_ } #behavior of sort undefined in scalar context
3744     sort { $a->_date <=> $b->_date }
3745       qsearch($opt);
3746 }
3747
3748 =item cust_credit
3749
3750 Returns all the credits (see L<FS::cust_credit>) for this customer.
3751
3752 =cut
3753
3754 sub cust_credit {
3755   my $self = shift;
3756   map { $_ } #return $self->num_cust_credit unless wantarray;
3757   sort { $a->_date <=> $b->_date }
3758     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3759 }
3760
3761 =item cust_credit_pkgnum
3762
3763 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3764 package when using experimental package balances.
3765
3766 =cut
3767
3768 sub cust_credit_pkgnum {
3769   my( $self, $pkgnum ) = @_;
3770   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3771   sort { $a->_date <=> $b->_date }
3772     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3773                               'pkgnum'  => $pkgnum,
3774                             }
3775     );
3776 }
3777
3778 =item cust_pay
3779
3780 Returns all the payments (see L<FS::cust_pay>) for this customer.
3781
3782 =cut
3783
3784 sub cust_pay {
3785   my $self = shift;
3786   return $self->num_cust_pay unless wantarray;
3787   sort { $a->_date <=> $b->_date }
3788     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3789 }
3790
3791 =item num_cust_pay
3792
3793 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
3794 called automatically when the cust_pay method is used in a scalar context.
3795
3796 =cut
3797
3798 sub num_cust_pay {
3799   my $self = shift;
3800   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3801   my $sth = dbh->prepare($sql) or die dbh->errstr;
3802   $sth->execute($self->custnum) or die $sth->errstr;
3803   $sth->fetchrow_arrayref->[0];
3804 }
3805
3806 =item cust_pay_pkgnum
3807
3808 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3809 package when using experimental package balances.
3810
3811 =cut
3812
3813 sub cust_pay_pkgnum {
3814   my( $self, $pkgnum ) = @_;
3815   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3816   sort { $a->_date <=> $b->_date }
3817     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3818                            'pkgnum'  => $pkgnum,
3819                          }
3820     );
3821 }
3822
3823 =item cust_pay_void
3824
3825 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3826
3827 =cut
3828
3829 sub cust_pay_void {
3830   my $self = shift;
3831   map { $_ } #return $self->num_cust_pay_void unless wantarray;
3832   sort { $a->_date <=> $b->_date }
3833     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3834 }
3835
3836 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3837
3838 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
3839
3840 Optionally, a list or hashref of additional arguments to the qsearch call can
3841 be passed.
3842
3843 =cut
3844
3845 sub cust_pay_batch {
3846   my $self = shift;
3847   my $opt = ref($_[0]) ? shift : { @_ };
3848
3849   #return $self->num_cust_statement unless wantarray || keys %$opt;
3850
3851   $opt->{'table'} = 'cust_pay_batch';
3852   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3853   $opt->{'hashref'}{'custnum'} = $self->custnum;
3854   $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
3855
3856   map { $_ } #behavior of sort undefined in scalar context
3857     sort { $a->paybatchnum <=> $b->paybatchnum }
3858       qsearch($opt);
3859 }
3860
3861 =item cust_pay_pending
3862
3863 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3864 (without status "done").
3865
3866 =cut
3867
3868 sub cust_pay_pending {
3869   my $self = shift;
3870   return $self->num_cust_pay_pending unless wantarray;
3871   sort { $a->_date <=> $b->_date }
3872     qsearch( 'cust_pay_pending', {
3873                                    'custnum' => $self->custnum,
3874                                    'status'  => { op=>'!=', value=>'done' },
3875                                  },
3876            );
3877 }
3878
3879 =item cust_pay_pending_attempt
3880
3881 Returns all payment attempts / declined payments for this customer, as pending
3882 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3883 a corresponding payment (see L<FS::cust_pay>).
3884
3885 =cut
3886
3887 sub cust_pay_pending_attempt {
3888   my $self = shift;
3889   return $self->num_cust_pay_pending_attempt unless wantarray;
3890   sort { $a->_date <=> $b->_date }
3891     qsearch( 'cust_pay_pending', {
3892                                    'custnum' => $self->custnum,
3893                                    'status'  => 'done',
3894                                    'paynum'  => '',
3895                                  },
3896            );
3897 }
3898
3899 =item num_cust_pay_pending
3900
3901 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3902 customer (without status "done").  Also called automatically when the
3903 cust_pay_pending method is used in a scalar context.
3904
3905 =cut
3906
3907 sub num_cust_pay_pending {
3908   my $self = shift;
3909   $self->scalar_sql(
3910     " SELECT COUNT(*) FROM cust_pay_pending ".
3911       " WHERE custnum = ? AND status != 'done' ",
3912     $self->custnum
3913   );
3914 }
3915
3916 =item num_cust_pay_pending_attempt
3917
3918 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3919 customer, with status "done" but without a corresp.  Also called automatically when the
3920 cust_pay_pending method is used in a scalar context.
3921
3922 =cut
3923
3924 sub num_cust_pay_pending_attempt {
3925   my $self = shift;
3926   $self->scalar_sql(
3927     " SELECT COUNT(*) FROM cust_pay_pending ".
3928       " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3929     $self->custnum
3930   );
3931 }
3932
3933 =item cust_refund
3934
3935 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3936
3937 =cut
3938
3939 sub cust_refund {
3940   my $self = shift;
3941   map { $_ } #return $self->num_cust_refund unless wantarray;
3942   sort { $a->_date <=> $b->_date }
3943     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3944 }
3945
3946 =item display_custnum
3947
3948 Returns the displayed customer number for this customer: agent_custid if
3949 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3950
3951 =cut
3952
3953 sub display_custnum {
3954   my $self = shift;
3955
3956   my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
3957   if ( my $special = $conf->config('cust_main-custnum-display_special') ) {
3958     if ( $special eq 'CoStAg' ) {
3959       $prefix = uc( join('',
3960         $self->country,
3961         ($self->state =~ /^(..)/),
3962         $prefix || ($self->agent->agent =~ /^(..)/)
3963       ) );
3964     }
3965     elsif ( $special eq 'CoStCl' ) {
3966       $prefix = uc( join('',
3967         $self->country,
3968         ($self->state =~ /^(..)/),
3969         ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__')
3970       ) );
3971     }
3972     # add any others here if needed
3973   }
3974
3975   my $length = $conf->config('cust_main-custnum-display_length');
3976   if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
3977     return $self->agent_custid;
3978   } elsif ( $prefix ) {
3979     $length = 8 if !defined($length);
3980     return $prefix .
3981            sprintf('%0'.$length.'d', $self->custnum)
3982   } elsif ( $length ) {
3983     return sprintf('%0'.$length.'d', $self->custnum);
3984   } else {
3985     return $self->custnum;
3986   }
3987 }
3988
3989 =item name
3990
3991 Returns a name string for this customer, either "Company (Last, First)" or
3992 "Last, First".
3993
3994 =cut
3995
3996 sub name {
3997   my $self = shift;
3998   my $name = $self->contact;
3999   $name = $self->company. " ($name)" if $self->company;
4000   $name;
4001 }
4002
4003 =item ship_name
4004
4005 Returns a name string for this (service/shipping) contact, either
4006 "Company (Last, First)" or "Last, First".
4007
4008 =cut
4009
4010 sub ship_name {
4011   my $self = shift;
4012   if ( $self->get('ship_last') ) {
4013     my $name = $self->ship_contact;
4014     $name = $self->ship_company. " ($name)" if $self->ship_company;
4015     $name;
4016   } else {
4017     $self->name;
4018   }
4019 }
4020
4021 =item name_short
4022
4023 Returns a name string for this customer, either "Company" or "First Last".
4024
4025 =cut
4026
4027 sub name_short {
4028   my $self = shift;
4029   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
4030 }
4031
4032 =item ship_name_short
4033
4034 Returns a name string for this (service/shipping) contact, either "Company"
4035 or "First Last".
4036
4037 =cut
4038
4039 sub ship_name_short {
4040   my $self = shift;
4041   if ( $self->get('ship_last') ) {
4042     $self->ship_company !~ /^\s*$/
4043       ? $self->ship_company
4044       : $self->ship_contact_firstlast;
4045   } else {
4046     $self->name_company_or_firstlast;
4047   }
4048 }
4049
4050 =item contact
4051
4052 Returns this customer's full (billing) contact name only, "Last, First"
4053
4054 =cut
4055
4056 sub contact {
4057   my $self = shift;
4058   $self->get('last'). ', '. $self->first;
4059 }
4060
4061 =item ship_contact
4062
4063 Returns this customer's full (shipping) contact name only, "Last, First"
4064
4065 =cut
4066
4067 sub ship_contact {
4068   my $self = shift;
4069   $self->get('ship_last')
4070     ? $self->get('ship_last'). ', '. $self->ship_first
4071     : $self->contact;
4072 }
4073
4074 =item contact_firstlast
4075
4076 Returns this customers full (billing) contact name only, "First Last".
4077
4078 =cut
4079
4080 sub contact_firstlast {
4081   my $self = shift;
4082   $self->first. ' '. $self->get('last');
4083 }
4084
4085 =item ship_contact_firstlast
4086
4087 Returns this customer's full (shipping) contact name only, "First Last".
4088
4089 =cut
4090
4091 sub ship_contact_firstlast {
4092   my $self = shift;
4093   $self->get('ship_last')
4094     ? $self->first. ' '. $self->get('ship_last')
4095     : $self->contact_firstlast;
4096 }
4097
4098 =item country_full
4099
4100 Returns this customer's full country name
4101
4102 =cut
4103
4104 sub country_full {
4105   my $self = shift;
4106   code2country($self->country);
4107 }
4108
4109 =item county_state_county [ PREFIX ]
4110
4111 Returns a string consisting of just the county, state and country.
4112
4113 =cut
4114
4115 sub county_state_country {
4116   my $self = shift;
4117   my $prefix = (@_ && $_[0]) ? shift : '';
4118   my $label = $self->get($prefix.'country');
4119   $label = $self->get($prefix.'state'). ", $label"
4120     if $self->get($prefix.'state');
4121   $label = $self->get($prefix.'county')." County, $label"
4122     if $self->get($prefix.'county');
4123   $label;
4124 }
4125
4126 =item geocode DATA_VENDOR
4127
4128 Returns a value for the customer location as encoded by DATA_VENDOR.
4129 Currently this only makes sense for "CCH" as DATA_VENDOR.
4130
4131 =cut
4132
4133 =item cust_status
4134
4135 =item status
4136
4137 Returns a status string for this customer, currently:
4138
4139 =over 4
4140
4141 =item prospect - No packages have ever been ordered
4142
4143 =item ordered - Recurring packages all are new (not yet billed).
4144
4145 =item active - One or more recurring packages is active
4146
4147 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4148
4149 =item suspended - All non-cancelled recurring packages are suspended
4150
4151 =item cancelled - All recurring packages are cancelled
4152
4153 =back
4154
4155 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4156 cust_main-status_module configuration option.
4157
4158 =cut
4159
4160 sub status { shift->cust_status(@_); }
4161
4162 sub cust_status {
4163   my $self = shift;
4164   for my $status ( FS::cust_main->statuses() ) {
4165     my $method = $status.'_sql';
4166     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4167     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4168     $sth->execute( ($self->custnum) x $numnum )
4169       or die "Error executing 'SELECT $sql': ". $sth->errstr;
4170     return $status if $sth->fetchrow_arrayref->[0];
4171   }
4172 }
4173
4174 =item ucfirst_cust_status
4175
4176 =item ucfirst_status
4177
4178 Returns the status with the first character capitalized.
4179
4180 =cut
4181
4182 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4183
4184 sub ucfirst_cust_status {
4185   my $self = shift;
4186   ucfirst($self->cust_status);
4187 }
4188
4189 =item statuscolor
4190
4191 Returns a hex triplet color string for this customer's status.
4192
4193 =cut
4194
4195 sub statuscolor { shift->cust_statuscolor(@_); }
4196
4197 sub cust_statuscolor {
4198   my $self = shift;
4199   __PACKAGE__->statuscolors->{$self->cust_status};
4200 }
4201
4202 =item tickets
4203
4204 Returns an array of hashes representing the customer's RT tickets.
4205
4206 =cut
4207
4208 sub tickets {
4209   my $self = shift;
4210
4211   my $num = $conf->config('cust_main-max_tickets') || 10;
4212   my @tickets = ();
4213
4214   if ( $conf->config('ticket_system') ) {
4215     unless ( $conf->config('ticket_system-custom_priority_field') ) {
4216
4217       @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
4218
4219     } else {
4220
4221       foreach my $priority (
4222         $conf->config('ticket_system-custom_priority_field-values'), ''
4223       ) {
4224         last if scalar(@tickets) >= $num;
4225         push @tickets,
4226           @{ FS::TicketSystem->customer_tickets( $self->custnum,
4227                                                  $num - scalar(@tickets),
4228                                                  $priority,
4229                                                )
4230            };
4231       }
4232     }
4233   }
4234   (@tickets);
4235 }
4236
4237 # Return services representing svc_accts in customer support packages
4238 sub support_services {
4239   my $self = shift;
4240   my %packages = map { $_ => 1 } $conf->config('support_packages');
4241
4242   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4243     grep { $_->part_svc->svcdb eq 'svc_acct' }
4244     map { $_->cust_svc }
4245     grep { exists $packages{ $_->pkgpart } }
4246     $self->ncancelled_pkgs;
4247
4248 }
4249
4250 # Return a list of latitude/longitude for one of the services (if any)
4251 sub service_coordinates {
4252   my $self = shift;
4253
4254   my @svc_X =
4255     grep { $_->latitude && $_->longitude }
4256     map { $_->svc_x }
4257     map { $_->cust_svc }
4258     $self->ncancelled_pkgs;
4259
4260   scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4261 }
4262
4263 =item masked FIELD
4264
4265 Returns a masked version of the named field
4266
4267 =cut
4268
4269 sub masked {
4270 my ($self,$field) = @_;
4271
4272 # Show last four
4273
4274 'x'x(length($self->getfield($field))-4).
4275   substr($self->getfield($field), (length($self->getfield($field))-4));
4276
4277 }
4278
4279 =back
4280
4281 =head1 CLASS METHODS
4282
4283 =over 4
4284
4285 =item statuses
4286
4287 Class method that returns the list of possible status strings for customers
4288 (see L<the status method|/status>).  For example:
4289
4290   @statuses = FS::cust_main->statuses();
4291
4292 =cut
4293
4294 sub statuses {
4295   my $self = shift;
4296   keys %{ $self->statuscolors };
4297 }
4298
4299 =item cust_status_sql
4300
4301 Returns an SQL fragment to determine the status of a cust_main record, as a
4302 string.
4303
4304 =cut
4305
4306 sub cust_status_sql {
4307   my $sql = 'CASE';
4308   for my $status ( FS::cust_main->statuses() ) {
4309     my $method = $status.'_sql';
4310     $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4311   }
4312   $sql .= ' END';
4313   return $sql;
4314 }
4315
4316
4317 =item prospect_sql
4318
4319 Returns an SQL expression identifying prospective cust_main records (customers
4320 with no packages ever ordered)
4321
4322 =cut
4323
4324 use vars qw($select_count_pkgs);
4325 $select_count_pkgs =
4326   "SELECT COUNT(*) FROM cust_pkg
4327     WHERE cust_pkg.custnum = cust_main.custnum";
4328
4329 sub select_count_pkgs_sql {
4330   $select_count_pkgs;
4331 }
4332
4333 sub prospect_sql {
4334   " 0 = ( $select_count_pkgs ) ";
4335 }
4336
4337 =item ordered_sql
4338
4339 Returns an SQL expression identifying ordered cust_main records (customers with
4340 no active packages, but recurring packages not yet setup or one time charges
4341 not yet billed).
4342
4343 =cut
4344
4345 sub ordered_sql {
4346   FS::cust_main->none_active_sql.
4347   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4348 }
4349
4350 =item active_sql
4351
4352 Returns an SQL expression identifying active cust_main records (customers with
4353 active recurring packages).
4354
4355 =cut
4356
4357 sub active_sql {
4358   " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4359 }
4360
4361 =item none_active_sql
4362
4363 Returns an SQL expression identifying cust_main records with no active
4364 recurring packages.  This includes customers of status prospect, ordered,
4365 inactive, and suspended.
4366
4367 =cut
4368
4369 sub none_active_sql {
4370   " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4371 }
4372
4373 =item inactive_sql
4374
4375 Returns an SQL expression identifying inactive cust_main records (customers with
4376 no active recurring packages, but otherwise unsuspended/uncancelled).
4377
4378 =cut
4379
4380 sub inactive_sql {
4381   FS::cust_main->none_active_sql.
4382   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4383 }
4384
4385 =item susp_sql
4386 =item suspended_sql
4387
4388 Returns an SQL expression identifying suspended cust_main records.
4389
4390 =cut
4391
4392
4393 sub suspended_sql { susp_sql(@_); }
4394 sub susp_sql {
4395   FS::cust_main->none_active_sql.
4396   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4397 }
4398
4399 =item cancel_sql
4400 =item cancelled_sql
4401
4402 Returns an SQL expression identifying cancelled cust_main records.
4403
4404 =cut
4405
4406 sub cancel_sql { shift->cancelled_sql(@_); }
4407
4408 =item uncancel_sql
4409 =item uncancelled_sql
4410
4411 Returns an SQL expression identifying un-cancelled cust_main records.
4412
4413 =cut
4414
4415 sub uncancelled_sql { uncancel_sql(@_); }
4416 sub uncancel_sql { "
4417   ( 0 < ( $select_count_pkgs
4418                    AND ( cust_pkg.cancel IS NULL
4419                          OR cust_pkg.cancel = 0
4420                        )
4421         )
4422     OR 0 = ( $select_count_pkgs )
4423   )
4424 "; }
4425
4426 =item balance_sql
4427
4428 Returns an SQL fragment to retreive the balance.
4429
4430 =cut
4431
4432 sub balance_sql { "
4433     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4434         WHERE cust_bill.custnum   = cust_main.custnum     )
4435   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
4436         WHERE cust_pay.custnum    = cust_main.custnum     )
4437   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
4438         WHERE cust_credit.custnum = cust_main.custnum     )
4439   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
4440         WHERE cust_refund.custnum = cust_main.custnum     )
4441 "; }
4442
4443 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4444
4445 Returns an SQL fragment to retreive the balance for this customer, optionally
4446 considering invoices with date earlier than START_TIME, and not
4447 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4448 total_unapplied_payments).
4449
4450 Times are specified as SQL fragments or numeric
4451 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4452 L<Date::Parse> for conversion functions.  The empty string can be passed
4453 to disable that time constraint completely.
4454
4455 Available options are:
4456
4457 =over 4
4458
4459 =item unapplied_date
4460
4461 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)
4462
4463 =item total
4464
4465 (unused.  obsolete?)
4466 set to true to remove all customer comparison clauses, for totals
4467
4468 =item where
4469
4470 (unused.  obsolete?)
4471 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4472
4473 =item join
4474
4475 (unused.  obsolete?)
4476 JOIN clause (typically used with the total option)
4477
4478 =item cutoff
4479
4480 An absolute cutoff time.  Payments, credits, and refunds I<applied> after this
4481 time will be ignored.  Note that START_TIME and END_TIME only limit the date
4482 range for invoices and I<unapplied> payments, credits, and refunds.
4483
4484 =back
4485
4486 =cut
4487
4488 sub balance_date_sql {
4489   my( $class, $start, $end, %opt ) = @_;
4490
4491   my $cutoff = $opt{'cutoff'};
4492
4493   my $owed         = FS::cust_bill->owed_sql($cutoff);
4494   my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4495   my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4496   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4497
4498   my $j = $opt{'join'} || '';
4499
4500   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
4501   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4502   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4503   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
4504
4505   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
4506     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4507     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4508     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
4509   ";
4510
4511 }
4512
4513 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4514
4515 Returns an SQL fragment to retreive the total unapplied payments for this
4516 customer, only considering payments with date earlier than START_TIME, and
4517 optionally not later than END_TIME.
4518
4519 Times are specified as SQL fragments or numeric
4520 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4521 L<Date::Parse> for conversion functions.  The empty string can be passed
4522 to disable that time constraint completely.
4523
4524 Available options are:
4525
4526 =cut
4527
4528 sub unapplied_payments_date_sql {
4529   my( $class, $start, $end, %opt ) = @_;
4530
4531   my $cutoff = $opt{'cutoff'};
4532
4533   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4534
4535   my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4536                                                           'unapplied_date'=>1 );
4537
4538   " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4539 }
4540
4541 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4542
4543 Helper method for balance_date_sql; name (and usage) subject to change
4544 (suggestions welcome).
4545
4546 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4547 cust_refund, cust_credit or cust_pay).
4548
4549 If TABLE is "cust_bill" or the unapplied_date option is true, only
4550 considers records with date earlier than START_TIME, and optionally not
4551 later than END_TIME .
4552
4553 =cut
4554
4555 sub _money_table_where {
4556   my( $class, $table, $start, $end, %opt ) = @_;
4557
4558   my @where = ();
4559   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4560   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4561     push @where, "$table._date <= $start" if defined($start) && length($start);
4562     push @where, "$table._date >  $end"   if defined($end)   && length($end);
4563   }
4564   push @where, @{$opt{'where'}} if $opt{'where'};
4565   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4566
4567   $where;
4568
4569 }
4570
4571 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4572 use FS::cust_main::Search;
4573 sub search {
4574   my $class = shift;
4575   FS::cust_main::Search->search(@_);
4576 }
4577
4578 =back
4579
4580 =head1 SUBROUTINES
4581
4582 =over 4
4583
4584 =item batch_charge
4585
4586 =cut
4587
4588 sub batch_charge {
4589   my $param = shift;
4590   #warn join('-',keys %$param);
4591   my $fh = $param->{filehandle};
4592   my $agentnum = $param->{agentnum};
4593   my $format = $param->{format};
4594
4595   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
4596
4597   my @fields;
4598   if ( $format eq 'simple' ) {
4599     @fields = qw( custnum agent_custid amount pkg );
4600   } else {
4601     die "unknown format $format";
4602   }
4603
4604   eval "use Text::CSV_XS;";
4605   die $@ if $@;
4606
4607   my $csv = new Text::CSV_XS;
4608   #warn $csv;
4609   #warn $fh;
4610
4611   my $imported = 0;
4612   #my $columns;
4613
4614   local $SIG{HUP} = 'IGNORE';
4615   local $SIG{INT} = 'IGNORE';
4616   local $SIG{QUIT} = 'IGNORE';
4617   local $SIG{TERM} = 'IGNORE';
4618   local $SIG{TSTP} = 'IGNORE';
4619   local $SIG{PIPE} = 'IGNORE';
4620
4621   my $oldAutoCommit = $FS::UID::AutoCommit;
4622   local $FS::UID::AutoCommit = 0;
4623   my $dbh = dbh;
4624
4625   #while ( $columns = $csv->getline($fh) ) {
4626   my $line;
4627   while ( defined($line=<$fh>) ) {
4628
4629     $csv->parse($line) or do {
4630       $dbh->rollback if $oldAutoCommit;
4631       return "can't parse: ". $csv->error_input();
4632     };
4633
4634     my @columns = $csv->fields();
4635     #warn join('-',@columns);
4636
4637     my %row = ();
4638     foreach my $field ( @fields ) {
4639       $row{$field} = shift @columns;
4640     }
4641
4642     if ( $row{custnum} && $row{agent_custid} ) {
4643       dbh->rollback if $oldAutoCommit;
4644       return "can't specify custnum with agent_custid $row{agent_custid}";
4645     }
4646
4647     my %hash = ();
4648     if ( $row{agent_custid} && $agentnum ) {
4649       %hash = ( 'agent_custid' => $row{agent_custid},
4650                 'agentnum'     => $agentnum,
4651               );
4652     }
4653
4654     if ( $row{custnum} ) {
4655       %hash = ( 'custnum' => $row{custnum} );
4656     }
4657
4658     unless ( scalar(keys %hash) ) {
4659       $dbh->rollback if $oldAutoCommit;
4660       return "can't find customer without custnum or agent_custid and agentnum";
4661     }
4662
4663     my $cust_main = qsearchs('cust_main', { %hash } );
4664     unless ( $cust_main ) {
4665       $dbh->rollback if $oldAutoCommit;
4666       my $custnum = $row{custnum} || $row{agent_custid};
4667       return "unknown custnum $custnum";
4668     }
4669
4670     if ( $row{'amount'} > 0 ) {
4671       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4672       if ( $error ) {
4673         $dbh->rollback if $oldAutoCommit;
4674         return $error;
4675       }
4676       $imported++;
4677     } elsif ( $row{'amount'} < 0 ) {
4678       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4679                                       $row{'pkg'}                         );
4680       if ( $error ) {
4681         $dbh->rollback if $oldAutoCommit;
4682         return $error;
4683       }
4684       $imported++;
4685     } else {
4686       #hmm?
4687     }
4688
4689   }
4690
4691   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4692
4693   return "Empty file!" unless $imported;
4694
4695   ''; #no error
4696
4697 }
4698
4699 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4700
4701 Deprecated.  Use event notification and message templates
4702 (L<FS::msg_template>) instead.
4703
4704 Sends a templated email notification to the customer (see L<Text::Template>).
4705
4706 OPTIONS is a hash and may include
4707
4708 I<from> - the email sender (default is invoice_from)
4709
4710 I<to> - comma-separated scalar or arrayref of recipients
4711    (default is invoicing_list)
4712
4713 I<subject> - The subject line of the sent email notification
4714    (default is "Notice from company_name")
4715
4716 I<extra_fields> - a hashref of name/value pairs which will be substituted
4717    into the template
4718
4719 The following variables are vavailable in the template.
4720
4721 I<$first> - the customer first name
4722 I<$last> - the customer last name
4723 I<$company> - the customer company
4724 I<$payby> - a description of the method of payment for the customer
4725             # would be nice to use FS::payby::shortname
4726 I<$payinfo> - the account information used to collect for this customer
4727 I<$expdate> - the expiration of the customer payment in seconds from epoch
4728
4729 =cut
4730
4731 sub notify {
4732   my ($self, $template, %options) = @_;
4733
4734   return unless $conf->exists($template);
4735
4736   my $from = $conf->config('invoice_from', $self->agentnum)
4737     if $conf->exists('invoice_from', $self->agentnum);
4738   $from = $options{from} if exists($options{from});
4739
4740   my $to = join(',', $self->invoicing_list_emailonly);
4741   $to = $options{to} if exists($options{to});
4742
4743   my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4744     if $conf->exists('company_name', $self->agentnum);
4745   $subject = $options{subject} if exists($options{subject});
4746
4747   my $notify_template = new Text::Template (TYPE => 'ARRAY',
4748                                             SOURCE => [ map "$_\n",
4749                                               $conf->config($template)]
4750                                            )
4751     or die "can't create new Text::Template object: Text::Template::ERROR";
4752   $notify_template->compile()
4753     or die "can't compile template: Text::Template::ERROR";
4754
4755   $FS::notify_template::_template::company_name =
4756     $conf->config('company_name', $self->agentnum);
4757   $FS::notify_template::_template::company_address =
4758     join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4759
4760   my $paydate = $self->paydate || '2037-12-31';
4761   $FS::notify_template::_template::first = $self->first;
4762   $FS::notify_template::_template::last = $self->last;
4763   $FS::notify_template::_template::company = $self->company;
4764   $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4765   my $payby = $self->payby;
4766   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4767   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4768
4769   #credit cards expire at the end of the month/year of their exp date
4770   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4771     $FS::notify_template::_template::payby = 'credit card';
4772     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4773     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4774     $expire_time--;
4775   }elsif ($payby eq 'COMP') {
4776     $FS::notify_template::_template::payby = 'complimentary account';
4777   }else{
4778     $FS::notify_template::_template::payby = 'current method';
4779   }
4780   $FS::notify_template::_template::expdate = $expire_time;
4781
4782   for (keys %{$options{extra_fields}}){
4783     no strict "refs";
4784     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4785   }
4786
4787   send_email(from => $from,
4788              to => $to,
4789              subject => $subject,
4790              body => $notify_template->fill_in( PACKAGE =>
4791                                                 'FS::notify_template::_template'                                              ),
4792             );
4793
4794 }
4795
4796 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4797
4798 Generates a templated notification to the customer (see L<Text::Template>).
4799
4800 OPTIONS is a hash and may include
4801
4802 I<extra_fields> - a hashref of name/value pairs which will be substituted
4803    into the template.  These values may override values mentioned below
4804    and those from the customer record.
4805
4806 The following variables are available in the template instead of or in addition
4807 to the fields of the customer record.
4808
4809 I<$payby> - a description of the method of payment for the customer
4810             # would be nice to use FS::payby::shortname
4811 I<$payinfo> - the masked account information used to collect for this customer
4812 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4813 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4814
4815 =cut
4816
4817 # a lot like cust_bill::print_latex
4818 sub generate_letter {
4819   my ($self, $template, %options) = @_;
4820
4821   return unless $conf->exists($template);
4822
4823   my $letter_template = new Text::Template
4824                         ( TYPE       => 'ARRAY',
4825                           SOURCE     => [ map "$_\n", $conf->config($template)],
4826                           DELIMITERS => [ '[@--', '--@]' ],
4827                         )
4828     or die "can't create new Text::Template object: Text::Template::ERROR";
4829
4830   $letter_template->compile()
4831     or die "can't compile template: Text::Template::ERROR";
4832
4833   my %letter_data = map { $_ => $self->$_ } $self->fields;
4834   $letter_data{payinfo} = $self->mask_payinfo;
4835
4836   #my $paydate = $self->paydate || '2037-12-31';
4837   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4838
4839   my $payby = $self->payby;
4840   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4841   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4842
4843   #credit cards expire at the end of the month/year of their exp date
4844   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4845     $letter_data{payby} = 'credit card';
4846     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4847     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4848     $expire_time--;
4849   }elsif ($payby eq 'COMP') {
4850     $letter_data{payby} = 'complimentary account';
4851   }else{
4852     $letter_data{payby} = 'current method';
4853   }
4854   $letter_data{expdate} = $expire_time;
4855
4856   for (keys %{$options{extra_fields}}){
4857     $letter_data{$_} = $options{extra_fields}->{$_};
4858   }
4859
4860   unless(exists($letter_data{returnaddress})){
4861     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4862                                                   $self->agent_template)
4863                      );
4864     if ( length($retadd) ) {
4865       $letter_data{returnaddress} = $retadd;
4866     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4867       $letter_data{returnaddress} =
4868         join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4869                           s/$/\\\\\*/;
4870                           $_;
4871                         }
4872                     ( $conf->config('company_name', $self->agentnum),
4873                       $conf->config('company_address', $self->agentnum),
4874                     )
4875         );
4876     } else {
4877       $letter_data{returnaddress} = '~';
4878     }
4879   }
4880
4881   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4882
4883   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4884
4885   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4886
4887   my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4888                            DIR      => $dir,
4889                            SUFFIX   => '.eps',
4890                            UNLINK   => 0,
4891                          ) or die "can't open temp file: $!\n";
4892   print $lh $conf->config_binary('logo.eps', $self->agentnum)
4893     or die "can't write temp file: $!\n";
4894   close $lh;
4895   $letter_data{'logo_file'} = $lh->filename;
4896
4897   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4898                            DIR      => $dir,
4899                            SUFFIX   => '.tex',
4900                            UNLINK   => 0,
4901                          ) or die "can't open temp file: $!\n";
4902
4903   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4904   close $fh;
4905   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4906   return ($1, $letter_data{'logo_file'});
4907
4908 }
4909
4910 =item print_ps TEMPLATE
4911
4912 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4913
4914 =cut
4915
4916 sub print_ps {
4917   my $self = shift;
4918   my($file, $lfile) = $self->generate_letter(@_);
4919   my $ps = FS::Misc::generate_ps($file);
4920   unlink($file.'.tex');
4921   unlink($lfile);
4922
4923   $ps;
4924 }
4925
4926 =item print TEMPLATE
4927
4928 Prints the filled in template.
4929
4930 TEMPLATE is the name of a L<Text::Template> to fill in and print.
4931
4932 =cut
4933
4934 sub queueable_print {
4935   my %opt = @_;
4936
4937   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
4938     or die "invalid customer number: " . $opt{custvnum};
4939
4940   my $error = $self->print( $opt{template} );
4941   die $error if $error;
4942 }
4943
4944 sub print {
4945   my ($self, $template) = (shift, shift);
4946   do_print(
4947     [ $self->print_ps($template) ],
4948     'agentnum' => $self->agentnum,
4949   );
4950 }
4951
4952 #these three subs should just go away once agent stuff is all config overrides
4953
4954 sub agent_template {
4955   my $self = shift;
4956   $self->_agent_plandata('agent_templatename');
4957 }
4958
4959 sub agent_invoice_from {
4960   my $self = shift;
4961   $self->_agent_plandata('agent_invoice_from');
4962 }
4963
4964 sub _agent_plandata {
4965   my( $self, $option ) = @_;
4966
4967   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
4968   #agent-specific Conf
4969
4970   use FS::part_event::Condition;
4971
4972   my $agentnum = $self->agentnum;
4973
4974   my $regexp = regexp_sql();
4975
4976   my $part_event_option =
4977     qsearchs({
4978       'select'    => 'part_event_option.*',
4979       'table'     => 'part_event_option',
4980       'addl_from' => q{
4981         LEFT JOIN part_event USING ( eventpart )
4982         LEFT JOIN part_event_option AS peo_agentnum
4983           ON ( part_event.eventpart = peo_agentnum.eventpart
4984                AND peo_agentnum.optionname = 'agentnum'
4985                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
4986              )
4987         LEFT JOIN part_event_condition
4988           ON ( part_event.eventpart = part_event_condition.eventpart
4989                AND part_event_condition.conditionname = 'cust_bill_age'
4990              )
4991         LEFT JOIN part_event_condition_option
4992           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
4993                AND part_event_condition_option.optionname = 'age'
4994              )
4995       },
4996       #'hashref'   => { 'optionname' => $option },
4997       #'hashref'   => { 'part_event_option.optionname' => $option },
4998       'extra_sql' =>
4999         " WHERE part_event_option.optionname = ". dbh->quote($option).
5000         " AND action = 'cust_bill_send_agent' ".
5001         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
5002         " AND peo_agentnum.optionname = 'agentnum' ".
5003         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
5004         " ORDER BY
5005            CASE WHEN part_event_condition_option.optionname IS NULL
5006            THEN -1
5007            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
5008         " END
5009           , part_event.weight".
5010         " LIMIT 1"
5011     });
5012
5013   unless ( $part_event_option ) {
5014     return $self->agent->invoice_template || ''
5015       if $option eq 'agent_templatename';
5016     return '';
5017   }
5018
5019   $part_event_option->optionvalue;
5020
5021 }
5022
5023 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5024
5025 Subroutine (not a method), designed to be called from the queue.
5026
5027 Takes a list of options and values.
5028
5029 Pulls up the customer record via the custnum option and calls bill_and_collect.
5030
5031 =cut
5032
5033 sub queued_bill {
5034   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5035
5036   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5037   warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5038
5039   $cust_main->bill_and_collect( %args );
5040 }
5041
5042 sub process_bill_and_collect {
5043   my $job = shift;
5044   my $param = thaw(decode_base64(shift));
5045   my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5046       or die "custnum '$param->{custnum}' not found!\n";
5047   $param->{'job'}   = $job;
5048   $param->{'fatal'} = 1; # runs from job queue, will be caught
5049   $param->{'retry'} = 1;
5050
5051   $cust_main->bill_and_collect( %$param );
5052 }
5053
5054 =item process_censustract_update CUSTNUM
5055
5056 Queueable function to update the census tract to the current year (as set in
5057 the 'census_year' configuration variable) and retrieve the new tract code.
5058
5059 =cut
5060
5061 sub process_censustract_update {
5062   eval "use FS::Misc::Geo qw(get_censustract)";
5063   die $@ if $@;
5064   my $custnum = shift;
5065   my $cust_main = qsearchs( 'cust_main', { custnum => $custnum })
5066       or die "custnum '$custnum' not found!\n";
5067
5068   my $new_year = $conf->config('census_year') or return;
5069   my $new_tract = get_censustract({ $cust_main->location_hash }, $new_year);
5070   if ( $new_tract =~ /^\d/ ) {
5071     # then it's a tract code
5072         $cust_main->set('censustract', $new_tract);
5073     $cust_main->set('censusyear',  $new_year);
5074
5075     local($ignore_expired_card) = 1;
5076     local($ignore_illegal_zip) = 1;
5077     local($ignore_banned_card) = 1;
5078     local($skip_fuzzyfiles) = 1;
5079     local($import) = 1; #prevent automatic geocoding (need its own variable?)
5080     my $error = $cust_main->replace;
5081     die $error if $error;
5082   }
5083   else {
5084     # it's an error message
5085     die $new_tract;
5086   }
5087   return;
5088 }
5089
5090 sub _upgrade_data { #class method
5091   my ($class, %opts) = @_;
5092
5093   my @statements = (
5094     'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
5095   );
5096
5097   #this seems to be the only expensive one.. why does it take so long?
5098   unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
5099     push @statements,
5100       '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';
5101     FS::upgrade_journal->set_done('cust_main__signupdate');
5102   }
5103
5104   unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) {
5105
5106     # fix yyyy-m-dd formatted paydates
5107     if ( driver_name =~ /^mysql/i ) {
5108       push @statements,
5109       "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5110     } else { # the SQL standard
5111       push @statements,
5112       "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5113     }
5114     FS::upgrade_journal->set_done('cust_main__paydate');
5115   }
5116
5117   unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) {
5118
5119     push @statements, #fix the weird BILL with a cc# in payinfo problem
5120       #DCRD to be safe
5121       "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
5122
5123     FS::upgrade_journal->set_done('cust_main__payinfo');
5124
5125   }
5126
5127   my $t = time;
5128   foreach my $sql ( @statements ) {
5129     my $sth = dbh->prepare($sql) or die dbh->errstr;
5130     $sth->execute or die $sth->errstr;
5131     #warn ( (time - $t). " seconds\n" );
5132     #$t = time;
5133   }
5134
5135   local($ignore_expired_card) = 1;
5136   local($ignore_illegal_zip) = 1;
5137   local($ignore_banned_card) = 1;
5138   local($skip_fuzzyfiles) = 1;
5139   local($import) = 1; #prevent automatic geocoding (need its own variable?)
5140
5141   unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
5142
5143     foreach my $cust_main ( qsearch({
5144       'table'     => 'cust_main',
5145       'hashref'   => {},
5146       'extra_sql' => 'WHERE '.
5147                        join(' OR ',
5148                          map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '%  %'",
5149                            qw( first last company )
5150                        ),
5151     }) ) {
5152       my $error = $cust_main->replace;
5153       die $error if $error;
5154     }
5155
5156     FS::upgrade_journal->set_done('cust_main__trimspaces');
5157
5158   }
5159
5160   $class->_upgrade_otaker(%opts);
5161
5162 }
5163
5164 =back
5165
5166 =head1 BUGS
5167
5168 The delete method.
5169
5170 The delete method should possibly take an FS::cust_main object reference
5171 instead of a scalar customer number.
5172
5173 Bill and collect options should probably be passed as references instead of a
5174 list.
5175
5176 There should probably be a configuration file with a list of allowed credit
5177 card types.
5178
5179 No multiple currency support (probably a larger project than just this module).
5180
5181 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5182
5183 Birthdates rely on negative epoch values.
5184
5185 The payby for card/check batches is broken.  With mixed batching, bad
5186 things will happen.
5187
5188 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5189
5190 =head1 SEE ALSO
5191
5192 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5193 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5194 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
5195
5196 =cut
5197
5198 1;
5199