FS/FS/cust_main.pm

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