FS/FS/cust_main.pm

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