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