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