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