FS/FS/cust_main.pm

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