FS/FS/cust_main.pm

   1 package FS::cust_main;
   2
   3 require 5.006;
   4 use strict;
   5 use base qw( FS::cust_main::Billing FS::cust_main::Billing_Realtime
   6              FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin
   7              FS::Record
   8            );
   9 use vars qw( @EXPORT_OK $DEBUG $me $conf
  10              @encrypted_fields
  11              $import $ignore_expired_card
  12              $skip_fuzzyfiles @fuzzyfields
  13              @paytypes
  14            );
  15 use vars qw( $realtime_bop_decline_quiet ); #ugh
  16 use Carp;
  17 use Exporter;
  18 use Scalar::Util qw( blessed );
  19 use List::Util qw( min );
  20 use Time::Local qw(timelocal);
  21 use Storable qw(thaw);
  22 use MIME::Base64;
  23 use Data::Dumper;
  24 use Tie::IxHash;
  25 use Digest::MD5 qw(md5_base64);
  26 use Date::Format;
  27 #use Date::Manip;
  28 use File::Temp qw( tempfile );
  29 use String::Approx qw(amatch);
  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_event;
  61 use FS::part_event_condition;
  62 use FS::part_export;
  63 #use FS::cust_event;
  64 use FS::type_pkgs;
  65 use FS::payment_gateway;
  66 use FS::agent_payment_gateway;
  67 use FS::banned_pay;
  68 use FS::TicketSystem;
  69
  70 @EXPORT_OK = qw( smart_search );
  71
  72 $realtime_bop_decline_quiet = 0; #move to Billing_Realtime
  73
  74 # 1 is mostly method/subroutine entry and options
  75 # 2 traces progress of some operations
  76 # 3 is even more information including possibly sensitive data
  77 $DEBUG = 0;
  78 $me = '[FS::cust_main]';
  79
  80 $import = 0;
  81 $ignore_expired_card = 0;
  82
  83 $skip_fuzzyfiles = 0;
  84 @fuzzyfields = ( 'first', 'last', 'company', 'address1' );
  85
  86 @encrypted_fields = ('payinfo', 'paycvv');
  87 sub nohistory_fields { ('payinfo', 'paycvv'); }
  88
  89 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
  90
  91 #ask FS::UID to run this stuff for us later
  92 #$FS::UID::callback{'FS::cust_main'} = sub {
  93 install_callback FS::UID sub {
  94   $conf = new FS::Conf;
  95   #yes, need it for stuff below (prolly should be cached)
  96 };
  97
  98 sub _cache {
  99   my $self = shift;
 100   my ( $hashref, $cache ) = @_;
 101   if ( exists $hashref->{'pkgnum'} ) {
 102     #@{ $self->{'_pkgnum'} } = ();
 103     my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
 104     $self->{'_pkgnum'} = $subcache;
 105     #push @{ $self->{'_pkgnum'} },
 106     FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
 107   }
 108 }
 109
 110 =head1 NAME
 111
 112 FS::cust_main - Object methods for cust_main records
 113
 114 =head1 SYNOPSIS
 115
 116   use FS::cust_main;
 117
 118   $record = new FS::cust_main \%hash;
 119   $record = new FS::cust_main { 'column' => 'value' };
 120
 121   $error = $record->insert;
 122
 123   $error = $new_record->replace($old_record);
 124
 125   $error = $record->delete;
 126
 127   $error = $record->check;
 128
 129   @cust_pkg = $record->all_pkgs;
 130
 131   @cust_pkg = $record->ncancelled_pkgs;
 132
 133   @cust_pkg = $record->suspended_pkgs;
 134
 135   $error = $record->bill;
 136   $error = $record->bill %options;
 137   $error = $record->bill 'time' => $time;
 138
 139   $error = $record->collect;
 140   $error = $record->collect %options;
 141   $error = $record->collect 'invoice_time'   => $time,
 142                           ;
 143
 144 =head1 DESCRIPTION
 145
 146 An FS::cust_main object represents a customer.  FS::cust_main inherits from
 147 FS::Record.  The following fields are currently supported:
 148
 149 =over 4
 150
 151 =item custnum
 152
 153 Primary key (assigned automatically for new customers)
 154
 155 =item agentnum
 156
 157 Agent (see L<FS::agent>)
 158
 159 =item refnum
 160
 161 Advertising source (see L<FS::part_referral>)
 162
 163 =item first
 164
 165 First name
 166
 167 =item last
 168
 169 Last name
 170
 171 =item ss
 172
 173 Cocial security number (optional)
 174
 175 =item company
 176
 177 (optional)
 178
 179 =item address1
 180
 181 =item address2
 182
 183 (optional)
 184
 185 =item city
 186
 187 =item county
 188
 189 (optional, see L<FS::cust_main_county>)
 190
 191 =item state
 192
 193 (see L<FS::cust_main_county>)
 194
 195 =item zip
 196
 197 =item country
 198
 199 (see L<FS::cust_main_county>)
 200
 201 =item daytime
 202
 203 phone (optional)
 204
 205 =item night
 206
 207 phone (optional)
 208
 209 =item fax
 210
 211 phone (optional)
 212
 213 =item ship_first
 214
 215 Shipping first name
 216
 217 =item ship_last
 218
 219 Shipping last name
 220
 221 =item ship_company
 222
 223 (optional)
 224
 225 =item ship_address1
 226
 227 =item ship_address2
 228
 229 (optional)
 230
 231 =item ship_city
 232
 233 =item ship_county
 234
 235 (optional, see L<FS::cust_main_county>)
 236
 237 =item ship_state
 238
 239 (see L<FS::cust_main_county>)
 240
 241 =item ship_zip
 242
 243 =item ship_country
 244
 245 (see L<FS::cust_main_county>)
 246
 247 =item ship_daytime
 248
 249 phone (optional)
 250
 251 =item ship_night
 252
 253 phone (optional)
 254
 255 =item ship_fax
 256
 257 phone (optional)
 258
 259 =item payby
 260
 261 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
 262
 263 =item payinfo
 264
 265 Payment Information (See L<FS::payinfo_Mixin> for data format)
 266
 267 =item paymask
 268
 269 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
 270
 271 =item paycvv
 272
 273 Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card
 274
 275 =item paydate
 276
 277 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
 278
 279 =item paystart_month
 280
 281 Start date month (maestro/solo cards only)
 282
 283 =item paystart_year
 284
 285 Start date year (maestro/solo cards only)
 286
 287 =item payissue
 288
 289 Issue number (maestro/solo cards only)
 290
 291 =item payname
 292
 293 Name on card or billing name
 294
 295 =item payip
 296
 297 IP address from which payment information was received
 298
 299 =item tax
 300
 301 Tax exempt, empty or `Y'
 302
 303 =item usernum
 304
 305 Order taker (see L<FS::access_user>)
 306
 307 =item comments
 308
 309 Comments (optional)
 310
 311 =item referral_custnum
 312
 313 Referring customer number
 314
 315 =item spool_cdr
 316
 317 Enable individual CDR spooling, empty or `Y'
 318
 319 =item dundate
 320
 321 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
 322
 323 =item squelch_cdr
 324
 325 Discourage individual CDR printing, empty or `Y'
 326
 327 =back
 328
 329 =head1 METHODS
 330
 331 =over 4
 332
 333 =item new HASHREF
 334
 335 Creates a new customer.  To add the customer to the database, see L<"insert">.
 336
 337 Note that this stores the hash reference, not a distinct copy of the hash it
 338 points to.  You can ask the object for a copy with the I<hash> method.
 339
 340 =cut
 341
 342 sub table { 'cust_main'; }
 343
 344 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
 345
 346 Adds this customer to the database.  If there is an error, returns the error,
 347 otherwise returns false.
 348
 349 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
 350 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
 351 are inserted atomicly, or the transaction is rolled back.  Passing an empty
 352 hash reference is equivalent to not supplying this parameter.  There should be
 353 a better explanation of this, but until then, here's an example:
 354
 355   use Tie::RefHash;
 356   tie %hash, 'Tie::RefHash'; #this part is important
 357   %hash = (
 358     $cust_pkg => [ $svc_acct ],
 359     ...
 360   );
 361   $cust_main->insert( \%hash );
 362
 363 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 364 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 365 expected and rollback the entire transaction; it is not necessary to call
 366 check_invoicing_list first.  The invoicing_list is set after the records in the
 367 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
 368 invoicing_list destination to the newly-created svc_acct.  Here's an example:
 369
 370   $cust_main->insert( {}, [ $email, 'POST' ] );
 371
 372 Currently available options are: I<depend_jobnum>, I<noexport> and I<tax_exemption>.
 373
 374 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 375 on the supplied jobnum (they will not run until the specific job completes).
 376 This can be used to defer provisioning until some action completes (such
 377 as running the customer's credit card successfully).
 378
 379 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 380 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 381 the B<reexport> method.)
 382
 383 The I<tax_exemption> option can be set to an arrayref of tax names.
 384 FS::cust_main_exemption records will be created and inserted.
 385
 386 =cut
 387
 388 sub insert {
 389   my $self = shift;
 390   my $cust_pkgs = @_ ? shift : {};
 391   my $invoicing_list = @_ ? shift : '';
 392   my %options = @_;
 393   warn "$me insert called with options ".
 394        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 395     if $DEBUG;
 396
 397   local $SIG{HUP} = 'IGNORE';
 398   local $SIG{INT} = 'IGNORE';
 399   local $SIG{QUIT} = 'IGNORE';
 400   local $SIG{TERM} = 'IGNORE';
 401   local $SIG{TSTP} = 'IGNORE';
 402   local $SIG{PIPE} = 'IGNORE';
 403
 404   my $oldAutoCommit = $FS::UID::AutoCommit;
 405   local $FS::UID::AutoCommit = 0;
 406   my $dbh = dbh;
 407
 408   my $prepay_identifier = '';
 409   my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
 410   my $payby = '';
 411   if ( $self->payby eq 'PREPAY' ) {
 412
 413     $self->payby('BILL');
 414     $prepay_identifier = $self->payinfo;
 415     $self->payinfo('');
 416
 417     warn "  looking up prepaid card $prepay_identifier\n"
 418       if $DEBUG > 1;
 419
 420     my $error = $self->get_prepay( $prepay_identifier,
 421                                    'amount_ref'     => \$amount,
 422                                    'seconds_ref'    => \$seconds,
 423                                    'upbytes_ref'    => \$upbytes,
 424                                    'downbytes_ref'  => \$downbytes,
 425                                    'totalbytes_ref' => \$totalbytes,
 426                                  );
 427     if ( $error ) {
 428       $dbh->rollback if $oldAutoCommit;
 429       #return "error applying prepaid card (transaction rolled back): $error";
 430       return $error;
 431     }
 432
 433     $payby = 'PREP' if $amount;
 434
 435   } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
 436
 437     $payby = $1;
 438     $self->payby('BILL');
 439     $amount = $self->paid;
 440
 441   }
 442
 443   warn "  inserting $self\n"
 444     if $DEBUG > 1;
 445
 446   $self->signupdate(time) unless $self->signupdate;
 447
 448   $self->auto_agent_custid()
 449     if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
 450
 451   my $error = $self->SUPER::insert;
 452   if ( $error ) {
 453     $dbh->rollback if $oldAutoCommit;
 454     #return "inserting cust_main record (transaction rolled back): $error";
 455     return $error;
 456   }
 457
 458   warn "  setting invoicing list\n"
 459     if $DEBUG > 1;
 460
 461   if ( $invoicing_list ) {
 462     $error = $self->check_invoicing_list( $invoicing_list );
 463     if ( $error ) {
 464       $dbh->rollback if $oldAutoCommit;
 465       #return "checking invoicing_list (transaction rolled back): $error";
 466       return $error;
 467     }
 468     $self->invoicing_list( $invoicing_list );
 469   }
 470
 471   warn "  setting customer tags\n"
 472     if $DEBUG > 1;
 473
 474   foreach my $tagnum ( @{ $self->tagnum || [] } ) {
 475     my $cust_tag = new FS::cust_tag { 'tagnum'  => $tagnum,
 476                                       'custnum' => $self->custnum };
 477     my $error = $cust_tag->insert;
 478     if ( $error ) {
 479       $dbh->rollback if $oldAutoCommit;
 480       return $error;
 481     }
 482   }
 483
 484   if ( $invoicing_list ) {
 485     $error = $self->check_invoicing_list( $invoicing_list );
 486     if ( $error ) {
 487       $dbh->rollback if $oldAutoCommit;
 488       #return "checking invoicing_list (transaction rolled back): $error";
 489       return $error;
 490     }
 491     $self->invoicing_list( $invoicing_list );
 492   }
 493
 494
 495   warn "  setting cust_main_exemption\n"
 496     if $DEBUG > 1;
 497
 498   my $tax_exemption = delete $options{'tax_exemption'};
 499   if ( $tax_exemption ) {
 500     foreach my $taxname ( @$tax_exemption ) {
 501       my $cust_main_exemption = new FS::cust_main_exemption {
 502         'custnum' => $self->custnum,
 503         'taxname' => $taxname,
 504       };
 505       my $error = $cust_main_exemption->insert;
 506       if ( $error ) {
 507         $dbh->rollback if $oldAutoCommit;
 508         return "inserting cust_main_exemption (transaction rolled back): $error";
 509       }
 510     }
 511   }
 512
 513   if (    $conf->config('cust_main-skeleton_tables')
 514        && $conf->config('cust_main-skeleton_custnum') ) {
 515
 516     warn "  inserting skeleton records\n"
 517       if $DEBUG > 1;
 518
 519     my $error = $self->start_copy_skel;
 520     if ( $error ) {
 521       $dbh->rollback if $oldAutoCommit;
 522       return $error;
 523     }
 524
 525   }
 526
 527   warn "  ordering packages\n"
 528     if $DEBUG > 1;
 529
 530   $error = $self->order_pkgs( $cust_pkgs,
 531                               %options,
 532                               'seconds_ref'    => \$seconds,
 533                               'upbytes_ref'    => \$upbytes,
 534                               'downbytes_ref'  => \$downbytes,
 535                               'totalbytes_ref' => \$totalbytes,
 536                             );
 537   if ( $error ) {
 538     $dbh->rollback if $oldAutoCommit;
 539     return $error;
 540   }
 541
 542   if ( $seconds ) {
 543     $dbh->rollback if $oldAutoCommit;
 544     return "No svc_acct record to apply pre-paid time";
 545   }
 546   if ( $upbytes || $downbytes || $totalbytes ) {
 547     $dbh->rollback if $oldAutoCommit;
 548     return "No svc_acct record to apply pre-paid data";
 549   }
 550
 551   if ( $amount ) {
 552     warn "  inserting initial $payby payment of $amount\n"
 553       if $DEBUG > 1;
 554     $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
 555     if ( $error ) {
 556       $dbh->rollback if $oldAutoCommit;
 557       return "inserting payment (transaction rolled back): $error";
 558     }
 559   }
 560
 561   unless ( $import || $skip_fuzzyfiles ) {
 562     warn "  queueing fuzzyfiles update\n"
 563       if $DEBUG > 1;
 564     $error = $self->queue_fuzzyfiles_update;
 565     if ( $error ) {
 566       $dbh->rollback if $oldAutoCommit;
 567       return "updating fuzzy search cache: $error";
 568     }
 569   }
 570
 571   # cust_main exports!
 572   warn "  exporting\n" if $DEBUG > 1;
 573
 574   my $export_args = $options{'export_args'} || [];
 575
 576   my @part_export =
 577     map qsearch( 'part_export', {exportnum=>$_} ),
 578       $conf->config('cust_main-exports'); #, $agentnum
 579
 580   foreach my $part_export ( @part_export ) {
 581     my $error = $part_export->export_insert($self, @$export_args);
 582     if ( $error ) {
 583       $dbh->rollback if $oldAutoCommit;
 584       return "exporting to ". $part_export->exporttype.
 585              " (transaction rolled back): $error";
 586     }
 587   }
 588
 589   #foreach my $depend_jobnum ( @$depend_jobnums ) {
 590   #    warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
 591   #      if $DEBUG;
 592   #    foreach my $jobnum ( @jobnums ) {
 593   #      my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
 594   #      warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
 595   #        if $DEBUG;
 596   #      my $error = $queue->depend_insert($depend_jobnum);
 597   #      if ( $error ) {
 598   #        $dbh->rollback if $oldAutoCommit;
 599   #        return "error queuing job dependancy: $error";
 600   #      }
 601   #    }
 602   #  }
 603   #
 604   #}
 605   #
 606   #if ( exists $options{'jobnums'} ) {
 607   #  push @{ $options{'jobnums'} }, @jobnums;
 608   #}
 609
 610   warn "  insert complete; committing transaction\n"
 611     if $DEBUG > 1;
 612
 613   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 614   '';
 615
 616 }
 617
 618 use File::CounterFile;
 619 sub auto_agent_custid {
 620   my $self = shift;
 621
 622   my $format = $conf->config('cust_main-auto_agent_custid');
 623   my $agent_custid;
 624   if ( $format eq '1YMMXXXXXXXX' ) {
 625
 626     my $counter = new File::CounterFile 'cust_main.agent_custid';
 627     $counter->lock;
 628
 629     my $ym = 100000000000 + time2str('%y%m00000000', time);
 630     if ( $ym > $counter->value ) {
 631       $counter->{'value'} = $agent_custid = $ym;
 632       $counter->{'updated'} = 1;
 633     } else {
 634       $agent_custid = $counter->inc;
 635     }
 636
 637     $counter->unlock;
 638
 639   } else {
 640     die "Unknown cust_main-auto_agent_custid format: $format";
 641   }
 642
 643   $self->agent_custid($agent_custid);
 644
 645 }
 646
 647 sub start_copy_skel {
 648   my $self = shift;
 649
 650   #'mg_user_preference' => {},
 651   #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
 652   #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
 653   #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
 654   #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
 655   my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
 656   die $@ if $@;
 657
 658   _copy_skel( 'cust_main',                                 #tablename
 659               $conf->config('cust_main-skeleton_custnum'), #sourceid
 660               $self->custnum,                              #destid
 661               @tables,                                     #child tables
 662             );
 663 }
 664
 665 #recursive subroutine, not a method
 666 sub _copy_skel {
 667   my( $table, $sourceid, $destid, %child_tables ) = @_;
 668
 669   my $primary_key;
 670   if ( $table =~ /^(\w+)\.(\w+)$/ ) {
 671     ( $table, $primary_key ) = ( $1, $2 );
 672   } else {
 673     my $dbdef_table = dbdef->table($table);
 674     $primary_key = $dbdef_table->primary_key
 675       or return "$table has no primary key".
 676                 " (or do you need to run dbdef-create?)";
 677   }
 678
 679   warn "  _copy_skel: $table.$primary_key $sourceid to $destid for ".
 680        join (', ', keys %child_tables). "\n"
 681     if $DEBUG > 2;
 682
 683   foreach my $child_table_def ( keys %child_tables ) {
 684
 685     my $child_table;
 686     my $child_pkey = '';
 687     if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
 688       ( $child_table, $child_pkey ) = ( $1, $2 );
 689     } else {
 690       $child_table = $child_table_def;
 691
 692       $child_pkey = dbdef->table($child_table)->primary_key;
 693       #  or return "$table has no primary key".
 694       #            " (or do you need to run dbdef-create?)\n";
 695     }
 696
 697     my $sequence = '';
 698     if ( keys %{ $child_tables{$child_table_def} } ) {
 699
 700       return "$child_table has no primary key".
 701              " (run dbdef-create or try specifying it?)\n"
 702         unless $child_pkey;
 703
 704       #false laziness w/Record::insert and only works on Pg
 705       #refactor the proper last-inserted-id stuff out of Record::insert if this
 706       # ever gets use for anything besides a quick kludge for one customer
 707       my $default = dbdef->table($child_table)->column($child_pkey)->default;
 708       $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
 709         or return "can't parse $child_table.$child_pkey default value ".
 710                   " for sequence name: $default";
 711       $sequence = $1;
 712
 713     }
 714
 715     my @sel_columns = grep { $_ ne $primary_key }
 716                            dbdef->table($child_table)->columns;
 717     my $sel_columns = join(', ', @sel_columns );
 718
 719     my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
 720     my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
 721     my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
 722
 723     my $sel_st = "SELECT $sel_columns FROM $child_table".
 724                  " WHERE $primary_key = $sourceid";
 725     warn "    $sel_st\n"
 726       if $DEBUG > 2;
 727     my $sel_sth = dbh->prepare( $sel_st )
 728       or return dbh->errstr;
 729
 730     $sel_sth->execute or return $sel_sth->errstr;
 731
 732     while ( my $row = $sel_sth->fetchrow_hashref ) {
 733
 734       warn "    selected row: ".
 735            join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
 736         if $DEBUG > 2;
 737
 738       my $statement =
 739         "INSERT INTO $child_table $ins_columns VALUES $placeholders";
 740       my $ins_sth =dbh->prepare($statement)
 741           or return dbh->errstr;
 742       my @param = ( $destid, map $row->{$_}, @ins_columns );
 743       warn "    $statement: [ ". join(', ', @param). " ]\n"
 744         if $DEBUG > 2;
 745       $ins_sth->execute( @param )
 746         or return $ins_sth->errstr;
 747
 748       #next unless keys %{ $child_tables{$child_table} };
 749       next unless $sequence;
 750
 751       #another section of that laziness
 752       my $seq_sql = "SELECT currval('$sequence')";
 753       my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
 754       $seq_sth->execute or return $seq_sth->errstr;
 755       my $insertid = $seq_sth->fetchrow_arrayref->[0];
 756
 757       # don't drink soap!  recurse!  recurse!  okay!
 758       my $error =
 759         _copy_skel( $child_table_def,
 760                     $row->{$child_pkey}, #sourceid
 761                     $insertid, #destid
 762                     %{ $child_tables{$child_table_def} },
 763                   );
 764       return $error if $error;
 765
 766     }
 767
 768   }
 769
 770   return '';
 771
 772 }
 773
 774 =item order_pkg HASHREF | OPTION => VALUE ...
 775
 776 Orders a single package.
 777
 778 Options may be passed as a list of key/value pairs or as a hash reference.
 779 Options are:
 780
 781 =over 4
 782
 783 =item cust_pkg
 784
 785 FS::cust_pkg object
 786
 787 =item cust_location
 788
 789 Optional FS::cust_location object
 790
 791 =item svcs
 792
 793 Optional arryaref of FS::svc_* service objects.
 794
 795 =item depend_jobnum
 796
 797 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
 798 jobs will have a dependancy on the supplied job (they will not run until the
 799 specific job completes).  This can be used to defer provisioning until some
 800 action completes (such as running the customer's credit card successfully).
 801
 802 =item ticket_subject
 803
 804 Optional subject for a ticket created and attached to this customer
 805
 806 =item ticket_subject
 807
 808 Optional queue name for ticket additions
 809
 810 =back
 811
 812 =cut
 813
 814 sub order_pkg {
 815   my $self = shift;
 816   my $opt = ref($_[0]) ? shift : { @_ };
 817
 818   warn "$me order_pkg called with options ".
 819        join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
 820     if $DEBUG;
 821
 822   my $cust_pkg = $opt->{'cust_pkg'};
 823   my $svcs     = $opt->{'svcs'} || [];
 824
 825   my %svc_options = ();
 826   $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
 827     if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
 828
 829   my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
 830                           qw( ticket_subject ticket_queue );
 831
 832   local $SIG{HUP} = 'IGNORE';
 833   local $SIG{INT} = 'IGNORE';
 834   local $SIG{QUIT} = 'IGNORE';
 835   local $SIG{TERM} = 'IGNORE';
 836   local $SIG{TSTP} = 'IGNORE';
 837   local $SIG{PIPE} = 'IGNORE';
 838
 839   my $oldAutoCommit = $FS::UID::AutoCommit;
 840   local $FS::UID::AutoCommit = 0;
 841   my $dbh = dbh;
 842
 843   if ( $opt->{'cust_location'} &&
 844        ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
 845     my $error = $opt->{'cust_location'}->insert;
 846     if ( $error ) {
 847       $dbh->rollback if $oldAutoCommit;
 848       return "inserting cust_location (transaction rolled back): $error";
 849     }
 850     $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
 851   }
 852
 853   $cust_pkg->custnum( $self->custnum );
 854
 855   my $error = $cust_pkg->insert( %insert_params );
 856   if ( $error ) {
 857     $dbh->rollback if $oldAutoCommit;
 858     return "inserting cust_pkg (transaction rolled back): $error";
 859   }
 860
 861   foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
 862     if ( $svc_something->svcnum ) {
 863       my $old_cust_svc = $svc_something->cust_svc;
 864       my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
 865       $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
 866       $error = $new_cust_svc->replace($old_cust_svc);
 867     } else {
 868       $svc_something->pkgnum( $cust_pkg->pkgnum );
 869       if ( $svc_something->isa('FS::svc_acct') ) {
 870         foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
 871                        qw( seconds upbytes downbytes totalbytes )      ) {
 872           $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
 873           ${ $opt->{$_.'_ref'} } = 0;
 874         }
 875       }
 876       $error = $svc_something->insert(%svc_options);
 877     }
 878     if ( $error ) {
 879       $dbh->rollback if $oldAutoCommit;
 880       return "inserting svc_ (transaction rolled back): $error";
 881     }
 882   }
 883
 884   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 885   ''; #no error
 886
 887 }
 888
 889 #deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ]
 890 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
 891
 892 Like the insert method on an existing record, this method orders multiple
 893 packages and included services atomicaly.  Pass a Tie::RefHash data structure
 894 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
 895 There should be a better explanation of this, but until then, here's an
 896 example:
 897
 898   use Tie::RefHash;
 899   tie %hash, 'Tie::RefHash'; #this part is important
 900   %hash = (
 901     $cust_pkg => [ $svc_acct ],
 902     ...
 903   );
 904   $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
 905
 906 Services can be new, in which case they are inserted, or existing unaudited
 907 services, in which case they are linked to the newly-created package.
 908
 909 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
 910 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
 911
 912 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 913 on the supplied jobnum (they will not run until the specific job completes).
 914 This can be used to defer provisioning until some action completes (such
 915 as running the customer's credit card successfully).
 916
 917 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 918 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 919 the B<reexport> method for each cust_pkg object.  Using the B<reexport> method
 920 on the cust_main object is not recommended, as existing services will also be
 921 reexported.)
 922
 923 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
 924 provided, the scalars (provided by references) will be incremented by the
 925 values of the prepaid card.`
 926
 927 =cut
 928
 929 sub order_pkgs {
 930   my $self = shift;
 931   my $cust_pkgs = shift;
 932   my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated
 933   my %options = @_;
 934   $seconds_ref ||= $options{'seconds_ref'};
 935
 936   warn "$me order_pkgs called with options ".
 937        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 938     if $DEBUG;
 939
 940   local $SIG{HUP} = 'IGNORE';
 941   local $SIG{INT} = 'IGNORE';
 942   local $SIG{QUIT} = 'IGNORE';
 943   local $SIG{TERM} = 'IGNORE';
 944   local $SIG{TSTP} = 'IGNORE';
 945   local $SIG{PIPE} = 'IGNORE';
 946
 947   my $oldAutoCommit = $FS::UID::AutoCommit;
 948   local $FS::UID::AutoCommit = 0;
 949   my $dbh = dbh;
 950
 951   local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
 952
 953   foreach my $cust_pkg ( keys %$cust_pkgs ) {
 954
 955     my $error = $self->order_pkg(
 956       'cust_pkg'     => $cust_pkg,
 957       'svcs'         => $cust_pkgs->{$cust_pkg},
 958       'seconds_ref'  => $seconds_ref,
 959       map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref
 960                                      depend_jobnum
 961                                    )
 962     );
 963     if ( $error ) {
 964       $dbh->rollback if $oldAutoCommit;
 965       return $error;
 966     }
 967
 968   }
 969
 970   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 971   ''; #no error
 972 }
 973
 974 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
 975
 976 Recharges this (existing) customer with the specified prepaid card (see
 977 L<FS::prepay_credit>), specified either by I<identifier> or as an
 978 FS::prepay_credit object.  If there is an error, returns the error, otherwise
 979 returns false.
 980
 981 Optionally, five scalar references can be passed as well.  They will have their
 982 values filled in with the amount, number of seconds, and number of upload,
 983 download, and total bytes applied by this prepaid card.
 984
 985 =cut
 986
 987 #the ref bullshit here should be refactored like get_prepay.  MyAccount.pm is
 988 #the only place that uses these args
 989 sub recharge_prepay {
 990   my( $self, $prepay_credit, $amountref, $secondsref,
 991       $upbytesref, $downbytesref, $totalbytesref ) = @_;
 992
 993   local $SIG{HUP} = 'IGNORE';
 994   local $SIG{INT} = 'IGNORE';
 995   local $SIG{QUIT} = 'IGNORE';
 996   local $SIG{TERM} = 'IGNORE';
 997   local $SIG{TSTP} = 'IGNORE';
 998   local $SIG{PIPE} = 'IGNORE';
 999
1000   my $oldAutoCommit = $FS::UID::AutoCommit;
1001   local $FS::UID::AutoCommit = 0;
1002   my $dbh = dbh;
1003
1004   my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
1005
1006   my $error = $self->get_prepay( $prepay_credit,
1007                                  'amount_ref'     => \$amount,
1008                                  'seconds_ref'    => \$seconds,
1009                                  'upbytes_ref'    => \$upbytes,
1010                                  'downbytes_ref'  => \$downbytes,
1011                                  'totalbytes_ref' => \$totalbytes,
1012                                )
1013            || $self->increment_seconds($seconds)
1014            || $self->increment_upbytes($upbytes)
1015            || $self->increment_downbytes($downbytes)
1016            || $self->increment_totalbytes($totalbytes)
1017            || $self->insert_cust_pay_prepay( $amount,
1018                                              ref($prepay_credit)
1019                                                ? $prepay_credit->identifier
1020                                                : $prepay_credit
1021                                            );
1022
1023   if ( $error ) {
1024     $dbh->rollback if $oldAutoCommit;
1025     return $error;
1026   }
1027
1028   if ( defined($amountref)  ) { $$amountref  = $amount;  }
1029   if ( defined($secondsref) ) { $$secondsref = $seconds; }
1030   if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
1031   if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
1032   if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
1033
1034   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1035   '';
1036
1037 }
1038
1039 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
1040
1041 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
1042 specified either by I<identifier> or as an FS::prepay_credit object.
1043
1044 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
1045 incremented by the values of the prepaid card.
1046
1047 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
1048 check or set this customer's I<agentnum>.
1049
1050 If there is an error, returns the error, otherwise returns false.
1051
1052 =cut
1053
1054
1055 sub get_prepay {
1056   my( $self, $prepay_credit, %opt ) = @_;
1057
1058   local $SIG{HUP} = 'IGNORE';
1059   local $SIG{INT} = 'IGNORE';
1060   local $SIG{QUIT} = 'IGNORE';
1061   local $SIG{TERM} = 'IGNORE';
1062   local $SIG{TSTP} = 'IGNORE';
1063   local $SIG{PIPE} = 'IGNORE';
1064
1065   my $oldAutoCommit = $FS::UID::AutoCommit;
1066   local $FS::UID::AutoCommit = 0;
1067   my $dbh = dbh;
1068
1069   unless ( ref($prepay_credit) ) {
1070
1071     my $identifier = $prepay_credit;
1072
1073     $prepay_credit = qsearchs(
1074       'prepay_credit',
1075       { 'identifier' => $prepay_credit },
1076       '',
1077       'FOR UPDATE'
1078     );
1079
1080     unless ( $prepay_credit ) {
1081       $dbh->rollback if $oldAutoCommit;
1082       return "Invalid prepaid card: ". $identifier;
1083     }
1084
1085   }
1086
1087   if ( $prepay_credit->agentnum ) {
1088     if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
1089       $dbh->rollback if $oldAutoCommit;
1090       return "prepaid card not valid for agent ". $self->agentnum;
1091     }
1092     $self->agentnum($prepay_credit->agentnum);
1093   }
1094
1095   my $error = $prepay_credit->delete;
1096   if ( $error ) {
1097     $dbh->rollback if $oldAutoCommit;
1098     return "removing prepay_credit (transaction rolled back): $error";
1099   }
1100
1101   ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
1102     for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
1103
1104   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1105   '';
1106
1107 }
1108
1109 =item increment_upbytes SECONDS
1110
1111 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1112 the specified number of upbytes.  If there is an error, returns the error,
1113 otherwise returns false.
1114
1115 =cut
1116
1117 sub increment_upbytes {
1118   _increment_column( shift, 'upbytes', @_);
1119 }
1120
1121 =item increment_downbytes SECONDS
1122
1123 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1124 the specified number of downbytes.  If there is an error, returns the error,
1125 otherwise returns false.
1126
1127 =cut
1128
1129 sub increment_downbytes {
1130   _increment_column( shift, 'downbytes', @_);
1131 }
1132
1133 =item increment_totalbytes SECONDS
1134
1135 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1136 the specified number of totalbytes.  If there is an error, returns the error,
1137 otherwise returns false.
1138
1139 =cut
1140
1141 sub increment_totalbytes {
1142   _increment_column( shift, 'totalbytes', @_);
1143 }
1144
1145 =item increment_seconds SECONDS
1146
1147 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1148 the specified number of seconds.  If there is an error, returns the error,
1149 otherwise returns false.
1150
1151 =cut
1152
1153 sub increment_seconds {
1154   _increment_column( shift, 'seconds', @_);
1155 }
1156
1157 =item _increment_column AMOUNT
1158
1159 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1160 the specified number of seconds or bytes.  If there is an error, returns
1161 the error, otherwise returns false.
1162
1163 =cut
1164
1165 sub _increment_column {
1166   my( $self, $column, $amount ) = @_;
1167   warn "$me increment_column called: $column, $amount\n"
1168     if $DEBUG;
1169
1170   return '' unless $amount;
1171
1172   my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
1173                       $self->ncancelled_pkgs;
1174
1175   if ( ! @cust_pkg ) {
1176     return 'No packages with primary or single services found'.
1177            ' to apply pre-paid time';
1178   } elsif ( scalar(@cust_pkg) > 1 ) {
1179     #maybe have a way to specify the package/account?
1180     return 'Multiple packages found to apply pre-paid time';
1181   }
1182
1183   my $cust_pkg = $cust_pkg[0];
1184   warn "  found package pkgnum ". $cust_pkg->pkgnum. "\n"
1185     if $DEBUG > 1;
1186
1187   my @cust_svc =
1188     $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1189
1190   if ( ! @cust_svc ) {
1191     return 'No account found to apply pre-paid time';
1192   } elsif ( scalar(@cust_svc) > 1 ) {
1193     return 'Multiple accounts found to apply pre-paid time';
1194   }
1195
1196   my $svc_acct = $cust_svc[0]->svc_x;
1197   warn "  found service svcnum ". $svc_acct->pkgnum.
1198        ' ('. $svc_acct->email. ")\n"
1199     if $DEBUG > 1;
1200
1201   $column = "increment_$column";
1202   $svc_acct->$column($amount);
1203
1204 }
1205
1206 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1207
1208 Inserts a prepayment in the specified amount for this customer.  An optional
1209 second argument can specify the prepayment identifier for tracking purposes.
1210 If there is an error, returns the error, otherwise returns false.
1211
1212 =cut
1213
1214 sub insert_cust_pay_prepay {
1215   shift->insert_cust_pay('PREP', @_);
1216 }
1217
1218 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1219
1220 Inserts a cash payment in the specified amount for this customer.  An optional
1221 second argument can specify the payment identifier for tracking purposes.
1222 If there is an error, returns the error, otherwise returns false.
1223
1224 =cut
1225
1226 sub insert_cust_pay_cash {
1227   shift->insert_cust_pay('CASH', @_);
1228 }
1229
1230 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1231
1232 Inserts a Western Union payment in the specified amount for this customer.  An
1233 optional second argument can specify the prepayment identifier for tracking
1234 purposes.  If there is an error, returns the error, otherwise returns false.
1235
1236 =cut
1237
1238 sub insert_cust_pay_west {
1239   shift->insert_cust_pay('WEST', @_);
1240 }
1241
1242 sub insert_cust_pay {
1243   my( $self, $payby, $amount ) = splice(@_, 0, 3);
1244   my $payinfo = scalar(@_) ? shift : '';
1245
1246   my $cust_pay = new FS::cust_pay {
1247     'custnum' => $self->custnum,
1248     'paid'    => sprintf('%.2f', $amount),
1249     #'_date'   => #date the prepaid card was purchased???
1250     'payby'   => $payby,
1251     'payinfo' => $payinfo,
1252   };
1253   $cust_pay->insert;
1254
1255 }
1256
1257 =item reexport
1258
1259 This method is deprecated.  See the I<depend_jobnum> option to the insert and
1260 order_pkgs methods for a better way to defer provisioning.
1261
1262 Re-schedules all exports by calling the B<reexport> method of all associated
1263 packages (see L<FS::cust_pkg>).  If there is an error, returns the error;
1264 otherwise returns false.
1265
1266 =cut
1267
1268 sub reexport {
1269   my $self = shift;
1270
1271   carp "WARNING: FS::cust_main::reexport is deprectated; ".
1272        "use the depend_jobnum option to insert or order_pkgs to delay export";
1273
1274   local $SIG{HUP} = 'IGNORE';
1275   local $SIG{INT} = 'IGNORE';
1276   local $SIG{QUIT} = 'IGNORE';
1277   local $SIG{TERM} = 'IGNORE';
1278   local $SIG{TSTP} = 'IGNORE';
1279   local $SIG{PIPE} = 'IGNORE';
1280
1281   my $oldAutoCommit = $FS::UID::AutoCommit;
1282   local $FS::UID::AutoCommit = 0;
1283   my $dbh = dbh;
1284
1285   foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1286     my $error = $cust_pkg->reexport;
1287     if ( $error ) {
1288       $dbh->rollback if $oldAutoCommit;
1289       return $error;
1290     }
1291   }
1292
1293   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1294   '';
1295
1296 }
1297
1298 =item delete [ OPTION => VALUE ... ]
1299
1300 This deletes the customer.  If there is an error, returns the error, otherwise
1301 returns false.
1302
1303 This will completely remove all traces of the customer record.  This is not
1304 what you want when a customer cancels service; for that, cancel all of the
1305 customer's packages (see L</cancel>).
1306
1307 If the customer has any uncancelled packages, you need to pass a new (valid)
1308 customer number for those packages to be transferred to, as the "new_customer"
1309 option.  Cancelled packages will be deleted.  Did I mention that this is NOT
1310 what you want when a customer cancels service and that you really should be
1311 looking at L<FS::cust_pkg/cancel>?
1312
1313 You can't delete a customer with invoices (see L<FS::cust_bill>),
1314 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1315 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1316 set the "delete_financials" option to a true value.
1317
1318 =cut
1319
1320 sub delete {
1321   my( $self, %opt ) = @_;
1322
1323   local $SIG{HUP} = 'IGNORE';
1324   local $SIG{INT} = 'IGNORE';
1325   local $SIG{QUIT} = 'IGNORE';
1326   local $SIG{TERM} = 'IGNORE';
1327   local $SIG{TSTP} = 'IGNORE';
1328   local $SIG{PIPE} = 'IGNORE';
1329
1330   my $oldAutoCommit = $FS::UID::AutoCommit;
1331   local $FS::UID::AutoCommit = 0;
1332   my $dbh = dbh;
1333
1334   if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1335      $dbh->rollback if $oldAutoCommit;
1336      return "Can't delete a master agent customer";
1337   }
1338
1339   #use FS::access_user
1340   if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1341      $dbh->rollback if $oldAutoCommit;
1342      return "Can't delete a master employee customer";
1343   }
1344
1345   tie my %financial_tables, 'Tie::IxHash',
1346     'cust_bill'      => 'invoices',
1347     'cust_statement' => 'statements',
1348     'cust_credit'    => 'credits',
1349     'cust_pay'       => 'payments',
1350     'cust_refund'    => 'refunds',
1351   ;
1352
1353   foreach my $table ( keys %financial_tables ) {
1354
1355     my @records = $self->$table();
1356
1357     if ( @records && ! $opt{'delete_financials'} ) {
1358       $dbh->rollback if $oldAutoCommit;
1359       return "Can't delete a customer with ". $financial_tables{$table};
1360     }
1361
1362     foreach my $record ( @records ) {
1363       my $error = $record->delete;
1364       if ( $error ) {
1365         $dbh->rollback if $oldAutoCommit;
1366         return "Error deleting ". $financial_tables{$table}. ": $error\n";
1367       }
1368     }
1369
1370   }
1371
1372   my @cust_pkg = $self->ncancelled_pkgs;
1373   if ( @cust_pkg ) {
1374     my $new_custnum = $opt{'new_custnum'};
1375     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1376       $dbh->rollback if $oldAutoCommit;
1377       return "Invalid new customer number: $new_custnum";
1378     }
1379     foreach my $cust_pkg ( @cust_pkg ) {
1380       my %hash = $cust_pkg->hash;
1381       $hash{'custnum'} = $new_custnum;
1382       my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1383       my $error = $new_cust_pkg->replace($cust_pkg,
1384                                          options => { $cust_pkg->options },
1385                                         );
1386       if ( $error ) {
1387         $dbh->rollback if $oldAutoCommit;
1388         return $error;
1389       }
1390     }
1391   }
1392   my @cancelled_cust_pkg = $self->all_pkgs;
1393   foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1394     my $error = $cust_pkg->delete;
1395     if ( $error ) {
1396       $dbh->rollback if $oldAutoCommit;
1397       return $error;
1398     }
1399   }
1400
1401   #cust_tax_adjustment in financials?
1402   #cust_pay_pending?  ouch
1403   #cust_recon?
1404   foreach my $table (qw(
1405     cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1406     cust_location cust_main_note cust_tax_adjustment
1407     cust_pay_void cust_pay_batch queue cust_tax_exempt
1408   )) {
1409     foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1410       my $error = $record->delete;
1411       if ( $error ) {
1412         $dbh->rollback if $oldAutoCommit;
1413         return $error;
1414       }
1415     }
1416   }
1417
1418   my $sth = $dbh->prepare(
1419     'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1420   ) or do {
1421     my $errstr = $dbh->errstr;
1422     $dbh->rollback if $oldAutoCommit;
1423     return $errstr;
1424   };
1425   $sth->execute($self->custnum) or do {
1426     my $errstr = $sth->errstr;
1427     $dbh->rollback if $oldAutoCommit;
1428     return $errstr;
1429   };
1430
1431   #tickets
1432
1433   my $ticket_dbh = '';
1434   if ($conf->config('ticket_system') eq 'RT_Internal') {
1435     $ticket_dbh = $dbh;
1436   } elsif ($conf->config('ticket_system') eq 'RT_External') {
1437     my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1438     $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1439       #or die "RT_External DBI->connect error: $DBI::errstr\n";
1440   }
1441
1442   if ( $ticket_dbh ) {
1443
1444     my $ticket_sth = $ticket_dbh->prepare(
1445       'DELETE FROM Links WHERE Target = ?'
1446     ) or do {
1447       my $errstr = $ticket_dbh->errstr;
1448       $dbh->rollback if $oldAutoCommit;
1449       return $errstr;
1450     };
1451     $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1452       or do {
1453         my $errstr = $ticket_sth->errstr;
1454         $dbh->rollback if $oldAutoCommit;
1455         return $errstr;
1456       };
1457
1458     #check and see if the customer is the only link on the ticket, and
1459     #if so, set the ticket to deleted status in RT?
1460     #maybe someday, for now this will at least fix tickets not displaying
1461
1462   }
1463
1464   #delete the customer record
1465
1466   my $error = $self->SUPER::delete;
1467   if ( $error ) {
1468     $dbh->rollback if $oldAutoCommit;
1469     return $error;
1470   }
1471
1472   # cust_main exports!
1473
1474   #my $export_args = $options{'export_args'} || [];
1475
1476   my @part_export =
1477     map qsearch( 'part_export', {exportnum=>$_} ),
1478       $conf->config('cust_main-exports'); #, $agentnum
1479
1480   foreach my $part_export ( @part_export ) {
1481     my $error = $part_export->export_delete( $self ); #, @$export_args);
1482     if ( $error ) {
1483       $dbh->rollback if $oldAutoCommit;
1484       return "exporting to ". $part_export->exporttype.
1485              " (transaction rolled back): $error";
1486     }
1487   }
1488
1489   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1490   '';
1491
1492 }
1493
1494 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1495
1496
1497 Replaces the OLD_RECORD with this one in the database.  If there is an error,
1498 returns the error, otherwise returns false.
1499
1500 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1501 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
1502 expected and rollback the entire transaction; it is not necessary to call
1503 check_invoicing_list first.  Here's an example:
1504
1505   $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1506
1507 Currently available options are: I<tax_exemption>.
1508
1509 The I<tax_exemption> option can be set to an arrayref of tax names.
1510 FS::cust_main_exemption records will be deleted and inserted as appropriate.
1511
1512 =cut
1513
1514 sub replace {
1515   my $self = shift;
1516
1517   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1518               ? shift
1519               : $self->replace_old;
1520
1521   my @param = @_;
1522
1523   warn "$me replace called\n"
1524     if $DEBUG;
1525
1526   my $curuser = $FS::CurrentUser::CurrentUser;
1527   if (    $self->payby eq 'COMP'
1528        && $self->payby ne $old->payby
1529        && ! $curuser->access_right('Complimentary customer')
1530      )
1531   {
1532     return "You are not permitted to create complimentary accounts.";
1533   }
1534
1535   local($ignore_expired_card) = 1
1536     if $old->payby  =~ /^(CARD|DCRD)$/
1537     && $self->payby =~ /^(CARD|DCRD)$/
1538     && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1539
1540   local $SIG{HUP} = 'IGNORE';
1541   local $SIG{INT} = 'IGNORE';
1542   local $SIG{QUIT} = 'IGNORE';
1543   local $SIG{TERM} = 'IGNORE';
1544   local $SIG{TSTP} = 'IGNORE';
1545   local $SIG{PIPE} = 'IGNORE';
1546
1547   my $oldAutoCommit = $FS::UID::AutoCommit;
1548   local $FS::UID::AutoCommit = 0;
1549   my $dbh = dbh;
1550
1551   my $error = $self->SUPER::replace($old);
1552
1553   if ( $error ) {
1554     $dbh->rollback if $oldAutoCommit;
1555     return $error;
1556   }
1557
1558   if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1559     my $invoicing_list = shift @param;
1560     $error = $self->check_invoicing_list( $invoicing_list );
1561     if ( $error ) {
1562       $dbh->rollback if $oldAutoCommit;
1563       return $error;
1564     }
1565     $self->invoicing_list( $invoicing_list );
1566   }
1567
1568   if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1569
1570     #this could be more efficient than deleting and re-inserting, if it matters
1571     foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1572       my $error = $cust_tag->delete;
1573       if ( $error ) {
1574         $dbh->rollback if $oldAutoCommit;
1575         return $error;
1576       }
1577     }
1578     foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1579       my $cust_tag = new FS::cust_tag { 'tagnum'  => $tagnum,
1580                                         'custnum' => $self->custnum };
1581       my $error = $cust_tag->insert;
1582       if ( $error ) {
1583         $dbh->rollback if $oldAutoCommit;
1584         return $error;
1585       }
1586     }
1587
1588   }
1589
1590   my %options = @param;
1591
1592   my $tax_exemption = delete $options{'tax_exemption'};
1593   if ( $tax_exemption ) {
1594
1595     my %cust_main_exemption =
1596       map { $_->taxname => $_ }
1597           qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1598
1599     foreach my $taxname ( @$tax_exemption ) {
1600
1601       next if delete $cust_main_exemption{$taxname};
1602
1603       my $cust_main_exemption = new FS::cust_main_exemption {
1604         'custnum' => $self->custnum,
1605         'taxname' => $taxname,
1606       };
1607       my $error = $cust_main_exemption->insert;
1608       if ( $error ) {
1609         $dbh->rollback if $oldAutoCommit;
1610         return "inserting cust_main_exemption (transaction rolled back): $error";
1611       }
1612     }
1613
1614     foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1615       my $error = $cust_main_exemption->delete;
1616       if ( $error ) {
1617         $dbh->rollback if $oldAutoCommit;
1618         return "deleting cust_main_exemption (transaction rolled back): $error";
1619       }
1620     }
1621
1622   }
1623
1624   if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
1625        && ( ( $self->get('payinfo') ne $old->get('payinfo')
1626               && $self->get('payinfo') !~ /^99\d{14}$/
1627             )
1628             || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
1629           )
1630      )
1631   {
1632
1633     # card/check/lec info has changed, want to retry realtime_ invoice events
1634     my $error = $self->retry_realtime;
1635     if ( $error ) {
1636       $dbh->rollback if $oldAutoCommit;
1637       return $error;
1638     }
1639   }
1640
1641   unless ( $import || $skip_fuzzyfiles ) {
1642     $error = $self->queue_fuzzyfiles_update;
1643     if ( $error ) {
1644       $dbh->rollback if $oldAutoCommit;
1645       return "updating fuzzy search cache: $error";
1646     }
1647   }
1648
1649   # cust_main exports!
1650
1651   my $export_args = $options{'export_args'} || [];
1652
1653   my @part_export =
1654     map qsearch( 'part_export', {exportnum=>$_} ),
1655       $conf->config('cust_main-exports'); #, $agentnum
1656
1657   foreach my $part_export ( @part_export ) {
1658     my $error = $part_export->export_replace( $self, $old, @$export_args);
1659     if ( $error ) {
1660       $dbh->rollback if $oldAutoCommit;
1661       return "exporting to ". $part_export->exporttype.
1662              " (transaction rolled back): $error";
1663     }
1664   }
1665
1666   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1667   '';
1668
1669 }
1670
1671 =item queue_fuzzyfiles_update
1672
1673 Used by insert & replace to update the fuzzy search cache
1674
1675 =cut
1676
1677 sub queue_fuzzyfiles_update {
1678   my $self = shift;
1679
1680   local $SIG{HUP} = 'IGNORE';
1681   local $SIG{INT} = 'IGNORE';
1682   local $SIG{QUIT} = 'IGNORE';
1683   local $SIG{TERM} = 'IGNORE';
1684   local $SIG{TSTP} = 'IGNORE';
1685   local $SIG{PIPE} = 'IGNORE';
1686
1687   my $oldAutoCommit = $FS::UID::AutoCommit;
1688   local $FS::UID::AutoCommit = 0;
1689   my $dbh = dbh;
1690
1691   my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1692   my $error = $queue->insert( map $self->getfield($_), @fuzzyfields );
1693   if ( $error ) {
1694     $dbh->rollback if $oldAutoCommit;
1695     return "queueing job (transaction rolled back): $error";
1696   }
1697
1698   if ( $self->ship_last ) {
1699     $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1700     $error = $queue->insert( map $self->getfield("ship_$_"), @fuzzyfields );
1701     if ( $error ) {
1702       $dbh->rollback if $oldAutoCommit;
1703       return "queueing job (transaction rolled back): $error";
1704     }
1705   }
1706
1707   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1708   '';
1709
1710 }
1711
1712 =item check
1713
1714 Checks all fields to make sure this is a valid customer record.  If there is
1715 an error, returns the error, otherwise returns false.  Called by the insert
1716 and replace methods.
1717
1718 =cut
1719
1720 sub check {
1721   my $self = shift;
1722
1723   warn "$me check BEFORE: \n". $self->_dump
1724     if $DEBUG > 2;
1725
1726   my $error =
1727     $self->ut_numbern('custnum')
1728     || $self->ut_number('agentnum')
1729     || $self->ut_textn('agent_custid')
1730     || $self->ut_number('refnum')
1731     || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1732     || $self->ut_textn('custbatch')
1733     || $self->ut_name('last')
1734     || $self->ut_name('first')
1735     || $self->ut_snumbern('birthdate')
1736     || $self->ut_snumbern('signupdate')
1737     || $self->ut_textn('company')
1738     || $self->ut_text('address1')
1739     || $self->ut_textn('address2')
1740     || $self->ut_text('city')
1741     || $self->ut_textn('county')
1742     || $self->ut_textn('state')
1743     || $self->ut_country('country')
1744     || $self->ut_anything('comments')
1745     || $self->ut_numbern('referral_custnum')
1746     || $self->ut_textn('stateid')
1747     || $self->ut_textn('stateid_state')
1748     || $self->ut_textn('invoice_terms')
1749     || $self->ut_alphan('geocode')
1750     || $self->ut_floatn('cdr_termination_percentage')
1751   ;
1752
1753   #barf.  need message catalogs.  i18n.  etc.
1754   $error .= "Please select an advertising source."
1755     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1756   return $error if $error;
1757
1758   return "Unknown agent"
1759     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1760
1761   return "Unknown refnum"
1762     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1763
1764   return "Unknown referring custnum: ". $self->referral_custnum
1765     unless ! $self->referral_custnum
1766            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1767
1768   if ( $self->censustract ne '' ) {
1769     $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/
1770       or return "Illegal census tract: ". $self->censustract;
1771
1772     $self->censustract("$1.$2");
1773   }
1774
1775   if ( $self->ss eq '' ) {
1776     $self->ss('');
1777   } else {
1778     my $ss = $self->ss;
1779     $ss =~ s/\D//g;
1780     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1781       or return "Illegal social security number: ". $self->ss;
1782     $self->ss("$1-$2-$3");
1783   }
1784
1785
1786 # bad idea to disable, causes billing to fail because of no tax rates later
1787 # except we don't fail any more
1788   unless ( $import ) {
1789     unless ( qsearch('cust_main_county', {
1790       'country' => $self->country,
1791       'state'   => '',
1792      } ) ) {
1793       return "Unknown state/county/country: ".
1794         $self->state. "/". $self->county. "/". $self->country
1795         unless qsearch('cust_main_county',{
1796           'state'   => $self->state,
1797           'county'  => $self->county,
1798           'country' => $self->country,
1799         } );
1800     }
1801   }
1802
1803   $error =
1804     $self->ut_phonen('daytime', $self->country)
1805     || $self->ut_phonen('night', $self->country)
1806     || $self->ut_phonen('fax', $self->country)
1807     || $self->ut_zip('zip', $self->country)
1808   ;
1809   return $error if $error;
1810
1811   if ( $conf->exists('cust_main-require_phone')
1812        && ! length($self->daytime) && ! length($self->night)
1813      ) {
1814
1815     my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1816                           ? 'Day Phone'
1817                           : FS::Msgcat::_gettext('daytime');
1818     my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1819                         ? 'Night Phone'
1820                         : FS::Msgcat::_gettext('night');
1821
1822     return "$daytime_label or $night_label is required"
1823
1824   }
1825
1826   if ( $self->has_ship_address
1827        && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1828                         $self->addr_fields )
1829      )
1830   {
1831     my $error =
1832       $self->ut_name('ship_last')
1833       || $self->ut_name('ship_first')
1834       || $self->ut_textn('ship_company')
1835       || $self->ut_text('ship_address1')
1836       || $self->ut_textn('ship_address2')
1837       || $self->ut_text('ship_city')
1838       || $self->ut_textn('ship_county')
1839       || $self->ut_textn('ship_state')
1840       || $self->ut_country('ship_country')
1841     ;
1842     return $error if $error;
1843
1844     #false laziness with above
1845     unless ( qsearchs('cust_main_county', {
1846       'country' => $self->ship_country,
1847       'state'   => '',
1848      } ) ) {
1849       return "Unknown ship_state/ship_county/ship_country: ".
1850         $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1851         unless qsearch('cust_main_county',{
1852           'state'   => $self->ship_state,
1853           'county'  => $self->ship_county,
1854           'country' => $self->ship_country,
1855         } );
1856     }
1857     #eofalse
1858
1859     $error =
1860       $self->ut_phonen('ship_daytime', $self->ship_country)
1861       || $self->ut_phonen('ship_night', $self->ship_country)
1862       || $self->ut_phonen('ship_fax', $self->ship_country)
1863       || $self->ut_zip('ship_zip', $self->ship_country)
1864     ;
1865     return $error if $error;
1866
1867     return "Unit # is required."
1868       if $self->ship_address2 =~ /^\s*$/
1869       && $conf->exists('cust_main-require_address2');
1870
1871   } else { # ship_ info eq billing info, so don't store dup info in database
1872
1873     $self->setfield("ship_$_", '')
1874       foreach $self->addr_fields;
1875
1876     return "Unit # is required."
1877       if $self->address2 =~ /^\s*$/
1878       && $conf->exists('cust_main-require_address2');
1879
1880   }
1881
1882   #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1883   #  or return "Illegal payby: ". $self->payby;
1884   #$self->payby($1);
1885   FS::payby->can_payby($self->table, $self->payby)
1886     or return "Illegal payby: ". $self->payby;
1887
1888   $error =    $self->ut_numbern('paystart_month')
1889            || $self->ut_numbern('paystart_year')
1890            || $self->ut_numbern('payissue')
1891            || $self->ut_textn('paytype')
1892   ;
1893   return $error if $error;
1894
1895   if ( $self->payip eq '' ) {
1896     $self->payip('');
1897   } else {
1898     $error = $self->ut_ip('payip');
1899     return $error if $error;
1900   }
1901
1902   # If it is encrypted and the private key is not availaible then we can't
1903   # check the credit card.
1904   my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1905
1906   if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1907
1908     my $payinfo = $self->payinfo;
1909     $payinfo =~ s/\D//g;
1910     $payinfo =~ /^(\d{13,16})$/
1911       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1912     $payinfo = $1;
1913     $self->payinfo($payinfo);
1914     validate($payinfo)
1915       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1916
1917     return gettext('unknown_card_type')
1918       if $self->payinfo !~ /^99\d{14}$/ #token
1919       && cardtype($self->payinfo) eq "Unknown";
1920
1921     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1922     if ( $ban ) {
1923       return 'Banned credit card: banned on '.
1924              time2str('%a %h %o at %r', $ban->_date).
1925              ' by '. $ban->otaker.
1926              ' (ban# '. $ban->bannum. ')';
1927     }
1928
1929     if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1930       if ( cardtype($self->payinfo) eq 'American Express card' ) {
1931         $self->paycvv =~ /^(\d{4})$/
1932           or return "CVV2 (CID) for American Express cards is four digits.";
1933         $self->paycvv($1);
1934       } else {
1935         $self->paycvv =~ /^(\d{3})$/
1936           or return "CVV2 (CVC2/CID) is three digits.";
1937         $self->paycvv($1);
1938       }
1939     } else {
1940       $self->paycvv('');
1941     }
1942
1943     my $cardtype = cardtype($payinfo);
1944     if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1945
1946       return "Start date or issue number is required for $cardtype cards"
1947         unless $self->paystart_month && $self->paystart_year or $self->payissue;
1948
1949       return "Start month must be between 1 and 12"
1950         if $self->paystart_month
1951            and $self->paystart_month < 1 || $self->paystart_month > 12;
1952
1953       return "Start year must be 1990 or later"
1954         if $self->paystart_year
1955            and $self->paystart_year < 1990;
1956
1957       return "Issue number must be beween 1 and 99"
1958         if $self->payissue
1959           and $self->payissue < 1 || $self->payissue > 99;
1960
1961     } else {
1962       $self->paystart_month('');
1963       $self->paystart_year('');
1964       $self->payissue('');
1965     }
1966
1967   } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1968
1969     my $payinfo = $self->payinfo;
1970     $payinfo =~ s/[^\d\@]//g;
1971     if ( $conf->exists('echeck-nonus') ) {
1972       $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1973       $payinfo = "$1\@$2";
1974     } else {
1975       $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1976       $payinfo = "$1\@$2";
1977     }
1978     $self->payinfo($payinfo);
1979     $self->paycvv('');
1980
1981     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1982     if ( $ban ) {
1983       return 'Banned ACH account: banned on '.
1984              time2str('%a %h %o at %r', $ban->_date).
1985              ' by '. $ban->otaker.
1986              ' (ban# '. $ban->bannum. ')';
1987     }
1988
1989   } elsif ( $self->payby eq 'LECB' ) {
1990
1991     my $payinfo = $self->payinfo;
1992     $payinfo =~ s/\D//g;
1993     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1994     $payinfo = $1;
1995     $self->payinfo($payinfo);
1996     $self->paycvv('');
1997
1998   } elsif ( $self->payby eq 'BILL' ) {
1999
2000     $error = $self->ut_textn('payinfo');
2001     return "Illegal P.O. number: ". $self->payinfo if $error;
2002     $self->paycvv('');
2003
2004   } elsif ( $self->payby eq 'COMP' ) {
2005
2006     my $curuser = $FS::CurrentUser::CurrentUser;
2007     if (    ! $self->custnum
2008          && ! $curuser->access_right('Complimentary customer')
2009        )
2010     {
2011       return "You are not permitted to create complimentary accounts."
2012     }
2013
2014     $error = $self->ut_textn('payinfo');
2015     return "Illegal comp account issuer: ". $self->payinfo if $error;
2016     $self->paycvv('');
2017
2018   } elsif ( $self->payby eq 'PREPAY' ) {
2019
2020     my $payinfo = $self->payinfo;
2021     $payinfo =~ s/\W//g; #anything else would just confuse things
2022     $self->payinfo($payinfo);
2023     $error = $self->ut_alpha('payinfo');
2024     return "Illegal prepayment identifier: ". $self->payinfo if $error;
2025     return "Unknown prepayment identifier"
2026       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
2027     $self->paycvv('');
2028
2029   }
2030
2031   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
2032     return "Expiration date required"
2033       unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
2034     $self->paydate('');
2035   } else {
2036     my( $m, $y );
2037     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
2038       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
2039     } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2040       ( $m, $y ) = ( $2, "19$1" );
2041     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2042       ( $m, $y ) = ( $3, "20$2" );
2043     } else {
2044       return "Illegal expiration date: ". $self->paydate;
2045     }
2046     $self->paydate("$y-$m-01");
2047     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
2048     return gettext('expired_card')
2049       if !$import
2050       && !$ignore_expired_card
2051       && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
2052   }
2053
2054   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
2055        ( ! $conf->exists('require_cardname')
2056          || $self->payby !~ /^(CARD|DCRD)$/  )
2057   ) {
2058     $self->payname( $self->first. " ". $self->getfield('last') );
2059   } else {
2060     $self->payname =~ /^([\w \,\.\-\'\&]+)$/
2061       or return gettext('illegal_name'). " payname: ". $self->payname;
2062     $self->payname($1);
2063   }
2064
2065   foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
2066     $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
2067     $self->$flag($1);
2068   }
2069
2070   $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
2071
2072   warn "$me check AFTER: \n". $self->_dump
2073     if $DEBUG > 2;
2074
2075   $self->SUPER::check;
2076 }
2077
2078 =item addr_fields
2079
2080 Returns a list of fields which have ship_ duplicates.
2081
2082 =cut
2083
2084 sub addr_fields {
2085   qw( last first company
2086       address1 address2 city county state zip country
2087       daytime night fax
2088     );
2089 }
2090
2091 =item has_ship_address
2092
2093 Returns true if this customer record has a separate shipping address.
2094
2095 =cut
2096
2097 sub has_ship_address {
2098   my $self = shift;
2099   scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
2100 }
2101
2102 =item location_hash
2103
2104 Returns a list of key/value pairs, with the following keys: address1, adddress2,
2105 city, county, state, zip, country.  The shipping address is used if present.
2106
2107 =cut
2108
2109 #geocode?  dependent on tax-ship_address config, not available in cust_location
2110 #mostly.  not yet then.
2111
2112 sub location_hash {
2113   my $self = shift;
2114   my $prefix = $self->has_ship_address ? 'ship_' : '';
2115
2116   map { $_ => $self->get($prefix.$_) }
2117       qw( address1 address2 city county state zip country geocode );
2118       #fields that cust_location has
2119 }
2120
2121 =item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
2122
2123 Returns all packages (see L<FS::cust_pkg>) for this customer.
2124
2125 =cut
2126
2127 sub all_pkgs {
2128   my $self = shift;
2129   my $extra_qsearch = ref($_[0]) ? shift : {};
2130
2131   return $self->num_pkgs unless wantarray || keys(%$extra_qsearch);
2132
2133   my @cust_pkg = ();
2134   if ( $self->{'_pkgnum'} ) {
2135     @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
2136   } else {
2137     @cust_pkg = $self->_cust_pkg($extra_qsearch);
2138   }
2139
2140   sort sort_packages @cust_pkg;
2141 }
2142
2143 =item cust_pkg
2144
2145 Synonym for B<all_pkgs>.
2146
2147 =cut
2148
2149 sub cust_pkg {
2150   shift->all_pkgs(@_);
2151 }
2152
2153 =item cust_location
2154
2155 Returns all locations (see L<FS::cust_location>) for this customer.
2156
2157 =cut
2158
2159 sub cust_location {
2160   my $self = shift;
2161   qsearch('cust_location', { 'custnum' => $self->custnum } );
2162 }
2163
2164 =item location_label [ OPTION => VALUE ... ]
2165
2166 Returns the label of the service location (see analog in L<FS::cust_location>) for this customer.
2167
2168 Options are
2169
2170 =over 4
2171
2172 =item join_string
2173
2174 used to separate the address elements (defaults to ', ')
2175
2176 =item escape_function
2177
2178 a callback used for escaping the text of the address elements
2179
2180 =back
2181
2182 =cut
2183
2184 # false laziness with FS::cust_location::line
2185
2186 sub location_label {
2187   my $self = shift;
2188   my %opt = @_;
2189
2190   my $separator = $opt{join_string} || ', ';
2191   my $escape = $opt{escape_function} || sub{ shift };
2192   my $line = '';
2193   my $cydefault = FS::conf->new->config('countrydefault') || 'US';
2194   my $prefix = length($self->ship_last) ? 'ship_' : '';
2195
2196   my $notfirst = 0;
2197   foreach (qw ( address1 address2 ) ) {
2198     my $method = "$prefix$_";
2199     $line .= ($notfirst ? $separator : ''). &$escape($self->$method)
2200       if $self->$method;
2201     $notfirst++;
2202   }
2203   $notfirst = 0;
2204   foreach (qw ( city county state zip ) ) {
2205     my $method = "$prefix$_";
2206     if ( $self->$method ) {
2207       $line .= ' (' if $method eq 'county';
2208       $line .= ($notfirst ? ' ' : $separator). &$escape($self->$method);
2209       $line .= ' )' if $method eq 'county';
2210       $notfirst++;
2211     }
2212   }
2213   $line .= $separator. &$escape(code2country($self->country))
2214     if $self->country ne $cydefault;
2215
2216   $line;
2217 }
2218
2219 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
2220
2221 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
2222
2223 =cut
2224
2225 sub ncancelled_pkgs {
2226   my $self = shift;
2227   my $extra_qsearch = ref($_[0]) ? shift : {};
2228
2229   return $self->num_ncancelled_pkgs unless wantarray;
2230
2231   my @cust_pkg = ();
2232   if ( $self->{'_pkgnum'} ) {
2233
2234     warn "$me ncancelled_pkgs: returning cached objects"
2235       if $DEBUG > 1;
2236
2237     @cust_pkg = grep { ! $_->getfield('cancel') }
2238                 values %{ $self->{'_pkgnum'}->cache };
2239
2240   } else {
2241
2242     warn "$me ncancelled_pkgs: searching for packages with custnum ".
2243          $self->custnum. "\n"
2244       if $DEBUG > 1;
2245
2246     $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
2247
2248     @cust_pkg = $self->_cust_pkg($extra_qsearch);
2249
2250   }
2251
2252   sort sort_packages @cust_pkg;
2253
2254 }
2255
2256 sub _cust_pkg {
2257   my $self = shift;
2258   my $extra_qsearch = ref($_[0]) ? shift : {};
2259
2260   $extra_qsearch->{'select'} ||= '*';
2261   $extra_qsearch->{'select'} .=
2262    ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
2263      AS _num_cust_svc';
2264
2265   map {
2266         $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
2267         $_;
2268       }
2269   qsearch({
2270     %$extra_qsearch,
2271     'table'   => 'cust_pkg',
2272     'hashref' => { 'custnum' => $self->custnum },
2273   });
2274
2275 }
2276
2277 # This should be generalized to use config options to determine order.
2278 sub sort_packages {
2279
2280   my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
2281   return $locationsort if $locationsort;
2282
2283   if ( $a->get('cancel') xor $b->get('cancel') ) {
2284     return -1 if $b->get('cancel');
2285     return  1 if $a->get('cancel');
2286     #shouldn't get here...
2287     return 0;
2288   } else {
2289     my $a_num_cust_svc = $a->num_cust_svc;
2290     my $b_num_cust_svc = $b->num_cust_svc;
2291     return 0  if !$a_num_cust_svc && !$b_num_cust_svc;
2292     return -1 if  $a_num_cust_svc && !$b_num_cust_svc;
2293     return 1  if !$a_num_cust_svc &&  $b_num_cust_svc;
2294     my @a_cust_svc = $a->cust_svc;
2295     my @b_cust_svc = $b->cust_svc;
2296     return 0  if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
2297     return -1 if  scalar(@a_cust_svc) && !scalar(@b_cust_svc);
2298     return 1  if !scalar(@a_cust_svc) &&  scalar(@b_cust_svc);
2299     $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
2300   }
2301
2302 }
2303
2304 =item suspended_pkgs
2305
2306 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
2307
2308 =cut
2309
2310 sub suspended_pkgs {
2311   my $self = shift;
2312   grep { $_->susp } $self->ncancelled_pkgs;
2313 }
2314
2315 =item unflagged_suspended_pkgs
2316
2317 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
2318 customer (thouse packages without the `manual_flag' set).
2319
2320 =cut
2321
2322 sub unflagged_suspended_pkgs {
2323   my $self = shift;
2324   return $self->suspended_pkgs
2325     unless dbdef->table('cust_pkg')->column('manual_flag');
2326   grep { ! $_->manual_flag } $self->suspended_pkgs;
2327 }
2328
2329 =item unsuspended_pkgs
2330
2331 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
2332 this customer.
2333
2334 =cut
2335
2336 sub unsuspended_pkgs {
2337   my $self = shift;
2338   grep { ! $_->susp } $self->ncancelled_pkgs;
2339 }
2340
2341 =item next_bill_date
2342
2343 Returns the next date this customer will be billed, as a UNIX timestamp, or
2344 undef if no active package has a next bill date.
2345
2346 =cut
2347
2348 sub next_bill_date {
2349   my $self = shift;
2350   min( map $_->get('bill'), grep $_->get('bill'), $self->unsuspended_pkgs );
2351 }
2352
2353 =item num_cancelled_pkgs
2354
2355 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
2356 customer.
2357
2358 =cut
2359
2360 sub num_cancelled_pkgs {
2361   shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
2362 }
2363
2364 sub num_ncancelled_pkgs {
2365   shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
2366 }
2367
2368 sub num_pkgs {
2369   my( $self ) = shift;
2370   my $sql = scalar(@_) ? shift : '';
2371   $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
2372   my $sth = dbh->prepare(
2373     "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
2374   ) or die dbh->errstr;
2375   $sth->execute($self->custnum) or die $sth->errstr;
2376   $sth->fetchrow_arrayref->[0];
2377 }
2378
2379 =item unsuspend
2380
2381 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2382 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
2383 on success or a list of errors.
2384
2385 =cut
2386
2387 sub unsuspend {
2388   my $self = shift;
2389   grep { $_->unsuspend } $self->suspended_pkgs;
2390 }
2391
2392 =item suspend
2393
2394 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2395
2396 Returns a list: an empty list on success or a list of errors.
2397
2398 =cut
2399
2400 sub suspend {
2401   my $self = shift;
2402   grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2403 }
2404
2405 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2406
2407 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2408 PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref instead
2409 of a list of pkgparts; the hashref has the following keys:
2410
2411 =over 4
2412
2413 =item pkgparts - listref of pkgparts
2414
2415 =item (other options are passed to the suspend method)
2416
2417 =back
2418
2419
2420 Returns a list: an empty list on success or a list of errors.
2421
2422 =cut
2423
2424 sub suspend_if_pkgpart {
2425   my $self = shift;
2426   my (@pkgparts, %opt);
2427   if (ref($_[0]) eq 'HASH'){
2428     @pkgparts = @{$_[0]{pkgparts}};
2429     %opt      = %{$_[0]};
2430   }else{
2431     @pkgparts = @_;
2432   }
2433   grep { $_->suspend(%opt) }
2434     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2435       $self->unsuspended_pkgs;
2436 }
2437
2438 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2439
2440 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2441 given PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref
2442 instead of a list of pkgparts; the hashref has the following keys:
2443
2444 =over 4
2445
2446 =item pkgparts - listref of pkgparts
2447
2448 =item (other options are passed to the suspend method)
2449
2450 =back
2451
2452 Returns a list: an empty list on success or a list of errors.
2453
2454 =cut
2455
2456 sub suspend_unless_pkgpart {
2457   my $self = shift;
2458   my (@pkgparts, %opt);
2459   if (ref($_[0]) eq 'HASH'){
2460     @pkgparts = @{$_[0]{pkgparts}};
2461     %opt      = %{$_[0]};
2462   }else{
2463     @pkgparts = @_;
2464   }
2465   grep { $_->suspend(%opt) }
2466     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2467       $self->unsuspended_pkgs;
2468 }
2469
2470 =item cancel [ OPTION => VALUE ... ]
2471
2472 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2473
2474 Available options are:
2475
2476 =over 4
2477
2478 =item quiet - can be set true to supress email cancellation notices.
2479
2480 =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.
2481
2482 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2483
2484 =item nobill - can be set true to skip billing if it might otherwise be done.
2485
2486 =back
2487
2488 Always returns a list: an empty list on success or a list of errors.
2489
2490 =cut
2491
2492 # nb that dates are not specified as valid options to this method
2493
2494 sub cancel {
2495   my( $self, %opt ) = @_;
2496
2497   warn "$me cancel called on customer ". $self->custnum. " with options ".
2498        join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2499     if $DEBUG;
2500
2501   return ( 'access denied' )
2502     unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2503
2504   if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2505
2506     #should try decryption (we might have the private key)
2507     # and if not maybe queue a job for the server that does?
2508     return ( "Can't (yet) ban encrypted credit cards" )
2509       if $self->is_encrypted($self->payinfo);
2510
2511     my $ban = new FS::banned_pay $self->_banned_pay_hashref;
2512     my $error = $ban->insert;
2513     return ( $error ) if $error;
2514
2515   }
2516
2517   my @pkgs = $self->ncancelled_pkgs;
2518
2519   if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2520     $opt{nobill} = 1;
2521     my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2522     warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2523       if $error;
2524   }
2525
2526   warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2527        scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2528     if $DEBUG;
2529
2530   grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2531 }
2532
2533 sub _banned_pay_hashref {
2534   my $self = shift;
2535
2536   my %payby2ban = (
2537     'CARD' => 'CARD',
2538     'DCRD' => 'CARD',
2539     'CHEK' => 'CHEK',
2540     'DCHK' => 'CHEK'
2541   );
2542
2543   {
2544     'payby'   => $payby2ban{$self->payby},
2545     'payinfo' => md5_base64($self->payinfo),
2546     #don't ever *search* on reason! #'reason'  =>
2547   };
2548 }
2549
2550 =item notes
2551
2552 Returns all notes (see L<FS::cust_main_note>) for this customer.
2553
2554 =cut
2555
2556 sub notes {
2557   my $self = shift;
2558   #order by?
2559   qsearch( 'cust_main_note',
2560            { 'custnum' => $self->custnum },
2561            '',
2562            'ORDER BY _DATE DESC'
2563          );
2564 }
2565
2566 =item agent
2567
2568 Returns the agent (see L<FS::agent>) for this customer.
2569
2570 =cut
2571
2572 sub agent {
2573   my $self = shift;
2574   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2575 }
2576
2577 =item agent_name
2578
2579 Returns the agent name (see L<FS::agent>) for this customer.
2580
2581 =cut
2582
2583 sub agent_name {
2584   my $self = shift;
2585   $self->agent->agent;
2586 }
2587
2588 =item cust_tag
2589
2590 Returns any tags associated with this customer, as FS::cust_tag objects,
2591 or an empty list if there are no tags.
2592
2593 =cut
2594
2595 sub cust_tag {
2596   my $self = shift;
2597   qsearch('cust_tag', { 'custnum' => $self->custnum } );
2598 }
2599
2600 =item part_tag
2601
2602 Returns any tags associated with this customer, as FS::part_tag objects,
2603 or an empty list if there are no tags.
2604
2605 =cut
2606
2607 sub part_tag {
2608   my $self = shift;
2609   map $_->part_tag, $self->cust_tag;
2610 }
2611
2612
2613 =item cust_class
2614
2615 Returns the customer class, as an FS::cust_class object, or the empty string
2616 if there is no customer class.
2617
2618 =cut
2619
2620 sub cust_class {
2621   my $self = shift;
2622   if ( $self->classnum ) {
2623     qsearchs('cust_class', { 'classnum' => $self->classnum } );
2624   } else {
2625     return '';
2626   }
2627 }
2628
2629 =item categoryname
2630
2631 Returns the customer category name, or the empty string if there is no customer
2632 category.
2633
2634 =cut
2635
2636 sub categoryname {
2637   my $self = shift;
2638   my $cust_class = $self->cust_class;
2639   $cust_class
2640     ? $cust_class->categoryname
2641     : '';
2642 }
2643
2644 =item classname
2645
2646 Returns the customer class name, or the empty string if there is no customer
2647 class.
2648
2649 =cut
2650
2651 sub classname {
2652   my $self = shift;
2653   my $cust_class = $self->cust_class;
2654   $cust_class
2655     ? $cust_class->classname
2656     : '';
2657 }
2658
2659 =item BILLING METHODS
2660
2661 Documentation on billing methods has been moved to
2662 L<FS::cust_main::Billing>.
2663
2664 =item do_cust_event [ HASHREF | OPTION => VALUE ... ]
2665
2666 Runs billing events; see L<FS::part_event> and the billing events web
2667 interface.
2668
2669 If there is an error, returns the error, otherwise returns false.
2670
2671 Options are passed as name-value pairs.
2672
2673 Currently available options are:
2674
2675 =over 4
2676
2677 =item time
2678
2679 Use this time when deciding when to print invoices and late notices on those invoices.  The default is now.  It is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion functions.
2680
2681 =item check_freq
2682
2683 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2684
2685 =item stage
2686
2687 "collect" (the default) or "pre-bill"
2688
2689 =item quiet
2690
2691 set true to surpress email card/ACH decline notices.
2692
2693 =item debug
2694
2695 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
2696
2697 =cut
2698
2699 # =item payby
2700 #
2701 # allows for one time override of normal customer billing method
2702
2703 # =item retry
2704 #
2705 # Retry card/echeck/LEC transactions even when not scheduled by invoice events.
2706
2707 sub do_cust_event {
2708   my( $self, %options ) = @_;
2709   my $time = $options{'time'} || time;
2710
2711   #put below somehow?
2712   local $SIG{HUP} = 'IGNORE';
2713   local $SIG{INT} = 'IGNORE';
2714   local $SIG{QUIT} = 'IGNORE';
2715   local $SIG{TERM} = 'IGNORE';
2716   local $SIG{TSTP} = 'IGNORE';
2717   local $SIG{PIPE} = 'IGNORE';
2718
2719   my $oldAutoCommit = $FS::UID::AutoCommit;
2720   local $FS::UID::AutoCommit = 0;
2721   my $dbh = dbh;
2722
2723   $self->select_for_update; #mutex
2724
2725   if ( $DEBUG ) {
2726     my $balance = $self->balance;
2727     warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
2728   }
2729
2730 #  if ( exists($options{'retry_card'}) ) {
2731 #    carp 'retry_card option passed to collect is deprecated; use retry';
2732 #    $options{'retry'} ||= $options{'retry_card'};
2733 #  }
2734 #  if ( exists($options{'retry'}) && $options{'retry'} ) {
2735 #    my $error = $self->retry_realtime;
2736 #    if ( $error ) {
2737 #      $dbh->rollback if $oldAutoCommit;
2738 #      return $error;
2739 #    }
2740 #  }
2741
2742   # false laziness w/pay_batch::import_results
2743
2744   my $due_cust_event = $self->due_cust_event(
2745     'debug'      => ( $options{'debug'} || 0 ),
2746     'time'       => $time,
2747     'check_freq' => $options{'check_freq'},
2748     'stage'      => ( $options{'stage'} || 'collect' ),
2749   );
2750   unless( ref($due_cust_event) ) {
2751     $dbh->rollback if $oldAutoCommit;
2752     return $due_cust_event;
2753   }
2754
2755   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2756   #never want to roll back an event just because it or a different one
2757   # returned an error
2758   local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
2759
2760   foreach my $cust_event ( @$due_cust_event ) {
2761
2762     #XXX lock event
2763
2764     #re-eval event conditions (a previous event could have changed things)
2765     unless ( $cust_event->test_conditions( 'time' => $time ) ) {
2766       #don't leave stray "new/locked" records around
2767       my $error = $cust_event->delete;
2768       return $error if $error;
2769       next;
2770     }
2771
2772     {
2773       local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2774       warn "  running cust_event ". $cust_event->eventnum. "\n"
2775         if $DEBUG > 1;
2776
2777       #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
2778       if ( my $error = $cust_event->do_event() ) {
2779         #XXX wtf is this?  figure out a proper dealio with return value
2780         #from do_event
2781         return $error;
2782       }
2783     }
2784
2785   }
2786
2787   '';
2788
2789 }
2790
2791 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
2792
2793 Inserts database records for and returns an ordered listref of new events due
2794 for this customer, as FS::cust_event objects (see L<FS::cust_event>).  If no
2795 events are due, an empty listref is returned.  If there is an error, returns a
2796 scalar error message.
2797
2798 To actually run the events, call each event's test_condition method, and if
2799 still true, call the event's do_event method.
2800
2801 Options are passed as a hashref or as a list of name-value pairs.  Available
2802 options are:
2803
2804 =over 4
2805
2806 =item check_freq
2807
2808 Search only for events of this check frequency (how often events of this type are checked); currently "1d" (daily, the default) and "1m" (monthly) are recognized.
2809
2810 =item stage
2811
2812 "collect" (the default) or "pre-bill"
2813
2814 =item time
2815
2816 "Current time" for the events.
2817
2818 =item debug
2819
2820 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
2821
2822 =item eventtable
2823
2824 Only return events for the specified eventtable (by default, events of all eventtables are returned)
2825
2826 =item objects
2827
2828 Explicitly pass the objects to be tested (typically used with eventtable).
2829
2830 =item testonly
2831
2832 Set to true to return the objects, but not actually insert them into the
2833 database.
2834
2835 =back
2836
2837 =cut
2838
2839 sub due_cust_event {
2840   my $self = shift;
2841   my %opt = ref($_[0]) ? %{ $_[0] } : @_;
2842
2843   #???
2844   #my $DEBUG = $opt{'debug'}
2845   local($DEBUG) = $opt{'debug'}
2846     if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
2847
2848   warn "$me due_cust_event called with options ".
2849        join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
2850     if $DEBUG;
2851
2852   $opt{'time'} ||= time;
2853
2854   local $SIG{HUP} = 'IGNORE';
2855   local $SIG{INT} = 'IGNORE';
2856   local $SIG{QUIT} = 'IGNORE';
2857   local $SIG{TERM} = 'IGNORE';
2858   local $SIG{TSTP} = 'IGNORE';
2859   local $SIG{PIPE} = 'IGNORE';
2860
2861   my $oldAutoCommit = $FS::UID::AutoCommit;
2862   local $FS::UID::AutoCommit = 0;
2863   my $dbh = dbh;
2864
2865   $self->select_for_update #mutex
2866     unless $opt{testonly};
2867
2868   ###
2869   # find possible events (initial search)
2870   ###
2871
2872   my @cust_event = ();
2873
2874   my @eventtable = $opt{'eventtable'}
2875                      ? ( $opt{'eventtable'} )
2876                      : FS::part_event->eventtables_runorder;
2877
2878   foreach my $eventtable ( @eventtable ) {
2879
2880     my @objects;
2881     if ( $opt{'objects'} ) {
2882
2883       @objects = @{ $opt{'objects'} };
2884
2885     } else {
2886
2887       #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
2888       @objects = ( $eventtable eq 'cust_main' )
2889                    ? ( $self )
2890                    : ( $self->$eventtable() );
2891
2892     }
2893
2894     my @e_cust_event = ();
2895
2896     my $cross = "CROSS JOIN $eventtable";
2897     $cross .= ' LEFT JOIN cust_main USING ( custnum )'
2898       unless $eventtable eq 'cust_main';
2899
2900     foreach my $object ( @objects ) {
2901
2902       #this first search uses the condition_sql magic for optimization.
2903       #the more possible events we can eliminate in this step the better
2904
2905       my $cross_where = '';
2906       my $pkey = $object->primary_key;
2907       $cross_where = "$eventtable.$pkey = ". $object->$pkey();
2908
2909       my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
2910       my $extra_sql =
2911         FS::part_event_condition->where_conditions_sql( $eventtable,
2912                                                         'time'=>$opt{'time'}
2913                                                       );
2914       my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
2915
2916       $extra_sql = "AND $extra_sql" if $extra_sql;
2917
2918       #here is the agent virtualization
2919       $extra_sql .= " AND (    part_event.agentnum IS NULL
2920                             OR part_event.agentnum = ". $self->agentnum. ' )';
2921
2922       $extra_sql .= " $order";
2923
2924       warn "searching for events for $eventtable ". $object->$pkey. "\n"
2925         if $opt{'debug'} > 2;
2926       my @part_event = qsearch( {
2927         'debug'     => ( $opt{'debug'} > 3 ? 1 : 0 ),
2928         'select'    => 'part_event.*',
2929         'table'     => 'part_event',
2930         'addl_from' => "$cross $join",
2931         'hashref'   => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
2932                          'eventtable' => $eventtable,
2933                          'disabled'   => '',
2934                        },
2935         'extra_sql' => "AND $cross_where $extra_sql",
2936       } );
2937
2938       if ( $DEBUG > 2 ) {
2939         my $pkey = $object->primary_key;
2940         warn "      ". scalar(@part_event).
2941              " possible events found for $eventtable ". $object->$pkey(). "\n";
2942       }
2943
2944       push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
2945
2946     }
2947
2948     warn "    ". scalar(@e_cust_event).
2949          " subtotal possible cust events found for $eventtable\n"
2950       if $DEBUG > 1;
2951
2952     push @cust_event, @e_cust_event;
2953
2954   }
2955
2956   warn "  ". scalar(@cust_event).
2957        " total possible cust events found in initial search\n"
2958     if $DEBUG; # > 1;
2959
2960
2961   ##
2962   # test stage
2963   ##
2964
2965   $opt{stage} ||= 'collect';
2966   @cust_event =
2967     grep { my $stage = $_->part_event->event_stage;
2968            $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
2969          }
2970          @cust_event;
2971
2972   ##
2973   # test conditions
2974   ##
2975
2976   my %unsat = ();
2977
2978   @cust_event = grep $_->test_conditions( 'time'          => $opt{'time'},
2979                                           'stats_hashref' => \%unsat ),
2980                      @cust_event;
2981
2982   warn "  ". scalar(@cust_event). " cust events left satisfying conditions\n"
2983     if $DEBUG; # > 1;
2984
2985   warn "    invalid conditions not eliminated with condition_sql:\n".
2986        join('', map "      $_: ".$unsat{$_}."\n", keys %unsat )
2987     if keys %unsat && $DEBUG; # > 1;
2988
2989   ##
2990   # insert
2991   ##
2992
2993   unless( $opt{testonly} ) {
2994     foreach my $cust_event ( @cust_event ) {
2995
2996       my $error = $cust_event->insert();
2997       if ( $error ) {
2998         $dbh->rollback if $oldAutoCommit;
2999         return $error;
3000       }
3001
3002     }
3003   }
3004
3005   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3006
3007   ##
3008   # return
3009   ##
3010
3011   warn "  returning events: ". Dumper(@cust_event). "\n"
3012     if $DEBUG > 2;
3013
3014   \@cust_event;
3015
3016 }
3017
3018 =item retry_realtime
3019
3020 Schedules realtime / batch  credit card / electronic check / LEC billing
3021 events for for retry.  Useful if card information has changed or manual
3022 retry is desired.  The 'collect' method must be called to actually retry
3023 the transaction.
3024
3025 Implementation details: For either this customer, or for each of this
3026 customer's open invoices, changes the status of the first "done" (with
3027 statustext error) realtime processing event to "failed".
3028
3029 =cut
3030
3031 sub retry_realtime {
3032   my $self = shift;
3033
3034   local $SIG{HUP} = 'IGNORE';
3035   local $SIG{INT} = 'IGNORE';
3036   local $SIG{QUIT} = 'IGNORE';
3037   local $SIG{TERM} = 'IGNORE';
3038   local $SIG{TSTP} = 'IGNORE';
3039   local $SIG{PIPE} = 'IGNORE';
3040
3041   my $oldAutoCommit = $FS::UID::AutoCommit;
3042   local $FS::UID::AutoCommit = 0;
3043   my $dbh = dbh;
3044
3045   #a little false laziness w/due_cust_event (not too bad, really)
3046
3047   my $join = FS::part_event_condition->join_conditions_sql;
3048   my $order = FS::part_event_condition->order_conditions_sql;
3049   my $mine =
3050   '( '
3051    . join ( ' OR ' , map {
3052     "( part_event.eventtable = " . dbh->quote($_)
3053     . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
3054    } FS::part_event->eventtables)
3055    . ') ';
3056
3057   #here is the agent virtualization
3058   my $agent_virt = " (    part_event.agentnum IS NULL
3059                        OR part_event.agentnum = ". $self->agentnum. ' )';
3060
3061   #XXX this shouldn't be hardcoded, actions should declare it...
3062   my @realtime_events = qw(
3063     cust_bill_realtime_card
3064     cust_bill_realtime_check
3065     cust_bill_realtime_lec
3066     cust_bill_batch
3067   );
3068
3069   my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
3070                                                   @realtime_events
3071                                      ).
3072                           ' ) ';
3073
3074   my @cust_event = qsearchs({
3075     'table'     => 'cust_event',
3076     'select'    => 'cust_event.*',
3077     'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
3078     'hashref'   => { 'status' => 'done' },
3079     'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
3080                    " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
3081   });
3082
3083   my %seen_invnum = ();
3084   foreach my $cust_event (@cust_event) {
3085
3086     #max one for the customer, one for each open invoice
3087     my $cust_X = $cust_event->cust_X;
3088     next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
3089                           ? $cust_X->invnum
3090                           : 0
3091                         }++
3092          or $cust_event->part_event->eventtable eq 'cust_bill'
3093             && ! $cust_X->owed;
3094
3095     my $error = $cust_event->retry;
3096     if ( $error ) {
3097       $dbh->rollback if $oldAutoCommit;
3098       return "error scheduling event for retry: $error";
3099     }
3100
3101   }
3102
3103   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3104   '';
3105
3106 }
3107
3108
3109 =cut
3110
3111 =item REALTIME BILLING METHODS
3112
3113 Documentation on realtime billing methods has been moved to
3114 L<FS::cust_main::Billing_Realtime>.
3115
3116 =item remove_cvv
3117
3118 Removes the I<paycvv> field from the database directly.
3119
3120 If there is an error, returns the error, otherwise returns false.
3121
3122 =cut
3123
3124 sub remove_cvv {
3125   my $self = shift;
3126   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
3127     or return dbh->errstr;
3128   $sth->execute($self->custnum)
3129     or return $sth->errstr;
3130   $self->paycvv('');
3131   '';
3132 }
3133
3134 =item batch_card OPTION => VALUE...
3135
3136 Adds a payment for this invoice to the pending credit card batch (see
3137 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
3138 runs the payment using a realtime gateway.
3139
3140 =cut
3141
3142 sub batch_card {
3143   my ($self, %options) = @_;
3144
3145   my $amount;
3146   if (exists($options{amount})) {
3147     $amount = $options{amount};
3148   }else{
3149     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
3150   }
3151   return '' unless $amount > 0;
3152
3153   my $invnum = delete $options{invnum};
3154   my $payby = $options{invnum} || $self->payby;  #dubious
3155
3156   if ($options{'realtime'}) {
3157     return $self->realtime_bop( FS::payby->payby2bop($self->payby),
3158                                 $amount,
3159                                 %options,
3160                               );
3161   }
3162
3163   my $oldAutoCommit = $FS::UID::AutoCommit;
3164   local $FS::UID::AutoCommit = 0;
3165   my $dbh = dbh;
3166
3167   #this needs to handle mysql as well as Pg, like svc_acct.pm
3168   #(make it into a common function if folks need to do batching with mysql)
3169   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
3170     or return "Cannot lock pay_batch: " . $dbh->errstr;
3171
3172   my %pay_batch = (
3173     'status' => 'O',
3174     'payby'  => FS::payby->payby2payment($payby),
3175   );
3176
3177   my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
3178
3179   unless ( $pay_batch ) {
3180     $pay_batch = new FS::pay_batch \%pay_batch;
3181     my $error = $pay_batch->insert;
3182     if ( $error ) {
3183       $dbh->rollback if $oldAutoCommit;
3184       die "error creating new batch: $error\n";
3185     }
3186   }
3187
3188   my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
3189       'batchnum' => $pay_batch->batchnum,
3190       'custnum'  => $self->custnum,
3191   } );
3192
3193   foreach (qw( address1 address2 city state zip country payby payinfo paydate
3194                payname )) {
3195     $options{$_} = '' unless exists($options{$_});
3196   }
3197
3198   my $cust_pay_batch = new FS::cust_pay_batch ( {
3199     'batchnum' => $pay_batch->batchnum,
3200     'invnum'   => $invnum || 0,                    # is there a better value?
3201                                                    # this field should be
3202                                                    # removed...
3203                                                    # cust_bill_pay_batch now
3204     'custnum'  => $self->custnum,
3205     'last'     => $self->getfield('last'),
3206     'first'    => $self->getfield('first'),
3207     'address1' => $options{address1} || $self->address1,
3208     'address2' => $options{address2} || $self->address2,
3209     'city'     => $options{city}     || $self->city,
3210     'state'    => $options{state}    || $self->state,
3211     'zip'      => $options{zip}      || $self->zip,
3212     'country'  => $options{country}  || $self->country,
3213     'payby'    => $options{payby}    || $self->payby,
3214     'payinfo'  => $options{payinfo}  || $self->payinfo,
3215     'exp'      => $options{paydate}  || $self->paydate,
3216     'payname'  => $options{payname}  || $self->payname,
3217     'amount'   => $amount,                         # consolidating
3218   } );
3219
3220   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
3221     if $old_cust_pay_batch;
3222
3223   my $error;
3224   if ($old_cust_pay_batch) {
3225     $error = $cust_pay_batch->replace($old_cust_pay_batch)
3226   } else {
3227     $error = $cust_pay_batch->insert;
3228   }
3229
3230   if ( $error ) {
3231     $dbh->rollback if $oldAutoCommit;
3232     die $error;
3233   }
3234
3235   my $unapplied =   $self->total_unapplied_credits
3236                   + $self->total_unapplied_payments
3237                   + $self->in_transit_payments;
3238   foreach my $cust_bill ($self->open_cust_bill) {
3239     #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
3240     my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
3241       'invnum' => $cust_bill->invnum,
3242       'paybatchnum' => $cust_pay_batch->paybatchnum,
3243       'amount' => $cust_bill->owed,
3244       '_date' => time,
3245     };
3246     if ($unapplied >= $cust_bill_pay_batch->amount){
3247       $unapplied -= $cust_bill_pay_batch->amount;
3248       next;
3249     }else{
3250       $cust_bill_pay_batch->amount(sprintf ( "%.2f",
3251                                    $cust_bill_pay_batch->amount - $unapplied ));      $unapplied = 0;
3252     }
3253     $error = $cust_bill_pay_batch->insert;
3254     if ( $error ) {
3255       $dbh->rollback if $oldAutoCommit;
3256       die $error;
3257     }
3258   }
3259
3260   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3261   '';
3262 }
3263
3264 =item total_owed
3265
3266 Returns the total owed for this customer on all invoices
3267 (see L<FS::cust_bill/owed>).
3268
3269 =cut
3270
3271 sub total_owed {
3272   my $self = shift;
3273   $self->total_owed_date(2145859200); #12/31/2037
3274 }
3275
3276 =item total_owed_date TIME
3277
3278 Returns the total owed for this customer on all invoices with date earlier than
3279 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
3280 see L<Time::Local> and L<Date::Parse> for conversion functions.
3281
3282 =cut
3283
3284 sub total_owed_date {
3285   my $self = shift;
3286   my $time = shift;
3287
3288   my $custnum = $self->custnum;
3289
3290   my $owed_sql = FS::cust_bill->owed_sql;
3291
3292   my $sql = "
3293     SELECT SUM($owed_sql) FROM cust_bill
3294       WHERE custnum = $custnum
3295         AND _date <= $time
3296   ";
3297
3298   sprintf( "%.2f", $self->scalar_sql($sql) );
3299
3300 }
3301
3302 =item total_owed_pkgnum PKGNUM
3303
3304 Returns the total owed on all invoices for this customer's specific package
3305 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
3306
3307 =cut
3308
3309 sub total_owed_pkgnum {
3310   my( $self, $pkgnum ) = @_;
3311   $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
3312 }
3313
3314 =item total_owed_date_pkgnum TIME PKGNUM
3315
3316 Returns the total owed for this customer's specific package when using
3317 experimental package balances on all invoices with date earlier than
3318 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
3319 see L<Time::Local> and L<Date::Parse> for conversion functions.
3320
3321 =cut
3322
3323 sub total_owed_date_pkgnum {
3324   my( $self, $time, $pkgnum ) = @_;
3325
3326   my $total_bill = 0;
3327   foreach my $cust_bill (
3328     grep { $_->_date <= $time }
3329       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3330   ) {
3331     $total_bill += $cust_bill->owed_pkgnum($pkgnum);
3332   }
3333   sprintf( "%.2f", $total_bill );
3334
3335 }
3336
3337 =item total_paid
3338
3339 Returns the total amount of all payments.
3340
3341 =cut
3342
3343 sub total_paid {
3344   my $self = shift;
3345   my $total = 0;
3346   $total += $_->paid foreach $self->cust_pay;
3347   sprintf( "%.2f", $total );
3348 }
3349
3350 =item total_unapplied_credits
3351
3352 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3353 customer.  See L<FS::cust_credit/credited>.
3354
3355 =item total_credited
3356
3357 Old name for total_unapplied_credits.  Don't use.
3358
3359 =cut
3360
3361 sub total_credited {
3362   #carp "total_credited deprecated, use total_unapplied_credits";
3363   shift->total_unapplied_credits(@_);
3364 }
3365
3366 sub total_unapplied_credits {
3367   my $self = shift;
3368
3369   my $custnum = $self->custnum;
3370
3371   my $unapplied_sql = FS::cust_credit->unapplied_sql;
3372
3373   my $sql = "
3374     SELECT SUM($unapplied_sql) FROM cust_credit
3375       WHERE custnum = $custnum
3376   ";
3377
3378   sprintf( "%.2f", $self->scalar_sql($sql) );
3379
3380 }
3381
3382 =item total_unapplied_credits_pkgnum PKGNUM
3383
3384 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3385 customer.  See L<FS::cust_credit/credited>.
3386
3387 =cut
3388
3389 sub total_unapplied_credits_pkgnum {
3390   my( $self, $pkgnum ) = @_;
3391   my $total_credit = 0;
3392   $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
3393   sprintf( "%.2f", $total_credit );
3394 }
3395
3396
3397 =item total_unapplied_payments
3398
3399 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
3400 See L<FS::cust_pay/unapplied>.
3401
3402 =cut
3403
3404 sub total_unapplied_payments {
3405   my $self = shift;
3406
3407   my $custnum = $self->custnum;
3408
3409   my $unapplied_sql = FS::cust_pay->unapplied_sql;
3410
3411   my $sql = "
3412     SELECT SUM($unapplied_sql) FROM cust_pay
3413       WHERE custnum = $custnum
3414   ";
3415
3416   sprintf( "%.2f", $self->scalar_sql($sql) );
3417
3418 }
3419
3420 =item total_unapplied_payments_pkgnum PKGNUM
3421
3422 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
3423 specific package when using experimental package balances.  See
3424 L<FS::cust_pay/unapplied>.
3425
3426 =cut
3427
3428 sub total_unapplied_payments_pkgnum {
3429   my( $self, $pkgnum ) = @_;
3430   my $total_unapplied = 0;
3431   $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
3432   sprintf( "%.2f", $total_unapplied );
3433 }
3434
3435
3436 =item total_unapplied_refunds
3437
3438 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
3439 customer.  See L<FS::cust_refund/unapplied>.
3440
3441 =cut
3442
3443 sub total_unapplied_refunds {
3444   my $self = shift;
3445   my $custnum = $self->custnum;
3446
3447   my $unapplied_sql = FS::cust_refund->unapplied_sql;
3448
3449   my $sql = "
3450     SELECT SUM($unapplied_sql) FROM cust_refund
3451       WHERE custnum = $custnum
3452   ";
3453
3454   sprintf( "%.2f", $self->scalar_sql($sql) );
3455
3456 }
3457
3458 =item balance
3459
3460 Returns the balance for this customer (total_owed plus total_unrefunded, minus
3461 total_unapplied_credits minus total_unapplied_payments).
3462
3463 =cut
3464
3465 sub balance {
3466   my $self = shift;
3467   $self->balance_date_range;
3468 }
3469
3470 =item balance_date TIME
3471
3472 Returns the balance for this customer, only considering invoices with date
3473 earlier than TIME (total_owed_date minus total_credited minus
3474 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
3475 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
3476 functions.
3477
3478 =cut
3479
3480 sub balance_date {
3481   my $self = shift;
3482   $self->balance_date_range(shift);
3483 }
3484
3485 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
3486
3487 Returns the balance for this customer, optionally considering invoices with
3488 date earlier than START_TIME, and not later than END_TIME
3489 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
3490
3491 Times are specified as SQL fragments or numeric
3492 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
3493 L<Date::Parse> for conversion functions.  The empty string can be passed
3494 to disable that time constraint completely.
3495
3496 Available options are:
3497
3498 =over 4
3499
3500 =item unapplied_date
3501
3502 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)
3503
3504 =back
3505
3506 =cut
3507
3508 sub balance_date_range {
3509   my $self = shift;
3510   my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
3511             ') FROM cust_main WHERE custnum='. $self->custnum;
3512   sprintf( '%.2f', $self->scalar_sql($sql) );
3513 }
3514
3515 =item balance_pkgnum PKGNUM
3516
3517 Returns the balance for this customer's specific package when using
3518 experimental package balances (total_owed plus total_unrefunded, minus
3519 total_unapplied_credits minus total_unapplied_payments)
3520
3521 =cut
3522
3523 sub balance_pkgnum {
3524   my( $self, $pkgnum ) = @_;
3525
3526   sprintf( "%.2f",
3527       $self->total_owed_pkgnum($pkgnum)
3528 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
3529 #    + $self->total_unapplied_refunds_pkgnum($pkgnum)
3530     - $self->total_unapplied_credits_pkgnum($pkgnum)
3531     - $self->total_unapplied_payments_pkgnum($pkgnum)
3532   );
3533 }
3534
3535 =item in_transit_payments
3536
3537 Returns the total of requests for payments for this customer pending in
3538 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
3539
3540 =cut
3541
3542 sub in_transit_payments {
3543   my $self = shift;
3544   my $in_transit_payments = 0;
3545   foreach my $pay_batch ( qsearch('pay_batch', {
3546     'status' => 'I',
3547   } ) ) {
3548     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
3549       'batchnum' => $pay_batch->batchnum,
3550       'custnum' => $self->custnum,
3551     } ) ) {
3552       $in_transit_payments += $cust_pay_batch->amount;
3553     }
3554   }
3555   sprintf( "%.2f", $in_transit_payments );
3556 }
3557
3558 =item payment_info
3559
3560 Returns a hash of useful information for making a payment.
3561
3562 =over 4
3563
3564 =item balance
3565
3566 Current balance.
3567
3568 =item payby
3569
3570 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
3571 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
3572 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
3573
3574 =back
3575
3576 For credit card transactions:
3577
3578 =over 4
3579
3580 =item card_type 1
3581
3582 =item payname
3583
3584 Exact name on card
3585
3586 =back
3587
3588 For electronic check transactions:
3589
3590 =over 4
3591
3592 =item stateid_state
3593
3594 =back
3595
3596 =cut
3597
3598 sub payment_info {
3599   my $self = shift;
3600
3601   my %return = ();
3602
3603   $return{balance} = $self->balance;
3604
3605   $return{payname} = $self->payname
3606                      || ( $self->first. ' '. $self->get('last') );
3607
3608   $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
3609
3610   $return{payby} = $self->payby;
3611   $return{stateid_state} = $self->stateid_state;
3612
3613   if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
3614     $return{card_type} = cardtype($self->payinfo);
3615     $return{payinfo} = $self->paymask;
3616
3617     @return{'month', 'year'} = $self->paydate_monthyear;
3618
3619   }
3620
3621   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
3622     my ($payinfo1, $payinfo2) = split '@', $self->paymask;
3623     $return{payinfo1} = $payinfo1;
3624     $return{payinfo2} = $payinfo2;
3625     $return{paytype}  = $self->paytype;
3626     $return{paystate} = $self->paystate;
3627
3628   }
3629
3630   #doubleclick protection
3631   my $_date = time;
3632   $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
3633
3634   %return;
3635
3636 }
3637
3638 =item paydate_monthyear
3639
3640 Returns a two-element list consisting of the month and year of this customer's
3641 paydate (credit card expiration date for CARD customers)
3642
3643 =cut
3644
3645 sub paydate_monthyear {
3646   my $self = shift;
3647   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3648     ( $2, $1 );
3649   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3650     ( $1, $3 );
3651   } else {
3652     ('', '');
3653   }
3654 }
3655
3656 =item tax_exemption TAXNAME
3657
3658 =cut
3659
3660 sub tax_exemption {
3661   my( $self, $taxname ) = @_;
3662
3663   qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
3664                                      'taxname' => $taxname,
3665                                    },
3666           );
3667 }
3668
3669 =item cust_main_exemption
3670
3671 =cut
3672
3673 sub cust_main_exemption {
3674   my $self = shift;
3675   qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
3676 }
3677
3678 =item invoicing_list [ ARRAYREF ]
3679
3680 If an arguement is given, sets these email addresses as invoice recipients
3681 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
3682 (except as warnings), so use check_invoicing_list first.
3683
3684 Returns a list of email addresses (with svcnum entries expanded).
3685
3686 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
3687 check it without disturbing anything by passing nothing.
3688
3689 This interface may change in the future.
3690
3691 =cut
3692
3693 sub invoicing_list {
3694   my( $self, $arrayref ) = @_;
3695
3696   if ( $arrayref ) {
3697     my @cust_main_invoice;
3698     if ( $self->custnum ) {
3699       @cust_main_invoice =
3700         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3701     } else {
3702       @cust_main_invoice = ();
3703     }
3704     foreach my $cust_main_invoice ( @cust_main_invoice ) {
3705       #warn $cust_main_invoice->destnum;
3706       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3707         #warn $cust_main_invoice->destnum;
3708         my $error = $cust_main_invoice->delete;
3709         warn $error if $error;
3710       }
3711     }
3712     if ( $self->custnum ) {
3713       @cust_main_invoice =
3714         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3715     } else {
3716       @cust_main_invoice = ();
3717     }
3718     my %seen = map { $_->address => 1 } @cust_main_invoice;
3719     foreach my $address ( @{$arrayref} ) {
3720       next if exists $seen{$address} && $seen{$address};
3721       $seen{$address} = 1;
3722       my $cust_main_invoice = new FS::cust_main_invoice ( {
3723         'custnum' => $self->custnum,
3724         'dest'    => $address,
3725       } );
3726       my $error = $cust_main_invoice->insert;
3727       warn $error if $error;
3728     }
3729   }
3730
3731   if ( $self->custnum ) {
3732     map { $_->address }
3733       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3734   } else {
3735     ();
3736   }
3737
3738 }
3739
3740 =item check_invoicing_list ARRAYREF
3741
3742 Checks these arguements as valid input for the invoicing_list method.  If there
3743 is an error, returns the error, otherwise returns false.
3744
3745 =cut
3746
3747 sub check_invoicing_list {
3748   my( $self, $arrayref ) = @_;
3749
3750   foreach my $address ( @$arrayref ) {
3751
3752     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3753       return 'Can\'t add FAX invoice destination with a blank FAX number.';
3754     }
3755
3756     my $cust_main_invoice = new FS::cust_main_invoice ( {
3757       'custnum' => $self->custnum,
3758       'dest'    => $address,
3759     } );
3760     my $error = $self->custnum
3761                 ? $cust_main_invoice->check
3762                 : $cust_main_invoice->checkdest
3763     ;
3764     return $error if $error;
3765
3766   }
3767
3768   return "Email address required"
3769     if $conf->exists('cust_main-require_invoicing_list_email')
3770     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
3771
3772   '';
3773 }
3774
3775 =item set_default_invoicing_list
3776
3777 Sets the invoicing list to all accounts associated with this customer,
3778 overwriting any previous invoicing list.
3779
3780 =cut
3781
3782 sub set_default_invoicing_list {
3783   my $self = shift;
3784   $self->invoicing_list($self->all_emails);
3785 }
3786
3787 =item all_emails
3788
3789 Returns the email addresses of all accounts provisioned for this customer.
3790
3791 =cut
3792
3793 sub all_emails {
3794   my $self = shift;
3795   my %list;
3796   foreach my $cust_pkg ( $self->all_pkgs ) {
3797     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3798     my @svc_acct =
3799       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3800         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3801           @cust_svc;
3802     $list{$_}=1 foreach map { $_->email } @svc_acct;
3803   }
3804   keys %list;
3805 }
3806
3807 =item invoicing_list_addpost
3808
3809 Adds postal invoicing to this customer.  If this customer is already configured
3810 to receive postal invoices, does nothing.
3811
3812 =cut
3813
3814 sub invoicing_list_addpost {
3815   my $self = shift;
3816   return if grep { $_ eq 'POST' } $self->invoicing_list;
3817   my @invoicing_list = $self->invoicing_list;
3818   push @invoicing_list, 'POST';
3819   $self->invoicing_list(\@invoicing_list);
3820 }
3821
3822 =item invoicing_list_emailonly
3823
3824 Returns the list of email invoice recipients (invoicing_list without non-email
3825 destinations such as POST and FAX).
3826
3827 =cut
3828
3829 sub invoicing_list_emailonly {
3830   my $self = shift;
3831   warn "$me invoicing_list_emailonly called"
3832     if $DEBUG;
3833   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3834 }
3835
3836 =item invoicing_list_emailonly_scalar
3837
3838 Returns the list of email invoice recipients (invoicing_list without non-email
3839 destinations such as POST and FAX) as a comma-separated scalar.
3840
3841 =cut
3842
3843 sub invoicing_list_emailonly_scalar {
3844   my $self = shift;
3845   warn "$me invoicing_list_emailonly_scalar called"
3846     if $DEBUG;
3847   join(', ', $self->invoicing_list_emailonly);
3848 }
3849
3850 =item referral_custnum_cust_main
3851
3852 Returns the customer who referred this customer (or the empty string, if
3853 this customer was not referred).
3854
3855 Note the difference with referral_cust_main method: This method,
3856 referral_custnum_cust_main returns the single customer (if any) who referred
3857 this customer, while referral_cust_main returns an array of customers referred
3858 BY this customer.
3859
3860 =cut
3861
3862 sub referral_custnum_cust_main {
3863   my $self = shift;
3864   return '' unless $self->referral_custnum;
3865   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3866 }
3867
3868 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3869
3870 Returns an array of customers referred by this customer (referral_custnum set
3871 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
3872 customers referred by customers referred by this customer and so on, inclusive.
3873 The default behavior is DEPTH 1 (no recursion).
3874
3875 Note the difference with referral_custnum_cust_main method: This method,
3876 referral_cust_main, returns an array of customers referred BY this customer,
3877 while referral_custnum_cust_main returns the single customer (if any) who
3878 referred this customer.
3879
3880 =cut
3881
3882 sub referral_cust_main {
3883   my $self = shift;
3884   my $depth = @_ ? shift : 1;
3885   my $exclude = @_ ? shift : {};
3886
3887   my @cust_main =
3888     map { $exclude->{$_->custnum}++; $_; }
3889       grep { ! $exclude->{ $_->custnum } }
3890         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3891
3892   if ( $depth > 1 ) {
3893     push @cust_main,
3894       map { $_->referral_cust_main($depth-1, $exclude) }
3895         @cust_main;
3896   }
3897
3898   @cust_main;
3899 }
3900
3901 =item referral_cust_main_ncancelled
3902
3903 Same as referral_cust_main, except only returns customers with uncancelled
3904 packages.
3905
3906 =cut
3907
3908 sub referral_cust_main_ncancelled {
3909   my $self = shift;
3910   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3911 }
3912
3913 =item referral_cust_pkg [ DEPTH ]
3914
3915 Like referral_cust_main, except returns a flat list of all unsuspended (and
3916 uncancelled) packages for each customer.  The number of items in this list may
3917 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3918
3919 =cut
3920
3921 sub referral_cust_pkg {
3922   my $self = shift;
3923   my $depth = @_ ? shift : 1;
3924
3925   map { $_->unsuspended_pkgs }
3926     grep { $_->unsuspended_pkgs }
3927       $self->referral_cust_main($depth);
3928 }
3929
3930 =item referring_cust_main
3931
3932 Returns the single cust_main record for the customer who referred this customer
3933 (referral_custnum), or false.
3934
3935 =cut
3936
3937 sub referring_cust_main {
3938   my $self = shift;
3939   return '' unless $self->referral_custnum;
3940   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3941 }
3942
3943 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3944
3945 Applies a credit to this customer.  If there is an error, returns the error,
3946 otherwise returns false.
3947
3948 REASON can be a text string, an FS::reason object, or a scalar reference to
3949 a reasonnum.  If a text string, it will be automatically inserted as a new
3950 reason, and a 'reason_type' option must be passed to indicate the
3951 FS::reason_type for the new reason.
3952
3953 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3954
3955 Any other options are passed to FS::cust_credit::insert.
3956
3957 =cut
3958
3959 sub credit {
3960   my( $self, $amount, $reason, %options ) = @_;
3961
3962   my $cust_credit = new FS::cust_credit {
3963     'custnum' => $self->custnum,
3964     'amount'  => $amount,
3965   };
3966
3967   if ( ref($reason) ) {
3968
3969     if ( ref($reason) eq 'SCALAR' ) {
3970       $cust_credit->reasonnum( $$reason );
3971     } else {
3972       $cust_credit->reasonnum( $reason->reasonnum );
3973     }
3974
3975   } else {
3976     $cust_credit->set('reason', $reason)
3977   }
3978
3979   for (qw( addlinfo eventnum )) {
3980     $cust_credit->$_( delete $options{$_} )
3981       if exists($options{$_});
3982   }
3983
3984   $cust_credit->insert(%options);
3985
3986 }
3987
3988 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3989
3990 Creates a one-time charge for this customer.  If there is an error, returns
3991 the error, otherwise returns false.
3992
3993 New-style, with a hashref of options:
3994
3995   my $error = $cust_main->charge(
3996                                   {
3997                                     'amount'     => 54.32,
3998                                     'quantity'   => 1,
3999                                     'start_date' => str2time('7/4/2009'),
4000                                     'pkg'        => 'Description',
4001                                     'comment'    => 'Comment',
4002                                     'additional' => [], #extra invoice detail
4003                                     'classnum'   => 1,  #pkg_class
4004
4005                                     'setuptax'   => '', # or 'Y' for tax exempt
4006
4007                                     #internal taxation
4008                                     'taxclass'   => 'Tax class',
4009
4010                                     #vendor taxation
4011                                     'taxproduct' => 2,  #part_pkg_taxproduct
4012                                     'override'   => {}, #XXX describe
4013
4014                                     #will be filled in with the new object
4015                                     'cust_pkg_ref' => \$cust_pkg,
4016
4017                                     #generate an invoice immediately
4018                                     'bill_now' => 0,
4019                                     'invoice_terms' => '', #with these terms
4020                                   }
4021                                 );
4022
4023 Old-style:
4024
4025   my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
4026
4027 =cut
4028
4029 sub charge {
4030   my $self = shift;
4031   my ( $amount, $quantity, $start_date, $classnum );
4032   my ( $pkg, $comment, $additional );
4033   my ( $setuptax, $taxclass );   #internal taxes
4034   my ( $taxproduct, $override ); #vendor (CCH) taxes
4035   my $no_auto = '';
4036   my $cust_pkg_ref = '';
4037   my ( $bill_now, $invoice_terms ) = ( 0, '' );
4038   if ( ref( $_[0] ) ) {
4039     $amount     = $_[0]->{amount};
4040     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
4041     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
4042     $no_auto    = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
4043     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
4044     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
4045                                            : '$'. sprintf("%.2f",$amount);
4046     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
4047     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
4048     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
4049     $additional = $_[0]->{additional} || [];
4050     $taxproduct = $_[0]->{taxproductnum};
4051     $override   = { '' => $_[0]->{tax_override} };
4052     $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
4053     $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
4054     $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
4055   } else {
4056     $amount     = shift;
4057     $quantity   = 1;
4058     $start_date = '';
4059     $pkg        = @_ ? shift : 'One-time charge';
4060     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
4061     $setuptax   = '';
4062     $taxclass   = @_ ? shift : '';
4063     $additional = [];
4064   }
4065
4066   local $SIG{HUP} = 'IGNORE';
4067   local $SIG{INT} = 'IGNORE';
4068   local $SIG{QUIT} = 'IGNORE';
4069   local $SIG{TERM} = 'IGNORE';
4070   local $SIG{TSTP} = 'IGNORE';
4071   local $SIG{PIPE} = 'IGNORE';
4072
4073   my $oldAutoCommit = $FS::UID::AutoCommit;
4074   local $FS::UID::AutoCommit = 0;
4075   my $dbh = dbh;
4076
4077   my $part_pkg = new FS::part_pkg ( {
4078     'pkg'           => $pkg,
4079     'comment'       => $comment,
4080     'plan'          => 'flat',
4081     'freq'          => 0,
4082     'disabled'      => 'Y',
4083     'classnum'      => ( $classnum ? $classnum : '' ),
4084     'setuptax'      => $setuptax,
4085     'taxclass'      => $taxclass,
4086     'taxproductnum' => $taxproduct,
4087   } );
4088
4089   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
4090                         ( 0 .. @$additional - 1 )
4091                   ),
4092                   'additional_count' => scalar(@$additional),
4093                   'setup_fee' => $amount,
4094                 );
4095
4096   my $error = $part_pkg->insert( options       => \%options,
4097                                  tax_overrides => $override,
4098                                );
4099   if ( $error ) {
4100     $dbh->rollback if $oldAutoCommit;
4101     return $error;
4102   }
4103
4104   my $pkgpart = $part_pkg->pkgpart;
4105   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
4106   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
4107     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
4108     $error = $type_pkgs->insert;
4109     if ( $error ) {
4110       $dbh->rollback if $oldAutoCommit;
4111       return $error;
4112     }
4113   }
4114
4115   my $cust_pkg = new FS::cust_pkg ( {
4116     'custnum'    => $self->custnum,
4117     'pkgpart'    => $pkgpart,
4118     'quantity'   => $quantity,
4119     'start_date' => $start_date,
4120     'no_auto'    => $no_auto,
4121   } );
4122
4123   $error = $cust_pkg->insert;
4124   if ( $error ) {
4125     $dbh->rollback if $oldAutoCommit;
4126     return $error;
4127   } elsif ( $cust_pkg_ref ) {
4128     ${$cust_pkg_ref} = $cust_pkg;
4129   }
4130
4131   if ( $bill_now ) {
4132     my $error = $self->bill( 'invoice_terms' => $invoice_terms,
4133                              'pkg_list'      => [ $cust_pkg ],
4134                            );
4135     if ( $error ) {
4136       $dbh->rollback if $oldAutoCommit;
4137       return $error;
4138     }
4139   }
4140
4141   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4142   return '';
4143
4144 }
4145
4146 #=item charge_postal_fee
4147 #
4148 #Applies a one time charge this customer.  If there is an error,
4149 #returns the error, returns the cust_pkg charge object or false
4150 #if there was no charge.
4151 #
4152 #=cut
4153 #
4154 # This should be a customer event.  For that to work requires that bill
4155 # also be a customer event.
4156
4157 sub charge_postal_fee {
4158   my $self = shift;
4159
4160   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
4161   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
4162
4163   my $cust_pkg = new FS::cust_pkg ( {
4164     'custnum'  => $self->custnum,
4165     'pkgpart'  => $pkgpart,
4166     'quantity' => 1,
4167   } );
4168
4169   my $error = $cust_pkg->insert;
4170   $error ? $error : $cust_pkg;
4171 }
4172
4173 =item cust_bill
4174
4175 Returns all the invoices (see L<FS::cust_bill>) for this customer.
4176
4177 =cut
4178
4179 sub cust_bill {
4180   my $self = shift;
4181   map { $_ } #return $self->num_cust_bill unless wantarray;
4182   sort { $a->_date <=> $b->_date }
4183     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
4184 }
4185
4186 =item open_cust_bill
4187
4188 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
4189 customer.
4190
4191 =cut
4192
4193 sub open_cust_bill {
4194   my $self = shift;
4195
4196   qsearch({
4197     'table'     => 'cust_bill',
4198     'hashref'   => { 'custnum' => $self->custnum, },
4199     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
4200     'order_by'  => 'ORDER BY _date ASC',
4201   });
4202
4203 }
4204
4205 =item cust_statements
4206
4207 Returns all the statements (see L<FS::cust_statement>) for this customer.
4208
4209 =cut
4210
4211 sub cust_statement {
4212   my $self = shift;
4213   map { $_ } #return $self->num_cust_statement unless wantarray;
4214   sort { $a->_date <=> $b->_date }
4215     qsearch('cust_statement', { 'custnum' => $self->custnum, } )
4216 }
4217
4218 =item cust_credit
4219
4220 Returns all the credits (see L<FS::cust_credit>) for this customer.
4221
4222 =cut
4223
4224 sub cust_credit {
4225   my $self = shift;
4226   map { $_ } #return $self->num_cust_credit unless wantarray;
4227   sort { $a->_date <=> $b->_date }
4228     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
4229 }
4230
4231 =item cust_credit_pkgnum
4232
4233 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
4234 package when using experimental package balances.
4235
4236 =cut
4237
4238 sub cust_credit_pkgnum {
4239   my( $self, $pkgnum ) = @_;
4240   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
4241   sort { $a->_date <=> $b->_date }
4242     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
4243                               'pkgnum'  => $pkgnum,
4244                             }
4245     );
4246 }
4247
4248 =item cust_pay
4249
4250 Returns all the payments (see L<FS::cust_pay>) for this customer.
4251
4252 =cut
4253
4254 sub cust_pay {
4255   my $self = shift;
4256   return $self->num_cust_pay unless wantarray;
4257   sort { $a->_date <=> $b->_date }
4258     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
4259 }
4260
4261 =item num_cust_pay
4262
4263 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
4264 called automatically when the cust_pay method is used in a scalar context.
4265
4266 =cut
4267
4268 sub num_cust_pay {
4269   my $self = shift;
4270   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
4271   my $sth = dbh->prepare($sql) or die dbh->errstr;
4272   $sth->execute($self->custnum) or die $sth->errstr;
4273   $sth->fetchrow_arrayref->[0];
4274 }
4275
4276 =item cust_pay_pkgnum
4277
4278 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
4279 package when using experimental package balances.
4280
4281 =cut
4282
4283 sub cust_pay_pkgnum {
4284   my( $self, $pkgnum ) = @_;
4285   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
4286   sort { $a->_date <=> $b->_date }
4287     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
4288                            'pkgnum'  => $pkgnum,
4289                          }
4290     );
4291 }
4292
4293 =item cust_pay_void
4294
4295 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
4296
4297 =cut
4298
4299 sub cust_pay_void {
4300   my $self = shift;
4301   map { $_ } #return $self->num_cust_pay_void unless wantarray;
4302   sort { $a->_date <=> $b->_date }
4303     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
4304 }
4305
4306 =item cust_pay_batch
4307
4308 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
4309
4310 =cut
4311
4312 sub cust_pay_batch {
4313   my $self = shift;
4314   map { $_ } #return $self->num_cust_pay_batch unless wantarray;
4315   sort { $a->paybatchnum <=> $b->paybatchnum }
4316     qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
4317 }
4318
4319 =item cust_pay_pending
4320
4321 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
4322 (without status "done").
4323
4324 =cut
4325
4326 sub cust_pay_pending {
4327   my $self = shift;
4328   return $self->num_cust_pay_pending unless wantarray;
4329   sort { $a->_date <=> $b->_date }
4330     qsearch( 'cust_pay_pending', {
4331                                    'custnum' => $self->custnum,
4332                                    'status'  => { op=>'!=', value=>'done' },
4333                                  },
4334            );
4335 }
4336
4337 =item cust_pay_pending_attempt
4338
4339 Returns all payment attempts / declined payments for this customer, as pending
4340 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
4341 a corresponding payment (see L<FS::cust_pay>).
4342
4343 =cut
4344
4345 sub cust_pay_pending_attempt {
4346   my $self = shift;
4347   return $self->num_cust_pay_pending_attempt unless wantarray;
4348   sort { $a->_date <=> $b->_date }
4349     qsearch( 'cust_pay_pending', {
4350                                    'custnum' => $self->custnum,
4351                                    'status'  => 'done',
4352                                    'paynum'  => '',
4353                                  },
4354            );
4355 }
4356
4357 =item num_cust_pay_pending
4358
4359 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
4360 customer (without status "done").  Also called automatically when the
4361 cust_pay_pending method is used in a scalar context.
4362
4363 =cut
4364
4365 sub num_cust_pay_pending {
4366   my $self = shift;
4367   $self->scalar_sql(
4368     " SELECT COUNT(*) FROM cust_pay_pending ".
4369       " WHERE custnum = ? AND status != 'done' ",
4370     $self->custnum
4371   );
4372 }
4373
4374 =item num_cust_pay_pending_attempt
4375
4376 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
4377 customer, with status "done" but without a corresp.  Also called automatically when the
4378 cust_pay_pending method is used in a scalar context.
4379
4380 =cut
4381
4382 sub num_cust_pay_pending_attempt {
4383   my $self = shift;
4384   $self->scalar_sql(
4385     " SELECT COUNT(*) FROM cust_pay_pending ".
4386       " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
4387     $self->custnum
4388   );
4389 }
4390
4391 =item cust_refund
4392
4393 Returns all the refunds (see L<FS::cust_refund>) for this customer.
4394
4395 =cut
4396
4397 sub cust_refund {
4398   my $self = shift;
4399   map { $_ } #return $self->num_cust_refund unless wantarray;
4400   sort { $a->_date <=> $b->_date }
4401     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
4402 }
4403
4404 =item display_custnum
4405
4406 Returns the displayed customer number for this customer: agent_custid if
4407 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
4408
4409 =cut
4410
4411 sub display_custnum {
4412   my $self = shift;
4413   if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
4414     return $self->agent_custid;
4415   } else {
4416     return $self->custnum;
4417   }
4418 }
4419
4420 =item name
4421
4422 Returns a name string for this customer, either "Company (Last, First)" or
4423 "Last, First".
4424
4425 =cut
4426
4427 sub name {
4428   my $self = shift;
4429   my $name = $self->contact;
4430   $name = $self->company. " ($name)" if $self->company;
4431   $name;
4432 }
4433
4434 =item ship_name
4435
4436 Returns a name string for this (service/shipping) contact, either
4437 "Company (Last, First)" or "Last, First".
4438
4439 =cut
4440
4441 sub ship_name {
4442   my $self = shift;
4443   if ( $self->get('ship_last') ) {
4444     my $name = $self->ship_contact;
4445     $name = $self->ship_company. " ($name)" if $self->ship_company;
4446     $name;
4447   } else {
4448     $self->name;
4449   }
4450 }
4451
4452 =item name_short
4453
4454 Returns a name string for this customer, either "Company" or "First Last".
4455
4456 =cut
4457
4458 sub name_short {
4459   my $self = shift;
4460   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
4461 }
4462
4463 =item ship_name_short
4464
4465 Returns a name string for this (service/shipping) contact, either "Company"
4466 or "First Last".
4467
4468 =cut
4469
4470 sub ship_name_short {
4471   my $self = shift;
4472   if ( $self->get('ship_last') ) {
4473     $self->ship_company !~ /^\s*$/
4474       ? $self->ship_company
4475       : $self->ship_contact_firstlast;
4476   } else {
4477     $self->name_company_or_firstlast;
4478   }
4479 }
4480
4481 =item contact
4482
4483 Returns this customer's full (billing) contact name only, "Last, First"
4484
4485 =cut
4486
4487 sub contact {
4488   my $self = shift;
4489   $self->get('last'). ', '. $self->first;
4490 }
4491
4492 =item ship_contact
4493
4494 Returns this customer's full (shipping) contact name only, "Last, First"
4495
4496 =cut
4497
4498 sub ship_contact {
4499   my $self = shift;
4500   $self->get('ship_last')
4501     ? $self->get('ship_last'). ', '. $self->ship_first
4502     : $self->contact;
4503 }
4504
4505 =item contact_firstlast
4506
4507 Returns this customers full (billing) contact name only, "First Last".
4508
4509 =cut
4510
4511 sub contact_firstlast {
4512   my $self = shift;
4513   $self->first. ' '. $self->get('last');
4514 }
4515
4516 =item ship_contact_firstlast
4517
4518 Returns this customer's full (shipping) contact name only, "First Last".
4519
4520 =cut
4521
4522 sub ship_contact_firstlast {
4523   my $self = shift;
4524   $self->get('ship_last')
4525     ? $self->first. ' '. $self->get('ship_last')
4526     : $self->contact_firstlast;
4527 }
4528
4529 =item country_full
4530
4531 Returns this customer's full country name
4532
4533 =cut
4534
4535 sub country_full {
4536   my $self = shift;
4537   code2country($self->country);
4538 }
4539
4540 =item geocode DATA_VENDOR
4541
4542 Returns a value for the customer location as encoded by DATA_VENDOR.
4543 Currently this only makes sense for "CCH" as DATA_VENDOR.
4544
4545 =cut
4546
4547 sub geocode {
4548   my ($self, $data_vendor) = (shift, shift);  #always cch for now
4549
4550   my $geocode = $self->get('geocode');  #XXX only one data_vendor for geocode
4551   return $geocode if $geocode;
4552
4553   my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
4554                ? 'ship_'
4555                : '';
4556
4557   my($zip,$plus4) = split /-/, $self->get("${prefix}zip")
4558     if $self->country eq 'US';
4559
4560   $zip ||= '';
4561   $plus4 ||= '';
4562   #CCH specific location stuff
4563   my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
4564
4565   my @cust_tax_location =
4566     qsearch( {
4567                'table'     => 'cust_tax_location',
4568                'hashref'   => { 'zip' => $zip, 'data_vendor' => $data_vendor },
4569                'extra_sql' => $extra_sql,
4570                'order_by'  => 'ORDER BY plus4hi',#overlapping with distinct ends
4571              }
4572            );
4573   $geocode = $cust_tax_location[0]->geocode
4574     if scalar(@cust_tax_location);
4575
4576   $geocode;
4577 }
4578
4579 =item cust_status
4580
4581 =item status
4582
4583 Returns a status string for this customer, currently:
4584
4585 =over 4
4586
4587 =item prospect - No packages have ever been ordered
4588
4589 =item ordered - Recurring packages all are new (not yet billed).
4590
4591 =item active - One or more recurring packages is active
4592
4593 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4594
4595 =item suspended - All non-cancelled recurring packages are suspended
4596
4597 =item cancelled - All recurring packages are cancelled
4598
4599 =back
4600
4601 =cut
4602
4603 sub status { shift->cust_status(@_); }
4604
4605 sub cust_status {
4606   my $self = shift;
4607   # prospect ordered active inactive suspended cancelled
4608   for my $status ( FS::cust_main->statuses() ) {
4609     my $method = $status.'_sql';
4610     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4611     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4612     $sth->execute( ($self->custnum) x $numnum )
4613       or die "Error executing 'SELECT $sql': ". $sth->errstr;
4614     return $status if $sth->fetchrow_arrayref->[0];
4615   }
4616 }
4617
4618 =item ucfirst_cust_status
4619
4620 =item ucfirst_status
4621
4622 Returns the status with the first character capitalized.
4623
4624 =cut
4625
4626 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4627
4628 sub ucfirst_cust_status {
4629   my $self = shift;
4630   ucfirst($self->cust_status);
4631 }
4632
4633 =item statuscolor
4634
4635 Returns a hex triplet color string for this customer's status.
4636
4637 =cut
4638
4639 use vars qw(%statuscolor);
4640 tie %statuscolor, 'Tie::IxHash',
4641   'prospect'  => '7e0079', #'000000', #black?  naw, purple
4642   'active'    => '00CC00', #green
4643   'ordered'   => '009999', #teal? cyan?
4644   'inactive'  => '0000CC', #blue
4645   'suspended' => 'FF9900', #yellow
4646   'cancelled' => 'FF0000', #red
4647 ;
4648
4649 sub statuscolor { shift->cust_statuscolor(@_); }
4650
4651 sub cust_statuscolor {
4652   my $self = shift;
4653   $statuscolor{$self->cust_status};
4654 }
4655
4656 =item tickets
4657
4658 Returns an array of hashes representing the customer's RT tickets.
4659
4660 =cut
4661
4662 sub tickets {
4663   my $self = shift;
4664
4665   my $num = $conf->config('cust_main-max_tickets') || 10;
4666   my @tickets = ();
4667
4668   if ( $conf->config('ticket_system') ) {
4669     unless ( $conf->config('ticket_system-custom_priority_field') ) {
4670
4671       @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
4672
4673     } else {
4674
4675       foreach my $priority (
4676         $conf->config('ticket_system-custom_priority_field-values'), ''
4677       ) {
4678         last if scalar(@tickets) >= $num;
4679         push @tickets,
4680           @{ FS::TicketSystem->customer_tickets( $self->custnum,
4681                                                  $num - scalar(@tickets),
4682                                                  $priority,
4683                                                )
4684            };
4685       }
4686     }
4687   }
4688   (@tickets);
4689 }
4690
4691 # Return services representing svc_accts in customer support packages
4692 sub support_services {
4693   my $self = shift;
4694   my %packages = map { $_ => 1 } $conf->config('support_packages');
4695
4696   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4697     grep { $_->part_svc->svcdb eq 'svc_acct' }
4698     map { $_->cust_svc }
4699     grep { exists $packages{ $_->pkgpart } }
4700     $self->ncancelled_pkgs;
4701
4702 }
4703
4704 # Return a list of latitude/longitude for one of the services (if any)
4705 sub service_coordinates {
4706   my $self = shift;
4707
4708   my @svc_X =
4709     grep { $_->latitude && $_->longitude }
4710     map { $_->svc_x }
4711     map { $_->cust_svc }
4712     $self->ncancelled_pkgs;
4713
4714   scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4715 }
4716
4717 =back
4718
4719 =head1 CLASS METHODS
4720
4721 =over 4
4722
4723 =item statuses
4724
4725 Class method that returns the list of possible status strings for customers
4726 (see L<the status method|/status>).  For example:
4727
4728   @statuses = FS::cust_main->statuses();
4729
4730 =cut
4731
4732 sub statuses {
4733   #my $self = shift; #could be class...
4734   keys %statuscolor;
4735 }
4736
4737 =item prospect_sql
4738
4739 Returns an SQL expression identifying prospective cust_main records (customers
4740 with no packages ever ordered)
4741
4742 =cut
4743
4744 use vars qw($select_count_pkgs);
4745 $select_count_pkgs =
4746   "SELECT COUNT(*) FROM cust_pkg
4747     WHERE cust_pkg.custnum = cust_main.custnum";
4748
4749 sub select_count_pkgs_sql {
4750   $select_count_pkgs;
4751 }
4752
4753 sub prospect_sql {
4754   " 0 = ( $select_count_pkgs ) ";
4755 }
4756
4757 =item ordered_sql
4758
4759 Returns an SQL expression identifying ordered cust_main records (customers with
4760 recurring packages not yet setup).
4761
4762 =cut
4763
4764 sub ordered_sql {
4765   FS::cust_main->none_active_sql.
4766   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->ordered_sql. " ) ";
4767 }
4768
4769 =item active_sql
4770
4771 Returns an SQL expression identifying active cust_main records (customers with
4772 active recurring packages).
4773
4774 =cut
4775
4776 sub active_sql {
4777   " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4778 }
4779
4780 =item none_active_sql
4781
4782 Returns an SQL expression identifying cust_main records with no active
4783 recurring packages.  This includes customers of status prospect, ordered,
4784 inactive, and suspended.
4785
4786 =cut
4787
4788 sub none_active_sql {
4789   " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4790 }
4791
4792 =item inactive_sql
4793
4794 Returns an SQL expression identifying inactive cust_main records (customers with
4795 no active recurring packages, but otherwise unsuspended/uncancelled).
4796
4797 =cut
4798
4799 sub inactive_sql {
4800   FS::cust_main->none_active_sql.
4801   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4802 }
4803
4804 =item susp_sql
4805 =item suspended_sql
4806
4807 Returns an SQL expression identifying suspended cust_main records.
4808
4809 =cut
4810
4811
4812 sub suspended_sql { susp_sql(@_); }
4813 sub susp_sql {
4814   FS::cust_main->none_active_sql.
4815   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4816 }
4817
4818 =item cancel_sql
4819 =item cancelled_sql
4820
4821 Returns an SQL expression identifying cancelled cust_main records.
4822
4823 =cut
4824
4825 sub cancelled_sql { cancel_sql(@_); }
4826 sub cancel_sql {
4827
4828   my $recurring_sql = FS::cust_pkg->recurring_sql;
4829   my $cancelled_sql = FS::cust_pkg->cancelled_sql;
4830
4831   "
4832         0 < ( $select_count_pkgs )
4833     AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql   )
4834     AND 0 = ( $select_count_pkgs AND $recurring_sql
4835                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4836             )
4837     AND 0 = (  $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
4838   ";
4839
4840 }
4841
4842 =item uncancel_sql
4843 =item uncancelled_sql
4844
4845 Returns an SQL expression identifying un-cancelled cust_main records.
4846
4847 =cut
4848
4849 sub uncancelled_sql { uncancel_sql(@_); }
4850 sub uncancel_sql { "
4851   ( 0 < ( $select_count_pkgs
4852                    AND ( cust_pkg.cancel IS NULL
4853                          OR cust_pkg.cancel = 0
4854                        )
4855         )
4856     OR 0 = ( $select_count_pkgs )
4857   )
4858 "; }
4859
4860 =item balance_sql
4861
4862 Returns an SQL fragment to retreive the balance.
4863
4864 =cut
4865
4866 sub balance_sql { "
4867     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4868         WHERE cust_bill.custnum   = cust_main.custnum     )
4869   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
4870         WHERE cust_pay.custnum    = cust_main.custnum     )
4871   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
4872         WHERE cust_credit.custnum = cust_main.custnum     )
4873   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
4874         WHERE cust_refund.custnum = cust_main.custnum     )
4875 "; }
4876
4877 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4878
4879 Returns an SQL fragment to retreive the balance for this customer, optionally
4880 considering invoices with date earlier than START_TIME, and not
4881 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4882 total_unapplied_payments).
4883
4884 Times are specified as SQL fragments or numeric
4885 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4886 L<Date::Parse> for conversion functions.  The empty string can be passed
4887 to disable that time constraint completely.
4888
4889 Available options are:
4890
4891 =over 4
4892
4893 =item unapplied_date
4894
4895 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)
4896
4897 =item total
4898
4899 (unused.  obsolete?)
4900 set to true to remove all customer comparison clauses, for totals
4901
4902 =item where
4903
4904 (unused.  obsolete?)
4905 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4906
4907 =item join
4908
4909 (unused.  obsolete?)
4910 JOIN clause (typically used with the total option)
4911
4912 =item cutoff
4913
4914 An absolute cutoff time.  Payments, credits, and refunds I<applied> after this
4915 time will be ignored.  Note that START_TIME and END_TIME only limit the date
4916 range for invoices and I<unapplied> payments, credits, and refunds.
4917
4918 =back
4919
4920 =cut
4921
4922 sub balance_date_sql {
4923   my( $class, $start, $end, %opt ) = @_;
4924
4925   my $cutoff = $opt{'cutoff'};
4926
4927   my $owed         = FS::cust_bill->owed_sql($cutoff);
4928   my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4929   my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4930   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4931
4932   my $j = $opt{'join'} || '';
4933
4934   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
4935   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4936   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4937   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
4938
4939   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
4940     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4941     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4942     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
4943   ";
4944
4945 }
4946
4947 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4948
4949 Returns an SQL fragment to retreive the total unapplied payments for this
4950 customer, only considering invoices with date earlier than START_TIME, and
4951 optionally not later than END_TIME.
4952
4953 Times are specified as SQL fragments or numeric
4954 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4955 L<Date::Parse> for conversion functions.  The empty string can be passed
4956 to disable that time constraint completely.
4957
4958 Available options are:
4959
4960 =cut
4961
4962 sub unapplied_payments_date_sql {
4963   my( $class, $start, $end, %opt ) = @_;
4964
4965   my $cutoff = $opt{'cutoff'};
4966
4967   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4968
4969   my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4970                                                           'unapplied_date'=>1 );
4971
4972   " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4973 }
4974
4975 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4976
4977 Helper method for balance_date_sql; name (and usage) subject to change
4978 (suggestions welcome).
4979
4980 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4981 cust_refund, cust_credit or cust_pay).
4982
4983 If TABLE is "cust_bill" or the unapplied_date option is true, only
4984 considers records with date earlier than START_TIME, and optionally not
4985 later than END_TIME .
4986
4987 =cut
4988
4989 sub _money_table_where {
4990   my( $class, $table, $start, $end, %opt ) = @_;
4991
4992   my @where = ();
4993   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4994   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4995     push @where, "$table._date <= $start" if defined($start) && length($start);
4996     push @where, "$table._date >  $end"   if defined($end)   && length($end);
4997   }
4998   push @where, @{$opt{'where'}} if $opt{'where'};
4999   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
5000
5001   $where;
5002
5003 }
5004
5005 =item search HASHREF
5006
5007 (Class method)
5008
5009 Returns a qsearch hash expression to search for parameters specified in
5010 HASHREF.  Valid parameters are
5011
5012 =over 4
5013
5014 =item agentnum
5015
5016 =item status
5017
5018 =item cancelled_pkgs
5019
5020 bool
5021
5022 =item signupdate
5023
5024 listref of start date, end date
5025
5026 =item payby
5027
5028 listref
5029
5030 =item paydate_year
5031
5032 =item paydate_month
5033
5034 =item current_balance
5035
5036 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
5037
5038 =item cust_fields
5039
5040 =item flattened_pkgs
5041
5042 bool
5043
5044 =back
5045
5046 =cut
5047
5048 sub search {
5049   my ($class, $params) = @_;
5050
5051   my $dbh = dbh;
5052
5053   my @where = ();
5054   my $orderby;
5055
5056   ##
5057   # parse agent
5058   ##
5059
5060   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
5061     push @where,
5062       "cust_main.agentnum = $1";
5063   }
5064
5065   ##
5066   # do the same for user
5067   ##
5068
5069   if ( $params->{'usernum'} =~ /^(\d+)$/ and $1 ) {
5070     push @where,
5071       "cust_main.usernum = $1";
5072   }
5073
5074   ##
5075   # parse status
5076   ##
5077
5078   #prospect ordered active inactive suspended cancelled
5079   if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
5080     my $method = $params->{'status'}. '_sql';
5081     #push @where, $class->$method();
5082     push @where, FS::cust_main->$method();
5083   }
5084
5085   ##
5086   # parse cancelled package checkbox
5087   ##
5088
5089   my $pkgwhere = "";
5090
5091   $pkgwhere .= "AND (cancel = 0 or cancel is null)"
5092     unless $params->{'cancelled_pkgs'};
5093
5094   ##
5095   # parse without census tract checkbox
5096   ##
5097
5098   push @where, "(censustract = '' or censustract is null)"
5099     if $params->{'no_censustract'};
5100
5101   ##
5102   # dates
5103   ##
5104
5105   foreach my $field (qw( signupdate )) {
5106
5107     next unless exists($params->{$field});
5108
5109     my($beginning, $ending, $hour) = @{$params->{$field}};
5110
5111     push @where,
5112       "cust_main.$field IS NOT NULL",
5113       "cust_main.$field >= $beginning",
5114       "cust_main.$field <= $ending";
5115
5116     # XXX: do this for mysql and/or pull it out of here
5117     if(defined $hour) {
5118       if ($dbh->{Driver}->{Name} eq 'Pg') {
5119         push @where, "extract(hour from to_timestamp(cust_main.$field)) = $hour";
5120       }
5121       else {
5122         warn "search by time of day not supported on ".$dbh->{Driver}->{Name}." databases";
5123       }
5124     }
5125
5126     $orderby ||= "ORDER BY cust_main.$field";
5127
5128   }
5129
5130   ###
5131   # classnum
5132   ###
5133
5134   if ( $params->{'classnum'} ) {
5135
5136     my @classnum = ref( $params->{'classnum'} )
5137                      ? @{ $params->{'classnum'} }
5138                      :  ( $params->{'classnum'} );
5139
5140     @classnum = grep /^(\d*)$/, @classnum;
5141
5142     if ( @classnum ) {
5143       push @where, '( '. join(' OR ', map {
5144                                             $_ ? "cust_main.classnum = $_"
5145                                                : "cust_main.classnum IS NULL"
5146                                           }
5147                                           @classnum
5148                              ).
5149                    ' )';
5150     }
5151
5152   }
5153
5154   ###
5155   # payby
5156   ###
5157
5158   if ( $params->{'payby'} ) {
5159
5160     my @payby = ref( $params->{'payby'} )
5161                   ? @{ $params->{'payby'} }
5162                   :  ( $params->{'payby'} );
5163
5164     @payby = grep /^([A-Z]{4})$/, @payby;
5165
5166     push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )'
5167       if @payby;
5168
5169   }
5170
5171   ###
5172   # paydate_year / paydate_month
5173   ###
5174
5175   if ( $params->{'paydate_year'} =~ /^(\d{4})$/ ) {
5176     my $year = $1;
5177     $params->{'paydate_month'} =~ /^(\d\d?)$/
5178       or die "paydate_year without paydate_month?";
5179     my $month = $1;
5180
5181     push @where,
5182       'paydate IS NOT NULL',
5183       "paydate != ''",
5184       "CAST(paydate AS timestamp) < CAST('$year-$month-01' AS timestamp )"
5185 ;
5186   }
5187
5188   ###
5189   # invoice terms
5190   ###
5191
5192   if ( $params->{'invoice_terms'} =~ /^([\w ]+)$/ ) {
5193     my $terms = $1;
5194     if ( $1 eq 'NULL' ) {
5195       push @where,
5196         "( cust_main.invoice_terms IS NULL OR cust_main.invoice_terms = '' )";
5197     } else {
5198       push @where,
5199         "cust_main.invoice_terms IS NOT NULL",
5200         "cust_main.invoice_terms = '$1'";
5201     }
5202   }
5203
5204   ##
5205   # amounts
5206   ##
5207
5208   if ( $params->{'current_balance'} ) {
5209
5210     #my $balance_sql = $class->balance_sql();
5211     my $balance_sql = FS::cust_main->balance_sql();
5212
5213     my @current_balance =
5214       ref( $params->{'current_balance'} )
5215       ? @{ $params->{'current_balance'} }
5216       :  ( $params->{'current_balance'} );
5217
5218     push @where, map { s/current_balance/$balance_sql/; $_ }
5219                      @current_balance;
5220
5221   }
5222
5223   ##
5224   # custbatch
5225   ##
5226
5227   if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
5228     push @where,
5229       "cust_main.custbatch = '$1'";
5230   }
5231
5232   ##
5233   # setup queries, subs, etc. for the search
5234   ##
5235
5236   $orderby ||= 'ORDER BY custnum';
5237
5238   # here is the agent virtualization
5239   push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
5240
5241   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
5242
5243   my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum  ) ';
5244
5245   my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
5246
5247   my $select = join(', ',
5248                  'cust_main.custnum',
5249                  FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
5250                );
5251
5252   my(@extra_headers) = ();
5253   my(@extra_fields)  = ();
5254
5255   if ($params->{'flattened_pkgs'}) {
5256
5257     if ($dbh->{Driver}->{Name} eq 'Pg') {
5258
5259       $select .= ", array_to_string(array(select pkg from cust_pkg left join part_pkg using ( pkgpart ) where cust_main.custnum = cust_pkg.custnum $pkgwhere),'|') as magic";
5260
5261     }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
5262       $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
5263       $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
5264     }else{
5265       warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
5266            "omitting packing information from report.";
5267     }
5268
5269     my $header_query = "SELECT COUNT(cust_pkg.custnum = cust_main.custnum) AS count FROM cust_main $addl_from $extra_sql $pkgwhere group by cust_main.custnum order by count desc limit 1";
5270
5271     my $sth = dbh->prepare($header_query) or die dbh->errstr;
5272     $sth->execute() or die $sth->errstr;
5273     my $headerrow = $sth->fetchrow_arrayref;
5274     my $headercount = $headerrow ? $headerrow->[0] : 0;
5275     while($headercount) {
5276       unshift @extra_headers, "Package ". $headercount;
5277       unshift @extra_fields, eval q!sub {my $c = shift;
5278                                          my @a = split '\|', $c->magic;
5279                                          my $p = $a[!.--$headercount. q!];
5280                                          $p;
5281                                         };!;
5282     }
5283
5284   }
5285
5286   my $sql_query = {
5287     'table'         => 'cust_main',
5288     'select'        => $select,
5289     'hashref'       => {},
5290     'extra_sql'     => $extra_sql,
5291     'order_by'      => $orderby,
5292     'count_query'   => $count_query,
5293     'extra_headers' => \@extra_headers,
5294     'extra_fields'  => \@extra_fields,
5295   };
5296
5297 }
5298
5299 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
5300
5301 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
5302 records.  Currently, I<first>, I<last>, I<company> and/or I<address1> may be
5303 specified (the appropriate ship_ field is also searched).
5304
5305 Additional options are the same as FS::Record::qsearch
5306
5307 =cut
5308
5309 sub fuzzy_search {
5310   my( $self, $fuzzy, $hash, @opt) = @_;
5311   #$self
5312   $hash ||= {};
5313   my @cust_main = ();
5314
5315   check_and_rebuild_fuzzyfiles();
5316   foreach my $field ( keys %$fuzzy ) {
5317
5318     my $all = $self->all_X($field);
5319     next unless scalar(@$all);
5320
5321     my %match = ();
5322     $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
5323
5324     my @fcust = ();
5325     foreach ( keys %match ) {
5326       push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
5327       push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
5328     }
5329     my %fsaw = ();
5330     push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
5331   }
5332
5333   # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
5334   my %saw = ();
5335   @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
5336
5337   @cust_main;
5338
5339 }
5340
5341 =item masked FIELD
5342
5343 Returns a masked version of the named field
5344
5345 =cut
5346
5347 sub masked {
5348 my ($self,$field) = @_;
5349
5350 # Show last four
5351
5352 'x'x(length($self->getfield($field))-4).
5353   substr($self->getfield($field), (length($self->getfield($field))-4));
5354
5355 }
5356
5357 =back
5358
5359 =head1 SUBROUTINES
5360
5361 =over 4
5362
5363 =item smart_search OPTION => VALUE ...
5364
5365 Accepts the following options: I<search>, the string to search for.  The string
5366 will be searched for as a customer number, phone number, name or company name,
5367 as an exact, or, in some cases, a substring or fuzzy match (see the source code
5368 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
5369 skip fuzzy matching when an exact match is found.
5370
5371 Any additional options are treated as an additional qualifier on the search
5372 (i.e. I<agentnum>).
5373
5374 Returns a (possibly empty) array of FS::cust_main objects.
5375
5376 =cut
5377
5378 sub smart_search {
5379   my %options = @_;
5380
5381   #here is the agent virtualization
5382   my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
5383
5384   my @cust_main = ();
5385
5386   my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
5387   my $search = delete $options{'search'};
5388   ( my $alphanum_search = $search ) =~ s/\W//g;
5389
5390   if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
5391
5392     #false laziness w/Record::ut_phone
5393     my $phonen = "$1-$2-$3";
5394     $phonen .= " x$4" if $4;
5395
5396     push @cust_main, qsearch( {
5397       'table'   => 'cust_main',
5398       'hashref' => { %options },
5399       'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
5400                      ' ( '.
5401                          join(' OR ', map "$_ = '$phonen'",
5402                                           qw( daytime night fax
5403                                               ship_daytime ship_night ship_fax )
5404                              ).
5405                      ' ) '.
5406                      " AND $agentnums_sql", #agent virtualization
5407     } );
5408
5409     unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
5410       #try looking for matches with extensions unless one was specified
5411
5412       push @cust_main, qsearch( {
5413         'table'   => 'cust_main',
5414         'hashref' => { %options },
5415         'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
5416                        ' ( '.
5417                            join(' OR ', map "$_ LIKE '$phonen\%'",
5418                                             qw( daytime night
5419                                                 ship_daytime ship_night )
5420                                ).
5421                        ' ) '.
5422                        " AND $agentnums_sql", #agent virtualization
5423       } );
5424
5425     }
5426
5427   # custnum search (also try agent_custid), with some tweaking options if your
5428   # legacy cust "numbers" have letters
5429   }
5430
5431   if ( $search =~ /^\s*(\d+)\s*$/
5432          || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
5433               && $search =~ /^\s*(\w\w?\d+)\s*$/
5434             )
5435          || ( $conf->exists('address1-search' )
5436               && $search =~ /^\s*(\d+\-?\w*)\s*$/ #i.e. 1234A or 9432-D
5437             )
5438      )
5439   {
5440
5441     my $num = $1;
5442
5443     if ( $num =~ /^(\d+)$/ && $num <= 2147483647 ) { #need a bigint custnum? wow
5444       push @cust_main, qsearch( {
5445         'table'     => 'cust_main',
5446         'hashref'   => { 'custnum' => $num, %options },
5447         'extra_sql' => " AND $agentnums_sql", #agent virtualization
5448       } );
5449     }
5450
5451     push @cust_main, qsearch( {
5452       'table'     => 'cust_main',
5453       'hashref'   => { 'agent_custid' => $num, %options },
5454       'extra_sql' => " AND $agentnums_sql", #agent virtualization
5455     } );
5456
5457     if ( $conf->exists('address1-search') ) {
5458       my $len = length($num);
5459       $num = lc($num);
5460       foreach my $prefix ( '', 'ship_' ) {
5461         push @cust_main, qsearch( {
5462           'table'     => 'cust_main',
5463           'hashref'   => { %options, },
5464           'extra_sql' =>
5465             ( keys(%options) ? ' AND ' : ' WHERE ' ).
5466             " LOWER(SUBSTRING(${prefix}address1 FROM 1 FOR $len)) = '$num' ".
5467             " AND $agentnums_sql",
5468         } );
5469       }
5470     }
5471
5472   } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
5473
5474     my($company, $last, $first) = ( $1, $2, $3 );
5475
5476     # "Company (Last, First)"
5477     #this is probably something a browser remembered,
5478     #so just do an exact search (but case-insensitive, so USPS standardization
5479     #doesn't throw a wrench in the works)
5480
5481     foreach my $prefix ( '', 'ship_' ) {
5482       push @cust_main, qsearch( {
5483         'table'     => 'cust_main',
5484         'hashref'   => { %options },
5485         'extra_sql' =>
5486           ( keys(%options) ? ' AND ' : ' WHERE ' ).
5487           join(' AND ',
5488             " LOWER(${prefix}first)   = ". dbh->quote(lc($first)),
5489             " LOWER(${prefix}last)    = ". dbh->quote(lc($last)),
5490             " LOWER(${prefix}company) = ". dbh->quote(lc($company)),
5491             $agentnums_sql,
5492           ),
5493       } );
5494     }
5495
5496   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
5497                                               # try (ship_){last,company}
5498
5499     my $value = lc($1);
5500
5501     # # remove "(Last, First)" in "Company (Last, First)", otherwise the
5502     # # full strings the browser remembers won't work
5503     # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
5504
5505     use Lingua::EN::NameParse;
5506     my $NameParse = new Lingua::EN::NameParse(
5507              auto_clean     => 1,
5508              allow_reversed => 1,
5509     );
5510
5511     my($last, $first) = ( '', '' );
5512     #maybe disable this too and just rely on NameParse?
5513     if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
5514
5515       ($last, $first) = ( $1, $2 );
5516
5517     #} elsif  ( $value =~ /^(.+)\s+(.+)$/ ) {
5518     } elsif ( ! $NameParse->parse($value) ) {
5519
5520       my %name = $NameParse->components;
5521       $first = $name{'given_name_1'};
5522       $last  = $name{'surname_1'};
5523
5524     }
5525
5526     if ( $first && $last ) {
5527
5528       my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
5529
5530       #exact
5531       my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
5532       $sql .= "
5533         (     ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
5534            OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
5535         )";
5536
5537       push @cust_main, qsearch( {
5538         'table'     => 'cust_main',
5539         'hashref'   => \%options,
5540         'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
5541       } );
5542
5543       # or it just be something that was typed in... (try that in a sec)
5544
5545     }
5546
5547     my $q_value = dbh->quote($value);
5548
5549     #exact
5550     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
5551     $sql .= " (    LOWER(last)          = $q_value
5552                 OR LOWER(company)       = $q_value
5553                 OR LOWER(ship_last)     = $q_value
5554                 OR LOWER(ship_company)  = $q_value
5555             ";
5556     $sql .= "   OR LOWER(address1)      = $q_value
5557                 OR LOWER(ship_address1) = $q_value
5558             "
5559       if $conf->exists('address1-search');
5560     $sql .= " )";
5561
5562     push @cust_main, qsearch( {
5563       'table'     => 'cust_main',
5564       'hashref'   => \%options,
5565       'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
5566     } );
5567
5568     #no exact match, trying substring/fuzzy
5569     #always do substring & fuzzy (unless they're explicity config'ed off)
5570     #getting complaints searches are not returning enough
5571     unless ( @cust_main  && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
5572
5573       #still some false laziness w/search (was search/cust_main.cgi)
5574
5575       #substring
5576
5577       my @hashrefs = (
5578         { 'company'      => { op=>'ILIKE', value=>"%$value%" }, },
5579         { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
5580       );
5581
5582       if ( $first && $last ) {
5583
5584         push @hashrefs,
5585           { 'first'        => { op=>'ILIKE', value=>"%$first%" },
5586             'last'         => { op=>'ILIKE', value=>"%$last%" },
5587           },
5588           { 'ship_first'   => { op=>'ILIKE', value=>"%$first%" },
5589             'ship_last'    => { op=>'ILIKE', value=>"%$last%" },
5590           },
5591         ;
5592
5593       } else {
5594
5595         push @hashrefs,
5596           { 'last'         => { op=>'ILIKE', value=>"%$value%" }, },
5597           { 'ship_last'    => { op=>'ILIKE', value=>"%$value%" }, },
5598         ;
5599       }
5600
5601       if ( $conf->exists('address1-search') ) {
5602         push @hashrefs,
5603           { 'address1'      => { op=>'ILIKE', value=>"%$value%" }, },
5604           { 'ship_address1' => { op=>'ILIKE', value=>"%$value%" }, },
5605         ;
5606       }
5607
5608       foreach my $hashref ( @hashrefs ) {
5609
5610         push @cust_main, qsearch( {
5611           'table'     => 'cust_main',
5612           'hashref'   => { %$hashref,
5613                            %options,
5614                          },
5615           'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
5616         } );
5617
5618       }
5619
5620       #fuzzy
5621       my @fuzopts = (
5622         \%options,                #hashref
5623         '',                       #select
5624         " AND $agentnums_sql",    #extra_sql  #agent virtualization
5625       );
5626
5627       if ( $first && $last ) {
5628         push @cust_main, FS::cust_main->fuzzy_search(
5629           { 'last'   => $last,    #fuzzy hashref
5630             'first'  => $first }, #
5631           @fuzopts
5632         );
5633       }
5634       foreach my $field ( 'last', 'company' ) {
5635         push @cust_main,
5636           FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
5637       }
5638       if ( $conf->exists('address1-search') ) {
5639         push @cust_main,
5640           FS::cust_main->fuzzy_search( { 'address1' => $value }, @fuzopts );
5641       }
5642
5643     }
5644
5645   }
5646
5647   #eliminate duplicates
5648   my %saw = ();
5649   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
5650
5651   @cust_main;
5652
5653 }
5654
5655 =item email_search
5656
5657 Accepts the following options: I<email>, the email address to search for.  The
5658 email address will be searched for as an email invoice destination and as an
5659 svc_acct account.
5660
5661 #Any additional options are treated as an additional qualifier on the search
5662 #(i.e. I<agentnum>).
5663
5664 Returns a (possibly empty) array of FS::cust_main objects (but usually just
5665 none or one).
5666
5667 =cut
5668
5669 sub email_search {
5670   my %options = @_;
5671
5672   local($DEBUG) = 1;
5673
5674   my $email = delete $options{'email'};
5675
5676   #we're only being used by RT at the moment... no agent virtualization yet
5677   #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
5678
5679   my @cust_main = ();
5680
5681   if ( $email =~ /([^@]+)\@([^@]+)/ ) {
5682
5683     my ( $user, $domain ) = ( $1, $2 );
5684
5685     warn "$me smart_search: searching for $user in domain $domain"
5686       if $DEBUG;
5687
5688     push @cust_main,
5689       map $_->cust_main,
5690           qsearch( {
5691                      'table'     => 'cust_main_invoice',
5692                      'hashref'   => { 'dest' => $email },
5693                    }
5694                  );
5695
5696     push @cust_main,
5697       map  $_->cust_main,
5698       grep $_,
5699       map  $_->cust_svc->cust_pkg,
5700           qsearch( {
5701                      'table'     => 'svc_acct',
5702                      'hashref'   => { 'username' => $user, },
5703                      'extra_sql' =>
5704                        'AND ( SELECT domain FROM svc_domain
5705                                 WHERE svc_acct.domsvc = svc_domain.svcnum
5706                             ) = '. dbh->quote($domain),
5707                    }
5708                  );
5709   }
5710
5711   my %saw = ();
5712   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
5713
5714   warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
5715     if $DEBUG;
5716
5717   @cust_main;
5718
5719 }
5720
5721 =item check_and_rebuild_fuzzyfiles
5722
5723 =cut
5724
5725 sub check_and_rebuild_fuzzyfiles {
5726   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
5727   rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
5728 }
5729
5730 =item rebuild_fuzzyfiles
5731
5732 =cut
5733
5734 sub rebuild_fuzzyfiles {
5735
5736   use Fcntl qw(:flock);
5737
5738   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
5739   mkdir $dir, 0700 unless -d $dir;
5740
5741   foreach my $fuzzy ( @fuzzyfields ) {
5742
5743     open(LOCK,">>$dir/cust_main.$fuzzy")
5744       or die "can't open $dir/cust_main.$fuzzy: $!";
5745     flock(LOCK,LOCK_EX)
5746       or die "can't lock $dir/cust_main.$fuzzy: $!";
5747
5748     open (CACHE,">$dir/cust_main.$fuzzy.tmp")
5749       or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
5750
5751     foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
5752       my $sth = dbh->prepare("SELECT $field FROM cust_main".
5753                              " WHERE $field != '' AND $field IS NOT NULL");
5754       $sth->execute or die $sth->errstr;
5755
5756       while ( my $row = $sth->fetchrow_arrayref ) {
5757         print CACHE $row->[0]. "\n";
5758       }
5759
5760     }
5761
5762     close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
5763
5764     rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
5765     close LOCK;
5766   }
5767
5768 }
5769
5770 =item all_X
5771
5772 =cut
5773
5774 sub all_X {
5775   my( $self, $field ) = @_;
5776   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
5777   open(CACHE,"<$dir/cust_main.$field")
5778     or die "can't open $dir/cust_main.$field: $!";
5779   my @array = map { chomp; $_; } <CACHE>;
5780   close CACHE;
5781   \@array;
5782 }
5783
5784 =item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
5785
5786 =cut
5787
5788 sub append_fuzzyfiles {
5789   #my( $first, $last, $company ) = @_;
5790
5791   &check_and_rebuild_fuzzyfiles;
5792
5793   use Fcntl qw(:flock);
5794
5795   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
5796
5797   foreach my $field (@fuzzyfields) {
5798     my $value = shift;
5799
5800     if ( $value ) {
5801
5802       open(CACHE,">>$dir/cust_main.$field")
5803         or die "can't open $dir/cust_main.$field: $!";
5804       flock(CACHE,LOCK_EX)
5805         or die "can't lock $dir/cust_main.$field: $!";
5806
5807       print CACHE "$value\n";
5808
5809       flock(CACHE,LOCK_UN)
5810         or die "can't unlock $dir/cust_main.$field: $!";
5811       close CACHE;
5812     }
5813
5814   }
5815
5816   1;
5817 }
5818
5819 =item batch_charge
5820
5821 =cut
5822
5823 sub batch_charge {
5824   my $param = shift;
5825   #warn join('-',keys %$param);
5826   my $fh = $param->{filehandle};
5827   my $agentnum = $param->{agentnum};
5828   my $format = $param->{format};
5829
5830   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
5831
5832   my @fields;
5833   if ( $format eq 'simple' ) {
5834     @fields = qw( custnum agent_custid amount pkg );
5835   } else {
5836     die "unknown format $format";
5837   }
5838
5839   eval "use Text::CSV_XS;";
5840   die $@ if $@;
5841
5842   my $csv = new Text::CSV_XS;
5843   #warn $csv;
5844   #warn $fh;
5845
5846   my $imported = 0;
5847   #my $columns;
5848
5849   local $SIG{HUP} = 'IGNORE';
5850   local $SIG{INT} = 'IGNORE';
5851   local $SIG{QUIT} = 'IGNORE';
5852   local $SIG{TERM} = 'IGNORE';
5853   local $SIG{TSTP} = 'IGNORE';
5854   local $SIG{PIPE} = 'IGNORE';
5855
5856   my $oldAutoCommit = $FS::UID::AutoCommit;
5857   local $FS::UID::AutoCommit = 0;
5858   my $dbh = dbh;
5859
5860   #while ( $columns = $csv->getline($fh) ) {
5861   my $line;
5862   while ( defined($line=<$fh>) ) {
5863
5864     $csv->parse($line) or do {
5865       $dbh->rollback if $oldAutoCommit;
5866       return "can't parse: ". $csv->error_input();
5867     };
5868
5869     my @columns = $csv->fields();
5870     #warn join('-',@columns);
5871
5872     my %row = ();
5873     foreach my $field ( @fields ) {
5874       $row{$field} = shift @columns;
5875     }
5876
5877     if ( $row{custnum} && $row{agent_custid} ) {
5878       dbh->rollback if $oldAutoCommit;
5879       return "can't specify custnum with agent_custid $row{agent_custid}";
5880     }
5881
5882     my %hash = ();
5883     if ( $row{agent_custid} && $agentnum ) {
5884       %hash = ( 'agent_custid' => $row{agent_custid},
5885                 'agentnum'     => $agentnum,
5886               );
5887     }
5888
5889     if ( $row{custnum} ) {
5890       %hash = ( 'custnum' => $row{custnum} );
5891     }
5892
5893     unless ( scalar(keys %hash) ) {
5894       $dbh->rollback if $oldAutoCommit;
5895       return "can't find customer without custnum or agent_custid and agentnum";
5896     }
5897
5898     my $cust_main = qsearchs('cust_main', { %hash } );
5899     unless ( $cust_main ) {
5900       $dbh->rollback if $oldAutoCommit;
5901       my $custnum = $row{custnum} || $row{agent_custid};
5902       return "unknown custnum $custnum";
5903     }
5904
5905     if ( $row{'amount'} > 0 ) {
5906       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
5907       if ( $error ) {
5908         $dbh->rollback if $oldAutoCommit;
5909         return $error;
5910       }
5911       $imported++;
5912     } elsif ( $row{'amount'} < 0 ) {
5913       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
5914                                       $row{'pkg'}                         );
5915       if ( $error ) {
5916         $dbh->rollback if $oldAutoCommit;
5917         return $error;
5918       }
5919       $imported++;
5920     } else {
5921       #hmm?
5922     }
5923
5924   }
5925
5926   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5927
5928   return "Empty file!" unless $imported;
5929
5930   ''; #no error
5931
5932 }
5933
5934 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5935
5936 Deprecated.  Use event notification and message templates
5937 (L<FS::msg_template>) instead.
5938
5939 Sends a templated email notification to the customer (see L<Text::Template>).
5940
5941 OPTIONS is a hash and may include
5942
5943 I<from> - the email sender (default is invoice_from)
5944
5945 I<to> - comma-separated scalar or arrayref of recipients
5946    (default is invoicing_list)
5947
5948 I<subject> - The subject line of the sent email notification
5949    (default is "Notice from company_name")
5950
5951 I<extra_fields> - a hashref of name/value pairs which will be substituted
5952    into the template
5953
5954 The following variables are vavailable in the template.
5955
5956 I<$first> - the customer first name
5957 I<$last> - the customer last name
5958 I<$company> - the customer company
5959 I<$payby> - a description of the method of payment for the customer
5960             # would be nice to use FS::payby::shortname
5961 I<$payinfo> - the account information used to collect for this customer
5962 I<$expdate> - the expiration of the customer payment in seconds from epoch
5963
5964 =cut
5965
5966 sub notify {
5967   my ($self, $template, %options) = @_;
5968
5969   return unless $conf->exists($template);
5970
5971   my $from = $conf->config('invoice_from', $self->agentnum)
5972     if $conf->exists('invoice_from', $self->agentnum);
5973   $from = $options{from} if exists($options{from});
5974
5975   my $to = join(',', $self->invoicing_list_emailonly);
5976   $to = $options{to} if exists($options{to});
5977
5978   my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
5979     if $conf->exists('company_name', $self->agentnum);
5980   $subject = $options{subject} if exists($options{subject});
5981
5982   my $notify_template = new Text::Template (TYPE => 'ARRAY',
5983                                             SOURCE => [ map "$_\n",
5984                                               $conf->config($template)]
5985                                            )
5986     or die "can't create new Text::Template object: Text::Template::ERROR";
5987   $notify_template->compile()
5988     or die "can't compile template: Text::Template::ERROR";
5989
5990   $FS::notify_template::_template::company_name =
5991     $conf->config('company_name', $self->agentnum);
5992   $FS::notify_template::_template::company_address =
5993     join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
5994
5995   my $paydate = $self->paydate || '2037-12-31';
5996   $FS::notify_template::_template::first = $self->first;
5997   $FS::notify_template::_template::last = $self->last;
5998   $FS::notify_template::_template::company = $self->company;
5999   $FS::notify_template::_template::payinfo = $self->mask_payinfo;
6000   my $payby = $self->payby;
6001   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
6002   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
6003
6004   #credit cards expire at the end of the month/year of their exp date
6005   if ($payby eq 'CARD' || $payby eq 'DCRD') {
6006     $FS::notify_template::_template::payby = 'credit card';
6007     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
6008     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
6009     $expire_time--;
6010   }elsif ($payby eq 'COMP') {
6011     $FS::notify_template::_template::payby = 'complimentary account';
6012   }else{
6013     $FS::notify_template::_template::payby = 'current method';
6014   }
6015   $FS::notify_template::_template::expdate = $expire_time;
6016
6017   for (keys %{$options{extra_fields}}){
6018     no strict "refs";
6019     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
6020   }
6021
6022   send_email(from => $from,
6023              to => $to,
6024              subject => $subject,
6025              body => $notify_template->fill_in( PACKAGE =>
6026                                                 'FS::notify_template::_template'                                              ),
6027             );
6028
6029 }
6030
6031 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
6032
6033 Generates a templated notification to the customer (see L<Text::Template>).
6034
6035 OPTIONS is a hash and may include
6036
6037 I<extra_fields> - a hashref of name/value pairs which will be substituted
6038    into the template.  These values may override values mentioned below
6039    and those from the customer record.
6040
6041 The following variables are available in the template instead of or in addition
6042 to the fields of the customer record.
6043
6044 I<$payby> - a description of the method of payment for the customer
6045             # would be nice to use FS::payby::shortname
6046 I<$payinfo> - the masked account information used to collect for this customer
6047 I<$expdate> - the expiration of the customer payment method in seconds from epoch
6048 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
6049
6050 =cut
6051
6052 # a lot like cust_bill::print_latex
6053 sub generate_letter {
6054   my ($self, $template, %options) = @_;
6055
6056   return unless $conf->exists($template);
6057
6058   my $letter_template = new Text::Template
6059                         ( TYPE       => 'ARRAY',
6060                           SOURCE     => [ map "$_\n", $conf->config($template)],
6061                           DELIMITERS => [ '[@--', '--@]' ],
6062                         )
6063     or die "can't create new Text::Template object: Text::Template::ERROR";
6064
6065   $letter_template->compile()
6066     or die "can't compile template: Text::Template::ERROR";
6067
6068   my %letter_data = map { $_ => $self->$_ } $self->fields;
6069   $letter_data{payinfo} = $self->mask_payinfo;
6070
6071   #my $paydate = $self->paydate || '2037-12-31';
6072   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
6073
6074   my $payby = $self->payby;
6075   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
6076   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
6077
6078   #credit cards expire at the end of the month/year of their exp date
6079   if ($payby eq 'CARD' || $payby eq 'DCRD') {
6080     $letter_data{payby} = 'credit card';
6081     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
6082     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
6083     $expire_time--;
6084   }elsif ($payby eq 'COMP') {
6085     $letter_data{payby} = 'complimentary account';
6086   }else{
6087     $letter_data{payby} = 'current method';
6088   }
6089   $letter_data{expdate} = $expire_time;
6090
6091   for (keys %{$options{extra_fields}}){
6092     $letter_data{$_} = $options{extra_fields}->{$_};
6093   }
6094
6095   unless(exists($letter_data{returnaddress})){
6096     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
6097                                                   $self->agent_template)
6098                      );
6099     if ( length($retadd) ) {
6100       $letter_data{returnaddress} = $retadd;
6101     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
6102       $letter_data{returnaddress} =
6103         join( "\n", map { s/( {2,})/'~' x length($1)/eg;
6104                           s/$/\\\\\*/;
6105                           $_;
6106                         }
6107                     ( $conf->config('company_name', $self->agentnum),
6108                       $conf->config('company_address', $self->agentnum),
6109                     )
6110         );
6111     } else {
6112       $letter_data{returnaddress} = '~';
6113     }
6114   }
6115
6116   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
6117
6118   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
6119
6120   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
6121
6122   my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
6123                            DIR      => $dir,
6124                            SUFFIX   => '.eps',
6125                            UNLINK   => 0,
6126                          ) or die "can't open temp file: $!\n";
6127   print $lh $conf->config_binary('logo.eps', $self->agentnum)
6128     or die "can't write temp file: $!\n";
6129   close $lh;
6130   $letter_data{'logo_file'} = $lh->filename;
6131
6132   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
6133                            DIR      => $dir,
6134                            SUFFIX   => '.tex',
6135                            UNLINK   => 0,
6136                          ) or die "can't open temp file: $!\n";
6137
6138   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
6139   close $fh;
6140   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
6141   return ($1, $letter_data{'logo_file'});
6142
6143 }
6144
6145 =item print_ps TEMPLATE
6146
6147 Returns an postscript letter filled in from TEMPLATE, as a scalar.
6148
6149 =cut
6150
6151 sub print_ps {
6152   my $self = shift;
6153   my($file, $lfile) = $self->generate_letter(@_);
6154   my $ps = FS::Misc::generate_ps($file);
6155   unlink($file.'.tex');
6156   unlink($lfile);
6157
6158   $ps;
6159 }
6160
6161 =item print TEMPLATE
6162
6163 Prints the filled in template.
6164
6165 TEMPLATE is the name of a L<Text::Template> to fill in and print.
6166
6167 =cut
6168
6169 sub queueable_print {
6170   my %opt = @_;
6171
6172   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
6173     or die "invalid customer number: " . $opt{custvnum};
6174
6175   my $error = $self->print( $opt{template} );
6176   die $error if $error;
6177 }
6178
6179 sub print {
6180   my ($self, $template) = (shift, shift);
6181   do_print [ $self->print_ps($template) ];
6182 }
6183
6184 #these three subs should just go away once agent stuff is all config overrides
6185
6186 sub agent_template {
6187   my $self = shift;
6188   $self->_agent_plandata('agent_templatename');
6189 }
6190
6191 sub agent_invoice_from {
6192   my $self = shift;
6193   $self->_agent_plandata('agent_invoice_from');
6194 }
6195
6196 sub _agent_plandata {
6197   my( $self, $option ) = @_;
6198
6199   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
6200   #agent-specific Conf
6201
6202   use FS::part_event::Condition;
6203
6204   my $agentnum = $self->agentnum;
6205
6206   my $regexp = regexp_sql();
6207
6208   my $part_event_option =
6209     qsearchs({
6210       'select'    => 'part_event_option.*',
6211       'table'     => 'part_event_option',
6212       'addl_from' => q{
6213         LEFT JOIN part_event USING ( eventpart )
6214         LEFT JOIN part_event_option AS peo_agentnum
6215           ON ( part_event.eventpart = peo_agentnum.eventpart
6216                AND peo_agentnum.optionname = 'agentnum'
6217                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
6218              )
6219         LEFT JOIN part_event_condition
6220           ON ( part_event.eventpart = part_event_condition.eventpart
6221                AND part_event_condition.conditionname = 'cust_bill_age'
6222              )
6223         LEFT JOIN part_event_condition_option
6224           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
6225                AND part_event_condition_option.optionname = 'age'
6226              )
6227       },
6228       #'hashref'   => { 'optionname' => $option },
6229       #'hashref'   => { 'part_event_option.optionname' => $option },
6230       'extra_sql' =>
6231         " WHERE part_event_option.optionname = ". dbh->quote($option).
6232         " AND action = 'cust_bill_send_agent' ".
6233         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
6234         " AND peo_agentnum.optionname = 'agentnum' ".
6235         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
6236         " ORDER BY
6237            CASE WHEN part_event_condition_option.optionname IS NULL
6238            THEN -1
6239            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
6240         " END
6241           , part_event.weight".
6242         " LIMIT 1"
6243     });
6244
6245   unless ( $part_event_option ) {
6246     return $self->agent->invoice_template || ''
6247       if $option eq 'agent_templatename';
6248     return '';
6249   }
6250
6251   $part_event_option->optionvalue;
6252
6253 }
6254
6255 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
6256
6257 Subroutine (not a method), designed to be called from the queue.
6258
6259 Takes a list of options and values.
6260
6261 Pulls up the customer record via the custnum option and calls bill_and_collect.
6262
6263 =cut
6264
6265 sub queued_bill {
6266   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
6267
6268   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
6269   warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
6270
6271   $cust_main->bill_and_collect( %args );
6272 }
6273
6274 sub process_bill_and_collect {
6275   my $job = shift;
6276   my $param = thaw(decode_base64(shift));
6277   my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
6278       or die "custnum '$param->{custnum}' not found!\n";
6279   $param->{'job'}   = $job;
6280   $param->{'fatal'} = 1; # runs from job queue, will be caught
6281   $param->{'retry'} = 1;
6282
6283   $cust_main->bill_and_collect( %$param );
6284 }
6285
6286 sub _upgrade_data { #class method
6287   my ($class, %opts) = @_;
6288
6289   my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
6290   my $sth = dbh->prepare($sql) or die dbh->errstr;
6291   $sth->execute or die $sth->errstr;
6292
6293   local($ignore_expired_card) = 1;
6294   local($skip_fuzzyfiles) = 1;
6295   $class->_upgrade_otaker(%opts);
6296
6297 }
6298
6299 =back
6300
6301 =head1 BUGS
6302
6303 The delete method.
6304
6305 The delete method should possibly take an FS::cust_main object reference
6306 instead of a scalar customer number.
6307
6308 Bill and collect options should probably be passed as references instead of a
6309 list.
6310
6311 There should probably be a configuration file with a list of allowed credit
6312 card types.
6313
6314 No multiple currency support (probably a larger project than just this module).
6315
6316 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
6317
6318 Birthdates rely on negative epoch values.
6319
6320 The payby for card/check batches is broken.  With mixed batching, bad
6321 things will happen.
6322
6323 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
6324
6325 =head1 SEE ALSO
6326
6327 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
6328 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
6329 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
6330
6331 =cut
6332
6333 1;
6334