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 Likewise for I<eventnum>, I<commission_agentnum>, I<commission_salesnum> and
3304 I<commission_pkgnum>.
3305
3306 Any other options are passed to FS::cust_credit::insert.
3307
3308 =cut
3309
3310 sub credit {
3311   my( $self, $amount, $reason, %options ) = @_;
3312
3313   my $cust_credit = new FS::cust_credit {
3314     'custnum' => $self->custnum,
3315     'amount'  => $amount,
3316   };
3317
3318   if ( ref($reason) ) {
3319
3320     if ( ref($reason) eq 'SCALAR' ) {
3321       $cust_credit->reasonnum( $$reason );
3322     } else {
3323       $cust_credit->reasonnum( $reason->reasonnum );
3324     }
3325
3326   } else {
3327     $cust_credit->set('reason', $reason)
3328   }
3329
3330   $cust_credit->$_( delete $options{$_} )
3331     foreach grep exists($options{$_}),
3332               qw( addlinfo eventnum ),
3333               map "commission_$_", qw( agentnum salesnum pkgnum );
3334
3335   $cust_credit->insert(%options);
3336
3337 }
3338
3339 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3340
3341 Creates a one-time charge for this customer.  If there is an error, returns
3342 the error, otherwise returns false.
3343
3344 New-style, with a hashref of options:
3345
3346   my $error = $cust_main->charge(
3347                                   {
3348                                     'amount'     => 54.32,
3349                                     'quantity'   => 1,
3350                                     'start_date' => str2time('7/4/2009'),
3351                                     'pkg'        => 'Description',
3352                                     'comment'    => 'Comment',
3353                                     'additional' => [], #extra invoice detail
3354                                     'classnum'   => 1,  #pkg_class
3355
3356                                     'setuptax'   => '', # or 'Y' for tax exempt
3357
3358                                     'locationnum'=> 1234, # optional
3359
3360                                     #internal taxation
3361                                     'taxclass'   => 'Tax class',
3362
3363                                     #vendor taxation
3364                                     'taxproduct' => 2,  #part_pkg_taxproduct
3365                                     'override'   => {}, #XXX describe
3366
3367                                     #will be filled in with the new object
3368                                     'cust_pkg_ref' => \$cust_pkg,
3369
3370                                     #generate an invoice immediately
3371                                     'bill_now' => 0,
3372                                     'invoice_terms' => '', #with these terms
3373                                   }
3374                                 );
3375
3376 Old-style:
3377
3378   my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3379
3380 =cut
3381
3382 sub charge {
3383   my $self = shift;
3384   my ( $amount, $quantity, $start_date, $classnum );
3385   my ( $pkg, $comment, $additional );
3386   my ( $setuptax, $taxclass );   #internal taxes
3387   my ( $taxproduct, $override ); #vendor (CCH) taxes
3388   my $no_auto = '';
3389   my $cust_pkg_ref = '';
3390   my ( $bill_now, $invoice_terms ) = ( 0, '' );
3391   my $locationnum;
3392   if ( ref( $_[0] ) ) {
3393     $amount     = $_[0]->{amount};
3394     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3395     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3396     $no_auto    = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3397     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3398     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
3399                                            : '$'. sprintf("%.2f",$amount);
3400     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3401     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3402     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3403     $additional = $_[0]->{additional} || [];
3404     $taxproduct = $_[0]->{taxproductnum};
3405     $override   = { '' => $_[0]->{tax_override} };
3406     $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3407     $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3408     $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3409     $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3410   } else {
3411     $amount     = shift;
3412     $quantity   = 1;
3413     $start_date = '';
3414     $pkg        = @_ ? shift : 'One-time charge';
3415     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
3416     $setuptax   = '';
3417     $taxclass   = @_ ? shift : '';
3418     $additional = [];
3419   }
3420
3421   local $SIG{HUP} = 'IGNORE';
3422   local $SIG{INT} = 'IGNORE';
3423   local $SIG{QUIT} = 'IGNORE';
3424   local $SIG{TERM} = 'IGNORE';
3425   local $SIG{TSTP} = 'IGNORE';
3426   local $SIG{PIPE} = 'IGNORE';
3427
3428   my $oldAutoCommit = $FS::UID::AutoCommit;
3429   local $FS::UID::AutoCommit = 0;
3430   my $dbh = dbh;
3431
3432   my $part_pkg = new FS::part_pkg ( {
3433     'pkg'           => $pkg,
3434     'comment'       => $comment,
3435     'plan'          => 'flat',
3436     'freq'          => 0,
3437     'disabled'      => 'Y',
3438     'classnum'      => ( $classnum ? $classnum : '' ),
3439     'setuptax'      => $setuptax,
3440     'taxclass'      => $taxclass,
3441     'taxproductnum' => $taxproduct,
3442   } );
3443
3444   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3445                         ( 0 .. @$additional - 1 )
3446                   ),
3447                   'additional_count' => scalar(@$additional),
3448                   'setup_fee' => $amount,
3449                 );
3450
3451   my $error = $part_pkg->insert( options       => \%options,
3452                                  tax_overrides => $override,
3453                                );
3454   if ( $error ) {
3455     $dbh->rollback if $oldAutoCommit;
3456     return $error;
3457   }
3458
3459   my $pkgpart = $part_pkg->pkgpart;
3460   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3461   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3462     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3463     $error = $type_pkgs->insert;
3464     if ( $error ) {
3465       $dbh->rollback if $oldAutoCommit;
3466       return $error;
3467     }
3468   }
3469
3470   my $cust_pkg = new FS::cust_pkg ( {
3471     'custnum'    => $self->custnum,
3472     'pkgpart'    => $pkgpart,
3473     'quantity'   => $quantity,
3474     'start_date' => $start_date,
3475     'no_auto'    => $no_auto,
3476     'locationnum'=> $locationnum,
3477   } );
3478
3479   $error = $cust_pkg->insert;
3480   if ( $error ) {
3481     $dbh->rollback if $oldAutoCommit;
3482     return $error;
3483   } elsif ( $cust_pkg_ref ) {
3484     ${$cust_pkg_ref} = $cust_pkg;
3485   }
3486
3487   if ( $bill_now ) {
3488     my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3489                              'pkg_list'      => [ $cust_pkg ],
3490                            );
3491     if ( $error ) {
3492       $dbh->rollback if $oldAutoCommit;
3493       return $error;
3494     }
3495   }
3496
3497   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3498   return '';
3499
3500 }
3501
3502 #=item charge_postal_fee
3503 #
3504 #Applies a one time charge this customer.  If there is an error,
3505 #returns the error, returns the cust_pkg charge object or false
3506 #if there was no charge.
3507 #
3508 #=cut
3509 #
3510 # This should be a customer event.  For that to work requires that bill
3511 # also be a customer event.
3512
3513 sub charge_postal_fee {
3514   my $self = shift;
3515
3516   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3517   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3518
3519   my $cust_pkg = new FS::cust_pkg ( {
3520     'custnum'  => $self->custnum,
3521     'pkgpart'  => $pkgpart,
3522     'quantity' => 1,
3523   } );
3524
3525   my $error = $cust_pkg->insert;
3526   $error ? $error : $cust_pkg;
3527 }
3528
3529 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3530
3531 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3532
3533 Optionally, a list or hashref of additional arguments to the qsearch call can
3534 be passed.
3535
3536 =cut
3537
3538 sub cust_bill {
3539   my $self = shift;
3540   my $opt = ref($_[0]) ? shift : { @_ };
3541
3542   #return $self->num_cust_bill unless wantarray || keys %$opt;
3543
3544   $opt->{'table'} = 'cust_bill';
3545   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3546   $opt->{'hashref'}{'custnum'} = $self->custnum;
3547   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3548
3549   map { $_ } #behavior of sort undefined in scalar context
3550     sort { $a->_date <=> $b->_date }
3551       qsearch($opt);
3552 }
3553
3554 =item open_cust_bill
3555
3556 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3557 customer.
3558
3559 =cut
3560
3561 sub open_cust_bill {
3562   my $self = shift;
3563
3564   $self->cust_bill(
3565     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3566     #@_
3567   );
3568
3569 }
3570
3571 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3572
3573 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3574
3575 =cut
3576
3577 sub legacy_cust_bill {
3578   my $self = shift;
3579
3580   #return $self->num_legacy_cust_bill unless wantarray;
3581
3582   map { $_ } #behavior of sort undefined in scalar context
3583     sort { $a->_date <=> $b->_date }
3584       qsearch({ 'table'    => 'legacy_cust_bill',
3585                 'hashref'  => { 'custnum' => $self->custnum, },
3586                 'order_by' => 'ORDER BY _date ASC',
3587              });
3588 }
3589
3590 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3591
3592 Returns all the statements (see L<FS::cust_statement>) for this customer.
3593
3594 Optionally, a list or hashref of additional arguments to the qsearch call can
3595 be passed.
3596
3597 =cut
3598
3599 =item cust_bill_void
3600
3601 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3602
3603 =cut
3604
3605 sub cust_bill_void {
3606   my $self = shift;
3607
3608   map { $_ } #return $self->num_cust_bill_void unless wantarray;
3609   sort { $a->_date <=> $b->_date }
3610     qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3611 }
3612
3613 sub cust_statement {
3614   my $self = shift;
3615   my $opt = ref($_[0]) ? shift : { @_ };
3616
3617   #return $self->num_cust_statement unless wantarray || keys %$opt;
3618
3619   $opt->{'table'} = 'cust_statement';
3620   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3621   $opt->{'hashref'}{'custnum'} = $self->custnum;
3622   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3623
3624   map { $_ } #behavior of sort undefined in scalar context
3625     sort { $a->_date <=> $b->_date }
3626       qsearch($opt);
3627 }
3628
3629 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3630
3631 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3632
3633 Optionally, a list or hashref of additional arguments to the qsearch call can
3634 be passed following the SVCDB.
3635
3636 =cut
3637
3638 sub svc_x {
3639   my $self = shift;
3640   my $svcdb = shift;
3641   if ( ! $svcdb =~ /^svc_\w+$/ ) {
3642     warn "$me svc_x requires a svcdb";
3643     return;
3644   }
3645   my $opt = ref($_[0]) ? shift : { @_ };
3646
3647   $opt->{'table'} = $svcdb;
3648   $opt->{'addl_from'} =
3649     'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3650     ($opt->{'addl_from'} || '');
3651
3652   my $custnum = $self->custnum;
3653   $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3654   my $where = "cust_pkg.custnum = $custnum";
3655
3656   my $extra_sql = $opt->{'extra_sql'} || '';
3657   if ( keys %{ $opt->{'hashref'} } ) {
3658     $extra_sql = " AND $where $extra_sql";
3659   }
3660   else {
3661     if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3662       $extra_sql = "WHERE $where AND $1";
3663     }
3664     else {
3665       $extra_sql = "WHERE $where $extra_sql";
3666     }
3667   }
3668   $opt->{'extra_sql'} = $extra_sql;
3669
3670   qsearch($opt);
3671 }
3672
3673 # required for use as an eventtable;
3674 sub svc_acct {
3675   my $self = shift;
3676   $self->svc_x('svc_acct', @_);
3677 }
3678
3679 =item cust_credit
3680
3681 Returns all the credits (see L<FS::cust_credit>) for this customer.
3682
3683 =cut
3684
3685 sub cust_credit {
3686   my $self = shift;
3687   map { $_ } #return $self->num_cust_credit unless wantarray;
3688   sort { $a->_date <=> $b->_date }
3689     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3690 }
3691
3692 =item cust_credit_pkgnum
3693
3694 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3695 package when using experimental package balances.
3696
3697 =cut
3698
3699 sub cust_credit_pkgnum {
3700   my( $self, $pkgnum ) = @_;
3701   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3702   sort { $a->_date <=> $b->_date }
3703     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3704                               'pkgnum'  => $pkgnum,
3705                             }
3706     );
3707 }
3708
3709 =item cust_pay
3710
3711 Returns all the payments (see L<FS::cust_pay>) for this customer.
3712
3713 =cut
3714
3715 sub cust_pay {
3716   my $self = shift;
3717   return $self->num_cust_pay unless wantarray;
3718   sort { $a->_date <=> $b->_date }
3719     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3720 }
3721
3722 =item num_cust_pay
3723
3724 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
3725 called automatically when the cust_pay method is used in a scalar context.
3726
3727 =cut
3728
3729 sub num_cust_pay {
3730   my $self = shift;
3731   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3732   my $sth = dbh->prepare($sql) or die dbh->errstr;
3733   $sth->execute($self->custnum) or die $sth->errstr;
3734   $sth->fetchrow_arrayref->[0];
3735 }
3736
3737 =item cust_pay_pkgnum
3738
3739 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3740 package when using experimental package balances.
3741
3742 =cut
3743
3744 sub cust_pay_pkgnum {
3745   my( $self, $pkgnum ) = @_;
3746   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3747   sort { $a->_date <=> $b->_date }
3748     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3749                            'pkgnum'  => $pkgnum,
3750                          }
3751     );
3752 }
3753
3754 =item cust_pay_void
3755
3756 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3757
3758 =cut
3759
3760 sub cust_pay_void {
3761   my $self = shift;
3762   map { $_ } #return $self->num_cust_pay_void unless wantarray;
3763   sort { $a->_date <=> $b->_date }
3764     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3765 }
3766
3767 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3768
3769 Returns all batched payments (see L<FS::cust_pay_batch>) for this customer.
3770
3771 Optionally, a list or hashref of additional arguments to the qsearch call can
3772 be passed.
3773
3774 =cut
3775
3776 sub cust_pay_batch {
3777   my $self = shift;
3778   my $opt = ref($_[0]) ? shift : { @_ };
3779
3780   #return $self->num_cust_statement unless wantarray || keys %$opt;
3781
3782   $opt->{'table'} = 'cust_pay_batch';
3783   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3784   $opt->{'hashref'}{'custnum'} = $self->custnum;
3785   $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
3786
3787   map { $_ } #behavior of sort undefined in scalar context
3788     sort { $a->paybatchnum <=> $b->paybatchnum }
3789       qsearch($opt);
3790 }
3791
3792 =item cust_pay_pending
3793
3794 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3795 (without status "done").
3796
3797 =cut
3798
3799 sub cust_pay_pending {
3800   my $self = shift;
3801   return $self->num_cust_pay_pending unless wantarray;
3802   sort { $a->_date <=> $b->_date }
3803     qsearch( 'cust_pay_pending', {
3804                                    'custnum' => $self->custnum,
3805                                    'status'  => { op=>'!=', value=>'done' },
3806                                  },
3807            );
3808 }
3809
3810 =item cust_pay_pending_attempt
3811
3812 Returns all payment attempts / declined payments for this customer, as pending
3813 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3814 a corresponding payment (see L<FS::cust_pay>).
3815
3816 =cut
3817
3818 sub cust_pay_pending_attempt {
3819   my $self = shift;
3820   return $self->num_cust_pay_pending_attempt unless wantarray;
3821   sort { $a->_date <=> $b->_date }
3822     qsearch( 'cust_pay_pending', {
3823                                    'custnum' => $self->custnum,
3824                                    'status'  => 'done',
3825                                    'paynum'  => '',
3826                                  },
3827            );
3828 }
3829
3830 =item num_cust_pay_pending
3831
3832 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3833 customer (without status "done").  Also called automatically when the
3834 cust_pay_pending method is used in a scalar context.
3835
3836 =cut
3837
3838 sub num_cust_pay_pending {
3839   my $self = shift;
3840   $self->scalar_sql(
3841     " SELECT COUNT(*) FROM cust_pay_pending ".
3842       " WHERE custnum = ? AND status != 'done' ",
3843     $self->custnum
3844   );
3845 }
3846
3847 =item num_cust_pay_pending_attempt
3848
3849 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3850 customer, with status "done" but without a corresp.  Also called automatically when the
3851 cust_pay_pending method is used in a scalar context.
3852
3853 =cut
3854
3855 sub num_cust_pay_pending_attempt {
3856   my $self = shift;
3857   $self->scalar_sql(
3858     " SELECT COUNT(*) FROM cust_pay_pending ".
3859       " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3860     $self->custnum
3861   );
3862 }
3863
3864 =item cust_refund
3865
3866 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3867
3868 =cut
3869
3870 sub cust_refund {
3871   my $self = shift;
3872   map { $_ } #return $self->num_cust_refund unless wantarray;
3873   sort { $a->_date <=> $b->_date }
3874     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3875 }
3876
3877 =item display_custnum
3878
3879 Returns the displayed customer number for this customer: agent_custid if
3880 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3881
3882 =cut
3883
3884 sub display_custnum {
3885   my $self = shift;
3886
3887   my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
3888   if ( my $special = $conf->config('cust_main-custnum-display_special') ) {
3889     if ( $special eq 'CoStAg' ) {
3890       $prefix = uc( join('',
3891         $self->country,
3892         ($self->state =~ /^(..)/),
3893         $prefix || ($self->agent->agent =~ /^(..)/)
3894       ) );
3895     }
3896     elsif ( $special eq 'CoStCl' ) {
3897       $prefix = uc( join('',
3898         $self->country,
3899         ($self->state =~ /^(..)/),
3900         ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__')
3901       ) );
3902     }
3903     # add any others here if needed
3904   }
3905
3906   my $length = $conf->config('cust_main-custnum-display_length');
3907   if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
3908     return $self->agent_custid;
3909   } elsif ( $prefix ) {
3910     $length = 8 if !defined($length);
3911     return $prefix .
3912            sprintf('%0'.$length.'d', $self->custnum)
3913   } elsif ( $length ) {
3914     return sprintf('%0'.$length.'d', $self->custnum);
3915   } else {
3916     return $self->custnum;
3917   }
3918 }
3919
3920 =item name
3921
3922 Returns a name string for this customer, either "Company (Last, First)" or
3923 "Last, First".
3924
3925 =cut
3926
3927 sub name {
3928   my $self = shift;
3929   my $name = $self->contact;
3930   $name = $self->company. " ($name)" if $self->company;
3931   $name;
3932 }
3933
3934 =item service_contact
3935
3936 Returns the L<FS::contact> object for this customer that has the 'Service'
3937 contact class, or undef if there is no such contact.  Deprecated; don't use
3938 this in new code.
3939
3940 =cut
3941
3942 sub service_contact {
3943   my $self = shift;
3944   if ( !exists($self->{service_contact}) ) {
3945     my $classnum = $self->scalar_sql(
3946       'SELECT classnum FROM contact_class WHERE classname = \'Service\''
3947     ) || 0; #if it's zero, qsearchs will return nothing
3948     $self->{service_contact} = qsearchs('contact', {
3949         'classnum' => $classnum, 'custnum' => $self->custnum
3950       }) || undef;
3951   }
3952   $self->{service_contact};
3953 }
3954
3955 =item ship_name
3956
3957 Returns a name string for this (service/shipping) contact, either
3958 "Company (Last, First)" or "Last, First".
3959
3960 =cut
3961
3962 sub ship_name {
3963   my $self = shift;
3964
3965   my $name = $self->ship_contact;
3966   $name = $self->company. " ($name)" if $self->company;
3967   $name;
3968 }
3969
3970 =item name_short
3971
3972 Returns a name string for this customer, either "Company" or "First Last".
3973
3974 =cut
3975
3976 sub name_short {
3977   my $self = shift;
3978   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
3979 }
3980
3981 =item ship_name_short
3982
3983 Returns a name string for this (service/shipping) contact, either "Company"
3984 or "First Last".
3985
3986 =cut
3987
3988 sub ship_name_short {
3989   my $self = shift;
3990   $self->service_contact
3991     ? $self->ship_contact_firstlast
3992     : $self->name_short
3993 }
3994
3995 =item contact
3996
3997 Returns this customer's full (billing) contact name only, "Last, First"
3998
3999 =cut
4000
4001 sub contact {
4002   my $self = shift;
4003   $self->get('last'). ', '. $self->first;
4004 }
4005
4006 =item ship_contact
4007
4008 Returns this customer's full (shipping) contact name only, "Last, First"
4009
4010 =cut
4011
4012 sub ship_contact {
4013   my $self = shift;
4014   my $contact = $self->service_contact || $self;
4015   $contact->get('last') . ', ' . $contact->get('first');
4016 }
4017
4018 =item contact_firstlast
4019
4020 Returns this customers full (billing) contact name only, "First Last".
4021
4022 =cut
4023
4024 sub contact_firstlast {
4025   my $self = shift;
4026   $self->first. ' '. $self->get('last');
4027 }
4028
4029 =item ship_contact_firstlast
4030
4031 Returns this customer's full (shipping) contact name only, "First Last".
4032
4033 =cut
4034
4035 sub ship_contact_firstlast {
4036   my $self = shift;
4037   my $contact = $self->service_contact || $self;
4038   $contact->get('first') . ' '. $contact->get('last');
4039 }
4040
4041 #XXX this doesn't work in 3.x+
4042 #=item country_full
4043 #
4044 #Returns this customer's full country name
4045 #
4046 #=cut
4047 #
4048 #sub country_full {
4049 #  my $self = shift;
4050 #  code2country($self->country);
4051 #}
4052
4053 =item county_state_county [ PREFIX ]
4054
4055 Returns a string consisting of just the county, state and country.
4056
4057 =cut
4058
4059 sub county_state_country {
4060   my $self = shift;
4061   my $locationnum;
4062   if ( @_ && $_[0] && $self->has_ship_address ) {
4063     $locationnum = $self->ship_locationnum;
4064   } else {
4065     $locationnum = $self->bill_locationnum;
4066   }
4067   my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
4068   $cust_location->county_state_country;
4069 }
4070
4071 =item geocode DATA_VENDOR
4072
4073 Returns a value for the customer location as encoded by DATA_VENDOR.
4074 Currently this only makes sense for "CCH" as DATA_VENDOR.
4075
4076 =cut
4077
4078 =item cust_status
4079
4080 =item status
4081
4082 Returns a status string for this customer, currently:
4083
4084 =over 4
4085
4086 =item prospect - No packages have ever been ordered
4087
4088 =item ordered - Recurring packages all are new (not yet billed).
4089
4090 =item active - One or more recurring packages is active
4091
4092 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4093
4094 =item suspended - All non-cancelled recurring packages are suspended
4095
4096 =item cancelled - All recurring packages are cancelled
4097
4098 =back
4099
4100 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4101 cust_main-status_module configuration option.
4102
4103 =cut
4104
4105 sub status { shift->cust_status(@_); }
4106
4107 sub cust_status {
4108   my $self = shift;
4109   for my $status ( FS::cust_main->statuses() ) {
4110     my $method = $status.'_sql';
4111     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4112     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4113     $sth->execute( ($self->custnum) x $numnum )
4114       or die "Error executing 'SELECT $sql': ". $sth->errstr;
4115     return $status if $sth->fetchrow_arrayref->[0];
4116   }
4117 }
4118
4119 =item ucfirst_cust_status
4120
4121 =item ucfirst_status
4122
4123 Returns the status with the first character capitalized.
4124
4125 =cut
4126
4127 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4128
4129 sub ucfirst_cust_status {
4130   my $self = shift;
4131   ucfirst($self->cust_status);
4132 }
4133
4134 =item statuscolor
4135
4136 Returns a hex triplet color string for this customer's status.
4137
4138 =cut
4139
4140 sub statuscolor { shift->cust_statuscolor(@_); }
4141
4142 sub cust_statuscolor {
4143   my $self = shift;
4144   __PACKAGE__->statuscolors->{$self->cust_status};
4145 }
4146
4147 =item tickets [ STATUS ]
4148
4149 Returns an array of hashes representing the customer's RT tickets.
4150
4151 An optional status (or arrayref or hashref of statuses) may be specified.
4152
4153 =cut
4154
4155 sub tickets {
4156   my $self = shift;
4157   my $status = ( @_ && $_[0] ) ? shift : '';
4158
4159   my $num = $conf->config('cust_main-max_tickets') || 10;
4160   my @tickets = ();
4161
4162   if ( $conf->config('ticket_system') ) {
4163     unless ( $conf->config('ticket_system-custom_priority_field') ) {
4164
4165       @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
4166                                                         $num,
4167                                                         undef,
4168                                                         $status,
4169                                                       )
4170                   };
4171
4172     } else {
4173
4174       foreach my $priority (
4175         $conf->config('ticket_system-custom_priority_field-values'), ''
4176       ) {
4177         last if scalar(@tickets) >= $num;
4178         push @tickets,
4179           @{ FS::TicketSystem->customer_tickets( $self->custnum,
4180                                                  $num - scalar(@tickets),
4181                                                  $priority,
4182                                                  $status,
4183                                                )
4184            };
4185       }
4186     }
4187   }
4188   (@tickets);
4189 }
4190
4191 # Return services representing svc_accts in customer support packages
4192 sub support_services {
4193   my $self = shift;
4194   my %packages = map { $_ => 1 } $conf->config('support_packages');
4195
4196   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4197     grep { $_->part_svc->svcdb eq 'svc_acct' }
4198     map { $_->cust_svc }
4199     grep { exists $packages{ $_->pkgpart } }
4200     $self->ncancelled_pkgs;
4201
4202 }
4203
4204 # Return a list of latitude/longitude for one of the services (if any)
4205 sub service_coordinates {
4206   my $self = shift;
4207
4208   my @svc_X =
4209     grep { $_->latitude && $_->longitude }
4210     map { $_->svc_x }
4211     map { $_->cust_svc }
4212     $self->ncancelled_pkgs;
4213
4214   scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4215 }
4216
4217 =item masked FIELD
4218
4219 Returns a masked version of the named field
4220
4221 =cut
4222
4223 sub masked {
4224 my ($self,$field) = @_;
4225
4226 # Show last four
4227
4228 'x'x(length($self->getfield($field))-4).
4229   substr($self->getfield($field), (length($self->getfield($field))-4));
4230
4231 }
4232
4233 =back
4234
4235 =head1 CLASS METHODS
4236
4237 =over 4
4238
4239 =item statuses
4240
4241 Class method that returns the list of possible status strings for customers
4242 (see L<the status method|/status>).  For example:
4243
4244   @statuses = FS::cust_main->statuses();
4245
4246 =cut
4247
4248 sub statuses {
4249   my $self = shift;
4250   keys %{ $self->statuscolors };
4251 }
4252
4253 =item cust_status_sql
4254
4255 Returns an SQL fragment to determine the status of a cust_main record, as a
4256 string.
4257
4258 =cut
4259
4260 sub cust_status_sql {
4261   my $sql = 'CASE';
4262   for my $status ( FS::cust_main->statuses() ) {
4263     my $method = $status.'_sql';
4264     $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4265   }
4266   $sql .= ' END';
4267   return $sql;
4268 }
4269
4270
4271 =item prospect_sql
4272
4273 Returns an SQL expression identifying prospective cust_main records (customers
4274 with no packages ever ordered)
4275
4276 =cut
4277
4278 use vars qw($select_count_pkgs);
4279 $select_count_pkgs =
4280   "SELECT COUNT(*) FROM cust_pkg
4281     WHERE cust_pkg.custnum = cust_main.custnum";
4282
4283 sub select_count_pkgs_sql {
4284   $select_count_pkgs;
4285 }
4286
4287 sub prospect_sql {
4288   " 0 = ( $select_count_pkgs ) ";
4289 }
4290
4291 =item ordered_sql
4292
4293 Returns an SQL expression identifying ordered cust_main records (customers with
4294 no active packages, but recurring packages not yet setup or one time charges
4295 not yet billed).
4296
4297 =cut
4298
4299 sub ordered_sql {
4300   FS::cust_main->none_active_sql.
4301   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4302 }
4303
4304 =item active_sql
4305
4306 Returns an SQL expression identifying active cust_main records (customers with
4307 active recurring packages).
4308
4309 =cut
4310
4311 sub active_sql {
4312   " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4313 }
4314
4315 =item none_active_sql
4316
4317 Returns an SQL expression identifying cust_main records with no active
4318 recurring packages.  This includes customers of status prospect, ordered,
4319 inactive, and suspended.
4320
4321 =cut
4322
4323 sub none_active_sql {
4324   " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4325 }
4326
4327 =item inactive_sql
4328
4329 Returns an SQL expression identifying inactive cust_main records (customers with
4330 no active recurring packages, but otherwise unsuspended/uncancelled).
4331
4332 =cut
4333
4334 sub inactive_sql {
4335   FS::cust_main->none_active_sql.
4336   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4337 }
4338
4339 =item susp_sql
4340 =item suspended_sql
4341
4342 Returns an SQL expression identifying suspended cust_main records.
4343
4344 =cut
4345
4346
4347 sub suspended_sql { susp_sql(@_); }
4348 sub susp_sql {
4349   FS::cust_main->none_active_sql.
4350   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4351 }
4352
4353 =item cancel_sql
4354 =item cancelled_sql
4355
4356 Returns an SQL expression identifying cancelled cust_main records.
4357
4358 =cut
4359
4360 sub cancel_sql { shift->cancelled_sql(@_); }
4361
4362 =item uncancel_sql
4363 =item uncancelled_sql
4364
4365 Returns an SQL expression identifying un-cancelled cust_main records.
4366
4367 =cut
4368
4369 sub uncancelled_sql { uncancel_sql(@_); }
4370 sub uncancel_sql { "
4371   ( 0 < ( $select_count_pkgs
4372                    AND ( cust_pkg.cancel IS NULL
4373                          OR cust_pkg.cancel = 0
4374                        )
4375         )
4376     OR 0 = ( $select_count_pkgs )
4377   )
4378 "; }
4379
4380 =item balance_sql
4381
4382 Returns an SQL fragment to retreive the balance.
4383
4384 =cut
4385
4386 sub balance_sql { "
4387     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4388         WHERE cust_bill.custnum   = cust_main.custnum     )
4389   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
4390         WHERE cust_pay.custnum    = cust_main.custnum     )
4391   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
4392         WHERE cust_credit.custnum = cust_main.custnum     )
4393   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
4394         WHERE cust_refund.custnum = cust_main.custnum     )
4395 "; }
4396
4397 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4398
4399 Returns an SQL fragment to retreive the balance for this customer, optionally
4400 considering invoices with date earlier than START_TIME, and not
4401 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4402 total_unapplied_payments).
4403
4404 Times are specified as SQL fragments or numeric
4405 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4406 L<Date::Parse> for conversion functions.  The empty string can be passed
4407 to disable that time constraint completely.
4408
4409 Available options are:
4410
4411 =over 4
4412
4413 =item unapplied_date
4414
4415 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)
4416
4417 =item total
4418
4419 (unused.  obsolete?)
4420 set to true to remove all customer comparison clauses, for totals
4421
4422 =item where
4423
4424 (unused.  obsolete?)
4425 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4426
4427 =item join
4428
4429 (unused.  obsolete?)
4430 JOIN clause (typically used with the total option)
4431
4432 =item cutoff
4433
4434 An absolute cutoff time.  Payments, credits, and refunds I<applied> after this
4435 time will be ignored.  Note that START_TIME and END_TIME only limit the date
4436 range for invoices and I<unapplied> payments, credits, and refunds.
4437
4438 =back
4439
4440 =cut
4441
4442 sub balance_date_sql {
4443   my( $class, $start, $end, %opt ) = @_;
4444
4445   my $cutoff = $opt{'cutoff'};
4446
4447   my $owed         = FS::cust_bill->owed_sql($cutoff);
4448   my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4449   my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4450   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4451
4452   my $j = $opt{'join'} || '';
4453
4454   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
4455   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4456   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4457   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
4458
4459   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
4460     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4461     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4462     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
4463   ";
4464
4465 }
4466
4467 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4468
4469 Returns an SQL fragment to retreive the total unapplied payments for this
4470 customer, only considering payments with date earlier than START_TIME, and
4471 optionally not later than END_TIME.
4472
4473 Times are specified as SQL fragments or numeric
4474 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4475 L<Date::Parse> for conversion functions.  The empty string can be passed
4476 to disable that time constraint completely.
4477
4478 Available options are:
4479
4480 =cut
4481
4482 sub unapplied_payments_date_sql {
4483   my( $class, $start, $end, %opt ) = @_;
4484
4485   my $cutoff = $opt{'cutoff'};
4486
4487   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4488
4489   my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4490                                                           'unapplied_date'=>1 );
4491
4492   " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4493 }
4494
4495 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4496
4497 Helper method for balance_date_sql; name (and usage) subject to change
4498 (suggestions welcome).
4499
4500 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4501 cust_refund, cust_credit or cust_pay).
4502
4503 If TABLE is "cust_bill" or the unapplied_date option is true, only
4504 considers records with date earlier than START_TIME, and optionally not
4505 later than END_TIME .
4506
4507 =cut
4508
4509 sub _money_table_where {
4510   my( $class, $table, $start, $end, %opt ) = @_;
4511
4512   my @where = ();
4513   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4514   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4515     push @where, "$table._date <= $start" if defined($start) && length($start);
4516     push @where, "$table._date >  $end"   if defined($end)   && length($end);
4517   }
4518   push @where, @{$opt{'where'}} if $opt{'where'};
4519   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4520
4521   $where;
4522
4523 }
4524
4525 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4526 use FS::cust_main::Search;
4527 sub search {
4528   my $class = shift;
4529   FS::cust_main::Search->search(@_);
4530 }
4531
4532 =back
4533
4534 =head1 SUBROUTINES
4535
4536 =over 4
4537
4538 =item batch_charge
4539
4540 =cut
4541
4542 sub batch_charge {
4543   my $param = shift;
4544   #warn join('-',keys %$param);
4545   my $fh = $param->{filehandle};
4546   my $agentnum = $param->{agentnum};
4547   my $format = $param->{format};
4548
4549   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
4550
4551   my @fields;
4552   if ( $format eq 'simple' ) {
4553     @fields = qw( custnum agent_custid amount pkg );
4554   } else {
4555     die "unknown format $format";
4556   }
4557
4558   eval "use Text::CSV_XS;";
4559   die $@ if $@;
4560
4561   my $csv = new Text::CSV_XS;
4562   #warn $csv;
4563   #warn $fh;
4564
4565   my $imported = 0;
4566   #my $columns;
4567
4568   local $SIG{HUP} = 'IGNORE';
4569   local $SIG{INT} = 'IGNORE';
4570   local $SIG{QUIT} = 'IGNORE';
4571   local $SIG{TERM} = 'IGNORE';
4572   local $SIG{TSTP} = 'IGNORE';
4573   local $SIG{PIPE} = 'IGNORE';
4574
4575   my $oldAutoCommit = $FS::UID::AutoCommit;
4576   local $FS::UID::AutoCommit = 0;
4577   my $dbh = dbh;
4578
4579   #while ( $columns = $csv->getline($fh) ) {
4580   my $line;
4581   while ( defined($line=<$fh>) ) {
4582
4583     $csv->parse($line) or do {
4584       $dbh->rollback if $oldAutoCommit;
4585       return "can't parse: ". $csv->error_input();
4586     };
4587
4588     my @columns = $csv->fields();
4589     #warn join('-',@columns);
4590
4591     my %row = ();
4592     foreach my $field ( @fields ) {
4593       $row{$field} = shift @columns;
4594     }
4595
4596     if ( $row{custnum} && $row{agent_custid} ) {
4597       dbh->rollback if $oldAutoCommit;
4598       return "can't specify custnum with agent_custid $row{agent_custid}";
4599     }
4600
4601     my %hash = ();
4602     if ( $row{agent_custid} && $agentnum ) {
4603       %hash = ( 'agent_custid' => $row{agent_custid},
4604                 'agentnum'     => $agentnum,
4605               );
4606     }
4607
4608     if ( $row{custnum} ) {
4609       %hash = ( 'custnum' => $row{custnum} );
4610     }
4611
4612     unless ( scalar(keys %hash) ) {
4613       $dbh->rollback if $oldAutoCommit;
4614       return "can't find customer without custnum or agent_custid and agentnum";
4615     }
4616
4617     my $cust_main = qsearchs('cust_main', { %hash } );
4618     unless ( $cust_main ) {
4619       $dbh->rollback if $oldAutoCommit;
4620       my $custnum = $row{custnum} || $row{agent_custid};
4621       return "unknown custnum $custnum";
4622     }
4623
4624     if ( $row{'amount'} > 0 ) {
4625       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4626       if ( $error ) {
4627         $dbh->rollback if $oldAutoCommit;
4628         return $error;
4629       }
4630       $imported++;
4631     } elsif ( $row{'amount'} < 0 ) {
4632       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4633                                       $row{'pkg'}                         );
4634       if ( $error ) {
4635         $dbh->rollback if $oldAutoCommit;
4636         return $error;
4637       }
4638       $imported++;
4639     } else {
4640       #hmm?
4641     }
4642
4643   }
4644
4645   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4646
4647   return "Empty file!" unless $imported;
4648
4649   ''; #no error
4650
4651 }
4652
4653 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4654
4655 Deprecated.  Use event notification and message templates
4656 (L<FS::msg_template>) instead.
4657
4658 Sends a templated email notification to the customer (see L<Text::Template>).
4659
4660 OPTIONS is a hash and may include
4661
4662 I<from> - the email sender (default is invoice_from)
4663
4664 I<to> - comma-separated scalar or arrayref of recipients
4665    (default is invoicing_list)
4666
4667 I<subject> - The subject line of the sent email notification
4668    (default is "Notice from company_name")
4669
4670 I<extra_fields> - a hashref of name/value pairs which will be substituted
4671    into the template
4672
4673 The following variables are vavailable in the template.
4674
4675 I<$first> - the customer first name
4676 I<$last> - the customer last name
4677 I<$company> - the customer company
4678 I<$payby> - a description of the method of payment for the customer
4679             # would be nice to use FS::payby::shortname
4680 I<$payinfo> - the account information used to collect for this customer
4681 I<$expdate> - the expiration of the customer payment in seconds from epoch
4682
4683 =cut
4684
4685 sub notify {
4686   my ($self, $template, %options) = @_;
4687
4688   return unless $conf->exists($template);
4689
4690   my $from = $conf->config('invoice_from', $self->agentnum)
4691     if $conf->exists('invoice_from', $self->agentnum);
4692   $from = $options{from} if exists($options{from});
4693
4694   my $to = join(',', $self->invoicing_list_emailonly);
4695   $to = $options{to} if exists($options{to});
4696
4697   my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4698     if $conf->exists('company_name', $self->agentnum);
4699   $subject = $options{subject} if exists($options{subject});
4700
4701   my $notify_template = new Text::Template (TYPE => 'ARRAY',
4702                                             SOURCE => [ map "$_\n",
4703                                               $conf->config($template)]
4704                                            )
4705     or die "can't create new Text::Template object: Text::Template::ERROR";
4706   $notify_template->compile()
4707     or die "can't compile template: Text::Template::ERROR";
4708
4709   $FS::notify_template::_template::company_name =
4710     $conf->config('company_name', $self->agentnum);
4711   $FS::notify_template::_template::company_address =
4712     join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4713
4714   my $paydate = $self->paydate || '2037-12-31';
4715   $FS::notify_template::_template::first = $self->first;
4716   $FS::notify_template::_template::last = $self->last;
4717   $FS::notify_template::_template::company = $self->company;
4718   $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4719   my $payby = $self->payby;
4720   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4721   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4722
4723   #credit cards expire at the end of the month/year of their exp date
4724   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4725     $FS::notify_template::_template::payby = 'credit card';
4726     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4727     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4728     $expire_time--;
4729   }elsif ($payby eq 'COMP') {
4730     $FS::notify_template::_template::payby = 'complimentary account';
4731   }else{
4732     $FS::notify_template::_template::payby = 'current method';
4733   }
4734   $FS::notify_template::_template::expdate = $expire_time;
4735
4736   for (keys %{$options{extra_fields}}){
4737     no strict "refs";
4738     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4739   }
4740
4741   send_email(from => $from,
4742              to => $to,
4743              subject => $subject,
4744              body => $notify_template->fill_in( PACKAGE =>
4745                                                 'FS::notify_template::_template'                                              ),
4746             );
4747
4748 }
4749
4750 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4751
4752 Generates a templated notification to the customer (see L<Text::Template>).
4753
4754 OPTIONS is a hash and may include
4755
4756 I<extra_fields> - a hashref of name/value pairs which will be substituted
4757    into the template.  These values may override values mentioned below
4758    and those from the customer record.
4759
4760 The following variables are available in the template instead of or in addition
4761 to the fields of the customer record.
4762
4763 I<$payby> - a description of the method of payment for the customer
4764             # would be nice to use FS::payby::shortname
4765 I<$payinfo> - the masked account information used to collect for this customer
4766 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4767 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4768
4769 =cut
4770
4771 # a lot like cust_bill::print_latex
4772 sub generate_letter {
4773   my ($self, $template, %options) = @_;
4774
4775   return unless $conf->exists($template);
4776
4777   my $letter_template = new Text::Template
4778                         ( TYPE       => 'ARRAY',
4779                           SOURCE     => [ map "$_\n", $conf->config($template)],
4780                           DELIMITERS => [ '[@--', '--@]' ],
4781                         )
4782     or die "can't create new Text::Template object: Text::Template::ERROR";
4783
4784   $letter_template->compile()
4785     or die "can't compile template: Text::Template::ERROR";
4786
4787   my %letter_data = map { $_ => $self->$_ } $self->fields;
4788   $letter_data{payinfo} = $self->mask_payinfo;
4789
4790   #my $paydate = $self->paydate || '2037-12-31';
4791   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4792
4793   my $payby = $self->payby;
4794   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4795   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4796
4797   #credit cards expire at the end of the month/year of their exp date
4798   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4799     $letter_data{payby} = 'credit card';
4800     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4801     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4802     $expire_time--;
4803   }elsif ($payby eq 'COMP') {
4804     $letter_data{payby} = 'complimentary account';
4805   }else{
4806     $letter_data{payby} = 'current method';
4807   }
4808   $letter_data{expdate} = $expire_time;
4809
4810   for (keys %{$options{extra_fields}}){
4811     $letter_data{$_} = $options{extra_fields}->{$_};
4812   }
4813
4814   unless(exists($letter_data{returnaddress})){
4815     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4816                                                   $self->agent_template)
4817                      );
4818     if ( length($retadd) ) {
4819       $letter_data{returnaddress} = $retadd;
4820     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4821       $letter_data{returnaddress} =
4822         join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4823                           s/$/\\\\\*/;
4824                           $_;
4825                         }
4826                     ( $conf->config('company_name', $self->agentnum),
4827                       $conf->config('company_address', $self->agentnum),
4828                     )
4829         );
4830     } else {
4831       $letter_data{returnaddress} = '~';
4832     }
4833   }
4834
4835   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4836
4837   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4838
4839   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4840
4841   my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4842                            DIR      => $dir,
4843                            SUFFIX   => '.eps',
4844                            UNLINK   => 0,
4845                          ) or die "can't open temp file: $!\n";
4846   print $lh $conf->config_binary('logo.eps', $self->agentnum)
4847     or die "can't write temp file: $!\n";
4848   close $lh;
4849   $letter_data{'logo_file'} = $lh->filename;
4850
4851   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4852                            DIR      => $dir,
4853                            SUFFIX   => '.tex',
4854                            UNLINK   => 0,
4855                          ) or die "can't open temp file: $!\n";
4856
4857   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4858   close $fh;
4859   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4860   return ($1, $letter_data{'logo_file'});
4861
4862 }
4863
4864 =item print_ps TEMPLATE
4865
4866 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4867
4868 =cut
4869
4870 sub print_ps {
4871   my $self = shift;
4872   my($file, $lfile) = $self->generate_letter(@_);
4873   my $ps = FS::Misc::generate_ps($file);
4874   unlink($file.'.tex');
4875   unlink($lfile);
4876
4877   $ps;
4878 }
4879
4880 =item print TEMPLATE
4881
4882 Prints the filled in template.
4883
4884 TEMPLATE is the name of a L<Text::Template> to fill in and print.
4885
4886 =cut
4887
4888 sub queueable_print {
4889   my %opt = @_;
4890
4891   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
4892     or die "invalid customer number: " . $opt{custvnum};
4893
4894   my $error = $self->print( $opt{template} );
4895   die $error if $error;
4896 }
4897
4898 sub print {
4899   my ($self, $template) = (shift, shift);
4900   do_print(
4901     [ $self->print_ps($template) ],
4902     'agentnum' => $self->agentnum,
4903   );
4904 }
4905
4906 #these three subs should just go away once agent stuff is all config overrides
4907
4908 sub agent_template {
4909   my $self = shift;
4910   $self->_agent_plandata('agent_templatename');
4911 }
4912
4913 sub agent_invoice_from {
4914   my $self = shift;
4915   $self->_agent_plandata('agent_invoice_from');
4916 }
4917
4918 sub _agent_plandata {
4919   my( $self, $option ) = @_;
4920
4921   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
4922   #agent-specific Conf
4923
4924   use FS::part_event::Condition;
4925
4926   my $agentnum = $self->agentnum;
4927
4928   my $regexp = regexp_sql();
4929
4930   my $part_event_option =
4931     qsearchs({
4932       'select'    => 'part_event_option.*',
4933       'table'     => 'part_event_option',
4934       'addl_from' => q{
4935         LEFT JOIN part_event USING ( eventpart )
4936         LEFT JOIN part_event_option AS peo_agentnum
4937           ON ( part_event.eventpart = peo_agentnum.eventpart
4938                AND peo_agentnum.optionname = 'agentnum'
4939                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
4940              )
4941         LEFT JOIN part_event_condition
4942           ON ( part_event.eventpart = part_event_condition.eventpart
4943                AND part_event_condition.conditionname = 'cust_bill_age'
4944              )
4945         LEFT JOIN part_event_condition_option
4946           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
4947                AND part_event_condition_option.optionname = 'age'
4948              )
4949       },
4950       #'hashref'   => { 'optionname' => $option },
4951       #'hashref'   => { 'part_event_option.optionname' => $option },
4952       'extra_sql' =>
4953         " WHERE part_event_option.optionname = ". dbh->quote($option).
4954         " AND action = 'cust_bill_send_agent' ".
4955         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
4956         " AND peo_agentnum.optionname = 'agentnum' ".
4957         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
4958         " ORDER BY
4959            CASE WHEN part_event_condition_option.optionname IS NULL
4960            THEN -1
4961            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
4962         " END
4963           , part_event.weight".
4964         " LIMIT 1"
4965     });
4966
4967   unless ( $part_event_option ) {
4968     return $self->agent->invoice_template || ''
4969       if $option eq 'agent_templatename';
4970     return '';
4971   }
4972
4973   $part_event_option->optionvalue;
4974
4975 }
4976
4977 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
4978
4979 Subroutine (not a method), designed to be called from the queue.
4980
4981 Takes a list of options and values.
4982
4983 Pulls up the customer record via the custnum option and calls bill_and_collect.
4984
4985 =cut
4986
4987 sub queued_bill {
4988   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
4989
4990   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
4991   warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
4992
4993   $cust_main->bill_and_collect( %args );
4994 }
4995
4996 sub process_bill_and_collect {
4997   my $job = shift;
4998   my $param = thaw(decode_base64(shift));
4999   my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5000       or die "custnum '$param->{custnum}' not found!\n";
5001   $param->{'job'}   = $job;
5002   $param->{'fatal'} = 1; # runs from job queue, will be caught
5003   $param->{'retry'} = 1;
5004
5005   $cust_main->bill_and_collect( %$param );
5006 }
5007
5008 #starting to take quite a while for big dbs
5009 #   (JRNL: journaled so it only happens once per database)
5010 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
5011 # JRNL seq scan of cust_main on signupdate... index signupdate?  will that help?
5012 # JRNL seq scan of cust_main on paydate... index on substrings?  maybe set an
5013 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
5014 # JRNL leading/trailing spaces in first, last, company
5015 # - otaker upgrade?  journal and call it good?  (double check to make sure
5016 #    we're not still setting otaker here)
5017 #
5018 #only going to get worse with new location stuff...
5019
5020 sub _upgrade_data { #class method
5021   my ($class, %opts) = @_;
5022
5023   my @statements = (
5024     'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
5025   );
5026
5027   #this seems to be the only expensive one.. why does it take so long?
5028   unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
5029     push @statements,
5030       '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';
5031     FS::upgrade_journal->set_done('cust_main__signupdate');
5032   }
5033
5034   unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) {
5035
5036     # fix yyyy-m-dd formatted paydates
5037     if ( driver_name =~ /^mysql/i ) {
5038       push @statements,
5039       "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5040     } else { # the SQL standard
5041       push @statements,
5042       "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5043     }
5044     FS::upgrade_journal->set_done('cust_main__paydate');
5045   }
5046
5047   unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) {
5048
5049     push @statements, #fix the weird BILL with a cc# in payinfo problem
5050       #DCRD to be safe
5051       "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
5052
5053     FS::upgrade_journal->set_done('cust_main__payinfo');
5054
5055   }
5056
5057   my $t = time;
5058   foreach my $sql ( @statements ) {
5059     my $sth = dbh->prepare($sql) or die dbh->errstr;
5060     $sth->execute or die $sth->errstr;
5061     #warn ( (time - $t). " seconds\n" );
5062     #$t = time;
5063   }
5064
5065   local($ignore_expired_card) = 1;
5066   local($ignore_banned_card) = 1;
5067   local($skip_fuzzyfiles) = 1;
5068   local($import) = 1; #prevent automatic geocoding (need its own variable?)
5069
5070   FS::cust_main::Location->_upgrade_data(%opts);
5071
5072   unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
5073
5074     foreach my $cust_main ( qsearch({
5075       'table'     => 'cust_main',
5076       'hashref'   => {},
5077       'extra_sql' => 'WHERE '.
5078                        join(' OR ',
5079                          map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '%  %'",
5080                            qw( first last company )
5081                        ),
5082     }) ) {
5083       my $error = $cust_main->replace;
5084       die $error if $error;
5085     }
5086
5087     FS::upgrade_journal->set_done('cust_main__trimspaces');
5088
5089   }
5090
5091   $class->_upgrade_otaker(%opts);
5092
5093 }
5094
5095 =back
5096
5097 =head1 BUGS
5098
5099 The delete method.
5100
5101 The delete method should possibly take an FS::cust_main object reference
5102 instead of a scalar customer number.
5103
5104 Bill and collect options should probably be passed as references instead of a
5105 list.
5106
5107 There should probably be a configuration file with a list of allowed credit
5108 card types.
5109
5110 No multiple currency support (probably a larger project than just this module).
5111
5112 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5113
5114 Birthdates rely on negative epoch values.
5115
5116 The payby for card/check batches is broken.  With mixed batching, bad
5117 things will happen.
5118
5119 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5120
5121 =head1 SEE ALSO
5122
5123 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5124 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5125 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
5126
5127 =cut
5128
5129 1;
5130