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