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