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