FS/FS/cust_main.pm

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