FS/FS/cust_main.pm

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