FS/FS/cust_main.pm

   1 package FS::cust_main;
   2
   3 require 5.006;
   4 use strict;
   5 use base qw( FS::otaker_Mixin
   6              FS::payinfo_Mixin
   7              FS::cust_main_Mixin
   8              FS::Record
   9             );
  10 use vars qw( @EXPORT_OK $DEBUG $me $conf
  11              @encrypted_fields
  12              $import $ignore_expired_card
  13              $skip_fuzzyfiles @fuzzyfields
  14              @paytypes
  15            );
  16 use vars qw( $realtime_bop_decline_quiet ); #ugh
  17 use Safe;
  18 use Carp;
  19 use Exporter;
  20 use Scalar::Util qw( blessed );
  21 use List::Util qw( min );
  22 use Time::Local qw(timelocal);
  23 use Storable qw(thaw);
  24 use MIME::Base64;
  25 use Data::Dumper;
  26 use Tie::IxHash;
  27 use Digest::MD5 qw(md5_base64);
  28 use Date::Format;
  29 #use Date::Manip;
  30 use File::Temp qw( tempfile );
  31 use String::Approx qw(amatch);
  32 use Business::CreditCard 0.28;
  33 use Locale::Country;
  34 use FS::UID qw( getotaker dbh driver_name );
  35 use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
  36 use FS::Misc qw( generate_email send_email generate_ps do_print );
  37 use FS::Msgcat qw(gettext);
  38 use FS::CurrentUser;
  39 use FS::payby;
  40 use FS::cust_pkg;
  41 use FS::cust_svc;
  42 use FS::cust_bill;
  43 use FS::cust_bill_pkg;
  44 use FS::cust_bill_pkg_display;
  45 use FS::cust_bill_pkg_tax_location;
  46 use FS::cust_bill_pkg_tax_rate_location;
  47 use FS::cust_pay;
  48 use FS::cust_pay_pending;
  49 use FS::cust_pay_void;
  50 use FS::cust_pay_batch;
  51 use FS::cust_credit;
  52 use FS::cust_refund;
  53 use FS::part_referral;
  54 use FS::cust_main_county;
  55 use FS::cust_location;
  56 use FS::cust_class;
  57 use FS::cust_main_exemption;
  58 use FS::cust_tax_adjustment;
  59 use FS::tax_rate;
  60 use FS::tax_rate_location;
  61 use FS::cust_tax_location;
  62 use FS::part_pkg_taxrate;
  63 use FS::agent;
  64 use FS::cust_main_invoice;
  65 use FS::cust_tag;
  66 use FS::cust_credit_bill;
  67 use FS::cust_bill_pay;
  68 use FS::prepay_credit;
  69 use FS::queue;
  70 use FS::part_pkg;
  71 use FS::part_event;
  72 use FS::part_event_condition;
  73 use FS::part_export;
  74 #use FS::cust_event;
  75 use FS::type_pkgs;
  76 use FS::payment_gateway;
  77 use FS::agent_payment_gateway;
  78 use FS::banned_pay;
  79 use FS::TicketSystem;
  80
  81 @EXPORT_OK = qw( smart_search );
  82
  83 $realtime_bop_decline_quiet = 0;
  84
  85 # 1 is mostly method/subroutine entry and options
  86 # 2 traces progress of some operations
  87 # 3 is even more information including possibly sensitive data
  88 $DEBUG = 0;
  89 $me = '[FS::cust_main]';
  90
  91 $import = 0;
  92 $ignore_expired_card = 0;
  93
  94 $skip_fuzzyfiles = 0;
  95 @fuzzyfields = ( 'first', 'last', 'company', 'address1' );
  96
  97 @encrypted_fields = ('payinfo', 'paycvv');
  98 sub nohistory_fields { ('payinfo', 'paycvv'); }
  99
 100 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
 101
 102 #ask FS::UID to run this stuff for us later
 103 #$FS::UID::callback{'FS::cust_main'} = sub {
 104 install_callback FS::UID sub {
 105   $conf = new FS::Conf;
 106   #yes, need it for stuff below (prolly should be cached)
 107 };
 108
 109 sub _cache {
 110   my $self = shift;
 111   my ( $hashref, $cache ) = @_;
 112   if ( exists $hashref->{'pkgnum'} ) {
 113     #@{ $self->{'_pkgnum'} } = ();
 114     my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
 115     $self->{'_pkgnum'} = $subcache;
 116     #push @{ $self->{'_pkgnum'} },
 117     FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
 118   }
 119 }
 120
 121 =head1 NAME
 122
 123 FS::cust_main - Object methods for cust_main records
 124
 125 =head1 SYNOPSIS
 126
 127   use FS::cust_main;
 128
 129   $record = new FS::cust_main \%hash;
 130   $record = new FS::cust_main { 'column' => 'value' };
 131
 132   $error = $record->insert;
 133
 134   $error = $new_record->replace($old_record);
 135
 136   $error = $record->delete;
 137
 138   $error = $record->check;
 139
 140   @cust_pkg = $record->all_pkgs;
 141
 142   @cust_pkg = $record->ncancelled_pkgs;
 143
 144   @cust_pkg = $record->suspended_pkgs;
 145
 146   $error = $record->bill;
 147   $error = $record->bill %options;
 148   $error = $record->bill 'time' => $time;
 149
 150   $error = $record->collect;
 151   $error = $record->collect %options;
 152   $error = $record->collect 'invoice_time'   => $time,
 153                           ;
 154
 155 =head1 DESCRIPTION
 156
 157 An FS::cust_main object represents a customer.  FS::cust_main inherits from
 158 FS::Record.  The following fields are currently supported:
 159
 160 =over 4
 161
 162 =item custnum
 163
 164 Primary key (assigned automatically for new customers)
 165
 166 =item agentnum
 167
 168 Agent (see L<FS::agent>)
 169
 170 =item refnum
 171
 172 Advertising source (see L<FS::part_referral>)
 173
 174 =item first
 175
 176 First name
 177
 178 =item last
 179
 180 Last name
 181
 182 =item ss
 183
 184 Cocial security number (optional)
 185
 186 =item company
 187
 188 (optional)
 189
 190 =item address1
 191
 192 =item address2
 193
 194 (optional)
 195
 196 =item city
 197
 198 =item county
 199
 200 (optional, see L<FS::cust_main_county>)
 201
 202 =item state
 203
 204 (see L<FS::cust_main_county>)
 205
 206 =item zip
 207
 208 =item country
 209
 210 (see L<FS::cust_main_county>)
 211
 212 =item daytime
 213
 214 phone (optional)
 215
 216 =item night
 217
 218 phone (optional)
 219
 220 =item fax
 221
 222 phone (optional)
 223
 224 =item ship_first
 225
 226 Shipping first name
 227
 228 =item ship_last
 229
 230 Shipping last name
 231
 232 =item ship_company
 233
 234 (optional)
 235
 236 =item ship_address1
 237
 238 =item ship_address2
 239
 240 (optional)
 241
 242 =item ship_city
 243
 244 =item ship_county
 245
 246 (optional, see L<FS::cust_main_county>)
 247
 248 =item ship_state
 249
 250 (see L<FS::cust_main_county>)
 251
 252 =item ship_zip
 253
 254 =item ship_country
 255
 256 (see L<FS::cust_main_county>)
 257
 258 =item ship_daytime
 259
 260 phone (optional)
 261
 262 =item ship_night
 263
 264 phone (optional)
 265
 266 =item ship_fax
 267
 268 phone (optional)
 269
 270 =item payby
 271
 272 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
 273
 274 =item payinfo
 275
 276 Payment Information (See L<FS::payinfo_Mixin> for data format)
 277
 278 =item paymask
 279
 280 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
 281
 282 =item paycvv
 283
 284 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
 285
 286 =item paydate
 287
 288 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
 289
 290 =item paystart_month
 291
 292 Start date month (maestro/solo cards only)
 293
 294 =item paystart_year
 295
 296 Start date year (maestro/solo cards only)
 297
 298 =item payissue
 299
 300 Issue number (maestro/solo cards only)
 301
 302 =item payname
 303
 304 Name on card or billing name
 305
 306 =item payip
 307
 308 IP address from which payment information was received
 309
 310 =item tax
 311
 312 Tax exempt, empty or `Y'
 313
 314 =item usernum
 315
 316 Order taker (see L<FS::access_user>)
 317
 318 =item comments
 319
 320 Comments (optional)
 321
 322 =item referral_custnum
 323
 324 Referring customer number
 325
 326 =item spool_cdr
 327
 328 Enable individual CDR spooling, empty or `Y'
 329
 330 =item dundate
 331
 332 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
 333
 334 =item squelch_cdr
 335
 336 Discourage individual CDR printing, empty or `Y'
 337
 338 =back
 339
 340 =head1 METHODS
 341
 342 =over 4
 343
 344 =item new HASHREF
 345
 346 Creates a new customer.  To add the customer to the database, see L<"insert">.
 347
 348 Note that this stores the hash reference, not a distinct copy of the hash it
 349 points to.  You can ask the object for a copy with the I<hash> method.
 350
 351 =cut
 352
 353 sub table { 'cust_main'; }
 354
 355 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
 356
 357 Adds this customer to the database.  If there is an error, returns the error,
 358 otherwise returns false.
 359
 360 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
 361 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
 362 are inserted atomicly, or the transaction is rolled back.  Passing an empty
 363 hash reference is equivalent to not supplying this parameter.  There should be
 364 a better explanation of this, but until then, here's an example:
 365
 366   use Tie::RefHash;
 367   tie %hash, 'Tie::RefHash'; #this part is important
 368   %hash = (
 369     $cust_pkg => [ $svc_acct ],
 370     ...
 371   );
 372   $cust_main->insert( \%hash );
 373
 374 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 375 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 376 expected and rollback the entire transaction; it is not necessary to call
 377 check_invoicing_list first.  The invoicing_list is set after the records in the
 378 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
 379 invoicing_list destination to the newly-created svc_acct.  Here's an example:
 380
 381   $cust_main->insert( {}, [ $email, 'POST' ] );
 382
 383 Currently available options are: I<depend_jobnum>, I<noexport> and I<tax_exemption>.
 384
 385 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 386 on the supplied jobnum (they will not run until the specific job completes).
 387 This can be used to defer provisioning until some action completes (such
 388 as running the customer's credit card successfully).
 389
 390 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 391 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 392 the B<reexport> method.)
 393
 394 The I<tax_exemption> option can be set to an arrayref of tax names.
 395 FS::cust_main_exemption records will be created and inserted.
 396
 397 =cut
 398
 399 sub insert {
 400   my $self = shift;
 401   my $cust_pkgs = @_ ? shift : {};
 402   my $invoicing_list = @_ ? shift : '';
 403   my %options = @_;
 404   warn "$me insert called with options ".
 405        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 406     if $DEBUG;
 407
 408   local $SIG{HUP} = 'IGNORE';
 409   local $SIG{INT} = 'IGNORE';
 410   local $SIG{QUIT} = 'IGNORE';
 411   local $SIG{TERM} = 'IGNORE';
 412   local $SIG{TSTP} = 'IGNORE';
 413   local $SIG{PIPE} = 'IGNORE';
 414
 415   my $oldAutoCommit = $FS::UID::AutoCommit;
 416   local $FS::UID::AutoCommit = 0;
 417   my $dbh = dbh;
 418
 419   my $prepay_identifier = '';
 420   my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
 421   my $payby = '';
 422   if ( $self->payby eq 'PREPAY' ) {
 423
 424     $self->payby('BILL');
 425     $prepay_identifier = $self->payinfo;
 426     $self->payinfo('');
 427
 428     warn "  looking up prepaid card $prepay_identifier\n"
 429       if $DEBUG > 1;
 430
 431     my $error = $self->get_prepay( $prepay_identifier,
 432                                    'amount_ref'     => \$amount,
 433                                    'seconds_ref'    => \$seconds,
 434                                    'upbytes_ref'    => \$upbytes,
 435                                    'downbytes_ref'  => \$downbytes,
 436                                    'totalbytes_ref' => \$totalbytes,
 437                                  );
 438     if ( $error ) {
 439       $dbh->rollback if $oldAutoCommit;
 440       #return "error applying prepaid card (transaction rolled back): $error";
 441       return $error;
 442     }
 443
 444     $payby = 'PREP' if $amount;
 445
 446   } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
 447
 448     $payby = $1;
 449     $self->payby('BILL');
 450     $amount = $self->paid;
 451
 452   }
 453
 454   warn "  inserting $self\n"
 455     if $DEBUG > 1;
 456
 457   $self->signupdate(time) unless $self->signupdate;
 458
 459   $self->auto_agent_custid()
 460     if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
 461
 462   my $error = $self->SUPER::insert;
 463   if ( $error ) {
 464     $dbh->rollback if $oldAutoCommit;
 465     #return "inserting cust_main record (transaction rolled back): $error";
 466     return $error;
 467   }
 468
 469   warn "  setting invoicing list\n"
 470     if $DEBUG > 1;
 471
 472   if ( $invoicing_list ) {
 473     $error = $self->check_invoicing_list( $invoicing_list );
 474     if ( $error ) {
 475       $dbh->rollback if $oldAutoCommit;
 476       #return "checking invoicing_list (transaction rolled back): $error";
 477       return $error;
 478     }
 479     $self->invoicing_list( $invoicing_list );
 480   }
 481
 482   warn "  setting customer tags\n"
 483     if $DEBUG > 1;
 484
 485   foreach my $tagnum ( @{ $self->tagnum || [] } ) {
 486     my $cust_tag = new FS::cust_tag { 'tagnum'  => $tagnum,
 487                                       'custnum' => $self->custnum };
 488     my $error = $cust_tag->insert;
 489     if ( $error ) {
 490       $dbh->rollback if $oldAutoCommit;
 491       return $error;
 492     }
 493   }
 494
 495   if ( $invoicing_list ) {
 496     $error = $self->check_invoicing_list( $invoicing_list );
 497     if ( $error ) {
 498       $dbh->rollback if $oldAutoCommit;
 499       #return "checking invoicing_list (transaction rolled back): $error";
 500       return $error;
 501     }
 502     $self->invoicing_list( $invoicing_list );
 503   }
 504
 505
 506   warn "  setting cust_main_exemption\n"
 507     if $DEBUG > 1;
 508
 509   my $tax_exemption = delete $options{'tax_exemption'};
 510   if ( $tax_exemption ) {
 511     foreach my $taxname ( @$tax_exemption ) {
 512       my $cust_main_exemption = new FS::cust_main_exemption {
 513         'custnum' => $self->custnum,
 514         'taxname' => $taxname,
 515       };
 516       my $error = $cust_main_exemption->insert;
 517       if ( $error ) {
 518         $dbh->rollback if $oldAutoCommit;
 519         return "inserting cust_main_exemption (transaction rolled back): $error";
 520       }
 521     }
 522   }
 523
 524   if (    $conf->config('cust_main-skeleton_tables')
 525        && $conf->config('cust_main-skeleton_custnum') ) {
 526
 527     warn "  inserting skeleton records\n"
 528       if $DEBUG > 1;
 529
 530     my $error = $self->start_copy_skel;
 531     if ( $error ) {
 532       $dbh->rollback if $oldAutoCommit;
 533       return $error;
 534     }
 535
 536   }
 537
 538   warn "  ordering packages\n"
 539     if $DEBUG > 1;
 540
 541   $error = $self->order_pkgs( $cust_pkgs,
 542                               %options,
 543                               'seconds_ref'    => \$seconds,
 544                               'upbytes_ref'    => \$upbytes,
 545                               'downbytes_ref'  => \$downbytes,
 546                               'totalbytes_ref' => \$totalbytes,
 547                             );
 548   if ( $error ) {
 549     $dbh->rollback if $oldAutoCommit;
 550     return $error;
 551   }
 552
 553   if ( $seconds ) {
 554     $dbh->rollback if $oldAutoCommit;
 555     return "No svc_acct record to apply pre-paid time";
 556   }
 557   if ( $upbytes || $downbytes || $totalbytes ) {
 558     $dbh->rollback if $oldAutoCommit;
 559     return "No svc_acct record to apply pre-paid data";
 560   }
 561
 562   if ( $amount ) {
 563     warn "  inserting initial $payby payment of $amount\n"
 564       if $DEBUG > 1;
 565     $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
 566     if ( $error ) {
 567       $dbh->rollback if $oldAutoCommit;
 568       return "inserting payment (transaction rolled back): $error";
 569     }
 570   }
 571
 572   unless ( $import || $skip_fuzzyfiles ) {
 573     warn "  queueing fuzzyfiles update\n"
 574       if $DEBUG > 1;
 575     $error = $self->queue_fuzzyfiles_update;
 576     if ( $error ) {
 577       $dbh->rollback if $oldAutoCommit;
 578       return "updating fuzzy search cache: $error";
 579     }
 580   }
 581
 582   # cust_main exports!
 583   warn "  exporting\n" if $DEBUG > 1;
 584
 585   my $export_args = $options{'export_args'} || [];
 586
 587   my @part_export =
 588     map qsearch( 'part_export', {exportnum=>$_} ),
 589       $conf->config('cust_main-exports'); #, $agentnum
 590
 591   foreach my $part_export ( @part_export ) {
 592     my $error = $part_export->export_insert($self, @$export_args);
 593     if ( $error ) {
 594       $dbh->rollback if $oldAutoCommit;
 595       return "exporting to ". $part_export->exporttype.
 596              " (transaction rolled back): $error";
 597     }
 598   }
 599
 600   #foreach my $depend_jobnum ( @$depend_jobnums ) {
 601   #    warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
 602   #      if $DEBUG;
 603   #    foreach my $jobnum ( @jobnums ) {
 604   #      my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
 605   #      warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
 606   #        if $DEBUG;
 607   #      my $error = $queue->depend_insert($depend_jobnum);
 608   #      if ( $error ) {
 609   #        $dbh->rollback if $oldAutoCommit;
 610   #        return "error queuing job dependancy: $error";
 611   #      }
 612   #    }
 613   #  }
 614   #
 615   #}
 616   #
 617   #if ( exists $options{'jobnums'} ) {
 618   #  push @{ $options{'jobnums'} }, @jobnums;
 619   #}
 620
 621   warn "  insert complete; committing transaction\n"
 622     if $DEBUG > 1;
 623
 624   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 625   '';
 626
 627 }
 628
 629 use File::CounterFile;
 630 sub auto_agent_custid {
 631   my $self = shift;
 632
 633   my $format = $conf->config('cust_main-auto_agent_custid');
 634   my $agent_custid;
 635   if ( $format eq '1YMMXXXXXXXX' ) {
 636
 637     my $counter = new File::CounterFile 'cust_main.agent_custid';
 638     $counter->lock;
 639
 640     my $ym = 100000000000 + time2str('%y%m00000000', time);
 641     if ( $ym > $counter->value ) {
 642       $counter->{'value'} = $agent_custid = $ym;
 643       $counter->{'updated'} = 1;
 644     } else {
 645       $agent_custid = $counter->inc;
 646     }
 647
 648     $counter->unlock;
 649
 650   } else {
 651     die "Unknown cust_main-auto_agent_custid format: $format";
 652   }
 653
 654   $self->agent_custid($agent_custid);
 655
 656 }
 657
 658 sub start_copy_skel {
 659   my $self = shift;
 660
 661   #'mg_user_preference' => {},
 662   #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
 663   #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
 664   #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
 665   #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
 666   my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
 667   die $@ if $@;
 668
 669   _copy_skel( 'cust_main',                                 #tablename
 670               $conf->config('cust_main-skeleton_custnum'), #sourceid
 671               $self->custnum,                              #destid
 672               @tables,                                     #child tables
 673             );
 674 }
 675
 676 #recursive subroutine, not a method
 677 sub _copy_skel {
 678   my( $table, $sourceid, $destid, %child_tables ) = @_;
 679
 680   my $primary_key;
 681   if ( $table =~ /^(\w+)\.(\w+)$/ ) {
 682     ( $table, $primary_key ) = ( $1, $2 );
 683   } else {
 684     my $dbdef_table = dbdef->table($table);
 685     $primary_key = $dbdef_table->primary_key
 686       or return "$table has no primary key".
 687                 " (or do you need to run dbdef-create?)";
 688   }
 689
 690   warn "  _copy_skel: $table.$primary_key $sourceid to $destid for ".
 691        join (', ', keys %child_tables). "\n"
 692     if $DEBUG > 2;
 693
 694   foreach my $child_table_def ( keys %child_tables ) {
 695
 696     my $child_table;
 697     my $child_pkey = '';
 698     if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
 699       ( $child_table, $child_pkey ) = ( $1, $2 );
 700     } else {
 701       $child_table = $child_table_def;
 702
 703       $child_pkey = dbdef->table($child_table)->primary_key;
 704       #  or return "$table has no primary key".
 705       #            " (or do you need to run dbdef-create?)\n";
 706     }
 707
 708     my $sequence = '';
 709     if ( keys %{ $child_tables{$child_table_def} } ) {
 710
 711       return "$child_table has no primary key".
 712              " (run dbdef-create or try specifying it?)\n"
 713         unless $child_pkey;
 714
 715       #false laziness w/Record::insert and only works on Pg
 716       #refactor the proper last-inserted-id stuff out of Record::insert if this
 717       # ever gets use for anything besides a quick kludge for one customer
 718       my $default = dbdef->table($child_table)->column($child_pkey)->default;
 719       $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
 720         or return "can't parse $child_table.$child_pkey default value ".
 721                   " for sequence name: $default";
 722       $sequence = $1;
 723
 724     }
 725
 726     my @sel_columns = grep { $_ ne $primary_key }
 727                            dbdef->table($child_table)->columns;
 728     my $sel_columns = join(', ', @sel_columns );
 729
 730     my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
 731     my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
 732     my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
 733
 734     my $sel_st = "SELECT $sel_columns FROM $child_table".
 735                  " WHERE $primary_key = $sourceid";
 736     warn "    $sel_st\n"
 737       if $DEBUG > 2;
 738     my $sel_sth = dbh->prepare( $sel_st )
 739       or return dbh->errstr;
 740
 741     $sel_sth->execute or return $sel_sth->errstr;
 742
 743     while ( my $row = $sel_sth->fetchrow_hashref ) {
 744
 745       warn "    selected row: ".
 746            join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
 747         if $DEBUG > 2;
 748
 749       my $statement =
 750         "INSERT INTO $child_table $ins_columns VALUES $placeholders";
 751       my $ins_sth =dbh->prepare($statement)
 752           or return dbh->errstr;
 753       my @param = ( $destid, map $row->{$_}, @ins_columns );
 754       warn "    $statement: [ ". join(', ', @param). " ]\n"
 755         if $DEBUG > 2;
 756       $ins_sth->execute( @param )
 757         or return $ins_sth->errstr;
 758
 759       #next unless keys %{ $child_tables{$child_table} };
 760       next unless $sequence;
 761
 762       #another section of that laziness
 763       my $seq_sql = "SELECT currval('$sequence')";
 764       my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
 765       $seq_sth->execute or return $seq_sth->errstr;
 766       my $insertid = $seq_sth->fetchrow_arrayref->[0];
 767
 768       # don't drink soap!  recurse!  recurse!  okay!
 769       my $error =
 770         _copy_skel( $child_table_def,
 771                     $row->{$child_pkey}, #sourceid
 772                     $insertid, #destid
 773                     %{ $child_tables{$child_table_def} },
 774                   );
 775       return $error if $error;
 776
 777     }
 778
 779   }
 780
 781   return '';
 782
 783 }
 784
 785 =item order_pkg HASHREF | OPTION => VALUE ...
 786
 787 Orders a single package.
 788
 789 Options may be passed as a list of key/value pairs or as a hash reference.
 790 Options are:
 791
 792 =over 4
 793
 794 =item cust_pkg
 795
 796 FS::cust_pkg object
 797
 798 =item cust_location
 799
 800 Optional FS::cust_location object
 801
 802 =item svcs
 803
 804 Optional arryaref of FS::svc_* service objects.
 805
 806 =item depend_jobnum
 807
 808 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
 809 jobs will have a dependancy on the supplied job (they will not run until the
 810 specific job completes).  This can be used to defer provisioning until some
 811 action completes (such as running the customer's credit card successfully).
 812
 813 =item ticket_subject
 814
 815 Optional subject for a ticket created and attached to this customer
 816
 817 =item ticket_subject
 818
 819 Optional queue name for ticket additions
 820
 821 =back
 822
 823 =cut
 824
 825 sub order_pkg {
 826   my $self = shift;
 827   my $opt = ref($_[0]) ? shift : { @_ };
 828
 829   warn "$me order_pkg called with options ".
 830        join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
 831     if $DEBUG;
 832
 833   my $cust_pkg = $opt->{'cust_pkg'};
 834   my $svcs     = $opt->{'svcs'} || [];
 835
 836   my %svc_options = ();
 837   $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
 838     if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
 839
 840   my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
 841                           qw( ticket_subject ticket_queue );
 842
 843   local $SIG{HUP} = 'IGNORE';
 844   local $SIG{INT} = 'IGNORE';
 845   local $SIG{QUIT} = 'IGNORE';
 846   local $SIG{TERM} = 'IGNORE';
 847   local $SIG{TSTP} = 'IGNORE';
 848   local $SIG{PIPE} = 'IGNORE';
 849
 850   my $oldAutoCommit = $FS::UID::AutoCommit;
 851   local $FS::UID::AutoCommit = 0;
 852   my $dbh = dbh;
 853
 854   if ( $opt->{'cust_location'} &&
 855        ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
 856     my $error = $opt->{'cust_location'}->insert;
 857     if ( $error ) {
 858       $dbh->rollback if $oldAutoCommit;
 859       return "inserting cust_location (transaction rolled back): $error";
 860     }
 861     $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
 862   }
 863
 864   $cust_pkg->custnum( $self->custnum );
 865
 866   my $error = $cust_pkg->insert( %insert_params );
 867   if ( $error ) {
 868     $dbh->rollback if $oldAutoCommit;
 869     return "inserting cust_pkg (transaction rolled back): $error";
 870   }
 871
 872   foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
 873     if ( $svc_something->svcnum ) {
 874       my $old_cust_svc = $svc_something->cust_svc;
 875       my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
 876       $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
 877       $error = $new_cust_svc->replace($old_cust_svc);
 878     } else {
 879       $svc_something->pkgnum( $cust_pkg->pkgnum );
 880       if ( $svc_something->isa('FS::svc_acct') ) {
 881         foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
 882                        qw( seconds upbytes downbytes totalbytes )      ) {
 883           $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
 884           ${ $opt->{$_.'_ref'} } = 0;
 885         }
 886       }
 887       $error = $svc_something->insert(%svc_options);
 888     }
 889     if ( $error ) {
 890       $dbh->rollback if $oldAutoCommit;
 891       return "inserting svc_ (transaction rolled back): $error";
 892     }
 893   }
 894
 895   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 896   ''; #no error
 897
 898 }
 899
 900 #deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ]
 901 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
 902
 903 Like the insert method on an existing record, this method orders multiple
 904 packages and included services atomicaly.  Pass a Tie::RefHash data structure
 905 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
 906 There should be a better explanation of this, but until then, here's an
 907 example:
 908
 909   use Tie::RefHash;
 910   tie %hash, 'Tie::RefHash'; #this part is important
 911   %hash = (
 912     $cust_pkg => [ $svc_acct ],
 913     ...
 914   );
 915   $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
 916
 917 Services can be new, in which case they are inserted, or existing unaudited
 918 services, in which case they are linked to the newly-created package.
 919
 920 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
 921 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
 922
 923 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 924 on the supplied jobnum (they will not run until the specific job completes).
 925 This can be used to defer provisioning until some action completes (such
 926 as running the customer's credit card successfully).
 927
 928 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 929 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 930 the B<reexport> method for each cust_pkg object.  Using the B<reexport> method
 931 on the cust_main object is not recommended, as existing services will also be
 932 reexported.)
 933
 934 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
 935 provided, the scalars (provided by references) will be incremented by the
 936 values of the prepaid card.`
 937
 938 =cut
 939
 940 sub order_pkgs {
 941   my $self = shift;
 942   my $cust_pkgs = shift;
 943   my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated
 944   my %options = @_;
 945   $seconds_ref ||= $options{'seconds_ref'};
 946
 947   warn "$me order_pkgs called with options ".
 948        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 949     if $DEBUG;
 950
 951   local $SIG{HUP} = 'IGNORE';
 952   local $SIG{INT} = 'IGNORE';
 953   local $SIG{QUIT} = 'IGNORE';
 954   local $SIG{TERM} = 'IGNORE';
 955   local $SIG{TSTP} = 'IGNORE';
 956   local $SIG{PIPE} = 'IGNORE';
 957
 958   my $oldAutoCommit = $FS::UID::AutoCommit;
 959   local $FS::UID::AutoCommit = 0;
 960   my $dbh = dbh;
 961
 962   local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
 963
 964   foreach my $cust_pkg ( keys %$cust_pkgs ) {
 965
 966     my $error = $self->order_pkg(
 967       'cust_pkg'     => $cust_pkg,
 968       'svcs'         => $cust_pkgs->{$cust_pkg},
 969       'seconds_ref'  => $seconds_ref,
 970       map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref
 971                                      depend_jobnum
 972                                    )
 973     );
 974     if ( $error ) {
 975       $dbh->rollback if $oldAutoCommit;
 976       return $error;
 977     }
 978
 979   }
 980
 981   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 982   ''; #no error
 983 }
 984
 985 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
 986
 987 Recharges this (existing) customer with the specified prepaid card (see
 988 L<FS::prepay_credit>), specified either by I<identifier> or as an
 989 FS::prepay_credit object.  If there is an error, returns the error, otherwise
 990 returns false.
 991
 992 Optionally, five scalar references can be passed as well.  They will have their
 993 values filled in with the amount, number of seconds, and number of upload,
 994 download, and total bytes applied by this prepaid card.
 995
 996 =cut
 997
 998 #the ref bullshit here should be refactored like get_prepay.  MyAccount.pm is
 999 #the only place that uses these args
1000 sub recharge_prepay {
1001   my( $self, $prepay_credit, $amountref, $secondsref,
1002       $upbytesref, $downbytesref, $totalbytesref ) = @_;
1003
1004   local $SIG{HUP} = 'IGNORE';
1005   local $SIG{INT} = 'IGNORE';
1006   local $SIG{QUIT} = 'IGNORE';
1007   local $SIG{TERM} = 'IGNORE';
1008   local $SIG{TSTP} = 'IGNORE';
1009   local $SIG{PIPE} = 'IGNORE';
1010
1011   my $oldAutoCommit = $FS::UID::AutoCommit;
1012   local $FS::UID::AutoCommit = 0;
1013   my $dbh = dbh;
1014
1015   my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
1016
1017   my $error = $self->get_prepay( $prepay_credit,
1018                                  'amount_ref'     => \$amount,
1019                                  'seconds_ref'    => \$seconds,
1020                                  'upbytes_ref'    => \$upbytes,
1021                                  'downbytes_ref'  => \$downbytes,
1022                                  'totalbytes_ref' => \$totalbytes,
1023                                )
1024            || $self->increment_seconds($seconds)
1025            || $self->increment_upbytes($upbytes)
1026            || $self->increment_downbytes($downbytes)
1027            || $self->increment_totalbytes($totalbytes)
1028            || $self->insert_cust_pay_prepay( $amount,
1029                                              ref($prepay_credit)
1030                                                ? $prepay_credit->identifier
1031                                                : $prepay_credit
1032                                            );
1033
1034   if ( $error ) {
1035     $dbh->rollback if $oldAutoCommit;
1036     return $error;
1037   }
1038
1039   if ( defined($amountref)  ) { $$amountref  = $amount;  }
1040   if ( defined($secondsref) ) { $$secondsref = $seconds; }
1041   if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
1042   if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
1043   if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
1044
1045   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1046   '';
1047
1048 }
1049
1050 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
1051
1052 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
1053 specified either by I<identifier> or as an FS::prepay_credit object.
1054
1055 Available options are: I<amount_ref>, I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.  The scalars (provided by references) will be
1056 incremented by the values of the prepaid card.
1057
1058 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
1059 check or set this customer's I<agentnum>.
1060
1061 If there is an error, returns the error, otherwise returns false.
1062
1063 =cut
1064
1065
1066 sub get_prepay {
1067   my( $self, $prepay_credit, %opt ) = @_;
1068
1069   local $SIG{HUP} = 'IGNORE';
1070   local $SIG{INT} = 'IGNORE';
1071   local $SIG{QUIT} = 'IGNORE';
1072   local $SIG{TERM} = 'IGNORE';
1073   local $SIG{TSTP} = 'IGNORE';
1074   local $SIG{PIPE} = 'IGNORE';
1075
1076   my $oldAutoCommit = $FS::UID::AutoCommit;
1077   local $FS::UID::AutoCommit = 0;
1078   my $dbh = dbh;
1079
1080   unless ( ref($prepay_credit) ) {
1081
1082     my $identifier = $prepay_credit;
1083
1084     $prepay_credit = qsearchs(
1085       'prepay_credit',
1086       { 'identifier' => $prepay_credit },
1087       '',
1088       'FOR UPDATE'
1089     );
1090
1091     unless ( $prepay_credit ) {
1092       $dbh->rollback if $oldAutoCommit;
1093       return "Invalid prepaid card: ". $identifier;
1094     }
1095
1096   }
1097
1098   if ( $prepay_credit->agentnum ) {
1099     if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
1100       $dbh->rollback if $oldAutoCommit;
1101       return "prepaid card not valid for agent ". $self->agentnum;
1102     }
1103     $self->agentnum($prepay_credit->agentnum);
1104   }
1105
1106   my $error = $prepay_credit->delete;
1107   if ( $error ) {
1108     $dbh->rollback if $oldAutoCommit;
1109     return "removing prepay_credit (transaction rolled back): $error";
1110   }
1111
1112   ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
1113     for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
1114
1115   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1116   '';
1117
1118 }
1119
1120 =item increment_upbytes SECONDS
1121
1122 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1123 the specified number of upbytes.  If there is an error, returns the error,
1124 otherwise returns false.
1125
1126 =cut
1127
1128 sub increment_upbytes {
1129   _increment_column( shift, 'upbytes', @_);
1130 }
1131
1132 =item increment_downbytes SECONDS
1133
1134 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1135 the specified number of downbytes.  If there is an error, returns the error,
1136 otherwise returns false.
1137
1138 =cut
1139
1140 sub increment_downbytes {
1141   _increment_column( shift, 'downbytes', @_);
1142 }
1143
1144 =item increment_totalbytes SECONDS
1145
1146 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1147 the specified number of totalbytes.  If there is an error, returns the error,
1148 otherwise returns false.
1149
1150 =cut
1151
1152 sub increment_totalbytes {
1153   _increment_column( shift, 'totalbytes', @_);
1154 }
1155
1156 =item increment_seconds SECONDS
1157
1158 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1159 the specified number of seconds.  If there is an error, returns the error,
1160 otherwise returns false.
1161
1162 =cut
1163
1164 sub increment_seconds {
1165   _increment_column( shift, 'seconds', @_);
1166 }
1167
1168 =item _increment_column AMOUNT
1169
1170 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1171 the specified number of seconds or bytes.  If there is an error, returns
1172 the error, otherwise returns false.
1173
1174 =cut
1175
1176 sub _increment_column {
1177   my( $self, $column, $amount ) = @_;
1178   warn "$me increment_column called: $column, $amount\n"
1179     if $DEBUG;
1180
1181   return '' unless $amount;
1182
1183   my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
1184                       $self->ncancelled_pkgs;
1185
1186   if ( ! @cust_pkg ) {
1187     return 'No packages with primary or single services found'.
1188            ' to apply pre-paid time';
1189   } elsif ( scalar(@cust_pkg) > 1 ) {
1190     #maybe have a way to specify the package/account?
1191     return 'Multiple packages found to apply pre-paid time';
1192   }
1193
1194   my $cust_pkg = $cust_pkg[0];
1195   warn "  found package pkgnum ". $cust_pkg->pkgnum. "\n"
1196     if $DEBUG > 1;
1197
1198   my @cust_svc =
1199     $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1200
1201   if ( ! @cust_svc ) {
1202     return 'No account found to apply pre-paid time';
1203   } elsif ( scalar(@cust_svc) > 1 ) {
1204     return 'Multiple accounts found to apply pre-paid time';
1205   }
1206
1207   my $svc_acct = $cust_svc[0]->svc_x;
1208   warn "  found service svcnum ". $svc_acct->pkgnum.
1209        ' ('. $svc_acct->email. ")\n"
1210     if $DEBUG > 1;
1211
1212   $column = "increment_$column";
1213   $svc_acct->$column($amount);
1214
1215 }
1216
1217 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1218
1219 Inserts a prepayment in the specified amount for this customer.  An optional
1220 second argument can specify the prepayment identifier for tracking purposes.
1221 If there is an error, returns the error, otherwise returns false.
1222
1223 =cut
1224
1225 sub insert_cust_pay_prepay {
1226   shift->insert_cust_pay('PREP', @_);
1227 }
1228
1229 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1230
1231 Inserts a cash payment in the specified amount for this customer.  An optional
1232 second argument can specify the payment identifier for tracking purposes.
1233 If there is an error, returns the error, otherwise returns false.
1234
1235 =cut
1236
1237 sub insert_cust_pay_cash {
1238   shift->insert_cust_pay('CASH', @_);
1239 }
1240
1241 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1242
1243 Inserts a Western Union payment in the specified amount for this customer.  An
1244 optional second argument can specify the prepayment identifier for tracking
1245 purposes.  If there is an error, returns the error, otherwise returns false.
1246
1247 =cut
1248
1249 sub insert_cust_pay_west {
1250   shift->insert_cust_pay('WEST', @_);
1251 }
1252
1253 sub insert_cust_pay {
1254   my( $self, $payby, $amount ) = splice(@_, 0, 3);
1255   my $payinfo = scalar(@_) ? shift : '';
1256
1257   my $cust_pay = new FS::cust_pay {
1258     'custnum' => $self->custnum,
1259     'paid'    => sprintf('%.2f', $amount),
1260     #'_date'   => #date the prepaid card was purchased???
1261     'payby'   => $payby,
1262     'payinfo' => $payinfo,
1263   };
1264   $cust_pay->insert;
1265
1266 }
1267
1268 =item reexport
1269
1270 This method is deprecated.  See the I<depend_jobnum> option to the insert and
1271 order_pkgs methods for a better way to defer provisioning.
1272
1273 Re-schedules all exports by calling the B<reexport> method of all associated
1274 packages (see L<FS::cust_pkg>).  If there is an error, returns the error;
1275 otherwise returns false.
1276
1277 =cut
1278
1279 sub reexport {
1280   my $self = shift;
1281
1282   carp "WARNING: FS::cust_main::reexport is deprectated; ".
1283        "use the depend_jobnum option to insert or order_pkgs to delay export";
1284
1285   local $SIG{HUP} = 'IGNORE';
1286   local $SIG{INT} = 'IGNORE';
1287   local $SIG{QUIT} = 'IGNORE';
1288   local $SIG{TERM} = 'IGNORE';
1289   local $SIG{TSTP} = 'IGNORE';
1290   local $SIG{PIPE} = 'IGNORE';
1291
1292   my $oldAutoCommit = $FS::UID::AutoCommit;
1293   local $FS::UID::AutoCommit = 0;
1294   my $dbh = dbh;
1295
1296   foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1297     my $error = $cust_pkg->reexport;
1298     if ( $error ) {
1299       $dbh->rollback if $oldAutoCommit;
1300       return $error;
1301     }
1302   }
1303
1304   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1305   '';
1306
1307 }
1308
1309 =item delete [ OPTION => VALUE ... ]
1310
1311 This deletes the customer.  If there is an error, returns the error, otherwise
1312 returns false.
1313
1314 This will completely remove all traces of the customer record.  This is not
1315 what you want when a customer cancels service; for that, cancel all of the
1316 customer's packages (see L</cancel>).
1317
1318 If the customer has any uncancelled packages, you need to pass a new (valid)
1319 customer number for those packages to be transferred to, as the "new_customer"
1320 option.  Cancelled packages will be deleted.  Did I mention that this is NOT
1321 what you want when a customer cancels service and that you really should be
1322 looking at L<FS::cust_pkg/cancel>?
1323
1324 You can't delete a customer with invoices (see L<FS::cust_bill>),
1325 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1326 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1327 set the "delete_financials" option to a true value.
1328
1329 =cut
1330
1331 sub delete {
1332   my( $self, %opt ) = @_;
1333
1334   local $SIG{HUP} = 'IGNORE';
1335   local $SIG{INT} = 'IGNORE';
1336   local $SIG{QUIT} = 'IGNORE';
1337   local $SIG{TERM} = 'IGNORE';
1338   local $SIG{TSTP} = 'IGNORE';
1339   local $SIG{PIPE} = 'IGNORE';
1340
1341   my $oldAutoCommit = $FS::UID::AutoCommit;
1342   local $FS::UID::AutoCommit = 0;
1343   my $dbh = dbh;
1344
1345   if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1346      $dbh->rollback if $oldAutoCommit;
1347      return "Can't delete a master agent customer";
1348   }
1349
1350   #use FS::access_user
1351   if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1352      $dbh->rollback if $oldAutoCommit;
1353      return "Can't delete a master employee customer";
1354   }
1355
1356   tie my %financial_tables, 'Tie::IxHash',
1357     'cust_bill'      => 'invoices',
1358     'cust_statement' => 'statements',
1359     'cust_credit'    => 'credits',
1360     'cust_pay'       => 'payments',
1361     'cust_refund'    => 'refunds',
1362   ;
1363
1364   foreach my $table ( keys %financial_tables ) {
1365
1366     my @records = $self->$table();
1367
1368     if ( @records && ! $opt{'delete_financials'} ) {
1369       $dbh->rollback if $oldAutoCommit;
1370       return "Can't delete a customer with ". $financial_tables{$table};
1371     }
1372
1373     foreach my $record ( @records ) {
1374       my $error = $record->delete;
1375       if ( $error ) {
1376         $dbh->rollback if $oldAutoCommit;
1377         return "Error deleting ". $financial_tables{$table}. ": $error\n";
1378       }
1379     }
1380
1381   }
1382
1383   my @cust_pkg = $self->ncancelled_pkgs;
1384   if ( @cust_pkg ) {
1385     my $new_custnum = $opt{'new_custnum'};
1386     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1387       $dbh->rollback if $oldAutoCommit;
1388       return "Invalid new customer number: $new_custnum";
1389     }
1390     foreach my $cust_pkg ( @cust_pkg ) {
1391       my %hash = $cust_pkg->hash;
1392       $hash{'custnum'} = $new_custnum;
1393       my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1394       my $error = $new_cust_pkg->replace($cust_pkg,
1395                                          options => { $cust_pkg->options },
1396                                         );
1397       if ( $error ) {
1398         $dbh->rollback if $oldAutoCommit;
1399         return $error;
1400       }
1401     }
1402   }
1403   my @cancelled_cust_pkg = $self->all_pkgs;
1404   foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1405     my $error = $cust_pkg->delete;
1406     if ( $error ) {
1407       $dbh->rollback if $oldAutoCommit;
1408       return $error;
1409     }
1410   }
1411
1412   #cust_tax_adjustment in financials?
1413   #cust_pay_pending?  ouch
1414   #cust_recon?
1415   foreach my $table (qw(
1416     cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1417     cust_location cust_main_note cust_tax_adjustment
1418     cust_pay_void cust_pay_batch queue cust_tax_exempt
1419   )) {
1420     foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1421       my $error = $record->delete;
1422       if ( $error ) {
1423         $dbh->rollback if $oldAutoCommit;
1424         return $error;
1425       }
1426     }
1427   }
1428
1429   my $sth = $dbh->prepare(
1430     'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1431   ) or do {
1432     my $errstr = $dbh->errstr;
1433     $dbh->rollback if $oldAutoCommit;
1434     return $errstr;
1435   };
1436   $sth->execute($self->custnum) or do {
1437     my $errstr = $sth->errstr;
1438     $dbh->rollback if $oldAutoCommit;
1439     return $errstr;
1440   };
1441
1442   #tickets
1443
1444   my $ticket_dbh = '';
1445   if ($conf->config('ticket_system') eq 'RT_Internal') {
1446     $ticket_dbh = $dbh;
1447   } elsif ($conf->config('ticket_system') eq 'RT_External') {
1448     my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1449     $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1450       #or die "RT_External DBI->connect error: $DBI::errstr\n";
1451   }
1452
1453   if ( $ticket_dbh ) {
1454
1455     my $ticket_sth = $ticket_dbh->prepare(
1456       'DELETE FROM Links WHERE Target = ?'
1457     ) or do {
1458       my $errstr = $ticket_dbh->errstr;
1459       $dbh->rollback if $oldAutoCommit;
1460       return $errstr;
1461     };
1462     $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1463       or do {
1464         my $errstr = $ticket_sth->errstr;
1465         $dbh->rollback if $oldAutoCommit;
1466         return $errstr;
1467       };
1468
1469     #check and see if the customer is the only link on the ticket, and
1470     #if so, set the ticket to deleted status in RT?
1471     #maybe someday, for now this will at least fix tickets not displaying
1472
1473   }
1474
1475   #delete the customer record
1476
1477   my $error = $self->SUPER::delete;
1478   if ( $error ) {
1479     $dbh->rollback if $oldAutoCommit;
1480     return $error;
1481   }
1482
1483   # cust_main exports!
1484
1485   #my $export_args = $options{'export_args'} || [];
1486
1487   my @part_export =
1488     map qsearch( 'part_export', {exportnum=>$_} ),
1489       $conf->config('cust_main-exports'); #, $agentnum
1490
1491   foreach my $part_export ( @part_export ) {
1492     my $error = $part_export->export_delete( $self ); #, @$export_args);
1493     if ( $error ) {
1494       $dbh->rollback if $oldAutoCommit;
1495       return "exporting to ". $part_export->exporttype.
1496              " (transaction rolled back): $error";
1497     }
1498   }
1499
1500   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1501   '';
1502
1503 }
1504
1505 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1506
1507
1508 Replaces the OLD_RECORD with this one in the database.  If there is an error,
1509 returns the error, otherwise returns false.
1510
1511 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1512 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
1513 expected and rollback the entire transaction; it is not necessary to call
1514 check_invoicing_list first.  Here's an example:
1515
1516   $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1517
1518 Currently available options are: I<tax_exemption>.
1519
1520 The I<tax_exemption> option can be set to an arrayref of tax names.
1521 FS::cust_main_exemption records will be deleted and inserted as appropriate.
1522
1523 =cut
1524
1525 sub replace {
1526   my $self = shift;
1527
1528   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1529               ? shift
1530               : $self->replace_old;
1531
1532   my @param = @_;
1533
1534   warn "$me replace called\n"
1535     if $DEBUG;
1536
1537   my $curuser = $FS::CurrentUser::CurrentUser;
1538   if (    $self->payby eq 'COMP'
1539        && $self->payby ne $old->payby
1540        && ! $curuser->access_right('Complimentary customer')
1541      )
1542   {
1543     return "You are not permitted to create complimentary accounts.";
1544   }
1545
1546   local($ignore_expired_card) = 1
1547     if $old->payby  =~ /^(CARD|DCRD)$/
1548     && $self->payby =~ /^(CARD|DCRD)$/
1549     && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1550
1551   local $SIG{HUP} = 'IGNORE';
1552   local $SIG{INT} = 'IGNORE';
1553   local $SIG{QUIT} = 'IGNORE';
1554   local $SIG{TERM} = 'IGNORE';
1555   local $SIG{TSTP} = 'IGNORE';
1556   local $SIG{PIPE} = 'IGNORE';
1557
1558   my $oldAutoCommit = $FS::UID::AutoCommit;
1559   local $FS::UID::AutoCommit = 0;
1560   my $dbh = dbh;
1561
1562   my $error = $self->SUPER::replace($old);
1563
1564   if ( $error ) {
1565     $dbh->rollback if $oldAutoCommit;
1566     return $error;
1567   }
1568
1569   if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1570     my $invoicing_list = shift @param;
1571     $error = $self->check_invoicing_list( $invoicing_list );
1572     if ( $error ) {
1573       $dbh->rollback if $oldAutoCommit;
1574       return $error;
1575     }
1576     $self->invoicing_list( $invoicing_list );
1577   }
1578
1579   if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1580
1581     #this could be more efficient than deleting and re-inserting, if it matters
1582     foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1583       my $error = $cust_tag->delete;
1584       if ( $error ) {
1585         $dbh->rollback if $oldAutoCommit;
1586         return $error;
1587       }
1588     }
1589     foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1590       my $cust_tag = new FS::cust_tag { 'tagnum'  => $tagnum,
1591                                         'custnum' => $self->custnum };
1592       my $error = $cust_tag->insert;
1593       if ( $error ) {
1594         $dbh->rollback if $oldAutoCommit;
1595         return $error;
1596       }
1597     }
1598
1599   }
1600
1601   my %options = @param;
1602
1603   my $tax_exemption = delete $options{'tax_exemption'};
1604   if ( $tax_exemption ) {
1605
1606     my %cust_main_exemption =
1607       map { $_->taxname => $_ }
1608           qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1609
1610     foreach my $taxname ( @$tax_exemption ) {
1611
1612       next if delete $cust_main_exemption{$taxname};
1613
1614       my $cust_main_exemption = new FS::cust_main_exemption {
1615         'custnum' => $self->custnum,
1616         'taxname' => $taxname,
1617       };
1618       my $error = $cust_main_exemption->insert;
1619       if ( $error ) {
1620         $dbh->rollback if $oldAutoCommit;
1621         return "inserting cust_main_exemption (transaction rolled back): $error";
1622       }
1623     }
1624
1625     foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1626       my $error = $cust_main_exemption->delete;
1627       if ( $error ) {
1628         $dbh->rollback if $oldAutoCommit;
1629         return "deleting cust_main_exemption (transaction rolled back): $error";
1630       }
1631     }
1632
1633   }
1634
1635   if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
1636        && ( ( $self->get('payinfo') ne $old->get('payinfo')
1637               && $self->get('payinfo') !~ /^99\d{14}$/
1638             )
1639             || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
1640           )
1641      )
1642   {
1643
1644     # card/check/lec info has changed, want to retry realtime_ invoice events
1645     my $error = $self->retry_realtime;
1646     if ( $error ) {
1647       $dbh->rollback if $oldAutoCommit;
1648       return $error;
1649     }
1650   }
1651
1652   unless ( $import || $skip_fuzzyfiles ) {
1653     $error = $self->queue_fuzzyfiles_update;
1654     if ( $error ) {
1655       $dbh->rollback if $oldAutoCommit;
1656       return "updating fuzzy search cache: $error";
1657     }
1658   }
1659
1660   # cust_main exports!
1661
1662   my $export_args = $options{'export_args'} || [];
1663
1664   my @part_export =
1665     map qsearch( 'part_export', {exportnum=>$_} ),
1666       $conf->config('cust_main-exports'); #, $agentnum
1667
1668   foreach my $part_export ( @part_export ) {
1669     my $error = $part_export->export_replace( $self, $old, @$export_args);
1670     if ( $error ) {
1671       $dbh->rollback if $oldAutoCommit;
1672       return "exporting to ". $part_export->exporttype.
1673              " (transaction rolled back): $error";
1674     }
1675   }
1676
1677   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1678   '';
1679
1680 }
1681
1682 =item queue_fuzzyfiles_update
1683
1684 Used by insert & replace to update the fuzzy search cache
1685
1686 =cut
1687
1688 sub queue_fuzzyfiles_update {
1689   my $self = shift;
1690
1691   local $SIG{HUP} = 'IGNORE';
1692   local $SIG{INT} = 'IGNORE';
1693   local $SIG{QUIT} = 'IGNORE';
1694   local $SIG{TERM} = 'IGNORE';
1695   local $SIG{TSTP} = 'IGNORE';
1696   local $SIG{PIPE} = 'IGNORE';
1697
1698   my $oldAutoCommit = $FS::UID::AutoCommit;
1699   local $FS::UID::AutoCommit = 0;
1700   my $dbh = dbh;
1701
1702   my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1703   my $error = $queue->insert( map $self->getfield($_), @fuzzyfields );
1704   if ( $error ) {
1705     $dbh->rollback if $oldAutoCommit;
1706     return "queueing job (transaction rolled back): $error";
1707   }
1708
1709   if ( $self->ship_last ) {
1710     $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1711     $error = $queue->insert( map $self->getfield("ship_$_"), @fuzzyfields );
1712     if ( $error ) {
1713       $dbh->rollback if $oldAutoCommit;
1714       return "queueing job (transaction rolled back): $error";
1715     }
1716   }
1717
1718   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1719   '';
1720
1721 }
1722
1723 =item check
1724
1725 Checks all fields to make sure this is a valid customer record.  If there is
1726 an error, returns the error, otherwise returns false.  Called by the insert
1727 and replace methods.
1728
1729 =cut
1730
1731 sub check {
1732   my $self = shift;
1733
1734   warn "$me check BEFORE: \n". $self->_dump
1735     if $DEBUG > 2;
1736
1737   my $error =
1738     $self->ut_numbern('custnum')
1739     || $self->ut_number('agentnum')
1740     || $self->ut_textn('agent_custid')
1741     || $self->ut_number('refnum')
1742     || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1743     || $self->ut_textn('custbatch')
1744     || $self->ut_name('last')
1745     || $self->ut_name('first')
1746     || $self->ut_snumbern('birthdate')
1747     || $self->ut_snumbern('signupdate')
1748     || $self->ut_textn('company')
1749     || $self->ut_text('address1')
1750     || $self->ut_textn('address2')
1751     || $self->ut_text('city')
1752     || $self->ut_textn('county')
1753     || $self->ut_textn('state')
1754     || $self->ut_country('country')
1755     || $self->ut_anything('comments')
1756     || $self->ut_numbern('referral_custnum')
1757     || $self->ut_textn('stateid')
1758     || $self->ut_textn('stateid_state')
1759     || $self->ut_textn('invoice_terms')
1760     || $self->ut_alphan('geocode')
1761     || $self->ut_floatn('cdr_termination_percentage')
1762   ;
1763
1764   #barf.  need message catalogs.  i18n.  etc.
1765   $error .= "Please select an advertising source."
1766     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1767   return $error if $error;
1768
1769   return "Unknown agent"
1770     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1771
1772   return "Unknown refnum"
1773     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1774
1775   return "Unknown referring custnum: ". $self->referral_custnum
1776     unless ! $self->referral_custnum
1777            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1778
1779   if ( $self->censustract ne '' ) {
1780     $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/
1781       or return "Illegal census tract: ". $self->censustract;
1782
1783     $self->censustract("$1.$2");
1784   }
1785
1786   if ( $self->ss eq '' ) {
1787     $self->ss('');
1788   } else {
1789     my $ss = $self->ss;
1790     $ss =~ s/\D//g;
1791     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1792       or return "Illegal social security number: ". $self->ss;
1793     $self->ss("$1-$2-$3");
1794   }
1795
1796
1797 # bad idea to disable, causes billing to fail because of no tax rates later
1798 # except we don't fail any more
1799   unless ( $import ) {
1800     unless ( qsearch('cust_main_county', {
1801       'country' => $self->country,
1802       'state'   => '',
1803      } ) ) {
1804       return "Unknown state/county/country: ".
1805         $self->state. "/". $self->county. "/". $self->country
1806         unless qsearch('cust_main_county',{
1807           'state'   => $self->state,
1808           'county'  => $self->county,
1809           'country' => $self->country,
1810         } );
1811     }
1812   }
1813
1814   $error =
1815     $self->ut_phonen('daytime', $self->country)
1816     || $self->ut_phonen('night', $self->country)
1817     || $self->ut_phonen('fax', $self->country)
1818     || $self->ut_zip('zip', $self->country)
1819   ;
1820   return $error if $error;
1821
1822   if ( $conf->exists('cust_main-require_phone')
1823        && ! length($self->daytime) && ! length($self->night)
1824      ) {
1825
1826     my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1827                           ? 'Day Phone'
1828                           : FS::Msgcat::_gettext('daytime');
1829     my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1830                         ? 'Night Phone'
1831                         : FS::Msgcat::_gettext('night');
1832
1833     return "$daytime_label or $night_label is required"
1834
1835   }
1836
1837   if ( $self->has_ship_address
1838        && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1839                         $self->addr_fields )
1840      )
1841   {
1842     my $error =
1843       $self->ut_name('ship_last')
1844       || $self->ut_name('ship_first')
1845       || $self->ut_textn('ship_company')
1846       || $self->ut_text('ship_address1')
1847       || $self->ut_textn('ship_address2')
1848       || $self->ut_text('ship_city')
1849       || $self->ut_textn('ship_county')
1850       || $self->ut_textn('ship_state')
1851       || $self->ut_country('ship_country')
1852     ;
1853     return $error if $error;
1854
1855     #false laziness with above
1856     unless ( qsearchs('cust_main_county', {
1857       'country' => $self->ship_country,
1858       'state'   => '',
1859      } ) ) {
1860       return "Unknown ship_state/ship_county/ship_country: ".
1861         $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1862         unless qsearch('cust_main_county',{
1863           'state'   => $self->ship_state,
1864           'county'  => $self->ship_county,
1865           'country' => $self->ship_country,
1866         } );
1867     }
1868     #eofalse
1869
1870     $error =
1871       $self->ut_phonen('ship_daytime', $self->ship_country)
1872       || $self->ut_phonen('ship_night', $self->ship_country)
1873       || $self->ut_phonen('ship_fax', $self->ship_country)
1874       || $self->ut_zip('ship_zip', $self->ship_country)
1875     ;
1876     return $error if $error;
1877
1878     return "Unit # is required."
1879       if $self->ship_address2 =~ /^\s*$/
1880       && $conf->exists('cust_main-require_address2');
1881
1882   } else { # ship_ info eq billing info, so don't store dup info in database
1883
1884     $self->setfield("ship_$_", '')
1885       foreach $self->addr_fields;
1886
1887     return "Unit # is required."
1888       if $self->address2 =~ /^\s*$/
1889       && $conf->exists('cust_main-require_address2');
1890
1891   }
1892
1893   #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1894   #  or return "Illegal payby: ". $self->payby;
1895   #$self->payby($1);
1896   FS::payby->can_payby($self->table, $self->payby)
1897     or return "Illegal payby: ". $self->payby;
1898
1899   $error =    $self->ut_numbern('paystart_month')
1900            || $self->ut_numbern('paystart_year')
1901            || $self->ut_numbern('payissue')
1902            || $self->ut_textn('paytype')
1903   ;
1904   return $error if $error;
1905
1906   if ( $self->payip eq '' ) {
1907     $self->payip('');
1908   } else {
1909     $error = $self->ut_ip('payip');
1910     return $error if $error;
1911   }
1912
1913   # If it is encrypted and the private key is not availaible then we can't
1914   # check the credit card.
1915   my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1916
1917   if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1918
1919     my $payinfo = $self->payinfo;
1920     $payinfo =~ s/\D//g;
1921     $payinfo =~ /^(\d{13,16})$/
1922       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1923     $payinfo = $1;
1924     $self->payinfo($payinfo);
1925     validate($payinfo)
1926       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1927
1928     return gettext('unknown_card_type')
1929       if $self->payinfo !~ /^99\d{14}$/ #token
1930       && cardtype($self->payinfo) eq "Unknown";
1931
1932     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1933     if ( $ban ) {
1934       return 'Banned credit card: banned on '.
1935              time2str('%a %h %o at %r', $ban->_date).
1936              ' by '. $ban->otaker.
1937              ' (ban# '. $ban->bannum. ')';
1938     }
1939
1940     if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1941       if ( cardtype($self->payinfo) eq 'American Express card' ) {
1942         $self->paycvv =~ /^(\d{4})$/
1943           or return "CVV2 (CID) for American Express cards is four digits.";
1944         $self->paycvv($1);
1945       } else {
1946         $self->paycvv =~ /^(\d{3})$/
1947           or return "CVV2 (CVC2/CID) is three digits.";
1948         $self->paycvv($1);
1949       }
1950     } else {
1951       $self->paycvv('');
1952     }
1953
1954     my $cardtype = cardtype($payinfo);
1955     if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1956
1957       return "Start date or issue number is required for $cardtype cards"
1958         unless $self->paystart_month && $self->paystart_year or $self->payissue;
1959
1960       return "Start month must be between 1 and 12"
1961         if $self->paystart_month
1962            and $self->paystart_month < 1 || $self->paystart_month > 12;
1963
1964       return "Start year must be 1990 or later"
1965         if $self->paystart_year
1966            and $self->paystart_year < 1990;
1967
1968       return "Issue number must be beween 1 and 99"
1969         if $self->payissue
1970           and $self->payissue < 1 || $self->payissue > 99;
1971
1972     } else {
1973       $self->paystart_month('');
1974       $self->paystart_year('');
1975       $self->payissue('');
1976     }
1977
1978   } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1979
1980     my $payinfo = $self->payinfo;
1981     $payinfo =~ s/[^\d\@]//g;
1982     if ( $conf->exists('echeck-nonus') ) {
1983       $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1984       $payinfo = "$1\@$2";
1985     } else {
1986       $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1987       $payinfo = "$1\@$2";
1988     }
1989     $self->payinfo($payinfo);
1990     $self->paycvv('');
1991
1992     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1993     if ( $ban ) {
1994       return 'Banned ACH account: banned on '.
1995              time2str('%a %h %o at %r', $ban->_date).
1996              ' by '. $ban->otaker.
1997              ' (ban# '. $ban->bannum. ')';
1998     }
1999
2000   } elsif ( $self->payby eq 'LECB' ) {
2001
2002     my $payinfo = $self->payinfo;
2003     $payinfo =~ s/\D//g;
2004     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
2005     $payinfo = $1;
2006     $self->payinfo($payinfo);
2007     $self->paycvv('');
2008
2009   } elsif ( $self->payby eq 'BILL' ) {
2010
2011     $error = $self->ut_textn('payinfo');
2012     return "Illegal P.O. number: ". $self->payinfo if $error;
2013     $self->paycvv('');
2014
2015   } elsif ( $self->payby eq 'COMP' ) {
2016
2017     my $curuser = $FS::CurrentUser::CurrentUser;
2018     if (    ! $self->custnum
2019          && ! $curuser->access_right('Complimentary customer')
2020        )
2021     {
2022       return "You are not permitted to create complimentary accounts."
2023     }
2024
2025     $error = $self->ut_textn('payinfo');
2026     return "Illegal comp account issuer: ". $self->payinfo if $error;
2027     $self->paycvv('');
2028
2029   } elsif ( $self->payby eq 'PREPAY' ) {
2030
2031     my $payinfo = $self->payinfo;
2032     $payinfo =~ s/\W//g; #anything else would just confuse things
2033     $self->payinfo($payinfo);
2034     $error = $self->ut_alpha('payinfo');
2035     return "Illegal prepayment identifier: ". $self->payinfo if $error;
2036     return "Unknown prepayment identifier"
2037       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
2038     $self->paycvv('');
2039
2040   }
2041
2042   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
2043     return "Expiration date required"
2044       unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
2045     $self->paydate('');
2046   } else {
2047     my( $m, $y );
2048     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
2049       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
2050     } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2051       ( $m, $y ) = ( $2, "19$1" );
2052     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2053       ( $m, $y ) = ( $3, "20$2" );
2054     } else {
2055       return "Illegal expiration date: ". $self->paydate;
2056     }
2057     $self->paydate("$y-$m-01");
2058     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
2059     return gettext('expired_card')
2060       if !$import
2061       && !$ignore_expired_card
2062       && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
2063   }
2064
2065   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
2066        ( ! $conf->exists('require_cardname')
2067          || $self->payby !~ /^(CARD|DCRD)$/  )
2068   ) {
2069     $self->payname( $self->first. " ". $self->getfield('last') );
2070   } else {
2071     $self->payname =~ /^([\w \,\.\-\'\&]+)$/
2072       or return gettext('illegal_name'). " payname: ". $self->payname;
2073     $self->payname($1);
2074   }
2075
2076   foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
2077     $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
2078     $self->$flag($1);
2079   }
2080
2081   $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
2082
2083   warn "$me check AFTER: \n". $self->_dump
2084     if $DEBUG > 2;
2085
2086   $self->SUPER::check;
2087 }
2088
2089 =item addr_fields
2090
2091 Returns a list of fields which have ship_ duplicates.
2092
2093 =cut
2094
2095 sub addr_fields {
2096   qw( last first company
2097       address1 address2 city county state zip country
2098       daytime night fax
2099     );
2100 }
2101
2102 =item has_ship_address
2103
2104 Returns true if this customer record has a separate shipping address.
2105
2106 =cut
2107
2108 sub has_ship_address {
2109   my $self = shift;
2110   scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
2111 }
2112
2113 =item location_hash
2114
2115 Returns a list of key/value pairs, with the following keys: address1, adddress2,
2116 city, county, state, zip, country.  The shipping address is used if present.
2117
2118 =cut
2119
2120 #geocode?  dependent on tax-ship_address config, not available in cust_location
2121 #mostly.  not yet then.
2122
2123 sub location_hash {
2124   my $self = shift;
2125   my $prefix = $self->has_ship_address ? 'ship_' : '';
2126
2127   map { $_ => $self->get($prefix.$_) }
2128       qw( address1 address2 city county state zip country geocode );
2129       #fields that cust_location has
2130 }
2131
2132 =item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
2133
2134 Returns all packages (see L<FS::cust_pkg>) for this customer.
2135
2136 =cut
2137
2138 sub all_pkgs {
2139   my $self = shift;
2140   my $extra_qsearch = ref($_[0]) ? shift : {};
2141
2142   return $self->num_pkgs unless wantarray || keys(%$extra_qsearch);
2143
2144   my @cust_pkg = ();
2145   if ( $self->{'_pkgnum'} ) {
2146     @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
2147   } else {
2148     @cust_pkg = $self->_cust_pkg($extra_qsearch);
2149   }
2150
2151   sort sort_packages @cust_pkg;
2152 }
2153
2154 =item cust_pkg
2155
2156 Synonym for B<all_pkgs>.
2157
2158 =cut
2159
2160 sub cust_pkg {
2161   shift->all_pkgs(@_);
2162 }
2163
2164 =item cust_location
2165
2166 Returns all locations (see L<FS::cust_location>) for this customer.
2167
2168 =cut
2169
2170 sub cust_location {
2171   my $self = shift;
2172   qsearch('cust_location', { 'custnum' => $self->custnum } );
2173 }
2174
2175 =item location_label [ OPTION => VALUE ... ]
2176
2177 Returns the label of the service location (see analog in L<FS::cust_location>) for this customer.
2178
2179 Options are
2180
2181 =over 4
2182
2183 =item join_string
2184
2185 used to separate the address elements (defaults to ', ')
2186
2187 =item escape_function
2188
2189 a callback used for escaping the text of the address elements
2190
2191 =back
2192
2193 =cut
2194
2195 # false laziness with FS::cust_location::line
2196
2197 sub location_label {
2198   my $self = shift;
2199   my %opt = @_;
2200
2201   my $separator = $opt{join_string} || ', ';
2202   my $escape = $opt{escape_function} || sub{ shift };
2203   my $line = '';
2204   my $cydefault = FS::conf->new->config('countrydefault') || 'US';
2205   my $prefix = length($self->ship_last) ? 'ship_' : '';
2206
2207   my $notfirst = 0;
2208   foreach (qw ( address1 address2 ) ) {
2209     my $method = "$prefix$_";
2210     $line .= ($notfirst ? $separator : ''). &$escape($self->$method)
2211       if $self->$method;
2212     $notfirst++;
2213   }
2214   $notfirst = 0;
2215   foreach (qw ( city county state zip ) ) {
2216     my $method = "$prefix$_";
2217     if ( $self->$method ) {
2218       $line .= ' (' if $method eq 'county';
2219       $line .= ($notfirst ? ' ' : $separator). &$escape($self->$method);
2220       $line .= ' )' if $method eq 'county';
2221       $notfirst++;
2222     }
2223   }
2224   $line .= $separator. &$escape(code2country($self->country))
2225     if $self->country ne $cydefault;
2226
2227   $line;
2228 }
2229
2230 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
2231
2232 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
2233
2234 =cut
2235
2236 sub ncancelled_pkgs {
2237   my $self = shift;
2238   my $extra_qsearch = ref($_[0]) ? shift : {};
2239
2240   return $self->num_ncancelled_pkgs unless wantarray;
2241
2242   my @cust_pkg = ();
2243   if ( $self->{'_pkgnum'} ) {
2244
2245     warn "$me ncancelled_pkgs: returning cached objects"
2246       if $DEBUG > 1;
2247
2248     @cust_pkg = grep { ! $_->getfield('cancel') }
2249                 values %{ $self->{'_pkgnum'}->cache };
2250
2251   } else {
2252
2253     warn "$me ncancelled_pkgs: searching for packages with custnum ".
2254          $self->custnum. "\n"
2255       if $DEBUG > 1;
2256
2257     $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
2258
2259     @cust_pkg = $self->_cust_pkg($extra_qsearch);
2260
2261   }
2262
2263   sort sort_packages @cust_pkg;
2264
2265 }
2266
2267 sub _cust_pkg {
2268   my $self = shift;
2269   my $extra_qsearch = ref($_[0]) ? shift : {};
2270
2271   $extra_qsearch->{'select'} ||= '*';
2272   $extra_qsearch->{'select'} .=
2273    ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
2274      AS _num_cust_svc';
2275
2276   map {
2277         $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
2278         $_;
2279       }
2280   qsearch({
2281     %$extra_qsearch,
2282     'table'   => 'cust_pkg',
2283     'hashref' => { 'custnum' => $self->custnum },
2284   });
2285
2286 }
2287
2288 # This should be generalized to use config options to determine order.
2289 sub sort_packages {
2290
2291   my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
2292   return $locationsort if $locationsort;
2293
2294   if ( $a->get('cancel') xor $b->get('cancel') ) {
2295     return -1 if $b->get('cancel');
2296     return  1 if $a->get('cancel');
2297     #shouldn't get here...
2298     return 0;
2299   } else {
2300     my $a_num_cust_svc = $a->num_cust_svc;
2301     my $b_num_cust_svc = $b->num_cust_svc;
2302     return 0  if !$a_num_cust_svc && !$b_num_cust_svc;
2303     return -1 if  $a_num_cust_svc && !$b_num_cust_svc;
2304     return 1  if !$a_num_cust_svc &&  $b_num_cust_svc;
2305     my @a_cust_svc = $a->cust_svc;
2306     my @b_cust_svc = $b->cust_svc;
2307     return 0  if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
2308     return -1 if  scalar(@a_cust_svc) && !scalar(@b_cust_svc);
2309     return 1  if !scalar(@a_cust_svc) &&  scalar(@b_cust_svc);
2310     $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
2311   }
2312
2313 }
2314
2315 =item suspended_pkgs
2316
2317 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
2318
2319 =cut
2320
2321 sub suspended_pkgs {
2322   my $self = shift;
2323   grep { $_->susp } $self->ncancelled_pkgs;
2324 }
2325
2326 =item unflagged_suspended_pkgs
2327
2328 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
2329 customer (thouse packages without the `manual_flag' set).
2330
2331 =cut
2332
2333 sub unflagged_suspended_pkgs {
2334   my $self = shift;
2335   return $self->suspended_pkgs
2336     unless dbdef->table('cust_pkg')->column('manual_flag');
2337   grep { ! $_->manual_flag } $self->suspended_pkgs;
2338 }
2339
2340 =item unsuspended_pkgs
2341
2342 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
2343 this customer.
2344
2345 =cut
2346
2347 sub unsuspended_pkgs {
2348   my $self = shift;
2349   grep { ! $_->susp } $self->ncancelled_pkgs;
2350 }
2351
2352 =item next_bill_date
2353
2354 Returns the next date this customer will be billed, as a UNIX timestamp, or
2355 undef if no active package has a next bill date.
2356
2357 =cut
2358
2359 sub next_bill_date {
2360   my $self = shift;
2361   min( map $_->get('bill'), grep $_->get('bill'), $self->unsuspended_pkgs );
2362 }
2363
2364 =item num_cancelled_pkgs
2365
2366 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
2367 customer.
2368
2369 =cut
2370
2371 sub num_cancelled_pkgs {
2372   shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
2373 }
2374
2375 sub num_ncancelled_pkgs {
2376   shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
2377 }
2378
2379 sub num_pkgs {
2380   my( $self ) = shift;
2381   my $sql = scalar(@_) ? shift : '';
2382   $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
2383   my $sth = dbh->prepare(
2384     "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
2385   ) or die dbh->errstr;
2386   $sth->execute($self->custnum) or die $sth->errstr;
2387   $sth->fetchrow_arrayref->[0];
2388 }
2389
2390 =item unsuspend
2391
2392 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2393 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
2394 on success or a list of errors.
2395
2396 =cut
2397
2398 sub unsuspend {
2399   my $self = shift;
2400   grep { $_->unsuspend } $self->suspended_pkgs;
2401 }
2402
2403 =item suspend
2404
2405 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2406
2407 Returns a list: an empty list on success or a list of errors.
2408
2409 =cut
2410
2411 sub suspend {
2412   my $self = shift;
2413   grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2414 }
2415
2416 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2417
2418 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2419 PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref instead
2420 of a list of pkgparts; the hashref has the following keys:
2421
2422 =over 4
2423
2424 =item pkgparts - listref of pkgparts
2425
2426 =item (other options are passed to the suspend method)
2427
2428 =back
2429
2430
2431 Returns a list: an empty list on success or a list of errors.
2432
2433 =cut
2434
2435 sub suspend_if_pkgpart {
2436   my $self = shift;
2437   my (@pkgparts, %opt);
2438   if (ref($_[0]) eq 'HASH'){
2439     @pkgparts = @{$_[0]{pkgparts}};
2440     %opt      = %{$_[0]};
2441   }else{
2442     @pkgparts = @_;
2443   }
2444   grep { $_->suspend(%opt) }
2445     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2446       $self->unsuspended_pkgs;
2447 }
2448
2449 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2450
2451 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2452 given PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref
2453 instead of a list of pkgparts; the hashref has the following keys:
2454
2455 =over 4
2456
2457 =item pkgparts - listref of pkgparts
2458
2459 =item (other options are passed to the suspend method)
2460
2461 =back
2462
2463 Returns a list: an empty list on success or a list of errors.
2464
2465 =cut
2466
2467 sub suspend_unless_pkgpart {
2468   my $self = shift;
2469   my (@pkgparts, %opt);
2470   if (ref($_[0]) eq 'HASH'){
2471     @pkgparts = @{$_[0]{pkgparts}};
2472     %opt      = %{$_[0]};
2473   }else{
2474     @pkgparts = @_;
2475   }
2476   grep { $_->suspend(%opt) }
2477     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2478       $self->unsuspended_pkgs;
2479 }
2480
2481 =item cancel [ OPTION => VALUE ... ]
2482
2483 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2484
2485 Available options are:
2486
2487 =over 4
2488
2489 =item quiet - can be set true to supress email cancellation notices.
2490
2491 =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.
2492
2493 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2494
2495 =item nobill - can be set true to skip billing if it might otherwise be done.
2496
2497 =back
2498
2499 Always returns a list: an empty list on success or a list of errors.
2500
2501 =cut
2502
2503 # nb that dates are not specified as valid options to this method
2504
2505 sub cancel {
2506   my( $self, %opt ) = @_;
2507
2508   warn "$me cancel called on customer ". $self->custnum. " with options ".
2509        join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2510     if $DEBUG;
2511
2512   return ( 'access denied' )
2513     unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2514
2515   if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2516
2517     #should try decryption (we might have the private key)
2518     # and if not maybe queue a job for the server that does?
2519     return ( "Can't (yet) ban encrypted credit cards" )
2520       if $self->is_encrypted($self->payinfo);
2521
2522     my $ban = new FS::banned_pay $self->_banned_pay_hashref;
2523     my $error = $ban->insert;
2524     return ( $error ) if $error;
2525
2526   }
2527
2528   my @pkgs = $self->ncancelled_pkgs;
2529
2530   if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2531     $opt{nobill} = 1;
2532     my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2533     warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2534       if $error;
2535   }
2536
2537   warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2538        scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2539     if $DEBUG;
2540
2541   grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2542 }
2543
2544 sub _banned_pay_hashref {
2545   my $self = shift;
2546
2547   my %payby2ban = (
2548     'CARD' => 'CARD',
2549     'DCRD' => 'CARD',
2550     'CHEK' => 'CHEK',
2551     'DCHK' => 'CHEK'
2552   );
2553
2554   {
2555     'payby'   => $payby2ban{$self->payby},
2556     'payinfo' => md5_base64($self->payinfo),
2557     #don't ever *search* on reason! #'reason'  =>
2558   };
2559 }
2560
2561 =item notes
2562
2563 Returns all notes (see L<FS::cust_main_note>) for this customer.
2564
2565 =cut
2566
2567 sub notes {
2568   my $self = shift;
2569   #order by?
2570   qsearch( 'cust_main_note',
2571            { 'custnum' => $self->custnum },
2572            '',
2573            'ORDER BY _DATE DESC'
2574          );
2575 }
2576
2577 =item agent
2578
2579 Returns the agent (see L<FS::agent>) for this customer.
2580
2581 =cut
2582
2583 sub agent {
2584   my $self = shift;
2585   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2586 }
2587
2588 =item agent_name
2589
2590 Returns the agent name (see L<FS::agent>) for this customer.
2591
2592 =cut
2593
2594 sub agent_name {
2595   my $self = shift;
2596   $self->agent->agent;
2597 }
2598
2599 =item cust_tag
2600
2601 Returns any tags associated with this customer, as FS::cust_tag objects,
2602 or an empty list if there are no tags.
2603
2604 =cut
2605
2606 sub cust_tag {
2607   my $self = shift;
2608   qsearch('cust_tag', { 'custnum' => $self->custnum } );
2609 }
2610
2611 =item part_tag
2612
2613 Returns any tags associated with this customer, as FS::part_tag objects,
2614 or an empty list if there are no tags.
2615
2616 =cut
2617
2618 sub part_tag {
2619   my $self = shift;
2620   map $_->part_tag, $self->cust_tag;
2621 }
2622
2623
2624 =item cust_class
2625
2626 Returns the customer class, as an FS::cust_class object, or the empty string
2627 if there is no customer class.
2628
2629 =cut
2630
2631 sub cust_class {
2632   my $self = shift;
2633   if ( $self->classnum ) {
2634     qsearchs('cust_class', { 'classnum' => $self->classnum } );
2635   } else {
2636     return '';
2637   }
2638 }
2639
2640 =item categoryname
2641
2642 Returns the customer category name, or the empty string if there is no customer
2643 category.
2644
2645 =cut
2646
2647 sub categoryname {
2648   my $self = shift;
2649   my $cust_class = $self->cust_class;
2650   $cust_class
2651     ? $cust_class->categoryname
2652     : '';
2653 }
2654
2655 =item classname
2656
2657 Returns the customer class name, or the empty string if there is no customer
2658 class.
2659
2660 =cut
2661
2662 sub classname {
2663   my $self = shift;
2664   my $cust_class = $self->cust_class;
2665   $cust_class
2666     ? $cust_class->classname
2667     : '';
2668 }
2669
2670
2671 =item bill_and_collect
2672
2673 Cancels and suspends any packages due, generates bills, applies payments and
2674 credits, and applies collection events to run cards, send bills and notices,
2675 etc.
2676
2677 By default, warns on errors and continues with the next operation (but see the
2678 "fatal" flag below).
2679
2680 Options are passed as name-value pairs.  Currently available options are:
2681
2682 =over 4
2683
2684 =item time
2685
2686 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:
2687
2688  use Date::Parse;
2689  ...
2690  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2691
2692 =item invoice_time
2693
2694 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.
2695
2696 =item check_freq
2697
2698 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2699
2700 =item resetup
2701
2702 If set true, re-charges setup fees.
2703
2704 =item fatal
2705
2706 If set any errors prevent subsequent operations from continusing.  If set
2707 specifically to "return", returns the error (or false, if there is no error).
2708 Any other true value causes errors to die.
2709
2710 =item debug
2711
2712 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)
2713
2714 =item job
2715
2716 Optional FS::queue entry to receive status updates.
2717
2718 =back
2719
2720 Options are passed to the B<bill> and B<collect> methods verbatim, so all
2721 options of those methods are also available.
2722
2723 =cut
2724
2725 sub bill_and_collect {
2726   my( $self, %options ) = @_;
2727
2728   my $error;
2729
2730   #$options{actual_time} not $options{time} because freeside-daily -d is for
2731   #pre-printing invoices
2732
2733   $options{'actual_time'} ||= time;
2734   my $job = $options{'job'};
2735
2736   $job->update_statustext('0,cleaning expired packages') if $job;
2737   $error = $self->cancel_expired_pkgs( $options{actual_time} );
2738   if ( $error ) {
2739     $error = "Error expiring custnum ". $self->custnum. ": $error";
2740     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
2741     elsif ( $options{fatal}                                ) { die    $error; }
2742     else                                                     { warn   $error; }
2743   }
2744
2745   $error = $self->suspend_adjourned_pkgs( $options{actual_time} );
2746   if ( $error ) {
2747     $error = "Error adjourning custnum ". $self->custnum. ": $error";
2748     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
2749     elsif ( $options{fatal}                                ) { die    $error; }
2750     else                                                     { warn   $error; }
2751   }
2752
2753   $job->update_statustext('20,billing packages') if $job;
2754   $error = $self->bill( %options );
2755   if ( $error ) {
2756     $error = "Error billing custnum ". $self->custnum. ": $error";
2757     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
2758     elsif ( $options{fatal}                                ) { die    $error; }
2759     else                                                     { warn   $error; }
2760   }
2761
2762   $job->update_statustext('50,applying payments and credits') if $job;
2763   $error = $self->apply_payments_and_credits;
2764   if ( $error ) {
2765     $error = "Error applying custnum ". $self->custnum. ": $error";
2766     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
2767     elsif ( $options{fatal}                                ) { die    $error; }
2768     else                                                     { warn   $error; }
2769   }
2770
2771   $job->update_statustext('70,running collection events') if $job;
2772   unless ( $conf->exists('cancelled_cust-noevents')
2773            && ! $self->num_ncancelled_pkgs
2774   ) {
2775     $error = $self->collect( %options );
2776     if ( $error ) {
2777       $error = "Error collecting custnum ". $self->custnum. ": $error";
2778       if    ($options{fatal} && $options{fatal} eq 'return') { return $error; }
2779       elsif ($options{fatal}                               ) { die    $error; }
2780       else                                                   { warn   $error; }
2781     }
2782   }
2783   $job->update_statustext('100,finished') if $job;
2784
2785   '';
2786
2787 }
2788
2789 sub cancel_expired_pkgs {
2790   my ( $self, $time, %options ) = @_;
2791
2792   my @cancel_pkgs = $self->ncancelled_pkgs( {
2793     'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time "
2794   } );
2795
2796   my @errors = ();
2797
2798   foreach my $cust_pkg ( @cancel_pkgs ) {
2799     my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
2800     my $error = $cust_pkg->cancel($cpr ? ( 'reason'        => $cpr->reasonnum,
2801                                            'reason_otaker' => $cpr->otaker
2802                                          )
2803                                        : ()
2804                                  );
2805     push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
2806   }
2807
2808   scalar(@errors) ? join(' / ', @errors) : '';
2809
2810 }
2811
2812 sub suspend_adjourned_pkgs {
2813   my ( $self, $time, %options ) = @_;
2814
2815   my @susp_pkgs = $self->ncancelled_pkgs( {
2816     'extra_sql' =>
2817       " AND ( susp IS NULL OR susp = 0 )
2818         AND (    ( bill    IS NOT NULL AND bill    != 0 AND bill    <  $time )
2819               OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time )
2820             )
2821       ",
2822   } );
2823
2824   #only because there's no SQL test for is_prepaid :/
2825   @susp_pkgs =
2826     grep {     (    $_->part_pkg->is_prepaid
2827                  && $_->bill
2828                  && $_->bill < $time
2829                )
2830             || (    $_->adjourn
2831                  && $_->adjourn <= $time
2832                )
2833
2834          }
2835          @susp_pkgs;
2836
2837   my @errors = ();
2838
2839   foreach my $cust_pkg ( @susp_pkgs ) {
2840     my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
2841       if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
2842     my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
2843                                             'reason_otaker' => $cpr->otaker
2844                                           )
2845                                         : ()
2846                                   );
2847     push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
2848   }
2849
2850   scalar(@errors) ? join(' / ', @errors) : '';
2851
2852 }
2853
2854 =item bill OPTIONS
2855
2856 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
2857 conjunction with the collect method by calling B<bill_and_collect>.
2858
2859 If there is an error, returns the error, otherwise returns false.
2860
2861 Options are passed as name-value pairs.  Currently available options are:
2862
2863 =over 4
2864
2865 =item resetup
2866
2867 If set true, re-charges setup fees.
2868
2869 =item time
2870
2871 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:
2872
2873  use Date::Parse;
2874  ...
2875  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2876
2877 =item pkg_list
2878
2879 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
2880
2881  $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
2882
2883 =item not_pkgpart
2884
2885 A hashref of pkgparts to exclude from this billing run (can also be specified as a comma-separated scalar).
2886
2887 =item invoice_time
2888
2889 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.
2890
2891 =item cancel
2892
2893 This boolean value informs the us that the package is being cancelled.  This
2894 typically might mean not charging the normal recurring fee but only usage
2895 fees since the last billing. Setup charges may be charged.  Not all package
2896 plans support this feature (they tend to charge 0).
2897
2898 =item invoice_terms
2899
2900 Optional terms to be printed on this invoice.  Otherwise, customer-specific
2901 terms or the default terms are used.
2902
2903 =back
2904
2905 =cut
2906
2907 sub bill {
2908   my( $self, %options ) = @_;
2909   return '' if $self->payby eq 'COMP';
2910   warn "$me bill customer ". $self->custnum. "\n"
2911     if $DEBUG;
2912
2913   my $time = $options{'time'} || time;
2914   my $invoice_time = $options{'invoice_time'} || $time;
2915
2916   $options{'not_pkgpart'} ||= {};
2917   $options{'not_pkgpart'} = { map { $_ => 1 }
2918                                   split(/\s*,\s*/, $options{'not_pkgpart'})
2919                             }
2920     unless ref($options{'not_pkgpart'});
2921
2922   local $SIG{HUP} = 'IGNORE';
2923   local $SIG{INT} = 'IGNORE';
2924   local $SIG{QUIT} = 'IGNORE';
2925   local $SIG{TERM} = 'IGNORE';
2926   local $SIG{TSTP} = 'IGNORE';
2927   local $SIG{PIPE} = 'IGNORE';
2928
2929   my $oldAutoCommit = $FS::UID::AutoCommit;
2930   local $FS::UID::AutoCommit = 0;
2931   my $dbh = dbh;
2932
2933   warn "$me acquiring lock on customer ". $self->custnum. "\n"
2934     if $DEBUG;
2935
2936   $self->select_for_update; #mutex
2937
2938   warn "$me running pre-bill events for customer ". $self->custnum. "\n"
2939     if $DEBUG;
2940
2941   my $error = $self->do_cust_event(
2942     'debug'      => ( $options{'debug'} || 0 ),
2943     'time'       => $invoice_time,
2944     'check_freq' => $options{'check_freq'},
2945     'stage'      => 'pre-bill',
2946   );
2947   if ( $error ) {
2948     $dbh->rollback if $oldAutoCommit;
2949     return $error;
2950   }
2951
2952   warn "$me done running pre-bill events for customer ". $self->custnum. "\n"
2953     if $DEBUG;
2954
2955   #keep auto-charge and non-auto-charge line items separate
2956   my @passes = ( '', 'no_auto' );
2957
2958   my %cust_bill_pkg = map { $_ => [] } @passes;
2959
2960   ###
2961   # find the packages which are due for billing, find out how much they are
2962   # & generate invoice database.
2963   ###
2964
2965   my %total_setup   = map { my $z = 0; $_ => \$z; } @passes;
2966   my %total_recur   = map { my $z = 0; $_ => \$z; } @passes;
2967
2968   my %taxlisthash = map { $_ => {} } @passes;
2969
2970   my @precommit_hooks = ();
2971
2972   $options{'pkg_list'} ||= [ $self->ncancelled_pkgs ];  #param checks?
2973   foreach my $cust_pkg ( @{ $options{'pkg_list'} } ) {
2974
2975     next if $options{'not_pkgpart'}->{$cust_pkg->pkgpart};
2976
2977     warn "  bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
2978
2979     #? to avoid use of uninitialized value errors... ?
2980     $cust_pkg->setfield('bill', '')
2981       unless defined($cust_pkg->bill);
2982
2983     #my $part_pkg = $cust_pkg->part_pkg;
2984
2985     my $real_pkgpart = $cust_pkg->pkgpart;
2986     my %hash = $cust_pkg->hash;
2987
2988     # we could implement this bit as FS::part_pkg::has_hidden, but we already
2989     # suffer from performance issues
2990     $options{has_hidden} = 0;
2991     my @part_pkg = $cust_pkg->part_pkg->self_and_bill_linked;
2992     $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
2993
2994     foreach my $part_pkg ( @part_pkg ) {
2995
2996       $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
2997
2998       my $pass = ($cust_pkg->no_auto || $part_pkg->no_auto) ? 'no_auto' : '';
2999
3000       my $error =
3001         $self->_make_lines( 'part_pkg'            => $part_pkg,
3002                             'cust_pkg'            => $cust_pkg,
3003                             'precommit_hooks'     => \@precommit_hooks,
3004                             'line_items'          => $cust_bill_pkg{$pass},
3005                             'setup'               => $total_setup{$pass},
3006                             'recur'               => $total_recur{$pass},
3007                             'tax_matrix'          => $taxlisthash{$pass},
3008                             'time'                => $time,
3009                             'real_pkgpart'        => $real_pkgpart,
3010                             'options'             => \%options,
3011                           );
3012       if ($error) {
3013         $dbh->rollback if $oldAutoCommit;
3014         return $error;
3015       }
3016
3017     } #foreach my $part_pkg
3018
3019   } #foreach my $cust_pkg
3020
3021   #if the customer isn't on an automatic payby, everything can go on a single
3022   #invoice anyway?
3023   #if ( $cust_main->payby !~ /^(CARD|CHEK)$/ ) {
3024     #merge everything into one list
3025   #}
3026
3027   foreach my $pass (@passes) { # keys %cust_bill_pkg ) {
3028
3029     my @cust_bill_pkg = _omit_zero_value_bundles(@{ $cust_bill_pkg{$pass} });
3030
3031     next unless @cust_bill_pkg; #don't create an invoice w/o line items
3032
3033     if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
3034            !$conf->exists('postal_invoice-recurring_only')
3035        )
3036     {
3037
3038       my $postal_pkg = $self->charge_postal_fee();
3039       if ( $postal_pkg && !ref( $postal_pkg ) ) {
3040
3041         $dbh->rollback if $oldAutoCommit;
3042         return "can't charge postal invoice fee for customer ".
3043           $self->custnum. ": $postal_pkg";
3044
3045       } elsif ( $postal_pkg ) {
3046
3047         my $real_pkgpart = $postal_pkg->pkgpart;
3048         # we could implement this bit as FS::part_pkg::has_hidden, but we already
3049         # suffer from performance issues
3050         $options{has_hidden} = 0;
3051         my @part_pkg = $postal_pkg->part_pkg->self_and_bill_linked;
3052         $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
3053
3054         foreach my $part_pkg ( @part_pkg ) {
3055           my %postal_options = %options;
3056           delete $postal_options{cancel};
3057           my $error =
3058             $self->_make_lines( 'part_pkg'            => $part_pkg,
3059                                 'cust_pkg'            => $postal_pkg,
3060                                 'precommit_hooks'     => \@precommit_hooks,
3061                                 'line_items'          => \@cust_bill_pkg,
3062                                 'setup'               => $total_setup{$pass},
3063                                 'recur'               => $total_recur{$pass},
3064                                 'tax_matrix'          => $taxlisthash{$pass},
3065                                 'time'                => $time,
3066                                 'real_pkgpart'        => $real_pkgpart,
3067                                 'options'             => \%postal_options,
3068                               );
3069           if ($error) {
3070             $dbh->rollback if $oldAutoCommit;
3071             return $error;
3072           }
3073         }
3074
3075         # it's silly to have a zero value postal_pkg, but....
3076         @cust_bill_pkg = _omit_zero_value_bundles(@cust_bill_pkg);
3077
3078       }
3079
3080     }
3081
3082     my $listref_or_error =
3083       $self->calculate_taxes( \@cust_bill_pkg, $taxlisthash{$pass}, $invoice_time);
3084
3085     unless ( ref( $listref_or_error ) ) {
3086       $dbh->rollback if $oldAutoCommit;
3087       return $listref_or_error;
3088     }
3089
3090     foreach my $taxline ( @$listref_or_error ) {
3091       ${ $total_setup{$pass} } =
3092         sprintf('%.2f', ${ $total_setup{$pass} } + $taxline->setup );
3093       push @cust_bill_pkg, $taxline;
3094     }
3095
3096     #add tax adjustments
3097     warn "adding tax adjustments...\n" if $DEBUG > 2;
3098     foreach my $cust_tax_adjustment (
3099       qsearch('cust_tax_adjustment', { 'custnum'    => $self->custnum,
3100                                        'billpkgnum' => '',
3101                                      }
3102              )
3103     ) {
3104
3105       my $tax = sprintf('%.2f', $cust_tax_adjustment->amount );
3106
3107       my $itemdesc = $cust_tax_adjustment->taxname;
3108       $itemdesc = '' if $itemdesc eq 'Tax';
3109
3110       push @cust_bill_pkg, new FS::cust_bill_pkg {
3111         'pkgnum'      => 0,
3112         'setup'       => $tax,
3113         'recur'       => 0,
3114         'sdate'       => '',
3115         'edate'       => '',
3116         'itemdesc'    => $itemdesc,
3117         'itemcomment' => $cust_tax_adjustment->comment,
3118         'cust_tax_adjustment' => $cust_tax_adjustment,
3119         #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
3120       };
3121
3122     }
3123
3124     my $charged = sprintf('%.2f', ${ $total_setup{$pass} } + ${ $total_recur{$pass} } );
3125
3126     my @cust_bill = $self->cust_bill;
3127     my $balance = $self->balance;
3128     my $previous_balance = scalar(@cust_bill)
3129                              ? ( $cust_bill[$#cust_bill]->billing_balance || 0 )
3130                              : 0;
3131
3132     $previous_balance += $cust_bill[$#cust_bill]->charged
3133       if scalar(@cust_bill);
3134     #my $balance_adjustments =
3135     #  sprintf('%.2f', $balance - $prior_prior_balance - $prior_charged);
3136
3137     #create the new invoice
3138     my $cust_bill = new FS::cust_bill ( {
3139       'custnum'             => $self->custnum,
3140       '_date'               => ( $invoice_time ),
3141       'charged'             => $charged,
3142       'billing_balance'     => $balance,
3143       'previous_balance'    => $previous_balance,
3144       'invoice_terms'       => $options{'invoice_terms'},
3145     } );
3146     $error = $cust_bill->insert;
3147     if ( $error ) {
3148       $dbh->rollback if $oldAutoCommit;
3149       return "can't create invoice for customer #". $self->custnum. ": $error";
3150     }
3151
3152     foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
3153       $cust_bill_pkg->invnum($cust_bill->invnum);
3154       my $error = $cust_bill_pkg->insert;
3155       if ( $error ) {
3156         $dbh->rollback if $oldAutoCommit;
3157         return "can't create invoice line item: $error";
3158       }
3159     }
3160
3161   } #foreach my $pass ( keys %cust_bill_pkg )
3162
3163   foreach my $hook ( @precommit_hooks ) {
3164     eval {
3165       &{$hook}; #($self) ?
3166     };
3167     if ( $@ ) {
3168       $dbh->rollback if $oldAutoCommit;
3169       return "$@ running precommit hook $hook\n";
3170     }
3171   }
3172
3173   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3174   ''; #no error
3175 }
3176
3177 #discard bundled packages of 0 value
3178 sub _omit_zero_value_bundles {
3179
3180   my @cust_bill_pkg = ();
3181   my @cust_bill_pkg_bundle = ();
3182   my $sum = 0;
3183
3184   foreach my $cust_bill_pkg ( @_ ) {
3185     if (scalar(@cust_bill_pkg_bundle) && !$cust_bill_pkg->pkgpart_override) {
3186       push @cust_bill_pkg, @cust_bill_pkg_bundle if $sum > 0;
3187       @cust_bill_pkg_bundle = ();
3188       $sum = 0;
3189     }
3190     $sum += $cust_bill_pkg->setup + $cust_bill_pkg->recur;
3191     push @cust_bill_pkg_bundle, $cust_bill_pkg;
3192   }
3193   push @cust_bill_pkg, @cust_bill_pkg_bundle if $sum > 0;
3194
3195   (@cust_bill_pkg);
3196
3197 }
3198
3199 =item calculate_taxes LINEITEMREF TAXHASHREF INVOICE_TIME
3200
3201 This is a weird one.  Perhaps it should not even be exposed.
3202
3203 Generates tax line items (see L<FS::cust_bill_pkg>) for this customer.
3204 Usually used internally by bill method B<bill>.
3205
3206 If there is an error, returns the error, otherwise returns reference to a
3207 list of line items suitable for insertion.
3208
3209 =over 4
3210
3211 =item LINEITEMREF
3212
3213 An array ref of the line items being billed.
3214
3215 =item TAXHASHREF
3216
3217 A strange beast.  The keys to this hash are internal identifiers consisting
3218 of the name of the tax object type, a space, and its unique identifier ( e.g.
3219  'cust_main_county 23' ).  The values of the hash are listrefs.  The first
3220 item in the list is the tax object.  The remaining items are either line
3221 items or floating point values (currency amounts).
3222
3223 The taxes are calculated on this entity.  Calculated exemption records are
3224 transferred to the LINEITEMREF items on the assumption that they are related.
3225
3226 Read the source.
3227
3228 =item INVOICE_TIME
3229
3230 This specifies the date appearing on the associated invoice.  Some
3231 jurisdictions (i.e. Texas) have tax exemptions which are date sensitive.
3232
3233 =back
3234
3235 =cut
3236 sub calculate_taxes {
3237   my ($self, $cust_bill_pkg, $taxlisthash, $invoice_time) = @_;
3238
3239   my @tax_line_items = ();
3240
3241   warn "having a look at the taxes we found...\n" if $DEBUG > 2;
3242
3243   # keys are tax names (as printed on invoices / itemdesc )
3244   # values are listrefs of taxlisthash keys (internal identifiers)
3245   my %taxname = ();
3246
3247   # keys are taxlisthash keys (internal identifiers)
3248   # values are (cumulative) amounts
3249   my %tax = ();
3250
3251   # keys are taxlisthash keys (internal identifiers)
3252   # values are listrefs of cust_bill_pkg_tax_location hashrefs
3253   my %tax_location = ();
3254
3255   # keys are taxlisthash keys (internal identifiers)
3256   # values are listrefs of cust_bill_pkg_tax_rate_location hashrefs
3257   my %tax_rate_location = ();
3258
3259   foreach my $tax ( keys %$taxlisthash ) {
3260     my $tax_object = shift @{ $taxlisthash->{$tax} };
3261     warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
3262     warn " ". join('/', @{ $taxlisthash->{$tax} } ). "\n" if $DEBUG > 2;
3263     my $hashref_or_error =
3264       $tax_object->taxline( $taxlisthash->{$tax},
3265                             'custnum'      => $self->custnum,
3266                             'invoice_time' => $invoice_time
3267                           );
3268     return $hashref_or_error unless ref($hashref_or_error);
3269
3270     unshift @{ $taxlisthash->{$tax} }, $tax_object;
3271
3272     my $name   = $hashref_or_error->{'name'};
3273     my $amount = $hashref_or_error->{'amount'};
3274
3275     #warn "adding $amount as $name\n";
3276     $taxname{ $name } ||= [];
3277     push @{ $taxname{ $name } }, $tax;
3278
3279     $tax{ $tax } += $amount;
3280
3281     $tax_location{ $tax } ||= [];
3282     if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) {
3283       push @{ $tax_location{ $tax }  },
3284         {
3285           'taxnum'      => $tax_object->taxnum,
3286           'taxtype'     => ref($tax_object),
3287           'pkgnum'      => $tax_object->get('pkgnum'),
3288           'locationnum' => $tax_object->get('locationnum'),
3289           'amount'      => sprintf('%.2f', $amount ),
3290         };
3291     }
3292
3293     $tax_rate_location{ $tax } ||= [];
3294     if ( ref($tax_object) eq 'FS::tax_rate' ) {
3295       my $taxratelocationnum =
3296         $tax_object->tax_rate_location->taxratelocationnum;
3297       push @{ $tax_rate_location{ $tax }  },
3298         {
3299           'taxnum'             => $tax_object->taxnum,
3300           'taxtype'            => ref($tax_object),
3301           'amount'             => sprintf('%.2f', $amount ),
3302           'locationtaxid'      => $tax_object->location,
3303           'taxratelocationnum' => $taxratelocationnum,
3304         };
3305     }
3306
3307   }
3308
3309   #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
3310   my %packagemap = map { $_->pkgnum => $_ } @$cust_bill_pkg;
3311   foreach my $tax ( keys %$taxlisthash ) {
3312     foreach ( @{ $taxlisthash->{$tax} }[1 ... scalar(@{ $taxlisthash->{$tax} })] ) {
3313       next unless ref($_) eq 'FS::cust_bill_pkg';
3314
3315       push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
3316         splice( @{ $_->_cust_tax_exempt_pkg } );
3317     }
3318   }
3319
3320   #consolidate and create tax line items
3321   warn "consolidating and generating...\n" if $DEBUG > 2;
3322   foreach my $taxname ( keys %taxname ) {
3323     my $tax = 0;
3324     my %seen = ();
3325     my @cust_bill_pkg_tax_location = ();
3326     my @cust_bill_pkg_tax_rate_location = ();
3327     warn "adding $taxname\n" if $DEBUG > 1;
3328     foreach my $taxitem ( @{ $taxname{$taxname} } ) {
3329       next if $seen{$taxitem}++;
3330       warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
3331       $tax += $tax{$taxitem};
3332       push @cust_bill_pkg_tax_location,
3333         map { new FS::cust_bill_pkg_tax_location $_ }
3334             @{ $tax_location{ $taxitem } };
3335       push @cust_bill_pkg_tax_rate_location,
3336         map { new FS::cust_bill_pkg_tax_rate_location $_ }
3337             @{ $tax_rate_location{ $taxitem } };
3338     }
3339     next unless $tax;
3340
3341     $tax = sprintf('%.2f', $tax );
3342
3343     my $pkg_category = qsearchs( 'pkg_category', { 'categoryname' => $taxname,
3344                                                    'disabled'     => '',
3345                                                  },
3346                                );
3347
3348     my @display = ();
3349     if ( $pkg_category and
3350          $conf->config('invoice_latexsummary') ||
3351          $conf->config('invoice_htmlsummary')
3352        )
3353     {
3354
3355       my %hash = (  'section' => $pkg_category->categoryname );
3356       push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
3357
3358     }
3359
3360     push @tax_line_items, new FS::cust_bill_pkg {
3361       'pkgnum'   => 0,
3362       'setup'    => $tax,
3363       'recur'    => 0,
3364       'sdate'    => '',
3365       'edate'    => '',
3366       'itemdesc' => $taxname,
3367       'display'  => \@display,
3368       'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
3369       'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location,
3370     };
3371
3372   }
3373
3374   \@tax_line_items;
3375 }
3376
3377 sub _make_lines {
3378   my ($self, %params) = @_;
3379
3380   my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
3381   my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
3382   my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
3383   my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
3384   my $total_setup = $params{setup} or die "no setup accumulator specified";
3385   my $total_recur = $params{recur} or die "no recur accumulator specified";
3386   my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
3387   my $time = $params{'time'} or die "no time specified";
3388   my (%options) = %{$params{options}};
3389
3390   my $dbh = dbh;
3391   my $real_pkgpart = $params{real_pkgpart};
3392   my %hash = $cust_pkg->hash;
3393   my $old_cust_pkg = new FS::cust_pkg \%hash;
3394
3395   my @details = ();
3396   my @discounts = ();
3397   my $lineitems = 0;
3398
3399   $cust_pkg->pkgpart($part_pkg->pkgpart);
3400
3401   ###
3402   # bill setup
3403   ###
3404
3405   my $setup = 0;
3406   my $unitsetup = 0;
3407   if ( $options{'resetup'}
3408        || ( ! $cust_pkg->setup
3409             && ( ! $cust_pkg->start_date
3410                  || $cust_pkg->start_date <= $time
3411                )
3412             && ( ! $conf->exists('disable_setup_suspended_pkgs')
3413                  || ( $conf->exists('disable_setup_suspended_pkgs') &&
3414                       ! $cust_pkg->getfield('susp')
3415                     )
3416                )
3417           )
3418     )
3419   {
3420
3421     warn "    bill setup\n" if $DEBUG > 1;
3422     $lineitems++;
3423
3424     $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
3425     return "$@ running calc_setup for $cust_pkg\n"
3426       if $@;
3427
3428     $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
3429
3430     $cust_pkg->setfield('setup', $time)
3431       unless $cust_pkg->setup;
3432           #do need it, but it won't get written to the db
3433           #|| $cust_pkg->pkgpart != $real_pkgpart;
3434
3435     $cust_pkg->setfield('start_date', '')
3436       if $cust_pkg->start_date;
3437
3438   }
3439
3440   ###
3441   # bill recurring fee
3442   ###
3443
3444   #XXX unit stuff here too
3445   my $recur = 0;
3446   my $unitrecur = 0;
3447   my $sdate;
3448   if (     ! $cust_pkg->get('susp')
3449        and ! $cust_pkg->get('start_date')
3450        and ( $part_pkg->getfield('freq') ne '0'
3451              && ( $cust_pkg->getfield('bill') || 0 ) <= $time
3452            )
3453         || ( $part_pkg->plan eq 'voip_cdr'
3454               && $part_pkg->option('bill_every_call')
3455            )
3456         || ( $options{cancel} )
3457   ) {
3458
3459     # XXX should this be a package event?  probably.  events are called
3460     # at collection time at the moment, though...
3461     $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
3462       if $part_pkg->can('reset_usage');
3463       #don't want to reset usage just cause we want a line item??
3464       #&& $part_pkg->pkgpart == $real_pkgpart;
3465
3466     warn "    bill recur\n" if $DEBUG > 1;
3467     $lineitems++;
3468
3469     # XXX shared with $recur_prog
3470     $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
3471              || $cust_pkg->setup
3472              || $time;
3473
3474     #over two params!  lets at least switch to a hashref for the rest...
3475     my $increment_next_bill = ( $part_pkg->freq ne '0'
3476                                 && ( $cust_pkg->getfield('bill') || 0 ) <= $time
3477                                 && !$options{cancel}
3478                               );
3479     my %param = ( 'precommit_hooks'     => $precommit_hooks,
3480                   'increment_next_bill' => $increment_next_bill,
3481                   'discounts'           => \@discounts,
3482                   'real_pkgpart'        => $real_pkgpart,
3483                 );
3484
3485     my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
3486     $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
3487     return "$@ running $method for $cust_pkg\n"
3488       if ( $@ );
3489
3490     if ( $increment_next_bill ) {
3491
3492       my $next_bill = $part_pkg->add_freq($sdate);
3493       return "unparsable frequency: ". $part_pkg->freq
3494         if $next_bill == -1;
3495
3496       #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
3497       # only for figuring next bill date, nothing else, so, reset $sdate again
3498       # here
3499       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
3500       #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
3501       $cust_pkg->last_bill($sdate);
3502
3503       $cust_pkg->setfield('bill', $next_bill );
3504
3505     }
3506
3507   }
3508
3509   warn "\$setup is undefined" unless defined($setup);
3510   warn "\$recur is undefined" unless defined($recur);
3511   warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
3512
3513   ###
3514   # If there's line items, create em cust_bill_pkg records
3515   # If $cust_pkg has been modified, update it (if we're a real pkgpart)
3516   ###
3517
3518   if ( $lineitems || $options{has_hidden} ) {
3519
3520     if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
3521       # hmm.. and if just the options are modified in some weird price plan?
3522
3523       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n"
3524         if $DEBUG >1;
3525
3526       my $error = $cust_pkg->replace( $old_cust_pkg,
3527                                       'options' => { $cust_pkg->options },
3528                                     );
3529       return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
3530         if $error; #just in case
3531     }
3532
3533     $setup = sprintf( "%.2f", $setup );
3534     $recur = sprintf( "%.2f", $recur );
3535     if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
3536       return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
3537     }
3538     if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
3539       return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
3540     }
3541
3542     if ( $setup != 0 ||
3543          $recur != 0 ||
3544          !$part_pkg->hidden && $options{has_hidden} ) #include some $0 lines
3545     {
3546
3547       warn "    charges (setup=$setup, recur=$recur); adding line items\n"
3548         if $DEBUG > 1;
3549
3550       my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
3551       if ( $DEBUG > 1 ) {
3552         warn "      adding customer package invoice detail: $_\n"
3553           foreach @cust_pkg_detail;
3554       }
3555       push @details, @cust_pkg_detail;
3556
3557       my $cust_bill_pkg = new FS::cust_bill_pkg {
3558         'pkgnum'    => $cust_pkg->pkgnum,
3559         'setup'     => $setup,
3560         'unitsetup' => $unitsetup,
3561         'recur'     => $recur,
3562         'unitrecur' => $unitrecur,
3563         'quantity'  => $cust_pkg->quantity,
3564         'details'   => \@details,
3565         'discounts' => \@discounts,
3566         'hidden'    => $part_pkg->hidden,
3567       };
3568
3569       if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
3570         $cust_bill_pkg->sdate( $hash{last_bill} );
3571         $cust_bill_pkg->edate( $sdate - 86399   ); #60s*60m*24h-1
3572         $cust_bill_pkg->edate( $time ) if $options{cancel};
3573       } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
3574         $cust_bill_pkg->sdate( $sdate );
3575         $cust_bill_pkg->edate( $cust_pkg->bill );
3576         #$cust_bill_pkg->edate( $time ) if $options{cancel};
3577       }
3578
3579       $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
3580         unless $part_pkg->pkgpart == $real_pkgpart;
3581
3582       $$total_setup += $setup;
3583       $$total_recur += $recur;
3584
3585       ###
3586       # handle taxes
3587       ###
3588
3589       my $error =
3590         $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time}, $real_pkgpart, \%options);
3591       return $error if $error;
3592
3593       push @$cust_bill_pkgs, $cust_bill_pkg;
3594
3595     } #if $setup != 0 || $recur != 0
3596
3597   } #if $line_items
3598
3599   '';
3600
3601 }
3602
3603 sub _handle_taxes {
3604   my $self = shift;
3605   my $part_pkg = shift;
3606   my $taxlisthash = shift;
3607   my $cust_bill_pkg = shift;
3608   my $cust_pkg = shift;
3609   my $invoice_time = shift;
3610   my $real_pkgpart = shift;
3611   my $options = shift;
3612
3613   my %cust_bill_pkg = ();
3614   my %taxes = ();
3615
3616   my @classes;
3617   #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
3618   push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
3619   push @classes, 'setup' if ($cust_bill_pkg->setup && !$options->{cancel});
3620   push @classes, 'recur' if ($cust_bill_pkg->recur && !$options->{cancel});
3621
3622   if ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
3623
3624     if ( $conf->exists('enable_taxproducts')
3625          && ( scalar($part_pkg->part_pkg_taxoverride)
3626               || $part_pkg->has_taxproduct
3627             )
3628        )
3629     {
3630
3631       if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
3632         return "fatal: Can't (yet) use tax-pkg_address with taxproducts";
3633       }
3634
3635       foreach my $class (@classes) {
3636         my $err_or_ref = $self->_gather_taxes( $part_pkg, $class );
3637         return $err_or_ref unless ref($err_or_ref);
3638         $taxes{$class} = $err_or_ref;
3639       }
3640
3641       unless (exists $taxes{''}) {
3642         my $err_or_ref = $self->_gather_taxes( $part_pkg, '' );
3643         return $err_or_ref unless ref($err_or_ref);
3644         $taxes{''} = $err_or_ref;
3645       }
3646
3647     } else {
3648
3649       my @loc_keys = qw( city county state country );
3650       my %taxhash;
3651       if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
3652         my $cust_location = $cust_pkg->cust_location;
3653         %taxhash = map { $_ => $cust_location->$_()    } @loc_keys;
3654       } else {
3655         my $prefix =
3656           ( $conf->exists('tax-ship_address') && length($self->ship_last) )
3657           ? 'ship_'
3658           : '';
3659         %taxhash = map { $_ => $self->get("$prefix$_") } @loc_keys;
3660       }
3661
3662       $taxhash{'taxclass'} = $part_pkg->taxclass;
3663
3664       my @taxes = ();
3665       my %taxhash_elim = %taxhash;
3666       my @elim = qw( city county state );
3667       do {
3668
3669         #first try a match with taxclass
3670         @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
3671
3672         if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) {
3673           #then try a match without taxclass
3674           my %no_taxclass = %taxhash_elim;
3675           $no_taxclass{ 'taxclass' } = '';
3676           @taxes = qsearch( 'cust_main_county', \%no_taxclass );
3677         }
3678
3679         $taxhash_elim{ shift(@elim) } = '';
3680
3681       } while ( !scalar(@taxes) && scalar(@elim) );
3682
3683       @taxes = grep { ! $_->taxname or ! $self->tax_exemption($_->taxname) }
3684                     @taxes
3685         if $self->cust_main_exemption; #just to be safe
3686
3687       if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
3688         foreach (@taxes) {
3689           $_->set('pkgnum',      $cust_pkg->pkgnum );
3690           $_->set('locationnum', $cust_pkg->locationnum );
3691         }
3692       }
3693
3694       $taxes{''} = [ @taxes ];
3695       $taxes{'setup'} = [ @taxes ];
3696       $taxes{'recur'} = [ @taxes ];
3697       $taxes{$_} = [ @taxes ] foreach (@classes);
3698
3699       # # maybe eliminate this entirely, along with all the 0% records
3700       # unless ( @taxes ) {
3701       #   return
3702       #     "fatal: can't find tax rate for state/county/country/taxclass ".
3703       #     join('/', map $taxhash{$_}, qw(state county country taxclass) );
3704       # }
3705
3706     } #if $conf->exists('enable_taxproducts') ...
3707
3708   }
3709
3710   my @display = ();
3711   my $separate = $conf->exists('separate_usage');
3712   my $temp_pkg = new FS::cust_pkg { pkgpart => $real_pkgpart };
3713   my $usage_mandate = $temp_pkg->part_pkg->option('usage_mandate', 'Hush!');
3714   my $section = $temp_pkg->part_pkg->categoryname;
3715   if ( $separate || $section || $usage_mandate ) {
3716
3717     my %hash = ( 'section' => $section );
3718
3719     $section = $temp_pkg->part_pkg->option('usage_section', 'Hush!');
3720     my $summary = $temp_pkg->part_pkg->option('summarize_usage', 'Hush!');
3721     if ( $separate ) {
3722       push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
3723       push @display, new FS::cust_bill_pkg_display { type => 'R', %hash };
3724     } else {
3725       push @display, new FS::cust_bill_pkg_display
3726                        { type => '',
3727                          %hash,
3728                          ( ( $usage_mandate ) ? ( 'summary' => 'Y' ) : () ),
3729                        };
3730     }
3731
3732     if ($separate && $section && $summary) {
3733       push @display, new FS::cust_bill_pkg_display { type    => 'U',
3734                                                      summary => 'Y',
3735                                                      %hash,
3736                                                    };
3737     }
3738     if ($usage_mandate || $section && $summary) {
3739       $hash{post_total} = 'Y';
3740     }
3741
3742     if ($separate || $usage_mandate) {
3743       $hash{section} = $section if ($separate || $usage_mandate);
3744       push @display, new FS::cust_bill_pkg_display { type => 'U', %hash };
3745     }
3746
3747   }
3748   $cust_bill_pkg->set('display', \@display);
3749
3750   my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
3751   foreach my $key (keys %tax_cust_bill_pkg) {
3752     my @taxes = @{ $taxes{$key} || [] };
3753     my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
3754
3755     my %localtaxlisthash = ();
3756     foreach my $tax ( @taxes ) {
3757
3758       my $taxname = ref( $tax ). ' '. $tax->taxnum;
3759 #      $taxname .= ' pkgnum'. $cust_pkg->pkgnum.
3760 #                  ' locationnum'. $cust_pkg->locationnum
3761 #        if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum;
3762
3763       $taxlisthash->{ $taxname } ||= [ $tax ];
3764       push @{ $taxlisthash->{ $taxname  } }, $tax_cust_bill_pkg;
3765
3766       $localtaxlisthash{ $taxname } ||= [ $tax ];
3767       push @{ $localtaxlisthash{ $taxname  } }, $tax_cust_bill_pkg;
3768
3769     }
3770
3771     warn "finding taxed taxes...\n" if $DEBUG > 2;
3772     foreach my $tax ( keys %localtaxlisthash ) {
3773       my $tax_object = shift @{ $localtaxlisthash{$tax} };
3774       warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
3775         if $DEBUG > 2;
3776       next unless $tax_object->can('tax_on_tax');
3777
3778       foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
3779         my $totname = ref( $tot ). ' '. $tot->taxnum;
3780
3781         warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
3782           if $DEBUG > 2;
3783         next unless exists( $localtaxlisthash{ $totname } ); # only increase
3784                                                              # existing taxes
3785         warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
3786         my $hashref_or_error =
3787           $tax_object->taxline( $localtaxlisthash{$tax},
3788                                 'custnum'      => $self->custnum,
3789                                 'invoice_time' => $invoice_time,
3790                               );
3791         return $hashref_or_error
3792           unless ref($hashref_or_error);
3793
3794         $taxlisthash->{ $totname } ||= [ $tot ];
3795         push @{ $taxlisthash->{ $totname  } }, $hashref_or_error->{amount};
3796
3797       }
3798     }
3799
3800   }
3801
3802   '';
3803 }
3804
3805 sub _gather_taxes {
3806   my $self = shift;
3807   my $part_pkg = shift;
3808   my $class = shift;
3809
3810   my @taxes = ();
3811   my $geocode = $self->geocode('cch');
3812
3813   my @taxclassnums = map { $_->taxclassnum }
3814                      $part_pkg->part_pkg_taxoverride($class);
3815
3816   unless (@taxclassnums) {
3817     @taxclassnums = map { $_->taxclassnum }
3818                     grep { $_->taxable eq 'Y' }
3819                     $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
3820   }
3821   warn "Found taxclassnum values of ". join(',', @taxclassnums)
3822     if $DEBUG;
3823
3824   my $extra_sql =
3825     "AND (".
3826     join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
3827
3828   @taxes = qsearch({ 'table' => 'tax_rate',
3829                      'hashref' => { 'geocode' => $geocode, },
3830                      'extra_sql' => $extra_sql,
3831                   })
3832     if scalar(@taxclassnums);
3833
3834   warn "Found taxes ".
3835        join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
3836    if $DEBUG;
3837
3838   [ @taxes ];
3839
3840 }
3841
3842 =item collect [ HASHREF | OPTION => VALUE ... ]
3843
3844 (Attempt to) collect money for this customer's outstanding invoices (see
3845 L<FS::cust_bill>).  Usually used after the bill method.
3846
3847 Actions are now triggered by billing events; see L<FS::part_event> and the
3848 billing events web interface.  Old-style invoice events (see
3849 L<FS::part_bill_event>) have been deprecated.
3850
3851 If there is an error, returns the error, otherwise returns false.
3852
3853 Options are passed as name-value pairs.
3854
3855 Currently available options are:
3856
3857 =over 4
3858
3859 =item invoice_time
3860
3861 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.
3862
3863 =item retry
3864
3865 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
3866
3867 =item check_freq
3868
3869 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
3870
3871 =item quiet
3872
3873 set true to surpress email card/ACH decline notices.
3874
3875 =item debug
3876
3877 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)
3878
3879 =back
3880
3881 # =item payby
3882 #
3883 # allows for one time override of normal customer billing method
3884
3885 =cut
3886
3887 sub collect {
3888   my( $self, %options ) = @_;
3889   my $invoice_time = $options{'invoice_time'} || time;
3890
3891   #put below somehow?
3892   local $SIG{HUP} = 'IGNORE';
3893   local $SIG{INT} = 'IGNORE';
3894   local $SIG{QUIT} = 'IGNORE';
3895   local $SIG{TERM} = 'IGNORE';
3896   local $SIG{TSTP} = 'IGNORE';
3897   local $SIG{PIPE} = 'IGNORE';
3898
3899   my $oldAutoCommit = $FS::UID::AutoCommit;
3900   local $FS::UID::AutoCommit = 0;
3901   my $dbh = dbh;
3902
3903   $self->select_for_update; #mutex
3904
3905   if ( $DEBUG ) {
3906     my $balance = $self->balance;
3907     warn "$me collect customer ". $self->custnum. ": balance $balance\n"
3908   }
3909
3910   if ( exists($options{'retry_card'}) ) {
3911     carp 'retry_card option passed to collect is deprecated; use retry';
3912     $options{'retry'} ||= $options{'retry_card'};
3913   }
3914   if ( exists($options{'retry'}) && $options{'retry'} ) {
3915     my $error = $self->retry_realtime;
3916     if ( $error ) {
3917       $dbh->rollback if $oldAutoCommit;
3918       return $error;
3919     }
3920   }
3921
3922   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3923
3924   #never want to roll back an event just because it returned an error
3925   local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
3926
3927   $self->do_cust_event(
3928     'debug'      => ( $options{'debug'} || 0 ),
3929     'time'       => $invoice_time,
3930     'check_freq' => $options{'check_freq'},
3931     'stage'      => 'collect',
3932   );
3933
3934 }
3935
3936 =item do_cust_event [ HASHREF | OPTION => VALUE ... ]
3937
3938 Runs billing events; see L<FS::part_event> and the billing events web
3939 interface.
3940
3941 If there is an error, returns the error, otherwise returns false.
3942
3943 Options are passed as name-value pairs.
3944
3945 Currently available options are:
3946
3947 =over 4
3948
3949 =item time
3950
3951 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.
3952
3953 =item check_freq
3954
3955 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
3956
3957 =item stage
3958
3959 "collect" (the default) or "pre-bill"
3960
3961 =item quiet
3962
3963 set true to surpress email card/ACH decline notices.
3964
3965 =item debug
3966
3967 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)
3968
3969 =cut
3970
3971 # =item payby
3972 #
3973 # allows for one time override of normal customer billing method
3974
3975 # =item retry
3976 #
3977 # Retry card/echeck/LEC transactions even when not scheduled by invoice events.
3978
3979 sub do_cust_event {
3980   my( $self, %options ) = @_;
3981   my $time = $options{'time'} || time;
3982
3983   #put below somehow?
3984   local $SIG{HUP} = 'IGNORE';
3985   local $SIG{INT} = 'IGNORE';
3986   local $SIG{QUIT} = 'IGNORE';
3987   local $SIG{TERM} = 'IGNORE';
3988   local $SIG{TSTP} = 'IGNORE';
3989   local $SIG{PIPE} = 'IGNORE';
3990
3991   my $oldAutoCommit = $FS::UID::AutoCommit;
3992   local $FS::UID::AutoCommit = 0;
3993   my $dbh = dbh;
3994
3995   $self->select_for_update; #mutex
3996
3997   if ( $DEBUG ) {
3998     my $balance = $self->balance;
3999     warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
4000   }
4001
4002 #  if ( exists($options{'retry_card'}) ) {
4003 #    carp 'retry_card option passed to collect is deprecated; use retry';
4004 #    $options{'retry'} ||= $options{'retry_card'};
4005 #  }
4006 #  if ( exists($options{'retry'}) && $options{'retry'} ) {
4007 #    my $error = $self->retry_realtime;
4008 #    if ( $error ) {
4009 #      $dbh->rollback if $oldAutoCommit;
4010 #      return $error;
4011 #    }
4012 #  }
4013
4014   # false laziness w/pay_batch::import_results
4015
4016   my $due_cust_event = $self->due_cust_event(
4017     'debug'      => ( $options{'debug'} || 0 ),
4018     'time'       => $time,
4019     'check_freq' => $options{'check_freq'},
4020     'stage'      => ( $options{'stage'} || 'collect' ),
4021   );
4022   unless( ref($due_cust_event) ) {
4023     $dbh->rollback if $oldAutoCommit;
4024     return $due_cust_event;
4025   }
4026
4027   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4028   #never want to roll back an event just because it or a different one
4029   # returned an error
4030   local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
4031
4032   foreach my $cust_event ( @$due_cust_event ) {
4033
4034     #XXX lock event
4035
4036     #re-eval event conditions (a previous event could have changed things)
4037     unless ( $cust_event->test_conditions( 'time' => $time ) ) {
4038       #don't leave stray "new/locked" records around
4039       my $error = $cust_event->delete;
4040       return $error if $error;
4041       next;
4042     }
4043
4044     {
4045       local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
4046       warn "  running cust_event ". $cust_event->eventnum. "\n"
4047         if $DEBUG > 1;
4048
4049       #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
4050       if ( my $error = $cust_event->do_event() ) {
4051         #XXX wtf is this?  figure out a proper dealio with return value
4052         #from do_event
4053         return $error;
4054       }
4055     }
4056
4057   }
4058
4059   '';
4060
4061 }
4062
4063 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
4064
4065 Inserts database records for and returns an ordered listref of new events due
4066 for this customer, as FS::cust_event objects (see L<FS::cust_event>).  If no
4067 events are due, an empty listref is returned.  If there is an error, returns a
4068 scalar error message.
4069
4070 To actually run the events, call each event's test_condition method, and if
4071 still true, call the event's do_event method.
4072
4073 Options are passed as a hashref or as a list of name-value pairs.  Available
4074 options are:
4075
4076 =over 4
4077
4078 =item check_freq
4079
4080 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.
4081
4082 =item stage
4083
4084 "collect" (the default) or "pre-bill"
4085
4086 =item time
4087
4088 "Current time" for the events.
4089
4090 =item debug
4091
4092 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)
4093
4094 =item eventtable
4095
4096 Only return events for the specified eventtable (by default, events of all eventtables are returned)
4097
4098 =item objects
4099
4100 Explicitly pass the objects to be tested (typically used with eventtable).
4101
4102 =item testonly
4103
4104 Set to true to return the objects, but not actually insert them into the
4105 database.
4106
4107 =back
4108
4109 =cut
4110
4111 sub due_cust_event {
4112   my $self = shift;
4113   my %opt = ref($_[0]) ? %{ $_[0] } : @_;
4114
4115   #???
4116   #my $DEBUG = $opt{'debug'}
4117   local($DEBUG) = $opt{'debug'}
4118     if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
4119
4120   warn "$me due_cust_event called with options ".
4121        join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
4122     if $DEBUG;
4123
4124   $opt{'time'} ||= time;
4125
4126   local $SIG{HUP} = 'IGNORE';
4127   local $SIG{INT} = 'IGNORE';
4128   local $SIG{QUIT} = 'IGNORE';
4129   local $SIG{TERM} = 'IGNORE';
4130   local $SIG{TSTP} = 'IGNORE';
4131   local $SIG{PIPE} = 'IGNORE';
4132
4133   my $oldAutoCommit = $FS::UID::AutoCommit;
4134   local $FS::UID::AutoCommit = 0;
4135   my $dbh = dbh;
4136
4137   $self->select_for_update #mutex
4138     unless $opt{testonly};
4139
4140   ###
4141   # find possible events (initial search)
4142   ###
4143
4144   my @cust_event = ();
4145
4146   my @eventtable = $opt{'eventtable'}
4147                      ? ( $opt{'eventtable'} )
4148                      : FS::part_event->eventtables_runorder;
4149
4150   foreach my $eventtable ( @eventtable ) {
4151
4152     my @objects;
4153     if ( $opt{'objects'} ) {
4154
4155       @objects = @{ $opt{'objects'} };
4156
4157     } else {
4158
4159       #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
4160       @objects = ( $eventtable eq 'cust_main' )
4161                    ? ( $self )
4162                    : ( $self->$eventtable() );
4163
4164     }
4165
4166     my @e_cust_event = ();
4167
4168     my $cross = "CROSS JOIN $eventtable";
4169     $cross .= ' LEFT JOIN cust_main USING ( custnum )'
4170       unless $eventtable eq 'cust_main';
4171
4172     foreach my $object ( @objects ) {
4173
4174       #this first search uses the condition_sql magic for optimization.
4175       #the more possible events we can eliminate in this step the better
4176
4177       my $cross_where = '';
4178       my $pkey = $object->primary_key;
4179       $cross_where = "$eventtable.$pkey = ". $object->$pkey();
4180
4181       my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
4182       my $extra_sql =
4183         FS::part_event_condition->where_conditions_sql( $eventtable,
4184                                                         'time'=>$opt{'time'}
4185                                                       );
4186       my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
4187
4188       $extra_sql = "AND $extra_sql" if $extra_sql;
4189
4190       #here is the agent virtualization
4191       $extra_sql .= " AND (    part_event.agentnum IS NULL
4192                             OR part_event.agentnum = ". $self->agentnum. ' )';
4193
4194       $extra_sql .= " $order";
4195
4196       warn "searching for events for $eventtable ". $object->$pkey. "\n"
4197         if $opt{'debug'} > 2;
4198       my @part_event = qsearch( {
4199         'debug'     => ( $opt{'debug'} > 3 ? 1 : 0 ),
4200         'select'    => 'part_event.*',
4201         'table'     => 'part_event',
4202         'addl_from' => "$cross $join",
4203         'hashref'   => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
4204                          'eventtable' => $eventtable,
4205                          'disabled'   => '',
4206                        },
4207         'extra_sql' => "AND $cross_where $extra_sql",
4208       } );
4209
4210       if ( $DEBUG > 2 ) {
4211         my $pkey = $object->primary_key;
4212         warn "      ". scalar(@part_event).
4213              " possible events found for $eventtable ". $object->$pkey(). "\n";
4214       }
4215
4216       push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
4217
4218     }
4219
4220     warn "    ". scalar(@e_cust_event).
4221          " subtotal possible cust events found for $eventtable\n"
4222       if $DEBUG > 1;
4223
4224     push @cust_event, @e_cust_event;
4225
4226   }
4227
4228   warn "  ". scalar(@cust_event).
4229        " total possible cust events found in initial search\n"
4230     if $DEBUG; # > 1;
4231
4232
4233   ##
4234   # test stage
4235   ##
4236
4237   $opt{stage} ||= 'collect';
4238   @cust_event =
4239     grep { my $stage = $_->part_event->event_stage;
4240            $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
4241          }
4242          @cust_event;
4243
4244   ##
4245   # test conditions
4246   ##
4247
4248   my %unsat = ();
4249
4250   @cust_event = grep $_->test_conditions( 'time'          => $opt{'time'},
4251                                           'stats_hashref' => \%unsat ),
4252                      @cust_event;
4253
4254   warn "  ". scalar(@cust_event). " cust events left satisfying conditions\n"
4255     if $DEBUG; # > 1;
4256
4257   warn "    invalid conditions not eliminated with condition_sql:\n".
4258        join('', map "      $_: ".$unsat{$_}."\n", keys %unsat )
4259     if keys %unsat && $DEBUG; # > 1;
4260
4261   ##
4262   # insert
4263   ##
4264
4265   unless( $opt{testonly} ) {
4266     foreach my $cust_event ( @cust_event ) {
4267
4268       my $error = $cust_event->insert();
4269       if ( $error ) {
4270         $dbh->rollback if $oldAutoCommit;
4271         return $error;
4272       }
4273
4274     }
4275   }
4276
4277   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4278
4279   ##
4280   # return
4281   ##
4282
4283   warn "  returning events: ". Dumper(@cust_event). "\n"
4284     if $DEBUG > 2;
4285
4286   \@cust_event;
4287
4288 }
4289
4290 =item retry_realtime
4291
4292 Schedules realtime / batch  credit card / electronic check / LEC billing
4293 events for for retry.  Useful if card information has changed or manual
4294 retry is desired.  The 'collect' method must be called to actually retry
4295 the transaction.
4296
4297 Implementation details: For either this customer, or for each of this
4298 customer's open invoices, changes the status of the first "done" (with
4299 statustext error) realtime processing event to "failed".
4300
4301 =cut
4302
4303 sub retry_realtime {
4304   my $self = shift;
4305
4306   local $SIG{HUP} = 'IGNORE';
4307   local $SIG{INT} = 'IGNORE';
4308   local $SIG{QUIT} = 'IGNORE';
4309   local $SIG{TERM} = 'IGNORE';
4310   local $SIG{TSTP} = 'IGNORE';
4311   local $SIG{PIPE} = 'IGNORE';
4312
4313   my $oldAutoCommit = $FS::UID::AutoCommit;
4314   local $FS::UID::AutoCommit = 0;
4315   my $dbh = dbh;
4316
4317   #a little false laziness w/due_cust_event (not too bad, really)
4318
4319   my $join = FS::part_event_condition->join_conditions_sql;
4320   my $order = FS::part_event_condition->order_conditions_sql;
4321   my $mine =
4322   '( '
4323    . join ( ' OR ' , map {
4324     "( part_event.eventtable = " . dbh->quote($_)
4325     . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
4326    } FS::part_event->eventtables)
4327    . ') ';
4328
4329   #here is the agent virtualization
4330   my $agent_virt = " (    part_event.agentnum IS NULL
4331                        OR part_event.agentnum = ". $self->agentnum. ' )';
4332
4333   #XXX this shouldn't be hardcoded, actions should declare it...
4334   my @realtime_events = qw(
4335     cust_bill_realtime_card
4336     cust_bill_realtime_check
4337     cust_bill_realtime_lec
4338     cust_bill_batch
4339   );
4340
4341   my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
4342                                                   @realtime_events
4343                                      ).
4344                           ' ) ';
4345
4346   my @cust_event = qsearchs({
4347     'table'     => 'cust_event',
4348     'select'    => 'cust_event.*',
4349     'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
4350     'hashref'   => { 'status' => 'done' },
4351     'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
4352                    " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
4353   });
4354
4355   my %seen_invnum = ();
4356   foreach my $cust_event (@cust_event) {
4357
4358     #max one for the customer, one for each open invoice
4359     my $cust_X = $cust_event->cust_X;
4360     next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
4361                           ? $cust_X->invnum
4362                           : 0
4363                         }++
4364          or $cust_event->part_event->eventtable eq 'cust_bill'
4365             && ! $cust_X->owed;
4366
4367     my $error = $cust_event->retry;
4368     if ( $error ) {
4369       $dbh->rollback if $oldAutoCommit;
4370       return "error scheduling event for retry: $error";
4371     }
4372
4373   }
4374
4375   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4376   '';
4377
4378 }
4379
4380
4381 =cut
4382
4383 =item realtime_collect [ OPTION => VALUE ... ]
4384
4385 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4386 via a Business::OnlinePayment or Business::OnlineThirdPartyPayment realtime
4387 gateway.  See L<http://420.am/business-onlinepayment> and
4388 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
4389
4390 On failure returns an error message.
4391
4392 Returns false or a hashref upon success.  The hashref contains keys popup_url reference, and collectitems.  The first is a URL to which a browser should be redirected for completion of collection.  The second is a reference id for the transaction suitable for the end user.  The collectitems is a reference to a list of name value pairs suitable for assigning to a html form and posted to popup_url.
4393
4394 Available options are: I<method>, I<amount>, I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>, I<pkgnum>
4395
4396 I<method> is one of: I<CC>, I<ECHECK> and I<LEC>.  If none is specified
4397 then it is deduced from the customer record.
4398
4399 If no I<amount> is specified, then the customer balance is used.
4400
4401 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4402 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
4403 if set, will override the value from the customer record.
4404
4405 I<description> is a free-text field passed to the gateway.  It defaults to
4406 the value defined by the business-onlinepayment-description configuration
4407 option, or "Internet services" if that is unset.
4408
4409 If an I<invnum> is specified, this payment (if successful) is applied to the
4410 specified invoice.  If you don't specify an I<invnum> you might want to
4411 call the B<apply_payments> method or set the I<apply> option.
4412
4413 I<apply> can be set to true to apply a resulting payment.
4414
4415 I<quiet> can be set true to surpress email decline notices.
4416
4417 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
4418 resulting paynum, if any.
4419
4420 I<payunique> is a unique identifier for this payment.
4421
4422 I<session_id> is a session identifier associated with this payment.
4423
4424 I<depend_jobnum> allows payment capture to unlock export jobs
4425
4426 =cut
4427
4428 sub realtime_collect {
4429   my( $self, %options ) = @_;
4430
4431   if ( $DEBUG ) {
4432     warn "$me realtime_collect:\n";
4433     warn "  $_ => $options{$_}\n" foreach keys %options;
4434   }
4435
4436   $options{amount} = $self->balance unless exists( $options{amount} );
4437   $options{method} = FS::payby->payby2bop($self->payby)
4438     unless exists( $options{method} );
4439
4440   return $self->realtime_bop({%options});
4441
4442 }
4443
4444 =item realtime_bop { [ ARG => VALUE ... ] }
4445
4446 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4447 via a Business::OnlinePayment realtime gateway.  See
4448 L<http://420.am/business-onlinepayment> for supported gateways.
4449
4450 Required arguments in the hashref are I<method>, and I<amount>
4451
4452 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4453
4454 Available optional arguments are: I<description>, I<invnum>, I<apply>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
4455
4456 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4457 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
4458 if set, will override the value from the customer record.
4459
4460 I<description> is a free-text field passed to the gateway.  It defaults to
4461 the value defined by the business-onlinepayment-description configuration
4462 option, or "Internet services" if that is unset.
4463
4464 If an I<invnum> is specified, this payment (if successful) is applied to the
4465 specified invoice.  If you don't specify an I<invnum> you might want to
4466 call the B<apply_payments> method or set the I<apply> option.
4467
4468 I<apply> can be set to true to apply a resulting payment.
4469
4470 I<quiet> can be set true to surpress email decline notices.
4471
4472 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
4473 resulting paynum, if any.
4474
4475 I<payunique> is a unique identifier for this payment.
4476
4477 I<session_id> is a session identifier associated with this payment.
4478
4479 I<depend_jobnum> allows payment capture to unlock export jobs
4480
4481 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
4482
4483 =cut
4484
4485 # some helper routines
4486 sub _bop_recurring_billing {
4487   my( $self, %opt ) = @_;
4488
4489   my $method = scalar($conf->config('credit_card-recurring_billing_flag'));
4490
4491   if ( defined($method) && $method eq 'transaction_is_recur' ) {
4492
4493     return 1 if $opt{'trans_is_recur'};
4494
4495   } else {
4496
4497     my %hash = ( 'custnum' => $self->custnum,
4498                  'payby'   => 'CARD',
4499                );
4500
4501     return 1
4502       if qsearch('cust_pay', { %hash, 'payinfo' => $opt{'payinfo'} } )
4503       || qsearch('cust_pay', { %hash, 'paymask' => $self->mask_payinfo('CARD',
4504                                                                $opt{'payinfo'} )
4505                              } );
4506
4507   }
4508
4509   return 0;
4510
4511 }
4512
4513 sub _payment_gateway {
4514   my ($self, $options) = @_;
4515
4516   $options->{payment_gateway} = $self->agent->payment_gateway( %$options )
4517     unless exists($options->{payment_gateway});
4518
4519   $options->{payment_gateway};
4520 }
4521
4522 sub _bop_auth {
4523   my ($self, $options) = @_;
4524
4525   (
4526     'login'    => $options->{payment_gateway}->gateway_username,
4527     'password' => $options->{payment_gateway}->gateway_password,
4528   );
4529 }
4530
4531 sub _bop_options {
4532   my ($self, $options) = @_;
4533
4534   $options->{payment_gateway}->gatewaynum
4535     ? $options->{payment_gateway}->options
4536     : @{ $options->{payment_gateway}->get('options') };
4537
4538 }
4539
4540 sub _bop_defaults {
4541   my ($self, $options) = @_;
4542
4543   unless ( $options->{'description'} ) {
4544     if ( $conf->exists('business-onlinepayment-description') ) {
4545       my $dtempl = $conf->config('business-onlinepayment-description');
4546
4547       my $agent = $self->agent->agent;
4548       #$pkgs... not here
4549       $options->{'description'} = eval qq("$dtempl");
4550     } else {
4551       $options->{'description'} = 'Internet services';
4552     }
4553   }
4554
4555   $options->{payinfo} = $self->payinfo unless exists( $options->{payinfo} );
4556   $options->{invnum} ||= '';
4557   $options->{payname} = $self->payname unless exists( $options->{payname} );
4558 }
4559
4560 sub _bop_content {
4561   my ($self, $options) = @_;
4562   my %content = ();
4563
4564   my $payip = exists($options->{'payip'}) ? $options->{'payip'} : $self->payip;
4565   $content{customer_ip} = $payip if length($payip);
4566
4567   $content{invoice_number} = $options->{'invnum'}
4568     if exists($options->{'invnum'}) && length($options->{'invnum'});
4569
4570   $content{email_customer} =
4571     (    $conf->exists('business-onlinepayment-email_customer')
4572       || $conf->exists('business-onlinepayment-email-override') );
4573
4574   my ($payname, $payfirst, $paylast);
4575   if ( $options->{payname} && $options->{method} ne 'ECHECK' ) {
4576     ($payname = $options->{payname}) =~
4577       /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4578       or return "Illegal payname $payname";
4579     ($payfirst, $paylast) = ($1, $2);
4580   } else {
4581     $payfirst = $self->getfield('first');
4582     $paylast = $self->getfield('last');
4583     $payname = "$payfirst $paylast";
4584   }
4585
4586   $content{last_name} = $paylast;
4587   $content{first_name} = $payfirst;
4588
4589   $content{name} = $payname;
4590
4591   $content{address} = exists($options->{'address1'})
4592                         ? $options->{'address1'}
4593                         : $self->address1;
4594   my $address2 = exists($options->{'address2'})
4595                    ? $options->{'address2'}
4596                    : $self->address2;
4597   $content{address} .= ", ". $address2 if length($address2);
4598
4599   $content{city} = exists($options->{city})
4600                      ? $options->{city}
4601                      : $self->city;
4602   $content{state} = exists($options->{state})
4603                       ? $options->{state}
4604                       : $self->state;
4605   $content{zip} = exists($options->{zip})
4606                     ? $options->{'zip'}
4607                     : $self->zip;
4608   $content{country} = exists($options->{country})
4609                         ? $options->{country}
4610                         : $self->country;
4611
4612   $content{referer} = 'http://cleanwhisker.420.am/'; #XXX fix referer :/
4613   $content{phone} = $self->daytime || $self->night;
4614
4615   \%content;
4616 }
4617
4618 my %bop_method2payby = (
4619   'CC'     => 'CARD',
4620   'ECHECK' => 'CHEK',
4621   'LEC'    => 'LECB',
4622 );
4623
4624 sub realtime_bop {
4625   my $self = shift;
4626
4627   my %options = ();
4628   if (ref($_[0]) eq 'HASH') {
4629     %options = %{$_[0]};
4630   } else {
4631     my ( $method, $amount ) = ( shift, shift );
4632     %options = @_;
4633     $options{method} = $method;
4634     $options{amount} = $amount;
4635   }
4636
4637   if ( $DEBUG ) {
4638     warn "$me realtime_bop (new): $options{method} $options{amount}\n";
4639     warn "  $_ => $options{$_}\n" foreach keys %options;
4640   }
4641
4642   return $self->fake_bop(%options) if $options{'fake'};
4643
4644   $self->_bop_defaults(\%options);
4645
4646   ###
4647   # set trans_is_recur based on invnum if there is one
4648   ###
4649
4650   my $trans_is_recur = 0;
4651   if ( $options{'invnum'} ) {
4652
4653     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
4654     die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
4655
4656     my @part_pkg =
4657       map  { $_->part_pkg }
4658       grep { $_ }
4659       map  { $_->cust_pkg }
4660       $cust_bill->cust_bill_pkg;
4661
4662     $trans_is_recur = 1
4663       if grep { $_->freq ne '0' } @part_pkg;
4664
4665   }
4666
4667   ###
4668   # select a gateway
4669   ###
4670
4671   my $payment_gateway =  $self->_payment_gateway( \%options );
4672   my $namespace = $payment_gateway->gateway_namespace;
4673
4674   eval "use $namespace";
4675   die $@ if $@;
4676
4677   ###
4678   # check for banned credit card/ACH
4679   ###
4680
4681   my $ban = qsearchs('banned_pay', {
4682     'payby'   => $bop_method2payby{$options{method}},
4683     'payinfo' => md5_base64($options{payinfo}),
4684   } );
4685   return "Banned credit card" if $ban;
4686
4687   ###
4688   # massage data
4689   ###
4690
4691   my $bop_content = $self->_bop_content(\%options);
4692   return $bop_content unless ref($bop_content);
4693
4694   my @invoicing_list = $self->invoicing_list_emailonly;
4695   if ( $conf->exists('emailinvoiceautoalways')
4696        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4697        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4698     push @invoicing_list, $self->all_emails;
4699   }
4700
4701   my $email = ($conf->exists('business-onlinepayment-email-override'))
4702               ? $conf->config('business-onlinepayment-email-override')
4703               : $invoicing_list[0];
4704
4705   my $paydate = '';
4706   my %content = ();
4707   if ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'CC' ) {
4708
4709     $content{card_number} = $options{payinfo};
4710     $paydate = exists($options{'paydate'})
4711                     ? $options{'paydate'}
4712                     : $self->paydate;
4713     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4714     $content{expiration} = "$2/$1";
4715
4716     my $paycvv = exists($options{'paycvv'})
4717                    ? $options{'paycvv'}
4718                    : $self->paycvv;
4719     $content{cvv2} = $paycvv
4720       if length($paycvv);
4721
4722     my $paystart_month = exists($options{'paystart_month'})
4723                            ? $options{'paystart_month'}
4724                            : $self->paystart_month;
4725
4726     my $paystart_year  = exists($options{'paystart_year'})
4727                            ? $options{'paystart_year'}
4728                            : $self->paystart_year;
4729
4730     $content{card_start} = "$paystart_month/$paystart_year"
4731       if $paystart_month && $paystart_year;
4732
4733     my $payissue       = exists($options{'payissue'})
4734                            ? $options{'payissue'}
4735                            : $self->payissue;
4736     $content{issue_number} = $payissue if $payissue;
4737
4738     if ( $self->_bop_recurring_billing( 'payinfo'        => $options{'payinfo'},
4739                                         'trans_is_recur' => $trans_is_recur,
4740                                       )
4741        )
4742     {
4743       $content{recurring_billing} = 'YES';
4744       $content{acct_code} = 'rebill'
4745         if $conf->exists('credit_card-recurring_billing_acct_code');
4746     }
4747
4748   } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'ECHECK' ){
4749     ( $content{account_number}, $content{routing_code} ) =
4750       split('@', $options{payinfo});
4751     $content{bank_name} = $options{payname};
4752     $content{bank_state} = exists($options{'paystate'})
4753                              ? $options{'paystate'}
4754                              : $self->getfield('paystate');
4755     $content{account_type} = exists($options{'paytype'})
4756                                ? uc($options{'paytype'}) || 'CHECKING'
4757                                : uc($self->getfield('paytype')) || 'CHECKING';
4758     $content{account_name} = $self->getfield('first'). ' '.
4759                              $self->getfield('last');
4760
4761     $content{customer_org} = $self->company ? 'B' : 'I';
4762     $content{state_id}       = exists($options{'stateid'})
4763                                  ? $options{'stateid'}
4764                                  : $self->getfield('stateid');
4765     $content{state_id_state} = exists($options{'stateid_state'})
4766                                  ? $options{'stateid_state'}
4767                                  : $self->getfield('stateid_state');
4768     $content{customer_ssn} = exists($options{'ss'})
4769                                ? $options{'ss'}
4770                                : $self->ss;
4771   } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'LEC' ) {
4772     $content{phone} = $options{payinfo};
4773   } elsif ( $namespace eq 'Business::OnlineThirdPartyPayment' ) {
4774     #move along
4775   } else {
4776     #die an evil death
4777   }
4778
4779   ###
4780   # run transaction(s)
4781   ###
4782
4783   my $balance = exists( $options{'balance'} )
4784                   ? $options{'balance'}
4785                   : $self->balance;
4786
4787   $self->select_for_update; #mutex ... just until we get our pending record in
4788
4789   #the checks here are intended to catch concurrent payments
4790   #double-form-submission prevention is taken care of in cust_pay_pending::check
4791
4792   #check the balance
4793   return "The customer's balance has changed; $options{method} transaction aborted."
4794     if $self->balance < $balance;
4795     #&& $self->balance < $options{amount}; #might as well anyway?
4796
4797   #also check and make sure there aren't *other* pending payments for this cust
4798
4799   my @pending = qsearch('cust_pay_pending', {
4800     'custnum' => $self->custnum,
4801     'status'  => { op=>'!=', value=>'done' }
4802   });
4803   return "A payment is already being processed for this customer (".
4804          join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
4805          "); $options{method} transaction aborted."
4806     if scalar(@pending);
4807
4808   #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
4809
4810   my $cust_pay_pending = new FS::cust_pay_pending {
4811     'custnum'           => $self->custnum,
4812     #'invnum'            => $options{'invnum'},
4813     'paid'              => $options{amount},
4814     '_date'             => '',
4815     'payby'             => $bop_method2payby{$options{method}},
4816     'payinfo'           => $options{payinfo},
4817     'paydate'           => $paydate,
4818     'recurring_billing' => $content{recurring_billing},
4819     'pkgnum'            => $options{'pkgnum'},
4820     'status'            => 'new',
4821     'gatewaynum'        => $payment_gateway->gatewaynum || '',
4822     'session_id'        => $options{session_id} || '',
4823     'jobnum'            => $options{depend_jobnum} || '',
4824   };
4825   $cust_pay_pending->payunique( $options{payunique} )
4826     if defined($options{payunique}) && length($options{payunique});
4827   my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
4828   return $cpp_new_err if $cpp_new_err;
4829
4830   my( $action1, $action2 ) =
4831     split( /\s*\,\s*/, $payment_gateway->gateway_action );
4832
4833   my $transaction = new $namespace( $payment_gateway->gateway_module,
4834                                     $self->_bop_options(\%options),
4835                                   );
4836
4837   $transaction->content(
4838     'type'           => $options{method},
4839     $self->_bop_auth(\%options),
4840     'action'         => $action1,
4841     'description'    => $options{'description'},
4842     'amount'         => $options{amount},
4843     #'invoice_number' => $options{'invnum'},
4844     'customer_id'    => $self->custnum,
4845     %$bop_content,
4846     'reference'      => $cust_pay_pending->paypendingnum, #for now
4847     'email'          => $email,
4848     %content, #after
4849   );
4850
4851   $cust_pay_pending->status('pending');
4852   my $cpp_pending_err = $cust_pay_pending->replace;
4853   return $cpp_pending_err if $cpp_pending_err;
4854
4855   #config?
4856   my $BOP_TESTING = 0;
4857   my $BOP_TESTING_SUCCESS = 1;
4858
4859   unless ( $BOP_TESTING ) {
4860     $transaction->test_transaction(1)
4861       if $conf->exists('business-onlinepayment-test_transaction');
4862     $transaction->submit();
4863   } else {
4864     if ( $BOP_TESTING_SUCCESS ) {
4865       $transaction->is_success(1);
4866       $transaction->authorization('fake auth');
4867     } else {
4868       $transaction->is_success(0);
4869       $transaction->error_message('fake failure');
4870     }
4871   }
4872
4873   if ( $transaction->is_success() && $namespace eq 'Business::OnlineThirdPartyPayment' ) {
4874
4875     return { reference => $cust_pay_pending->paypendingnum,
4876              map { $_ => $transaction->$_ } qw ( popup_url collectitems ) };
4877
4878   } elsif ( $transaction->is_success() && $action2 ) {
4879
4880     $cust_pay_pending->status('authorized');
4881     my $cpp_authorized_err = $cust_pay_pending->replace;
4882     return $cpp_authorized_err if $cpp_authorized_err;
4883
4884     my $auth = $transaction->authorization;
4885     my $ordernum = $transaction->can('order_number')
4886                    ? $transaction->order_number
4887                    : '';
4888
4889     my $capture =
4890       new Business::OnlinePayment( $payment_gateway->gateway_module,
4891                                    $self->_bop_options(\%options),
4892                                  );
4893
4894     my %capture = (
4895       %content,
4896       type           => $options{method},
4897       action         => $action2,
4898       $self->_bop_auth(\%options),
4899       order_number   => $ordernum,
4900       amount         => $options{amount},
4901       authorization  => $auth,
4902       description    => $options{'description'},
4903     );
4904
4905     foreach my $field (qw( authorization_source_code returned_ACI
4906                            transaction_identifier validation_code
4907                            transaction_sequence_num local_transaction_date
4908                            local_transaction_time AVS_result_code          )) {
4909       $capture{$field} = $transaction->$field() if $transaction->can($field);
4910     }
4911
4912     $capture->content( %capture );
4913
4914     $capture->test_transaction(1)
4915       if $conf->exists('business-onlinepayment-test_transaction');
4916     $capture->submit();
4917
4918     unless ( $capture->is_success ) {
4919       my $e = "Authorization successful but capture failed, custnum #".
4920               $self->custnum. ': '.  $capture->result_code.
4921               ": ". $capture->error_message;
4922       warn $e;
4923       return $e;
4924     }
4925
4926   }
4927
4928   ###
4929   # remove paycvv after initial transaction
4930   ###
4931
4932   #false laziness w/misc/process/payment.cgi - check both to make sure working
4933   # correctly
4934   if ( length($self->paycvv)
4935        && ! grep { $_ eq cardtype($options{payinfo}) } $conf->config('cvv-save')
4936   ) {
4937     my $error = $self->remove_cvv;
4938     if ( $error ) {
4939       warn "WARNING: error removing cvv: $error\n";
4940     }
4941   }
4942
4943   ###
4944   # Tokenize
4945   ###
4946
4947
4948   if ( $transaction->can('card_token') && $transaction->card_token ) {
4949
4950     $self->card_token($transaction->card_token);
4951
4952     if ( $options{'payinfo'} eq $self->payinfo ) {
4953       $self->payinfo($transaction->card_token);
4954       my $error = $self->replace;
4955       if ( $error ) {
4956         warn "WARNING: error storing token: $error, but proceeding anyway\n";
4957       }
4958     }
4959
4960   }
4961
4962   ###
4963   # result handling
4964   ###
4965
4966   $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
4967
4968 }
4969
4970 =item fake_bop
4971
4972 =cut
4973
4974 sub fake_bop {
4975   my $self = shift;
4976
4977   my %options = ();
4978   if (ref($_[0]) eq 'HASH') {
4979     %options = %{$_[0]};
4980   } else {
4981     my ( $method, $amount ) = ( shift, shift );
4982     %options = @_;
4983     $options{method} = $method;
4984     $options{amount} = $amount;
4985   }
4986
4987   if ( $options{'fake_failure'} ) {
4988      return "Error: No error; test failure requested with fake_failure";
4989   }
4990
4991   #my $paybatch = '';
4992   #if ( $payment_gateway->gatewaynum ) { # agent override
4993   #  $paybatch = $payment_gateway->gatewaynum. '-';
4994   #}
4995   #
4996   #$paybatch .= "$processor:". $transaction->authorization;
4997   #
4998   #$paybatch .= ':'. $transaction->order_number
4999   #  if $transaction->can('order_number')
5000   #  && length($transaction->order_number);
5001
5002   my $paybatch = 'FakeProcessor:54:32';
5003
5004   my $cust_pay = new FS::cust_pay ( {
5005      'custnum'  => $self->custnum,
5006      'invnum'   => $options{'invnum'},
5007      'paid'     => $options{amount},
5008      '_date'    => '',
5009      'payby'    => $bop_method2payby{$options{method}},
5010      #'payinfo'  => $payinfo,
5011      'payinfo'  => '4111111111111111',
5012      'paybatch' => $paybatch,
5013      #'paydate'  => $paydate,
5014      'paydate'  => '2012-05-01',
5015   } );
5016   $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
5017
5018   my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5019
5020   if ( $error ) {
5021     $cust_pay->invnum(''); #try again with no specific invnum
5022     my $error2 = $cust_pay->insert( $options{'manual'} ?
5023                                     ( 'manual' => 1 ) : ()
5024                                   );
5025     if ( $error2 ) {
5026       # gah, even with transactions.
5027       my $e = 'WARNING: Card/ACH debited but database not updated - '.
5028               "error inserting (fake!) payment: $error2".
5029               " (previously tried insert with invnum #$options{'invnum'}" .
5030               ": $error )";
5031       warn $e;
5032       return $e;
5033     }
5034   }
5035
5036   if ( $options{'paynum_ref'} ) {
5037     ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5038   }
5039
5040   return ''; #no error
5041
5042 }
5043
5044
5045 # item _realtime_bop_result CUST_PAY_PENDING, BOP_OBJECT [ OPTION => VALUE ... ]
5046 #
5047 # Wraps up processing of a realtime credit card, ACH (electronic check) or
5048 # phone bill transaction.
5049
5050 sub _realtime_bop_result {
5051   my( $self, $cust_pay_pending, $transaction, %options ) = @_;
5052   if ( $DEBUG ) {
5053     warn "$me _realtime_bop_result: pending transaction ".
5054       $cust_pay_pending->paypendingnum. "\n";
5055     warn "  $_ => $options{$_}\n" foreach keys %options;
5056   }
5057
5058   my $payment_gateway = $options{payment_gateway}
5059     or return "no payment gateway in arguments to _realtime_bop_result";
5060
5061   $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
5062   my $cpp_captured_err = $cust_pay_pending->replace;
5063   return $cpp_captured_err if $cpp_captured_err;
5064
5065   if ( $transaction->is_success() ) {
5066
5067     my $paybatch = '';
5068     if ( $payment_gateway->gatewaynum ) { # agent override
5069       $paybatch = $payment_gateway->gatewaynum. '-';
5070     }
5071
5072     $paybatch .= $payment_gateway->gateway_module. ":".
5073       $transaction->authorization;
5074
5075     $paybatch .= ':'. $transaction->order_number
5076       if $transaction->can('order_number')
5077       && length($transaction->order_number);
5078
5079     my $cust_pay = new FS::cust_pay ( {
5080        'custnum'  => $self->custnum,
5081        'invnum'   => $options{'invnum'},
5082        'paid'     => $cust_pay_pending->paid,
5083        '_date'    => '',
5084        'payby'    => $cust_pay_pending->payby,
5085        'payinfo'  => $options{'payinfo'},
5086        'paybatch' => $paybatch,
5087        'paydate'  => $cust_pay_pending->paydate,
5088        'pkgnum'   => $cust_pay_pending->pkgnum,
5089     } );
5090     #doesn't hurt to know, even though the dup check is in cust_pay_pending now
5091     $cust_pay->payunique( $options{payunique} )
5092       if defined($options{payunique}) && length($options{payunique});
5093
5094     my $oldAutoCommit = $FS::UID::AutoCommit;
5095     local $FS::UID::AutoCommit = 0;
5096     my $dbh = dbh;
5097
5098     #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
5099
5100     my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5101
5102     if ( $error ) {
5103       $cust_pay->invnum(''); #try again with no specific invnum
5104       my $error2 = $cust_pay->insert( $options{'manual'} ?
5105                                       ( 'manual' => 1 ) : ()
5106                                     );
5107       if ( $error2 ) {
5108         # gah.  but at least we have a record of the state we had to abort in
5109         # from cust_pay_pending now.
5110         my $e = "WARNING: $options{method} captured but payment not recorded -".
5111                 " error inserting payment (". $payment_gateway->gateway_module.
5112                 "): $error2".
5113                 " (previously tried insert with invnum #$options{'invnum'}" .
5114                 ": $error ) - pending payment saved as paypendingnum ".
5115                 $cust_pay_pending->paypendingnum. "\n";
5116         warn $e;
5117         return $e;
5118       }
5119     }
5120
5121     my $jobnum = $cust_pay_pending->jobnum;
5122     if ( $jobnum ) {
5123        my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5124
5125        unless ( $placeholder ) {
5126          $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5127          my $e = "WARNING: $options{method} captured but job $jobnum not ".
5128              "found for paypendingnum ". $cust_pay_pending->paypendingnum. "\n";
5129          warn $e;
5130          return $e;
5131        }
5132
5133        $error = $placeholder->delete;
5134
5135        if ( $error ) {
5136          $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5137          my $e = "WARNING: $options{method} captured but could not delete ".
5138               "job $jobnum for paypendingnum ".
5139               $cust_pay_pending->paypendingnum. ": $error\n";
5140          warn $e;
5141          return $e;
5142        }
5143
5144     }
5145
5146     if ( $options{'paynum_ref'} ) {
5147       ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5148     }
5149
5150     $cust_pay_pending->status('done');
5151     $cust_pay_pending->statustext('captured');
5152     $cust_pay_pending->paynum($cust_pay->paynum);
5153     my $cpp_done_err = $cust_pay_pending->replace;
5154
5155     if ( $cpp_done_err ) {
5156
5157       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5158       my $e = "WARNING: $options{method} captured but payment not recorded - ".
5159               "error updating status for paypendingnum ".
5160               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5161       warn $e;
5162       return $e;
5163
5164     } else {
5165
5166       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5167
5168       if ( $options{'apply'} ) {
5169         my $apply_error = $self->apply_payments_and_credits;
5170         if ( $apply_error ) {
5171           warn "WARNING: error applying payment: $apply_error\n";
5172           #but we still should return no error cause the payment otherwise went
5173           #through...
5174         }
5175       }
5176
5177       return ''; #no error
5178
5179     }
5180
5181   } else {
5182
5183     my $perror = $payment_gateway->gateway_module. " error: ".
5184       $transaction->error_message;
5185
5186     my $jobnum = $cust_pay_pending->jobnum;
5187     if ( $jobnum ) {
5188        my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5189
5190        if ( $placeholder ) {
5191          my $error = $placeholder->depended_delete;
5192          $error ||= $placeholder->delete;
5193          warn "error removing provisioning jobs after declined paypendingnum ".
5194            $cust_pay_pending->paypendingnum. "\n";
5195        } else {
5196          my $e = "error finding job $jobnum for declined paypendingnum ".
5197               $cust_pay_pending->paypendingnum. "\n";
5198          warn $e;
5199        }
5200
5201     }
5202
5203     unless ( $transaction->error_message ) {
5204
5205       my $t_response;
5206       if ( $transaction->can('response_page') ) {
5207         $t_response = {
5208                         'page'    => ( $transaction->can('response_page')
5209                                          ? $transaction->response_page
5210                                          : ''
5211                                      ),
5212                         'code'    => ( $transaction->can('response_code')
5213                                          ? $transaction->response_code
5214                                          : ''
5215                                      ),
5216                         'headers' => ( $transaction->can('response_headers')
5217                                          ? $transaction->response_headers
5218                                          : ''
5219                                      ),
5220                       };
5221       } else {
5222         $t_response .=
5223           "No additional debugging information available for ".
5224             $payment_gateway->gateway_module;
5225       }
5226
5227       $perror .= "No error_message returned from ".
5228                    $payment_gateway->gateway_module. " -- ".
5229                  ( ref($t_response) ? Dumper($t_response) : $t_response );
5230
5231     }
5232
5233     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
5234          && $conf->exists('emaildecline')
5235          && grep { $_ ne 'POST' } $self->invoicing_list
5236          && ! grep { $transaction->error_message =~ /$_/ }
5237                    $conf->config('emaildecline-exclude')
5238     ) {
5239
5240       # Send a decline alert to the customer.
5241       my $msgnum = $conf->config('decline_msgnum', $self->agentnum);
5242       my $error = '';
5243       if ( $msgnum ) {
5244         # include the raw error message in the transaction state
5245         $cust_pay_pending->setfield('error', $transaction->error_message);
5246         my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
5247         $error = $msg_template->send( 'cust_main' => $self,
5248                                       'object'    => $cust_pay_pending );
5249       }
5250       else { #!$msgnum
5251
5252         my @templ = $conf->config('declinetemplate');
5253         my $template = new Text::Template (
5254           TYPE   => 'ARRAY',
5255           SOURCE => [ map "$_\n", @templ ],
5256         ) or return "($perror) can't create template: $Text::Template::ERROR";
5257         $template->compile()
5258           or return "($perror) can't compile template: $Text::Template::ERROR";
5259
5260         my $templ_hash = {
5261           'company_name'    =>
5262             scalar( $conf->config('company_name', $self->agentnum ) ),
5263           'company_address' =>
5264             join("\n", $conf->config('company_address', $self->agentnum ) ),
5265           'error'           => $transaction->error_message,
5266         };
5267
5268         my $error = send_email(
5269           'from'    => $conf->config('invoice_from', $self->agentnum ),
5270           'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
5271           'subject' => 'Your payment could not be processed',
5272           'body'    => [ $template->fill_in(HASH => $templ_hash) ],
5273         );
5274       }
5275
5276       $perror .= " (also received error sending decline notification: $error)"
5277         if $error;
5278
5279     }
5280
5281     $cust_pay_pending->status('done');
5282     $cust_pay_pending->statustext("declined: $perror");
5283     my $cpp_done_err = $cust_pay_pending->replace;
5284     if ( $cpp_done_err ) {
5285       my $e = "WARNING: $options{method} declined but pending payment not ".
5286               "resolved - error updating status for paypendingnum ".
5287               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5288       warn $e;
5289       $perror = "$e ($perror)";
5290     }
5291
5292     return $perror;
5293   }
5294
5295 }
5296
5297 =item realtime_botpp_capture CUST_PAY_PENDING [ OPTION => VALUE ... ]
5298
5299 Verifies successful third party processing of a realtime credit card,
5300 ACH (electronic check) or phone bill transaction via a
5301 Business::OnlineThirdPartyPayment realtime gateway.  See
5302 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
5303
5304 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
5305
5306 The additional options I<payname>, I<city>, I<state>,
5307 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
5308 if set, will override the value from the customer record.
5309
5310 I<description> is a free-text field passed to the gateway.  It defaults to
5311 "Internet services".
5312
5313 If an I<invnum> is specified, this payment (if successful) is applied to the
5314 specified invoice.  If you don't specify an I<invnum> you might want to
5315 call the B<apply_payments> method.
5316
5317 I<quiet> can be set true to surpress email decline notices.
5318
5319 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
5320 resulting paynum, if any.
5321
5322 I<payunique> is a unique identifier for this payment.
5323
5324 Returns a hashref containing elements bill_error (which will be undefined
5325 upon success) and session_id of any associated session.
5326
5327 =cut
5328
5329 sub realtime_botpp_capture {
5330   my( $self, $cust_pay_pending, %options ) = @_;
5331   if ( $DEBUG ) {
5332     warn "$me realtime_botpp_capture: pending transaction $cust_pay_pending\n";
5333     warn "  $_ => $options{$_}\n" foreach keys %options;
5334   }
5335
5336   eval "use Business::OnlineThirdPartyPayment";
5337   die $@ if $@;
5338
5339   ###
5340   # select the gateway
5341   ###
5342
5343   my $method = FS::payby->payby2bop($cust_pay_pending->payby);
5344
5345   my $payment_gateway = $cust_pay_pending->gatewaynum
5346     ? qsearchs( 'payment_gateway',
5347                 { gatewaynum => $cust_pay_pending->gatewaynum }
5348               )
5349     : $self->agent->payment_gateway( 'method' => $method,
5350                                      # 'invnum'  => $cust_pay_pending->invnum,
5351                                      # 'payinfo' => $cust_pay_pending->payinfo,
5352                                    );
5353
5354   $options{payment_gateway} = $payment_gateway; # for the helper subs
5355
5356   ###
5357   # massage data
5358   ###
5359
5360   my @invoicing_list = $self->invoicing_list_emailonly;
5361   if ( $conf->exists('emailinvoiceautoalways')
5362        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5363        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5364     push @invoicing_list, $self->all_emails;
5365   }
5366
5367   my $email = ($conf->exists('business-onlinepayment-email-override'))
5368               ? $conf->config('business-onlinepayment-email-override')
5369               : $invoicing_list[0];
5370
5371   my %content = ();
5372
5373   $content{email_customer} =
5374     (    $conf->exists('business-onlinepayment-email_customer')
5375       || $conf->exists('business-onlinepayment-email-override') );
5376
5377   ###
5378   # run transaction(s)
5379   ###
5380
5381   my $transaction =
5382     new Business::OnlineThirdPartyPayment( $payment_gateway->gateway_module,
5383                                            $self->_bop_options(\%options),
5384                                          );
5385
5386   $transaction->reference({ %options });
5387
5388   $transaction->content(
5389     'type'           => $method,
5390     $self->_bop_auth(\%options),
5391     'action'         => 'Post Authorization',
5392     'description'    => $options{'description'},
5393     'amount'         => $cust_pay_pending->paid,
5394     #'invoice_number' => $options{'invnum'},
5395     'customer_id'    => $self->custnum,
5396     'referer'        => 'http://cleanwhisker.420.am/',
5397     'reference'      => $cust_pay_pending->paypendingnum,
5398     'email'          => $email,
5399     'phone'          => $self->daytime || $self->night,
5400     %content, #after
5401     # plus whatever is required for bogus capture avoidance
5402   );
5403
5404   $transaction->submit();
5405
5406   my $error =
5407     $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5408
5409   {
5410     bill_error => $error,
5411     session_id => $cust_pay_pending->session_id,
5412   }
5413
5414 }
5415
5416 =item default_payment_gateway DEPRECATED -- use agent->payment_gateway
5417
5418 =cut
5419
5420 sub default_payment_gateway {
5421   my( $self, $method ) = @_;
5422
5423   die "Real-time processing not enabled\n"
5424     unless $conf->exists('business-onlinepayment');
5425
5426   #warn "default_payment_gateway deprecated -- use agent->payment_gateway\n";
5427
5428   #load up config
5429   my $bop_config = 'business-onlinepayment';
5430   $bop_config .= '-ach'
5431     if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
5432   my ( $processor, $login, $password, $action, @bop_options ) =
5433     $conf->config($bop_config);
5434   $action ||= 'normal authorization';
5435   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
5436   die "No real-time processor is enabled - ".
5437       "did you set the business-onlinepayment configuration value?\n"
5438     unless $processor;
5439
5440   ( $processor, $login, $password, $action, @bop_options )
5441 }
5442
5443 =item remove_cvv
5444
5445 Removes the I<paycvv> field from the database directly.
5446
5447 If there is an error, returns the error, otherwise returns false.
5448
5449 =cut
5450
5451 sub remove_cvv {
5452   my $self = shift;
5453   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
5454     or return dbh->errstr;
5455   $sth->execute($self->custnum)
5456     or return $sth->errstr;
5457   $self->paycvv('');
5458   '';
5459 }
5460
5461 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
5462
5463 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
5464 via a Business::OnlinePayment realtime gateway.  See
5465 L<http://420.am/business-onlinepayment> for supported gateways.
5466
5467 Available methods are: I<CC>, I<ECHECK> and I<LEC>
5468
5469 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
5470
5471 Most gateways require a reference to an original payment transaction to refund,
5472 so you probably need to specify a I<paynum>.
5473
5474 I<amount> defaults to the original amount of the payment if not specified.
5475
5476 I<reason> specifies a reason for the refund.
5477
5478 I<paydate> specifies the expiration date for a credit card overriding the
5479 value from the customer record or the payment record. Specified as yyyy-mm-dd
5480
5481 Implementation note: If I<amount> is unspecified or equal to the amount of the
5482 orignal payment, first an attempt is made to "void" the transaction via
5483 the gateway (to cancel a not-yet settled transaction) and then if that fails,
5484 the normal attempt is made to "refund" ("credit") the transaction via the
5485 gateway is attempted.
5486
5487 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
5488 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
5489 #if set, will override the value from the customer record.
5490
5491 #If an I<invnum> is specified, this payment (if successful) is applied to the
5492 #specified invoice.  If you don't specify an I<invnum> you might want to
5493 #call the B<apply_payments> method.
5494
5495 =cut
5496
5497 #some false laziness w/realtime_bop, not enough to make it worth merging
5498 #but some useful small subs should be pulled out
5499 sub realtime_refund_bop {
5500   my $self = shift;
5501
5502   my %options = ();
5503   if (ref($_[0]) eq 'HASH') {
5504     %options = %{$_[0]};
5505   } else {
5506     my $method = shift;
5507     %options = @_;
5508     $options{method} = $method;
5509   }
5510
5511   if ( $DEBUG ) {
5512     warn "$me realtime_refund_bop (new): $options{method} refund\n";
5513     warn "  $_ => $options{$_}\n" foreach keys %options;
5514   }
5515
5516   ###
5517   # look up the original payment and optionally a gateway for that payment
5518   ###
5519
5520   my $cust_pay = '';
5521   my $amount = $options{'amount'};
5522
5523   my( $processor, $login, $password, @bop_options, $namespace ) ;
5524   my( $auth, $order_number ) = ( '', '', '' );
5525
5526   if ( $options{'paynum'} ) {
5527
5528     warn "  paynum: $options{paynum}\n" if $DEBUG > 1;
5529     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
5530       or return "Unknown paynum $options{'paynum'}";
5531     $amount ||= $cust_pay->paid;
5532
5533     $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
5534       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
5535                 $cust_pay->paybatch;
5536     my $gatewaynum = '';
5537     ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
5538
5539     if ( $gatewaynum ) { #gateway for the payment to be refunded
5540
5541       my $payment_gateway =
5542         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
5543       die "payment gateway $gatewaynum not found"
5544         unless $payment_gateway;
5545
5546       $processor   = $payment_gateway->gateway_module;
5547       $login       = $payment_gateway->gateway_username;
5548       $password    = $payment_gateway->gateway_password;
5549       $namespace   = $payment_gateway->gateway_namespace;
5550       @bop_options = $payment_gateway->options;
5551
5552     } else { #try the default gateway
5553
5554       my $conf_processor;
5555       my $payment_gateway =
5556         $self->agent->payment_gateway('method' => $options{method});
5557
5558       ( $conf_processor, $login, $password, $namespace ) =
5559         map { my $method = "gateway_$_"; $payment_gateway->$method }
5560           qw( module username password namespace );
5561
5562       @bop_options = $payment_gateway->gatewaynum
5563                        ? $payment_gateway->options
5564                        : @{ $payment_gateway->get('options') };
5565
5566       return "processor of payment $options{'paynum'} $processor does not".
5567              " match default processor $conf_processor"
5568         unless $processor eq $conf_processor;
5569
5570     }
5571
5572
5573   } else { # didn't specify a paynum, so look for agent gateway overrides
5574            # like a normal transaction
5575
5576     my $payment_gateway =
5577       $self->agent->payment_gateway( 'method'  => $options{method},
5578                                      #'payinfo' => $payinfo,
5579                                    );
5580     my( $processor, $login, $password, $namespace ) =
5581       map { my $method = "gateway_$_"; $payment_gateway->$method }
5582         qw( module username password namespace );
5583
5584     my @bop_options = $payment_gateway->gatewaynum
5585                         ? $payment_gateway->options
5586                         : @{ $payment_gateway->get('options') };
5587
5588   }
5589   return "neither amount nor paynum specified" unless $amount;
5590
5591   eval "use $namespace";
5592   die $@ if $@;
5593
5594   my %content = (
5595     'type'           => $options{method},
5596     'login'          => $login,
5597     'password'       => $password,
5598     'order_number'   => $order_number,
5599     'amount'         => $amount,
5600     'referer'        => 'http://cleanwhisker.420.am/', #XXX fix referer :/
5601   );
5602   $content{authorization} = $auth
5603     if length($auth); #echeck/ACH transactions have an order # but no auth
5604                       #(at least with authorize.net)
5605
5606   my $disable_void_after;
5607   if ($conf->exists('disable_void_after')
5608       && $conf->config('disable_void_after') =~ /^(\d+)$/) {
5609     $disable_void_after = $1;
5610   }
5611
5612   #first try void if applicable
5613   if ( $cust_pay && $cust_pay->paid == $amount
5614     && (
5615       ( not defined($disable_void_after) )
5616       || ( time < ($cust_pay->_date + $disable_void_after ) )
5617     )
5618   ) {
5619     warn "  attempting void\n" if $DEBUG > 1;
5620     my $void = new Business::OnlinePayment( $processor, @bop_options );
5621     if ( $void->can('info') ) {
5622       if ( $cust_pay->payby eq 'CARD'
5623            && $void->info('CC_void_requires_card') )
5624       {
5625         $content{'card_number'} = $cust_pay->payinfo;
5626       } elsif ( $cust_pay->payby eq 'CHEK'
5627                 && $void->info('ECHECK_void_requires_account') )
5628       {
5629         ( $content{'account_number'}, $content{'routing_code'} ) =
5630           split('@', $cust_pay->payinfo);
5631         $content{'name'} = $self->get('first'). ' '. $self->get('last');
5632       }
5633     }
5634     $void->content( 'action' => 'void', %content );
5635     $void->test_transaction(1)
5636       if $conf->exists('business-onlinepayment-test_transaction');
5637     $void->submit();
5638     if ( $void->is_success ) {
5639       my $error = $cust_pay->void($options{'reason'});
5640       if ( $error ) {
5641         # gah, even with transactions.
5642         my $e = 'WARNING: Card/ACH voided but database not updated - '.
5643                 "error voiding payment: $error";
5644         warn $e;
5645         return $e;
5646       }
5647       warn "  void successful\n" if $DEBUG > 1;
5648       return '';
5649     }
5650   }
5651
5652   warn "  void unsuccessful, trying refund\n"
5653     if $DEBUG > 1;
5654
5655   #massage data
5656   my $address = $self->address1;
5657   $address .= ", ". $self->address2 if $self->address2;
5658
5659   my($payname, $payfirst, $paylast);
5660   if ( $self->payname && $options{method} ne 'ECHECK' ) {
5661     $payname = $self->payname;
5662     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
5663       or return "Illegal payname $payname";
5664     ($payfirst, $paylast) = ($1, $2);
5665   } else {
5666     $payfirst = $self->getfield('first');
5667     $paylast = $self->getfield('last');
5668     $payname =  "$payfirst $paylast";
5669   }
5670
5671   my @invoicing_list = $self->invoicing_list_emailonly;
5672   if ( $conf->exists('emailinvoiceautoalways')
5673        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5674        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5675     push @invoicing_list, $self->all_emails;
5676   }
5677
5678   my $email = ($conf->exists('business-onlinepayment-email-override'))
5679               ? $conf->config('business-onlinepayment-email-override')
5680               : $invoicing_list[0];
5681
5682   my $payip = exists($options{'payip'})
5683                 ? $options{'payip'}
5684                 : $self->payip;
5685   $content{customer_ip} = $payip
5686     if length($payip);
5687
5688   my $payinfo = '';
5689   if ( $options{method} eq 'CC' ) {
5690
5691     if ( $cust_pay ) {
5692       $content{card_number} = $payinfo = $cust_pay->payinfo;
5693       (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
5694         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
5695         ($content{expiration} = "$2/$1");  # where available
5696     } else {
5697       $content{card_number} = $payinfo = $self->payinfo;
5698       (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
5699         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
5700       $content{expiration} = "$2/$1";
5701     }
5702
5703   } elsif ( $options{method} eq 'ECHECK' ) {
5704
5705     if ( $cust_pay ) {
5706       $payinfo = $cust_pay->payinfo;
5707     } else {
5708       $payinfo = $self->payinfo;
5709     }
5710     ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
5711     $content{bank_name} = $self->payname;
5712     $content{account_type} = 'CHECKING';
5713     $content{account_name} = $payname;
5714     $content{customer_org} = $self->company ? 'B' : 'I';
5715     $content{customer_ssn} = $self->ss;
5716   } elsif ( $options{method} eq 'LEC' ) {
5717     $content{phone} = $payinfo = $self->payinfo;
5718   }
5719
5720   #then try refund
5721   my $refund = new Business::OnlinePayment( $processor, @bop_options );
5722   my %sub_content = $refund->content(
5723     'action'         => 'credit',
5724     'customer_id'    => $self->custnum,
5725     'last_name'      => $paylast,
5726     'first_name'     => $payfirst,
5727     'name'           => $payname,
5728     'address'        => $address,
5729     'city'           => $self->city,
5730     'state'          => $self->state,
5731     'zip'            => $self->zip,
5732     'country'        => $self->country,
5733     'email'          => $email,
5734     'phone'          => $self->daytime || $self->night,
5735     %content, #after
5736   );
5737   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
5738     if $DEBUG > 1;
5739   $refund->test_transaction(1)
5740     if $conf->exists('business-onlinepayment-test_transaction');
5741   $refund->submit();
5742
5743   return "$processor error: ". $refund->error_message
5744     unless $refund->is_success();
5745
5746   my $paybatch = "$processor:". $refund->authorization;
5747   $paybatch .= ':'. $refund->order_number
5748     if $refund->can('order_number') && $refund->order_number;
5749
5750   while ( $cust_pay && $cust_pay->unapplied < $amount ) {
5751     my @cust_bill_pay = $cust_pay->cust_bill_pay;
5752     last unless @cust_bill_pay;
5753     my $cust_bill_pay = pop @cust_bill_pay;
5754     my $error = $cust_bill_pay->delete;
5755     last if $error;
5756   }
5757
5758   my $cust_refund = new FS::cust_refund ( {
5759     'custnum'  => $self->custnum,
5760     'paynum'   => $options{'paynum'},
5761     'refund'   => $amount,
5762     '_date'    => '',
5763     'payby'    => $bop_method2payby{$options{method}},
5764     'payinfo'  => $payinfo,
5765     'paybatch' => $paybatch,
5766     'reason'   => $options{'reason'} || 'card or ACH refund',
5767   } );
5768   my $error = $cust_refund->insert;
5769   if ( $error ) {
5770     $cust_refund->paynum(''); #try again with no specific paynum
5771     my $error2 = $cust_refund->insert;
5772     if ( $error2 ) {
5773       # gah, even with transactions.
5774       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
5775               "error inserting refund ($processor): $error2".
5776               " (previously tried insert with paynum #$options{'paynum'}" .
5777               ": $error )";
5778       warn $e;
5779       return $e;
5780     }
5781   }
5782
5783   ''; #no error
5784
5785 }
5786
5787 =item batch_card OPTION => VALUE...
5788
5789 Adds a payment for this invoice to the pending credit card batch (see
5790 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
5791 runs the payment using a realtime gateway.
5792
5793 =cut
5794
5795 sub batch_card {
5796   my ($self, %options) = @_;
5797
5798   my $amount;
5799   if (exists($options{amount})) {
5800     $amount = $options{amount};
5801   }else{
5802     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
5803   }
5804   return '' unless $amount > 0;
5805
5806   my $invnum = delete $options{invnum};
5807   my $payby = $options{invnum} || $self->payby;  #dubious
5808
5809   if ($options{'realtime'}) {
5810     return $self->realtime_bop( FS::payby->payby2bop($self->payby),
5811                                 $amount,
5812                                 %options,
5813                               );
5814   }
5815
5816   my $oldAutoCommit = $FS::UID::AutoCommit;
5817   local $FS::UID::AutoCommit = 0;
5818   my $dbh = dbh;
5819
5820   #this needs to handle mysql as well as Pg, like svc_acct.pm
5821   #(make it into a common function if folks need to do batching with mysql)
5822   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
5823     or return "Cannot lock pay_batch: " . $dbh->errstr;
5824
5825   my %pay_batch = (
5826     'status' => 'O',
5827     'payby'  => FS::payby->payby2payment($payby),
5828   );
5829
5830   my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
5831
5832   unless ( $pay_batch ) {
5833     $pay_batch = new FS::pay_batch \%pay_batch;
5834     my $error = $pay_batch->insert;
5835     if ( $error ) {
5836       $dbh->rollback if $oldAutoCommit;
5837       die "error creating new batch: $error\n";
5838     }
5839   }
5840
5841   my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
5842       'batchnum' => $pay_batch->batchnum,
5843       'custnum'  => $self->custnum,
5844   } );
5845
5846   foreach (qw( address1 address2 city state zip country payby payinfo paydate
5847                payname )) {
5848     $options{$_} = '' unless exists($options{$_});
5849   }
5850
5851   my $cust_pay_batch = new FS::cust_pay_batch ( {
5852     'batchnum' => $pay_batch->batchnum,
5853     'invnum'   => $invnum || 0,                    # is there a better value?
5854                                                    # this field should be
5855                                                    # removed...
5856                                                    # cust_bill_pay_batch now
5857     'custnum'  => $self->custnum,
5858     'last'     => $self->getfield('last'),
5859     'first'    => $self->getfield('first'),
5860     'address1' => $options{address1} || $self->address1,
5861     'address2' => $options{address2} || $self->address2,
5862     'city'     => $options{city}     || $self->city,
5863     'state'    => $options{state}    || $self->state,
5864     'zip'      => $options{zip}      || $self->zip,
5865     'country'  => $options{country}  || $self->country,
5866     'payby'    => $options{payby}    || $self->payby,
5867     'payinfo'  => $options{payinfo}  || $self->payinfo,
5868     'exp'      => $options{paydate}  || $self->paydate,
5869     'payname'  => $options{payname}  || $self->payname,
5870     'amount'   => $amount,                         # consolidating
5871   } );
5872
5873   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
5874     if $old_cust_pay_batch;
5875
5876   my $error;
5877   if ($old_cust_pay_batch) {
5878     $error = $cust_pay_batch->replace($old_cust_pay_batch)
5879   } else {
5880     $error = $cust_pay_batch->insert;
5881   }
5882
5883   if ( $error ) {
5884     $dbh->rollback if $oldAutoCommit;
5885     die $error;
5886   }
5887
5888   my $unapplied =   $self->total_unapplied_credits
5889                   + $self->total_unapplied_payments
5890                   + $self->in_transit_payments;
5891   foreach my $cust_bill ($self->open_cust_bill) {
5892     #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
5893     my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
5894       'invnum' => $cust_bill->invnum,
5895       'paybatchnum' => $cust_pay_batch->paybatchnum,
5896       'amount' => $cust_bill->owed,
5897       '_date' => time,
5898     };
5899     if ($unapplied >= $cust_bill_pay_batch->amount){
5900       $unapplied -= $cust_bill_pay_batch->amount;
5901       next;
5902     }else{
5903       $cust_bill_pay_batch->amount(sprintf ( "%.2f",
5904                                    $cust_bill_pay_batch->amount - $unapplied ));      $unapplied = 0;
5905     }
5906     $error = $cust_bill_pay_batch->insert;
5907     if ( $error ) {
5908       $dbh->rollback if $oldAutoCommit;
5909       die $error;
5910     }
5911   }
5912
5913   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5914   '';
5915 }
5916
5917 =item apply_payments_and_credits [ OPTION => VALUE ... ]
5918
5919 Applies unapplied payments and credits.
5920
5921 In most cases, this new method should be used in place of sequential
5922 apply_payments and apply_credits methods.
5923
5924 A hash of optional arguments may be passed.  Currently "manual" is supported.
5925 If true, a payment receipt is sent instead of a statement when
5926 'payment_receipt_email' configuration option is set.
5927
5928 If there is an error, returns the error, otherwise returns false.
5929
5930 =cut
5931
5932 sub apply_payments_and_credits {
5933   my( $self, %options ) = @_;
5934
5935   local $SIG{HUP} = 'IGNORE';
5936   local $SIG{INT} = 'IGNORE';
5937   local $SIG{QUIT} = 'IGNORE';
5938   local $SIG{TERM} = 'IGNORE';
5939   local $SIG{TSTP} = 'IGNORE';
5940   local $SIG{PIPE} = 'IGNORE';
5941
5942   my $oldAutoCommit = $FS::UID::AutoCommit;
5943   local $FS::UID::AutoCommit = 0;
5944   my $dbh = dbh;
5945
5946   $self->select_for_update; #mutex
5947
5948   foreach my $cust_bill ( $self->open_cust_bill ) {
5949     my $error = $cust_bill->apply_payments_and_credits(%options);
5950     if ( $error ) {
5951       $dbh->rollback if $oldAutoCommit;
5952       return "Error applying: $error";
5953     }
5954   }
5955
5956   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5957   ''; #no error
5958
5959 }
5960
5961 =item apply_credits OPTION => VALUE ...
5962
5963 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
5964 to outstanding invoice balances in chronological order (or reverse
5965 chronological order if the I<order> option is set to B<newest>) and returns the
5966 value of any remaining unapplied credits available for refund (see
5967 L<FS::cust_refund>).
5968
5969 Dies if there is an error.
5970
5971 =cut
5972
5973 sub apply_credits {
5974   my $self = shift;
5975   my %opt = @_;
5976
5977   local $SIG{HUP} = 'IGNORE';
5978   local $SIG{INT} = 'IGNORE';
5979   local $SIG{QUIT} = 'IGNORE';
5980   local $SIG{TERM} = 'IGNORE';
5981   local $SIG{TSTP} = 'IGNORE';
5982   local $SIG{PIPE} = 'IGNORE';
5983
5984   my $oldAutoCommit = $FS::UID::AutoCommit;
5985   local $FS::UID::AutoCommit = 0;
5986   my $dbh = dbh;
5987
5988   $self->select_for_update; #mutex
5989
5990   unless ( $self->total_unapplied_credits ) {
5991     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5992     return 0;
5993   }
5994
5995   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
5996       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
5997
5998   my @invoices = $self->open_cust_bill;
5999   @invoices = sort { $b->_date <=> $a->_date } @invoices
6000     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
6001
6002   if ( $conf->exists('pkg-balances') ) {
6003     # limit @credits to those w/ a pkgnum grepped from $self
6004     my %pkgnums = ();
6005     foreach my $i (@invoices) {
6006       foreach my $li ( $i->cust_bill_pkg ) {
6007         $pkgnums{$li->pkgnum} = 1;
6008       }
6009     }
6010     @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
6011   }
6012
6013   my $credit;
6014
6015   foreach my $cust_bill ( @invoices ) {
6016
6017     if ( !defined($credit) || $credit->credited == 0) {
6018       $credit = pop @credits or last;
6019     }
6020
6021     my $owed;
6022     if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
6023       $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
6024     } else {
6025       $owed = $cust_bill->owed;
6026     }
6027     unless ( $owed > 0 ) {
6028       push @credits, $credit;
6029       next;
6030     }
6031
6032     my $amount = min( $credit->credited, $owed );
6033
6034     my $cust_credit_bill = new FS::cust_credit_bill ( {
6035       'crednum' => $credit->crednum,
6036       'invnum'  => $cust_bill->invnum,
6037       'amount'  => $amount,
6038     } );
6039     $cust_credit_bill->pkgnum( $credit->pkgnum )
6040       if $conf->exists('pkg-balances') && $credit->pkgnum;
6041     my $error = $cust_credit_bill->insert;
6042     if ( $error ) {
6043       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
6044       die $error;
6045     }
6046
6047     redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
6048
6049   }
6050
6051   my $total_unapplied_credits = $self->total_unapplied_credits;
6052
6053   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6054
6055   return $total_unapplied_credits;
6056 }
6057
6058 =item apply_payments  [ OPTION => VALUE ... ]
6059
6060 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
6061 to outstanding invoice balances in chronological order.
6062
6063  #and returns the value of any remaining unapplied payments.
6064
6065 A hash of optional arguments may be passed.  Currently "manual" is supported.
6066 If true, a payment receipt is sent instead of a statement when
6067 'payment_receipt_email' configuration option is set.
6068
6069 Dies if there is an error.
6070
6071 =cut
6072
6073 sub apply_payments {
6074   my( $self, %options ) = @_;
6075
6076   local $SIG{HUP} = 'IGNORE';
6077   local $SIG{INT} = 'IGNORE';
6078   local $SIG{QUIT} = 'IGNORE';
6079   local $SIG{TERM} = 'IGNORE';
6080   local $SIG{TSTP} = 'IGNORE';
6081   local $SIG{PIPE} = 'IGNORE';
6082
6083   my $oldAutoCommit = $FS::UID::AutoCommit;
6084   local $FS::UID::AutoCommit = 0;
6085   my $dbh = dbh;
6086
6087   $self->select_for_update; #mutex
6088
6089   #return 0 unless
6090
6091   my @payments = sort { $b->_date <=> $a->_date }
6092                  grep { $_->unapplied > 0 }
6093                  $self->cust_pay;
6094
6095   my @invoices = sort { $a->_date <=> $b->_date}
6096                  grep { $_->owed > 0 }
6097                  $self->cust_bill;
6098
6099   if ( $conf->exists('pkg-balances') ) {
6100     # limit @payments to those w/ a pkgnum grepped from $self
6101     my %pkgnums = ();
6102     foreach my $i (@invoices) {
6103       foreach my $li ( $i->cust_bill_pkg ) {
6104         $pkgnums{$li->pkgnum} = 1;
6105       }
6106     }
6107     @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
6108   }
6109
6110   my $payment;
6111
6112   foreach my $cust_bill ( @invoices ) {
6113
6114     if ( !defined($payment) || $payment->unapplied == 0 ) {
6115       $payment = pop @payments or last;
6116     }
6117
6118     my $owed;
6119     if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
6120       $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
6121     } else {
6122       $owed = $cust_bill->owed;
6123     }
6124     unless ( $owed > 0 ) {
6125       push @payments, $payment;
6126       next;
6127     }
6128
6129     my $amount = min( $payment->unapplied, $owed );
6130
6131     my $cust_bill_pay = new FS::cust_bill_pay ( {
6132       'paynum' => $payment->paynum,
6133       'invnum' => $cust_bill->invnum,
6134       'amount' => $amount,
6135     } );
6136     $cust_bill_pay->pkgnum( $payment->pkgnum )
6137       if $conf->exists('pkg-balances') && $payment->pkgnum;
6138     my $error = $cust_bill_pay->insert(%options);
6139     if ( $error ) {
6140       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
6141       die $error;
6142     }
6143
6144     redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
6145
6146   }
6147
6148   my $total_unapplied_payments = $self->total_unapplied_payments;
6149
6150   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6151
6152   return $total_unapplied_payments;
6153 }
6154
6155 =item total_owed
6156
6157 Returns the total owed for this customer on all invoices
6158 (see L<FS::cust_bill/owed>).
6159
6160 =cut
6161
6162 sub total_owed {
6163   my $self = shift;
6164   $self->total_owed_date(2145859200); #12/31/2037
6165 }
6166
6167 =item total_owed_date TIME
6168
6169 Returns the total owed for this customer on all invoices with date earlier than
6170 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
6171 see L<Time::Local> and L<Date::Parse> for conversion functions.
6172
6173 =cut
6174
6175 sub total_owed_date {
6176   my $self = shift;
6177   my $time = shift;
6178
6179   my $custnum = $self->custnum;
6180
6181   my $owed_sql = FS::cust_bill->owed_sql;
6182
6183   my $sql = "
6184     SELECT SUM($owed_sql) FROM cust_bill
6185       WHERE custnum = $custnum
6186         AND _date <= $time
6187   ";
6188
6189   sprintf( "%.2f", $self->scalar_sql($sql) );
6190
6191 }
6192
6193 =item total_owed_pkgnum PKGNUM
6194
6195 Returns the total owed on all invoices for this customer's specific package
6196 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
6197
6198 =cut
6199
6200 sub total_owed_pkgnum {
6201   my( $self, $pkgnum ) = @_;
6202   $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
6203 }
6204
6205 =item total_owed_date_pkgnum TIME PKGNUM
6206
6207 Returns the total owed for this customer's specific package when using
6208 experimental package balances on all invoices with date earlier than
6209 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
6210 see L<Time::Local> and L<Date::Parse> for conversion functions.
6211
6212 =cut
6213
6214 sub total_owed_date_pkgnum {
6215   my( $self, $time, $pkgnum ) = @_;
6216
6217   my $total_bill = 0;
6218   foreach my $cust_bill (
6219     grep { $_->_date <= $time }
6220       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6221   ) {
6222     $total_bill += $cust_bill->owed_pkgnum($pkgnum);
6223   }
6224   sprintf( "%.2f", $total_bill );
6225
6226 }
6227
6228 =item total_paid
6229
6230 Returns the total amount of all payments.
6231
6232 =cut
6233
6234 sub total_paid {
6235   my $self = shift;
6236   my $total = 0;
6237   $total += $_->paid foreach $self->cust_pay;
6238   sprintf( "%.2f", $total );
6239 }
6240
6241 =item total_unapplied_credits
6242
6243 Returns the total outstanding credit (see L<FS::cust_credit>) for this
6244 customer.  See L<FS::cust_credit/credited>.
6245
6246 =item total_credited
6247
6248 Old name for total_unapplied_credits.  Don't use.
6249
6250 =cut
6251
6252 sub total_credited {
6253   #carp "total_credited deprecated, use total_unapplied_credits";
6254   shift->total_unapplied_credits(@_);
6255 }
6256
6257 sub total_unapplied_credits {
6258   my $self = shift;
6259
6260   my $custnum = $self->custnum;
6261
6262   my $unapplied_sql = FS::cust_credit->unapplied_sql;
6263
6264   my $sql = "
6265     SELECT SUM($unapplied_sql) FROM cust_credit
6266       WHERE custnum = $custnum
6267   ";
6268
6269   sprintf( "%.2f", $self->scalar_sql($sql) );
6270
6271 }
6272
6273 =item total_unapplied_credits_pkgnum PKGNUM
6274
6275 Returns the total outstanding credit (see L<FS::cust_credit>) for this
6276 customer.  See L<FS::cust_credit/credited>.
6277
6278 =cut
6279
6280 sub total_unapplied_credits_pkgnum {
6281   my( $self, $pkgnum ) = @_;
6282   my $total_credit = 0;
6283   $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
6284   sprintf( "%.2f", $total_credit );
6285 }
6286
6287
6288 =item total_unapplied_payments
6289
6290 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
6291 See L<FS::cust_pay/unapplied>.
6292
6293 =cut
6294
6295 sub total_unapplied_payments {
6296   my $self = shift;
6297
6298   my $custnum = $self->custnum;
6299
6300   my $unapplied_sql = FS::cust_pay->unapplied_sql;
6301
6302   my $sql = "
6303     SELECT SUM($unapplied_sql) FROM cust_pay
6304       WHERE custnum = $custnum
6305   ";
6306
6307   sprintf( "%.2f", $self->scalar_sql($sql) );
6308
6309 }
6310
6311 =item total_unapplied_payments_pkgnum PKGNUM
6312
6313 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
6314 specific package when using experimental package balances.  See
6315 L<FS::cust_pay/unapplied>.
6316
6317 =cut
6318
6319 sub total_unapplied_payments_pkgnum {
6320   my( $self, $pkgnum ) = @_;
6321   my $total_unapplied = 0;
6322   $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
6323   sprintf( "%.2f", $total_unapplied );
6324 }
6325
6326
6327 =item total_unapplied_refunds
6328
6329 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
6330 customer.  See L<FS::cust_refund/unapplied>.
6331
6332 =cut
6333
6334 sub total_unapplied_refunds {
6335   my $self = shift;
6336   my $custnum = $self->custnum;
6337
6338   my $unapplied_sql = FS::cust_refund->unapplied_sql;
6339
6340   my $sql = "
6341     SELECT SUM($unapplied_sql) FROM cust_refund
6342       WHERE custnum = $custnum
6343   ";
6344
6345   sprintf( "%.2f", $self->scalar_sql($sql) );
6346
6347 }
6348
6349 =item balance
6350
6351 Returns the balance for this customer (total_owed plus total_unrefunded, minus
6352 total_unapplied_credits minus total_unapplied_payments).
6353
6354 =cut
6355
6356 sub balance {
6357   my $self = shift;
6358   $self->balance_date_range;
6359 }
6360
6361 =item balance_date TIME
6362
6363 Returns the balance for this customer, only considering invoices with date
6364 earlier than TIME (total_owed_date minus total_credited minus
6365 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
6366 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
6367 functions.
6368
6369 =cut
6370
6371 sub balance_date {
6372   my $self = shift;
6373   $self->balance_date_range(shift);
6374 }
6375
6376 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
6377
6378 Returns the balance for this customer, optionally considering invoices with
6379 date earlier than START_TIME, and not later than END_TIME
6380 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
6381
6382 Times are specified as SQL fragments or numeric
6383 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
6384 L<Date::Parse> for conversion functions.  The empty string can be passed
6385 to disable that time constraint completely.
6386
6387 Available options are:
6388
6389 =over 4
6390
6391 =item unapplied_date
6392
6393 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)
6394
6395 =back
6396
6397 =cut
6398
6399 sub balance_date_range {
6400   my $self = shift;
6401   my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
6402             ') FROM cust_main WHERE custnum='. $self->custnum;
6403   sprintf( '%.2f', $self->scalar_sql($sql) );
6404 }
6405
6406 =item balance_pkgnum PKGNUM
6407
6408 Returns the balance for this customer's specific package when using
6409 experimental package balances (total_owed plus total_unrefunded, minus
6410 total_unapplied_credits minus total_unapplied_payments)
6411
6412 =cut
6413
6414 sub balance_pkgnum {
6415   my( $self, $pkgnum ) = @_;
6416
6417   sprintf( "%.2f",
6418       $self->total_owed_pkgnum($pkgnum)
6419 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
6420 #    + $self->total_unapplied_refunds_pkgnum($pkgnum)
6421     - $self->total_unapplied_credits_pkgnum($pkgnum)
6422     - $self->total_unapplied_payments_pkgnum($pkgnum)
6423   );
6424 }
6425
6426 =item in_transit_payments
6427
6428 Returns the total of requests for payments for this customer pending in
6429 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
6430
6431 =cut
6432
6433 sub in_transit_payments {
6434   my $self = shift;
6435   my $in_transit_payments = 0;
6436   foreach my $pay_batch ( qsearch('pay_batch', {
6437     'status' => 'I',
6438   } ) ) {
6439     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
6440       'batchnum' => $pay_batch->batchnum,
6441       'custnum' => $self->custnum,
6442     } ) ) {
6443       $in_transit_payments += $cust_pay_batch->amount;
6444     }
6445   }
6446   sprintf( "%.2f", $in_transit_payments );
6447 }
6448
6449 =item payment_info
6450
6451 Returns a hash of useful information for making a payment.
6452
6453 =over 4
6454
6455 =item balance
6456
6457 Current balance.
6458
6459 =item payby
6460
6461 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
6462 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
6463 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
6464
6465 =back
6466
6467 For credit card transactions:
6468
6469 =over 4
6470
6471 =item card_type 1
6472
6473 =item payname
6474
6475 Exact name on card
6476
6477 =back
6478
6479 For electronic check transactions:
6480
6481 =over 4
6482
6483 =item stateid_state
6484
6485 =back
6486
6487 =cut
6488
6489 sub payment_info {
6490   my $self = shift;
6491
6492   my %return = ();
6493
6494   $return{balance} = $self->balance;
6495
6496   $return{payname} = $self->payname
6497                      || ( $self->first. ' '. $self->get('last') );
6498
6499   $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
6500
6501   $return{payby} = $self->payby;
6502   $return{stateid_state} = $self->stateid_state;
6503
6504   if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
6505     $return{card_type} = cardtype($self->payinfo);
6506     $return{payinfo} = $self->paymask;
6507
6508     @return{'month', 'year'} = $self->paydate_monthyear;
6509
6510   }
6511
6512   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
6513     my ($payinfo1, $payinfo2) = split '@', $self->paymask;
6514     $return{payinfo1} = $payinfo1;
6515     $return{payinfo2} = $payinfo2;
6516     $return{paytype}  = $self->paytype;
6517     $return{paystate} = $self->paystate;
6518
6519   }
6520
6521   #doubleclick protection
6522   my $_date = time;
6523   $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
6524
6525   %return;
6526
6527 }
6528
6529 =item paydate_monthyear
6530
6531 Returns a two-element list consisting of the month and year of this customer's
6532 paydate (credit card expiration date for CARD customers)
6533
6534 =cut
6535
6536 sub paydate_monthyear {
6537   my $self = shift;
6538   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
6539     ( $2, $1 );
6540   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
6541     ( $1, $3 );
6542   } else {
6543     ('', '');
6544   }
6545 }
6546
6547 =item tax_exemption TAXNAME
6548
6549 =cut
6550
6551 sub tax_exemption {
6552   my( $self, $taxname ) = @_;
6553
6554   qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
6555                                      'taxname' => $taxname,
6556                                    },
6557           );
6558 }
6559
6560 =item cust_main_exemption
6561
6562 =cut
6563
6564 sub cust_main_exemption {
6565   my $self = shift;
6566   qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
6567 }
6568
6569 =item invoicing_list [ ARRAYREF ]
6570
6571 If an arguement is given, sets these email addresses as invoice recipients
6572 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
6573 (except as warnings), so use check_invoicing_list first.
6574
6575 Returns a list of email addresses (with svcnum entries expanded).
6576
6577 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
6578 check it without disturbing anything by passing nothing.
6579
6580 This interface may change in the future.
6581
6582 =cut
6583
6584 sub invoicing_list {
6585   my( $self, $arrayref ) = @_;
6586
6587   if ( $arrayref ) {
6588     my @cust_main_invoice;
6589     if ( $self->custnum ) {
6590       @cust_main_invoice =
6591         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6592     } else {
6593       @cust_main_invoice = ();
6594     }
6595     foreach my $cust_main_invoice ( @cust_main_invoice ) {
6596       #warn $cust_main_invoice->destnum;
6597       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
6598         #warn $cust_main_invoice->destnum;
6599         my $error = $cust_main_invoice->delete;
6600         warn $error if $error;
6601       }
6602     }
6603     if ( $self->custnum ) {
6604       @cust_main_invoice =
6605         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6606     } else {
6607       @cust_main_invoice = ();
6608     }
6609     my %seen = map { $_->address => 1 } @cust_main_invoice;
6610     foreach my $address ( @{$arrayref} ) {
6611       next if exists $seen{$address} && $seen{$address};
6612       $seen{$address} = 1;
6613       my $cust_main_invoice = new FS::cust_main_invoice ( {
6614         'custnum' => $self->custnum,
6615         'dest'    => $address,
6616       } );
6617       my $error = $cust_main_invoice->insert;
6618       warn $error if $error;
6619     }
6620   }
6621
6622   if ( $self->custnum ) {
6623     map { $_->address }
6624       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6625   } else {
6626     ();
6627   }
6628
6629 }
6630
6631 =item check_invoicing_list ARRAYREF
6632
6633 Checks these arguements as valid input for the invoicing_list method.  If there
6634 is an error, returns the error, otherwise returns false.
6635
6636 =cut
6637
6638 sub check_invoicing_list {
6639   my( $self, $arrayref ) = @_;
6640
6641   foreach my $address ( @$arrayref ) {
6642
6643     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
6644       return 'Can\'t add FAX invoice destination with a blank FAX number.';
6645     }
6646
6647     my $cust_main_invoice = new FS::cust_main_invoice ( {
6648       'custnum' => $self->custnum,
6649       'dest'    => $address,
6650     } );
6651     my $error = $self->custnum
6652                 ? $cust_main_invoice->check
6653                 : $cust_main_invoice->checkdest
6654     ;
6655     return $error if $error;
6656
6657   }
6658
6659   return "Email address required"
6660     if $conf->exists('cust_main-require_invoicing_list_email')
6661     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
6662
6663   '';
6664 }
6665
6666 =item set_default_invoicing_list
6667
6668 Sets the invoicing list to all accounts associated with this customer,
6669 overwriting any previous invoicing list.
6670
6671 =cut
6672
6673 sub set_default_invoicing_list {
6674   my $self = shift;
6675   $self->invoicing_list($self->all_emails);
6676 }
6677
6678 =item all_emails
6679
6680 Returns the email addresses of all accounts provisioned for this customer.
6681
6682 =cut
6683
6684 sub all_emails {
6685   my $self = shift;
6686   my %list;
6687   foreach my $cust_pkg ( $self->all_pkgs ) {
6688     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
6689     my @svc_acct =
6690       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6691         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6692           @cust_svc;
6693     $list{$_}=1 foreach map { $_->email } @svc_acct;
6694   }
6695   keys %list;
6696 }
6697
6698 =item invoicing_list_addpost
6699
6700 Adds postal invoicing to this customer.  If this customer is already configured
6701 to receive postal invoices, does nothing.
6702
6703 =cut
6704
6705 sub invoicing_list_addpost {
6706   my $self = shift;
6707   return if grep { $_ eq 'POST' } $self->invoicing_list;
6708   my @invoicing_list = $self->invoicing_list;
6709   push @invoicing_list, 'POST';
6710   $self->invoicing_list(\@invoicing_list);
6711 }
6712
6713 =item invoicing_list_emailonly
6714
6715 Returns the list of email invoice recipients (invoicing_list without non-email
6716 destinations such as POST and FAX).
6717
6718 =cut
6719
6720 sub invoicing_list_emailonly {
6721   my $self = shift;
6722   warn "$me invoicing_list_emailonly called"
6723     if $DEBUG;
6724   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
6725 }
6726
6727 =item invoicing_list_emailonly_scalar
6728
6729 Returns the list of email invoice recipients (invoicing_list without non-email
6730 destinations such as POST and FAX) as a comma-separated scalar.
6731
6732 =cut
6733
6734 sub invoicing_list_emailonly_scalar {
6735   my $self = shift;
6736   warn "$me invoicing_list_emailonly_scalar called"
6737     if $DEBUG;
6738   join(', ', $self->invoicing_list_emailonly);
6739 }
6740
6741 =item referral_custnum_cust_main
6742
6743 Returns the customer who referred this customer (or the empty string, if
6744 this customer was not referred).
6745
6746 Note the difference with referral_cust_main method: This method,
6747 referral_custnum_cust_main returns the single customer (if any) who referred
6748 this customer, while referral_cust_main returns an array of customers referred
6749 BY this customer.
6750
6751 =cut
6752
6753 sub referral_custnum_cust_main {
6754   my $self = shift;
6755   return '' unless $self->referral_custnum;
6756   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
6757 }
6758
6759 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
6760
6761 Returns an array of customers referred by this customer (referral_custnum set
6762 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
6763 customers referred by customers referred by this customer and so on, inclusive.
6764 The default behavior is DEPTH 1 (no recursion).
6765
6766 Note the difference with referral_custnum_cust_main method: This method,
6767 referral_cust_main, returns an array of customers referred BY this customer,
6768 while referral_custnum_cust_main returns the single customer (if any) who
6769 referred this customer.
6770
6771 =cut
6772
6773 sub referral_cust_main {
6774   my $self = shift;
6775   my $depth = @_ ? shift : 1;
6776   my $exclude = @_ ? shift : {};
6777
6778   my @cust_main =
6779     map { $exclude->{$_->custnum}++; $_; }
6780       grep { ! $exclude->{ $_->custnum } }
6781         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
6782
6783   if ( $depth > 1 ) {
6784     push @cust_main,
6785       map { $_->referral_cust_main($depth-1, $exclude) }
6786         @cust_main;
6787   }
6788
6789   @cust_main;
6790 }
6791
6792 =item referral_cust_main_ncancelled
6793
6794 Same as referral_cust_main, except only returns customers with uncancelled
6795 packages.
6796
6797 =cut
6798
6799 sub referral_cust_main_ncancelled {
6800   my $self = shift;
6801   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
6802 }
6803
6804 =item referral_cust_pkg [ DEPTH ]
6805
6806 Like referral_cust_main, except returns a flat list of all unsuspended (and
6807 uncancelled) packages for each customer.  The number of items in this list may
6808 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
6809
6810 =cut
6811
6812 sub referral_cust_pkg {
6813   my $self = shift;
6814   my $depth = @_ ? shift : 1;
6815
6816   map { $_->unsuspended_pkgs }
6817     grep { $_->unsuspended_pkgs }
6818       $self->referral_cust_main($depth);
6819 }
6820
6821 =item referring_cust_main
6822
6823 Returns the single cust_main record for the customer who referred this customer
6824 (referral_custnum), or false.
6825
6826 =cut
6827
6828 sub referring_cust_main {
6829   my $self = shift;
6830   return '' unless $self->referral_custnum;
6831   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
6832 }
6833
6834 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
6835
6836 Applies a credit to this customer.  If there is an error, returns the error,
6837 otherwise returns false.
6838
6839 REASON can be a text string, an FS::reason object, or a scalar reference to
6840 a reasonnum.  If a text string, it will be automatically inserted as a new
6841 reason, and a 'reason_type' option must be passed to indicate the
6842 FS::reason_type for the new reason.
6843
6844 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
6845
6846 Any other options are passed to FS::cust_credit::insert.
6847
6848 =cut
6849
6850 sub credit {
6851   my( $self, $amount, $reason, %options ) = @_;
6852
6853   my $cust_credit = new FS::cust_credit {
6854     'custnum' => $self->custnum,
6855     'amount'  => $amount,
6856   };
6857
6858   if ( ref($reason) ) {
6859
6860     if ( ref($reason) eq 'SCALAR' ) {
6861       $cust_credit->reasonnum( $$reason );
6862     } else {
6863       $cust_credit->reasonnum( $reason->reasonnum );
6864     }
6865
6866   } else {
6867     $cust_credit->set('reason', $reason)
6868   }
6869
6870   for (qw( addlinfo eventnum )) {
6871     $cust_credit->$_( delete $options{$_} )
6872       if exists($options{$_});
6873   }
6874
6875   $cust_credit->insert(%options);
6876
6877 }
6878
6879 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
6880
6881 Creates a one-time charge for this customer.  If there is an error, returns
6882 the error, otherwise returns false.
6883
6884 New-style, with a hashref of options:
6885
6886   my $error = $cust_main->charge(
6887                                   {
6888                                     'amount'     => 54.32,
6889                                     'quantity'   => 1,
6890                                     'start_date' => str2time('7/4/2009'),
6891                                     'pkg'        => 'Description',
6892                                     'comment'    => 'Comment',
6893                                     'additional' => [], #extra invoice detail
6894                                     'classnum'   => 1,  #pkg_class
6895
6896                                     'setuptax'   => '', # or 'Y' for tax exempt
6897
6898                                     #internal taxation
6899                                     'taxclass'   => 'Tax class',
6900
6901                                     #vendor taxation
6902                                     'taxproduct' => 2,  #part_pkg_taxproduct
6903                                     'override'   => {}, #XXX describe
6904
6905                                     #will be filled in with the new object
6906                                     'cust_pkg_ref' => \$cust_pkg,
6907
6908                                     #generate an invoice immediately
6909                                     'bill_now' => 0,
6910                                     'invoice_terms' => '', #with these terms
6911                                   }
6912                                 );
6913
6914 Old-style:
6915
6916   my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
6917
6918 =cut
6919
6920 sub charge {
6921   my $self = shift;
6922   my ( $amount, $quantity, $start_date, $classnum );
6923   my ( $pkg, $comment, $additional );
6924   my ( $setuptax, $taxclass );   #internal taxes
6925   my ( $taxproduct, $override ); #vendor (CCH) taxes
6926   my $no_auto = '';
6927   my $cust_pkg_ref = '';
6928   my ( $bill_now, $invoice_terms ) = ( 0, '' );
6929   if ( ref( $_[0] ) ) {
6930     $amount     = $_[0]->{amount};
6931     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
6932     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
6933     $no_auto    = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
6934     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
6935     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
6936                                            : '$'. sprintf("%.2f",$amount);
6937     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
6938     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
6939     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
6940     $additional = $_[0]->{additional} || [];
6941     $taxproduct = $_[0]->{taxproductnum};
6942     $override   = { '' => $_[0]->{tax_override} };
6943     $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
6944     $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
6945     $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
6946   } else {
6947     $amount     = shift;
6948     $quantity   = 1;
6949     $start_date = '';
6950     $pkg        = @_ ? shift : 'One-time charge';
6951     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
6952     $setuptax   = '';
6953     $taxclass   = @_ ? shift : '';
6954     $additional = [];
6955   }
6956
6957   local $SIG{HUP} = 'IGNORE';
6958   local $SIG{INT} = 'IGNORE';
6959   local $SIG{QUIT} = 'IGNORE';
6960   local $SIG{TERM} = 'IGNORE';
6961   local $SIG{TSTP} = 'IGNORE';
6962   local $SIG{PIPE} = 'IGNORE';
6963
6964   my $oldAutoCommit = $FS::UID::AutoCommit;
6965   local $FS::UID::AutoCommit = 0;
6966   my $dbh = dbh;
6967
6968   my $part_pkg = new FS::part_pkg ( {
6969     'pkg'           => $pkg,
6970     'comment'       => $comment,
6971     'plan'          => 'flat',
6972     'freq'          => 0,
6973     'disabled'      => 'Y',
6974     'classnum'      => ( $classnum ? $classnum : '' ),
6975     'setuptax'      => $setuptax,
6976     'taxclass'      => $taxclass,
6977     'taxproductnum' => $taxproduct,
6978   } );
6979
6980   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
6981                         ( 0 .. @$additional - 1 )
6982                   ),
6983                   'additional_count' => scalar(@$additional),
6984                   'setup_fee' => $amount,
6985                 );
6986
6987   my $error = $part_pkg->insert( options       => \%options,
6988                                  tax_overrides => $override,
6989                                );
6990   if ( $error ) {
6991     $dbh->rollback if $oldAutoCommit;
6992     return $error;
6993   }
6994
6995   my $pkgpart = $part_pkg->pkgpart;
6996   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
6997   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
6998     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
6999     $error = $type_pkgs->insert;
7000     if ( $error ) {
7001       $dbh->rollback if $oldAutoCommit;
7002       return $error;
7003     }
7004   }
7005
7006   my $cust_pkg = new FS::cust_pkg ( {
7007     'custnum'    => $self->custnum,
7008     'pkgpart'    => $pkgpart,
7009     'quantity'   => $quantity,
7010     'start_date' => $start_date,
7011     'no_auto'    => $no_auto,
7012   } );
7013
7014   $error = $cust_pkg->insert;
7015   if ( $error ) {
7016     $dbh->rollback if $oldAutoCommit;
7017     return $error;
7018   } elsif ( $cust_pkg_ref ) {
7019     ${$cust_pkg_ref} = $cust_pkg;
7020   }
7021
7022   if ( $bill_now ) {
7023     my $error = $self->bill( 'invoice_terms' => $invoice_terms,
7024                              'pkg_list'      => [ $cust_pkg ],
7025                            );
7026     if ( $error ) {
7027       $dbh->rollback if $oldAutoCommit;
7028       return $error;
7029     }
7030   }
7031
7032   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
7033   return '';
7034
7035 }
7036
7037 #=item charge_postal_fee
7038 #
7039 #Applies a one time charge this customer.  If there is an error,
7040 #returns the error, returns the cust_pkg charge object or false
7041 #if there was no charge.
7042 #
7043 #=cut
7044 #
7045 # This should be a customer event.  For that to work requires that bill
7046 # also be a customer event.
7047
7048 sub charge_postal_fee {
7049   my $self = shift;
7050
7051   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
7052   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
7053
7054   my $cust_pkg = new FS::cust_pkg ( {
7055     'custnum'  => $self->custnum,
7056     'pkgpart'  => $pkgpart,
7057     'quantity' => 1,
7058   } );
7059
7060   my $error = $cust_pkg->insert;
7061   $error ? $error : $cust_pkg;
7062 }
7063
7064 =item cust_bill
7065
7066 Returns all the invoices (see L<FS::cust_bill>) for this customer.
7067
7068 =cut
7069
7070 sub cust_bill {
7071   my $self = shift;
7072   map { $_ } #return $self->num_cust_bill unless wantarray;
7073   sort { $a->_date <=> $b->_date }
7074     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
7075 }
7076
7077 =item open_cust_bill
7078
7079 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
7080 customer.
7081
7082 =cut
7083
7084 sub open_cust_bill {
7085   my $self = shift;
7086
7087   qsearch({
7088     'table'     => 'cust_bill',
7089     'hashref'   => { 'custnum' => $self->custnum, },
7090     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
7091     'order_by'  => 'ORDER BY _date ASC',
7092   });
7093
7094 }
7095
7096 =item cust_statements
7097
7098 Returns all the statements (see L<FS::cust_statement>) for this customer.
7099
7100 =cut
7101
7102 sub cust_statement {
7103   my $self = shift;
7104   map { $_ } #return $self->num_cust_statement unless wantarray;
7105   sort { $a->_date <=> $b->_date }
7106     qsearch('cust_statement', { 'custnum' => $self->custnum, } )
7107 }
7108
7109 =item cust_credit
7110
7111 Returns all the credits (see L<FS::cust_credit>) for this customer.
7112
7113 =cut
7114
7115 sub cust_credit {
7116   my $self = shift;
7117   map { $_ } #return $self->num_cust_credit unless wantarray;
7118   sort { $a->_date <=> $b->_date }
7119     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
7120 }
7121
7122 =item cust_credit_pkgnum
7123
7124 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
7125 package when using experimental package balances.
7126
7127 =cut
7128
7129 sub cust_credit_pkgnum {
7130   my( $self, $pkgnum ) = @_;
7131   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
7132   sort { $a->_date <=> $b->_date }
7133     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
7134                               'pkgnum'  => $pkgnum,
7135                             }
7136     );
7137 }
7138
7139 =item cust_pay
7140
7141 Returns all the payments (see L<FS::cust_pay>) for this customer.
7142
7143 =cut
7144
7145 sub cust_pay {
7146   my $self = shift;
7147   return $self->num_cust_pay unless wantarray;
7148   sort { $a->_date <=> $b->_date }
7149     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
7150 }
7151
7152 =item num_cust_pay
7153
7154 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
7155 called automatically when the cust_pay method is used in a scalar context.
7156
7157 =cut
7158
7159 sub num_cust_pay {
7160   my $self = shift;
7161   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
7162   my $sth = dbh->prepare($sql) or die dbh->errstr;
7163   $sth->execute($self->custnum) or die $sth->errstr;
7164   $sth->fetchrow_arrayref->[0];
7165 }
7166
7167 =item cust_pay_pkgnum
7168
7169 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
7170 package when using experimental package balances.
7171
7172 =cut
7173
7174 sub cust_pay_pkgnum {
7175   my( $self, $pkgnum ) = @_;
7176   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
7177   sort { $a->_date <=> $b->_date }
7178     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
7179                            'pkgnum'  => $pkgnum,
7180                          }
7181     );
7182 }
7183
7184 =item cust_pay_void
7185
7186 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
7187
7188 =cut
7189
7190 sub cust_pay_void {
7191   my $self = shift;
7192   map { $_ } #return $self->num_cust_pay_void unless wantarray;
7193   sort { $a->_date <=> $b->_date }
7194     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
7195 }
7196
7197 =item cust_pay_batch
7198
7199 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
7200
7201 =cut
7202
7203 sub cust_pay_batch {
7204   my $self = shift;
7205   map { $_ } #return $self->num_cust_pay_batch unless wantarray;
7206   sort { $a->paybatchnum <=> $b->paybatchnum }
7207     qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
7208 }
7209
7210 =item cust_pay_pending
7211
7212 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
7213 (without status "done").
7214
7215 =cut
7216
7217 sub cust_pay_pending {
7218   my $self = shift;
7219   return $self->num_cust_pay_pending unless wantarray;
7220   sort { $a->_date <=> $b->_date }
7221     qsearch( 'cust_pay_pending', {
7222                                    'custnum' => $self->custnum,
7223                                    'status'  => { op=>'!=', value=>'done' },
7224                                  },
7225            );
7226 }
7227
7228 =item cust_pay_pending_attempt
7229
7230 Returns all payment attempts / declined payments for this customer, as pending
7231 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
7232 a corresponding payment (see L<FS::cust_pay>).
7233
7234 =cut
7235
7236 sub cust_pay_pending_attempt {
7237   my $self = shift;
7238   return $self->num_cust_pay_pending_attempt unless wantarray;
7239   sort { $a->_date <=> $b->_date }
7240     qsearch( 'cust_pay_pending', {
7241                                    'custnum' => $self->custnum,
7242                                    'status'  => 'done',
7243                                    'paynum'  => '',
7244                                  },
7245            );
7246 }
7247
7248 =item num_cust_pay_pending
7249
7250 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
7251 customer (without status "done").  Also called automatically when the
7252 cust_pay_pending method is used in a scalar context.
7253
7254 =cut
7255
7256 sub num_cust_pay_pending {
7257   my $self = shift;
7258   $self->scalar_sql(
7259     " SELECT COUNT(*) FROM cust_pay_pending ".
7260       " WHERE custnum = ? AND status != 'done' ",
7261     $self->custnum
7262   );
7263 }
7264
7265 =item num_cust_pay_pending_attempt
7266
7267 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
7268 customer, with status "done" but without a corresp.  Also called automatically when the
7269 cust_pay_pending method is used in a scalar context.
7270
7271 =cut
7272
7273 sub num_cust_pay_pending_attempt {
7274   my $self = shift;
7275   $self->scalar_sql(
7276     " SELECT COUNT(*) FROM cust_pay_pending ".
7277       " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
7278     $self->custnum
7279   );
7280 }
7281
7282 =item cust_refund
7283
7284 Returns all the refunds (see L<FS::cust_refund>) for this customer.
7285
7286 =cut
7287
7288 sub cust_refund {
7289   my $self = shift;
7290   map { $_ } #return $self->num_cust_refund unless wantarray;
7291   sort { $a->_date <=> $b->_date }
7292     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
7293 }
7294
7295 =item display_custnum
7296
7297 Returns the displayed customer number for this customer: agent_custid if
7298 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
7299
7300 =cut
7301
7302 sub display_custnum {
7303   my $self = shift;
7304   if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
7305     return $self->agent_custid;
7306   } else {
7307     return $self->custnum;
7308   }
7309 }
7310
7311 =item name
7312
7313 Returns a name string for this customer, either "Company (Last, First)" or
7314 "Last, First".
7315
7316 =cut
7317
7318 sub name {
7319   my $self = shift;
7320   my $name = $self->contact;
7321   $name = $self->company. " ($name)" if $self->company;
7322   $name;
7323 }
7324
7325 =item ship_name
7326
7327 Returns a name string for this (service/shipping) contact, either
7328 "Company (Last, First)" or "Last, First".
7329
7330 =cut
7331
7332 sub ship_name {
7333   my $self = shift;
7334   if ( $self->get('ship_last') ) {
7335     my $name = $self->ship_contact;
7336     $name = $self->ship_company. " ($name)" if $self->ship_company;
7337     $name;
7338   } else {
7339     $self->name;
7340   }
7341 }
7342
7343 =item name_short
7344
7345 Returns a name string for this customer, either "Company" or "First Last".
7346
7347 =cut
7348
7349 sub name_short {
7350   my $self = shift;
7351   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
7352 }
7353
7354 =item ship_name_short
7355
7356 Returns a name string for this (service/shipping) contact, either "Company"
7357 or "First Last".
7358
7359 =cut
7360
7361 sub ship_name_short {
7362   my $self = shift;
7363   if ( $self->get('ship_last') ) {
7364     $self->ship_company !~ /^\s*$/
7365       ? $self->ship_company
7366       : $self->ship_contact_firstlast;
7367   } else {
7368     $self->name_company_or_firstlast;
7369   }
7370 }
7371
7372 =item contact
7373
7374 Returns this customer's full (billing) contact name only, "Last, First"
7375
7376 =cut
7377
7378 sub contact {
7379   my $self = shift;
7380   $self->get('last'). ', '. $self->first;
7381 }
7382
7383 =item ship_contact
7384
7385 Returns this customer's full (shipping) contact name only, "Last, First"
7386
7387 =cut
7388
7389 sub ship_contact {
7390   my $self = shift;
7391   $self->get('ship_last')
7392     ? $self->get('ship_last'). ', '. $self->ship_first
7393     : $self->contact;
7394 }
7395
7396 =item contact_firstlast
7397
7398 Returns this customers full (billing) contact name only, "First Last".
7399
7400 =cut
7401
7402 sub contact_firstlast {
7403   my $self = shift;
7404   $self->first. ' '. $self->get('last');
7405 }
7406
7407 =item ship_contact_firstlast
7408
7409 Returns this customer's full (shipping) contact name only, "First Last".
7410
7411 =cut
7412
7413 sub ship_contact_firstlast {
7414   my $self = shift;
7415   $self->get('ship_last')
7416     ? $self->first. ' '. $self->get('ship_last')
7417     : $self->contact_firstlast;
7418 }
7419
7420 =item country_full
7421
7422 Returns this customer's full country name
7423
7424 =cut
7425
7426 sub country_full {
7427   my $self = shift;
7428   code2country($self->country);
7429 }
7430
7431 =item geocode DATA_VENDOR
7432
7433 Returns a value for the customer location as encoded by DATA_VENDOR.
7434 Currently this only makes sense for "CCH" as DATA_VENDOR.
7435
7436 =cut
7437
7438 sub geocode {
7439   my ($self, $data_vendor) = (shift, shift);  #always cch for now
7440
7441   my $geocode = $self->get('geocode');  #XXX only one data_vendor for geocode
7442   return $geocode if $geocode;
7443
7444   my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
7445                ? 'ship_'
7446                : '';
7447
7448   my($zip,$plus4) = split /-/, $self->get("${prefix}zip")
7449     if $self->country eq 'US';
7450
7451   $zip ||= '';
7452   $plus4 ||= '';
7453   #CCH specific location stuff
7454   my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
7455
7456   my @cust_tax_location =
7457     qsearch( {
7458                'table'     => 'cust_tax_location',
7459                'hashref'   => { 'zip' => $zip, 'data_vendor' => $data_vendor },
7460                'extra_sql' => $extra_sql,
7461                'order_by'  => 'ORDER BY plus4hi',#overlapping with distinct ends
7462              }
7463            );
7464   $geocode = $cust_tax_location[0]->geocode
7465     if scalar(@cust_tax_location);
7466
7467   $geocode;
7468 }
7469
7470 =item cust_status
7471
7472 =item status
7473
7474 Returns a status string for this customer, currently:
7475
7476 =over 4
7477
7478 =item prospect - No packages have ever been ordered
7479
7480 =item ordered - Recurring packages all are new (not yet billed).
7481
7482 =item active - One or more recurring packages is active
7483
7484 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
7485
7486 =item suspended - All non-cancelled recurring packages are suspended
7487
7488 =item cancelled - All recurring packages are cancelled
7489
7490 =back
7491
7492 =cut
7493
7494 sub status { shift->cust_status(@_); }
7495
7496 sub cust_status {
7497   my $self = shift;
7498   # prospect ordered active inactive suspended cancelled
7499   for my $status ( FS::cust_main->statuses() ) {
7500     my $method = $status.'_sql';
7501     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
7502     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
7503     $sth->execute( ($self->custnum) x $numnum )
7504       or die "Error executing 'SELECT $sql': ". $sth->errstr;
7505     return $status if $sth->fetchrow_arrayref->[0];
7506   }
7507 }
7508
7509 =item ucfirst_cust_status
7510
7511 =item ucfirst_status
7512
7513 Returns the status with the first character capitalized.
7514
7515 =cut
7516
7517 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
7518
7519 sub ucfirst_cust_status {
7520   my $self = shift;
7521   ucfirst($self->cust_status);
7522 }
7523
7524 =item statuscolor
7525
7526 Returns a hex triplet color string for this customer's status.
7527
7528 =cut
7529
7530 use vars qw(%statuscolor);
7531 tie %statuscolor, 'Tie::IxHash',
7532   'prospect'  => '7e0079', #'000000', #black?  naw, purple
7533   'active'    => '00CC00', #green
7534   'ordered'   => '009999', #teal? cyan?
7535   'inactive'  => '0000CC', #blue
7536   'suspended' => 'FF9900', #yellow
7537   'cancelled' => 'FF0000', #red
7538 ;
7539
7540 sub statuscolor { shift->cust_statuscolor(@_); }
7541
7542 sub cust_statuscolor {
7543   my $self = shift;
7544   $statuscolor{$self->cust_status};
7545 }
7546
7547 =item tickets
7548
7549 Returns an array of hashes representing the customer's RT tickets.
7550
7551 =cut
7552
7553 sub tickets {
7554   my $self = shift;
7555
7556   my $num = $conf->config('cust_main-max_tickets') || 10;
7557   my @tickets = ();
7558
7559   if ( $conf->config('ticket_system') ) {
7560     unless ( $conf->config('ticket_system-custom_priority_field') ) {
7561
7562       @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
7563
7564     } else {
7565
7566       foreach my $priority (
7567         $conf->config('ticket_system-custom_priority_field-values'), ''
7568       ) {
7569         last if scalar(@tickets) >= $num;
7570         push @tickets,
7571           @{ FS::TicketSystem->customer_tickets( $self->custnum,
7572                                                  $num - scalar(@tickets),
7573                                                  $priority,
7574                                                )
7575            };
7576       }
7577     }
7578   }
7579   (@tickets);
7580 }
7581
7582 # Return services representing svc_accts in customer support packages
7583 sub support_services {
7584   my $self = shift;
7585   my %packages = map { $_ => 1 } $conf->config('support_packages');
7586
7587   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
7588     grep { $_->part_svc->svcdb eq 'svc_acct' }
7589     map { $_->cust_svc }
7590     grep { exists $packages{ $_->pkgpart } }
7591     $self->ncancelled_pkgs;
7592
7593 }
7594
7595 # Return a list of latitude/longitude for one of the services (if any)
7596 sub service_coordinates {
7597   my $self = shift;
7598
7599   my @svc_X =
7600     grep { $_->latitude && $_->longitude }
7601     map { $_->svc_x }
7602     map { $_->cust_svc }
7603     $self->ncancelled_pkgs;
7604
7605   scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
7606 }
7607
7608 =back
7609
7610 =head1 CLASS METHODS
7611
7612 =over 4
7613
7614 =item statuses
7615
7616 Class method that returns the list of possible status strings for customers
7617 (see L<the status method|/status>).  For example:
7618
7619   @statuses = FS::cust_main->statuses();
7620
7621 =cut
7622
7623 sub statuses {
7624   #my $self = shift; #could be class...
7625   keys %statuscolor;
7626 }
7627
7628 =item prospect_sql
7629
7630 Returns an SQL expression identifying prospective cust_main records (customers
7631 with no packages ever ordered)
7632
7633 =cut
7634
7635 use vars qw($select_count_pkgs);
7636 $select_count_pkgs =
7637   "SELECT COUNT(*) FROM cust_pkg
7638     WHERE cust_pkg.custnum = cust_main.custnum";
7639
7640 sub select_count_pkgs_sql {
7641   $select_count_pkgs;
7642 }
7643
7644 sub prospect_sql {
7645   " 0 = ( $select_count_pkgs ) ";
7646 }
7647
7648 =item ordered_sql
7649
7650 Returns an SQL expression identifying ordered cust_main records (customers with
7651 recurring packages not yet setup).
7652
7653 =cut
7654
7655 sub ordered_sql {
7656   FS::cust_main->none_active_sql.
7657   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->ordered_sql. " ) ";
7658 }
7659
7660 =item active_sql
7661
7662 Returns an SQL expression identifying active cust_main records (customers with
7663 active recurring packages).
7664
7665 =cut
7666
7667 sub active_sql {
7668   " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
7669 }
7670
7671 =item none_active_sql
7672
7673 Returns an SQL expression identifying cust_main records with no active
7674 recurring packages.  This includes customers of status prospect, ordered,
7675 inactive, and suspended.
7676
7677 =cut
7678
7679 sub none_active_sql {
7680   " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
7681 }
7682
7683 =item inactive_sql
7684
7685 Returns an SQL expression identifying inactive cust_main records (customers with
7686 no active recurring packages, but otherwise unsuspended/uncancelled).
7687
7688 =cut
7689
7690 sub inactive_sql {
7691   FS::cust_main->none_active_sql.
7692   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
7693 }
7694
7695 =item susp_sql
7696 =item suspended_sql
7697
7698 Returns an SQL expression identifying suspended cust_main records.
7699
7700 =cut
7701
7702
7703 sub suspended_sql { susp_sql(@_); }
7704 sub susp_sql {
7705   FS::cust_main->none_active_sql.
7706   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
7707 }
7708
7709 =item cancel_sql
7710 =item cancelled_sql
7711
7712 Returns an SQL expression identifying cancelled cust_main records.
7713
7714 =cut
7715
7716 sub cancelled_sql { cancel_sql(@_); }
7717 sub cancel_sql {
7718
7719   my $recurring_sql = FS::cust_pkg->recurring_sql;
7720   my $cancelled_sql = FS::cust_pkg->cancelled_sql;
7721
7722   "
7723         0 < ( $select_count_pkgs )
7724     AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql   )
7725     AND 0 = ( $select_count_pkgs AND $recurring_sql
7726                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
7727             )
7728     AND 0 = (  $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7729   ";
7730
7731 }
7732
7733 =item uncancel_sql
7734 =item uncancelled_sql
7735
7736 Returns an SQL expression identifying un-cancelled cust_main records.
7737
7738 =cut
7739
7740 sub uncancelled_sql { uncancel_sql(@_); }
7741 sub uncancel_sql { "
7742   ( 0 < ( $select_count_pkgs
7743                    AND ( cust_pkg.cancel IS NULL
7744                          OR cust_pkg.cancel = 0
7745                        )
7746         )
7747     OR 0 = ( $select_count_pkgs )
7748   )
7749 "; }
7750
7751 =item balance_sql
7752
7753 Returns an SQL fragment to retreive the balance.
7754
7755 =cut
7756
7757 sub balance_sql { "
7758     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
7759         WHERE cust_bill.custnum   = cust_main.custnum     )
7760   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
7761         WHERE cust_pay.custnum    = cust_main.custnum     )
7762   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
7763         WHERE cust_credit.custnum = cust_main.custnum     )
7764   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
7765         WHERE cust_refund.custnum = cust_main.custnum     )
7766 "; }
7767
7768 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
7769
7770 Returns an SQL fragment to retreive the balance for this customer, optionally
7771 considering invoices with date earlier than START_TIME, and not
7772 later than END_TIME (total_owed_date minus total_unapplied_credits minus
7773 total_unapplied_payments).
7774
7775 Times are specified as SQL fragments or numeric
7776 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
7777 L<Date::Parse> for conversion functions.  The empty string can be passed
7778 to disable that time constraint completely.
7779
7780 Available options are:
7781
7782 =over 4
7783
7784 =item unapplied_date
7785
7786 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)
7787
7788 =item total
7789
7790 (unused.  obsolete?)
7791 set to true to remove all customer comparison clauses, for totals
7792
7793 =item where
7794
7795 (unused.  obsolete?)
7796 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
7797
7798 =item join
7799
7800 (unused.  obsolete?)
7801 JOIN clause (typically used with the total option)
7802
7803 =item cutoff
7804
7805 An absolute cutoff time.  Payments, credits, and refunds I<applied> after this
7806 time will be ignored.  Note that START_TIME and END_TIME only limit the date
7807 range for invoices and I<unapplied> payments, credits, and refunds.
7808
7809 =back
7810
7811 =cut
7812
7813 sub balance_date_sql {
7814   my( $class, $start, $end, %opt ) = @_;
7815
7816   my $cutoff = $opt{'cutoff'};
7817
7818   my $owed         = FS::cust_bill->owed_sql($cutoff);
7819   my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
7820   my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
7821   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
7822
7823   my $j = $opt{'join'} || '';
7824
7825   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
7826   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
7827   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
7828   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
7829
7830   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
7831     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
7832     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
7833     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
7834   ";
7835
7836 }
7837
7838 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
7839
7840 Returns an SQL fragment to retreive the total unapplied payments for this
7841 customer, only considering invoices with date earlier than START_TIME, and
7842 optionally not later than END_TIME.
7843
7844 Times are specified as SQL fragments or numeric
7845 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
7846 L<Date::Parse> for conversion functions.  The empty string can be passed
7847 to disable that time constraint completely.
7848
7849 Available options are:
7850
7851 =cut
7852
7853 sub unapplied_payments_date_sql {
7854   my( $class, $start, $end, %opt ) = @_;
7855
7856   my $cutoff = $opt{'cutoff'};
7857
7858   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
7859
7860   my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
7861                                                           'unapplied_date'=>1 );
7862
7863   " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
7864 }
7865
7866 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
7867
7868 Helper method for balance_date_sql; name (and usage) subject to change
7869 (suggestions welcome).
7870
7871 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
7872 cust_refund, cust_credit or cust_pay).
7873
7874 If TABLE is "cust_bill" or the unapplied_date option is true, only
7875 considers records with date earlier than START_TIME, and optionally not
7876 later than END_TIME .
7877
7878 =cut
7879
7880 sub _money_table_where {
7881   my( $class, $table, $start, $end, %opt ) = @_;
7882
7883   my @where = ();
7884   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
7885   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
7886     push @where, "$table._date <= $start" if defined($start) && length($start);
7887     push @where, "$table._date >  $end"   if defined($end)   && length($end);
7888   }
7889   push @where, @{$opt{'where'}} if $opt{'where'};
7890   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
7891
7892   $where;
7893
7894 }
7895
7896 =item search HASHREF
7897
7898 (Class method)
7899
7900 Returns a qsearch hash expression to search for parameters specified in
7901 HASHREF.  Valid parameters are
7902
7903 =over 4
7904
7905 =item agentnum
7906
7907 =item status
7908
7909 =item cancelled_pkgs
7910
7911 bool
7912
7913 =item signupdate
7914
7915 listref of start date, end date
7916
7917 =item payby
7918
7919 listref
7920
7921 =item paydate_year
7922
7923 =item paydate_month
7924
7925 =item current_balance
7926
7927 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
7928
7929 =item cust_fields
7930
7931 =item flattened_pkgs
7932
7933 bool
7934
7935 =back
7936
7937 =cut
7938
7939 sub search {
7940   my ($class, $params) = @_;
7941
7942   my $dbh = dbh;
7943
7944   my @where = ();
7945   my $orderby;
7946
7947   ##
7948   # parse agent
7949   ##
7950
7951   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
7952     push @where,
7953       "cust_main.agentnum = $1";
7954   }
7955
7956   ##
7957   # do the same for user
7958   ##
7959
7960   if ( $params->{'usernum'} =~ /^(\d+)$/ and $1 ) {
7961     push @where,
7962       "cust_main.usernum = $1";
7963   }
7964
7965   ##
7966   # parse status
7967   ##
7968
7969   #prospect ordered active inactive suspended cancelled
7970   if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
7971     my $method = $params->{'status'}. '_sql';
7972     #push @where, $class->$method();
7973     push @where, FS::cust_main->$method();
7974   }
7975
7976   ##
7977   # parse cancelled package checkbox
7978   ##
7979
7980   my $pkgwhere = "";
7981
7982   $pkgwhere .= "AND (cancel = 0 or cancel is null)"
7983     unless $params->{'cancelled_pkgs'};
7984
7985   ##
7986   # parse without census tract checkbox
7987   ##
7988
7989   push @where, "(censustract = '' or censustract is null)"
7990     if $params->{'no_censustract'};
7991
7992   ##
7993   # dates
7994   ##
7995
7996   foreach my $field (qw( signupdate )) {
7997
7998     next unless exists($params->{$field});
7999
8000     my($beginning, $ending, $hour) = @{$params->{$field}};
8001
8002     push @where,
8003       "cust_main.$field IS NOT NULL",
8004       "cust_main.$field >= $beginning",
8005       "cust_main.$field <= $ending";
8006
8007     # XXX: do this for mysql and/or pull it out of here
8008     if(defined $hour) {
8009       if ($dbh->{Driver}->{Name} eq 'Pg') {
8010         push @where, "extract(hour from to_timestamp(cust_main.$field)) = $hour";
8011       }
8012       else {
8013         warn "search by time of day not supported on ".$dbh->{Driver}->{Name}." databases";
8014       }
8015     }
8016
8017     $orderby ||= "ORDER BY cust_main.$field";
8018
8019   }
8020
8021   ###
8022   # classnum
8023   ###
8024
8025   if ( $params->{'classnum'} ) {
8026
8027     my @classnum = ref( $params->{'classnum'} )
8028                      ? @{ $params->{'classnum'} }
8029                      :  ( $params->{'classnum'} );
8030
8031     @classnum = grep /^(\d*)$/, @classnum;
8032
8033     if ( @classnum ) {
8034       push @where, '( '. join(' OR ', map {
8035                                             $_ ? "cust_main.classnum = $_"
8036                                                : "cust_main.classnum IS NULL"
8037                                           }
8038                                           @classnum
8039                              ).
8040                    ' )';
8041     }
8042
8043   }
8044
8045   ###
8046   # payby
8047   ###
8048
8049   if ( $params->{'payby'} ) {
8050
8051     my @payby = ref( $params->{'payby'} )
8052                   ? @{ $params->{'payby'} }
8053                   :  ( $params->{'payby'} );
8054
8055     @payby = grep /^([A-Z]{4})$/, @payby;
8056
8057     push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )'
8058       if @payby;
8059
8060   }
8061
8062   ###
8063   # paydate_year / paydate_month
8064   ###
8065
8066   if ( $params->{'paydate_year'} =~ /^(\d{4})$/ ) {
8067     my $year = $1;
8068     $params->{'paydate_month'} =~ /^(\d\d?)$/
8069       or die "paydate_year without paydate_month?";
8070     my $month = $1;
8071
8072     push @where,
8073       'paydate IS NOT NULL',
8074       "paydate != ''",
8075       "CAST(paydate AS timestamp) < CAST('$year-$month-01' AS timestamp )"
8076 ;
8077   }
8078
8079   ###
8080   # invoice terms
8081   ###
8082
8083   if ( $params->{'invoice_terms'} =~ /^([\w ]+)$/ ) {
8084     my $terms = $1;
8085     if ( $1 eq 'NULL' ) {
8086       push @where,
8087         "( cust_main.invoice_terms IS NULL OR cust_main.invoice_terms = '' )";
8088     } else {
8089       push @where,
8090         "cust_main.invoice_terms IS NOT NULL",
8091         "cust_main.invoice_terms = '$1'";
8092     }
8093   }
8094
8095   ##
8096   # amounts
8097   ##
8098
8099   if ( $params->{'current_balance'} ) {
8100
8101     #my $balance_sql = $class->balance_sql();
8102     my $balance_sql = FS::cust_main->balance_sql();
8103
8104     my @current_balance =
8105       ref( $params->{'current_balance'} )
8106       ? @{ $params->{'current_balance'} }
8107       :  ( $params->{'current_balance'} );
8108
8109     push @where, map { s/current_balance/$balance_sql/; $_ }
8110                      @current_balance;
8111
8112   }
8113
8114   ##
8115   # custbatch
8116   ##
8117
8118   if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
8119     push @where,
8120       "cust_main.custbatch = '$1'";
8121   }
8122
8123   ##
8124   # setup queries, subs, etc. for the search
8125   ##
8126
8127   $orderby ||= 'ORDER BY custnum';
8128
8129   # here is the agent virtualization
8130   push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
8131
8132   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
8133
8134   my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum  ) ';
8135
8136   my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
8137
8138   my $select = join(', ',
8139                  'cust_main.custnum',
8140                  FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
8141                );
8142
8143   my(@extra_headers) = ();
8144   my(@extra_fields)  = ();
8145
8146   if ($params->{'flattened_pkgs'}) {
8147
8148     if ($dbh->{Driver}->{Name} eq 'Pg') {
8149
8150       $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";
8151
8152     }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
8153       $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
8154       $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
8155     }else{
8156       warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
8157            "omitting packing information from report.";
8158     }
8159
8160     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";
8161
8162     my $sth = dbh->prepare($header_query) or die dbh->errstr;
8163     $sth->execute() or die $sth->errstr;
8164     my $headerrow = $sth->fetchrow_arrayref;
8165     my $headercount = $headerrow ? $headerrow->[0] : 0;
8166     while($headercount) {
8167       unshift @extra_headers, "Package ". $headercount;
8168       unshift @extra_fields, eval q!sub {my $c = shift;
8169                                          my @a = split '\|', $c->magic;
8170                                          my $p = $a[!.--$headercount. q!];
8171                                          $p;
8172                                         };!;
8173     }
8174
8175   }
8176
8177   my $sql_query = {
8178     'table'         => 'cust_main',
8179     'select'        => $select,
8180     'hashref'       => {},
8181     'extra_sql'     => $extra_sql,
8182     'order_by'      => $orderby,
8183     'count_query'   => $count_query,
8184     'extra_headers' => \@extra_headers,
8185     'extra_fields'  => \@extra_fields,
8186   };
8187
8188 }
8189
8190 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
8191
8192 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
8193 records.  Currently, I<first>, I<last>, I<company> and/or I<address1> may be
8194 specified (the appropriate ship_ field is also searched).
8195
8196 Additional options are the same as FS::Record::qsearch
8197
8198 =cut
8199
8200 sub fuzzy_search {
8201   my( $self, $fuzzy, $hash, @opt) = @_;
8202   #$self
8203   $hash ||= {};
8204   my @cust_main = ();
8205
8206   check_and_rebuild_fuzzyfiles();
8207   foreach my $field ( keys %$fuzzy ) {
8208
8209     my $all = $self->all_X($field);
8210     next unless scalar(@$all);
8211
8212     my %match = ();
8213     $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
8214
8215     my @fcust = ();
8216     foreach ( keys %match ) {
8217       push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
8218       push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
8219     }
8220     my %fsaw = ();
8221     push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
8222   }
8223
8224   # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
8225   my %saw = ();
8226   @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
8227
8228   @cust_main;
8229
8230 }
8231
8232 =item masked FIELD
8233
8234 Returns a masked version of the named field
8235
8236 =cut
8237
8238 sub masked {
8239 my ($self,$field) = @_;
8240
8241 # Show last four
8242
8243 'x'x(length($self->getfield($field))-4).
8244   substr($self->getfield($field), (length($self->getfield($field))-4));
8245
8246 }
8247
8248 =back
8249
8250 =head1 SUBROUTINES
8251
8252 =over 4
8253
8254 =item smart_search OPTION => VALUE ...
8255
8256 Accepts the following options: I<search>, the string to search for.  The string
8257 will be searched for as a customer number, phone number, name or company name,
8258 as an exact, or, in some cases, a substring or fuzzy match (see the source code
8259 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
8260 skip fuzzy matching when an exact match is found.
8261
8262 Any additional options are treated as an additional qualifier on the search
8263 (i.e. I<agentnum>).
8264
8265 Returns a (possibly empty) array of FS::cust_main objects.
8266
8267 =cut
8268
8269 sub smart_search {
8270   my %options = @_;
8271
8272   #here is the agent virtualization
8273   my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
8274
8275   my @cust_main = ();
8276
8277   my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
8278   my $search = delete $options{'search'};
8279   ( my $alphanum_search = $search ) =~ s/\W//g;
8280
8281   if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
8282
8283     #false laziness w/Record::ut_phone
8284     my $phonen = "$1-$2-$3";
8285     $phonen .= " x$4" if $4;
8286
8287     push @cust_main, qsearch( {
8288       'table'   => 'cust_main',
8289       'hashref' => { %options },
8290       'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
8291                      ' ( '.
8292                          join(' OR ', map "$_ = '$phonen'",
8293                                           qw( daytime night fax
8294                                               ship_daytime ship_night ship_fax )
8295                              ).
8296                      ' ) '.
8297                      " AND $agentnums_sql", #agent virtualization
8298     } );
8299
8300     unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
8301       #try looking for matches with extensions unless one was specified
8302
8303       push @cust_main, qsearch( {
8304         'table'   => 'cust_main',
8305         'hashref' => { %options },
8306         'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
8307                        ' ( '.
8308                            join(' OR ', map "$_ LIKE '$phonen\%'",
8309                                             qw( daytime night
8310                                                 ship_daytime ship_night )
8311                                ).
8312                        ' ) '.
8313                        " AND $agentnums_sql", #agent virtualization
8314       } );
8315
8316     }
8317
8318   # custnum search (also try agent_custid), with some tweaking options if your
8319   # legacy cust "numbers" have letters
8320   }
8321
8322   if ( $search =~ /^\s*(\d+)\s*$/
8323          || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
8324               && $search =~ /^\s*(\w\w?\d+)\s*$/
8325             )
8326          || ( $conf->exists('address1-search' )
8327               && $search =~ /^\s*(\d+\-?\w*)\s*$/ #i.e. 1234A or 9432-D
8328             )
8329      )
8330   {
8331
8332     my $num = $1;
8333
8334     if ( $num =~ /^(\d+)$/ && $num <= 2147483647 ) { #need a bigint custnum? wow
8335       push @cust_main, qsearch( {
8336         'table'     => 'cust_main',
8337         'hashref'   => { 'custnum' => $num, %options },
8338         'extra_sql' => " AND $agentnums_sql", #agent virtualization
8339       } );
8340     }
8341
8342     push @cust_main, qsearch( {
8343       'table'     => 'cust_main',
8344       'hashref'   => { 'agent_custid' => $num, %options },
8345       'extra_sql' => " AND $agentnums_sql", #agent virtualization
8346     } );
8347
8348     if ( $conf->exists('address1-search') ) {
8349       my $len = length($num);
8350       $num = lc($num);
8351       foreach my $prefix ( '', 'ship_' ) {
8352         push @cust_main, qsearch( {
8353           'table'     => 'cust_main',
8354           'hashref'   => { %options, },
8355           'extra_sql' =>
8356             ( keys(%options) ? ' AND ' : ' WHERE ' ).
8357             " LOWER(SUBSTRING(${prefix}address1 FROM 1 FOR $len)) = '$num' ".
8358             " AND $agentnums_sql",
8359         } );
8360       }
8361     }
8362
8363   } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
8364
8365     my($company, $last, $first) = ( $1, $2, $3 );
8366
8367     # "Company (Last, First)"
8368     #this is probably something a browser remembered,
8369     #so just do an exact search (but case-insensitive, so USPS standardization
8370     #doesn't throw a wrench in the works)
8371
8372     foreach my $prefix ( '', 'ship_' ) {
8373       push @cust_main, qsearch( {
8374         'table'     => 'cust_main',
8375         'hashref'   => { %options },
8376         'extra_sql' =>
8377           ( keys(%options) ? ' AND ' : ' WHERE ' ).
8378           join(' AND ',
8379             " LOWER(${prefix}first)   = ". dbh->quote(lc($first)),
8380             " LOWER(${prefix}last)    = ". dbh->quote(lc($last)),
8381             " LOWER(${prefix}company) = ". dbh->quote(lc($company)),
8382             $agentnums_sql,
8383           ),
8384       } );
8385     }
8386
8387   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
8388                                               # try (ship_){last,company}
8389
8390     my $value = lc($1);
8391
8392     # # remove "(Last, First)" in "Company (Last, First)", otherwise the
8393     # # full strings the browser remembers won't work
8394     # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
8395
8396     use Lingua::EN::NameParse;
8397     my $NameParse = new Lingua::EN::NameParse(
8398              auto_clean     => 1,
8399              allow_reversed => 1,
8400     );
8401
8402     my($last, $first) = ( '', '' );
8403     #maybe disable this too and just rely on NameParse?
8404     if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
8405
8406       ($last, $first) = ( $1, $2 );
8407
8408     #} elsif  ( $value =~ /^(.+)\s+(.+)$/ ) {
8409     } elsif ( ! $NameParse->parse($value) ) {
8410
8411       my %name = $NameParse->components;
8412       $first = $name{'given_name_1'};
8413       $last  = $name{'surname_1'};
8414
8415     }
8416
8417     if ( $first && $last ) {
8418
8419       my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
8420
8421       #exact
8422       my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
8423       $sql .= "
8424         (     ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
8425            OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
8426         )";
8427
8428       push @cust_main, qsearch( {
8429         'table'     => 'cust_main',
8430         'hashref'   => \%options,
8431         'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8432       } );
8433
8434       # or it just be something that was typed in... (try that in a sec)
8435
8436     }
8437
8438     my $q_value = dbh->quote($value);
8439
8440     #exact
8441     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
8442     $sql .= " (    LOWER(last)          = $q_value
8443                 OR LOWER(company)       = $q_value
8444                 OR LOWER(ship_last)     = $q_value
8445                 OR LOWER(ship_company)  = $q_value
8446             ";
8447     $sql .= "   OR LOWER(address1)      = $q_value
8448                 OR LOWER(ship_address1) = $q_value
8449             "
8450       if $conf->exists('address1-search');
8451     $sql .= " )";
8452
8453     push @cust_main, qsearch( {
8454       'table'     => 'cust_main',
8455       'hashref'   => \%options,
8456       'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8457     } );
8458
8459     #no exact match, trying substring/fuzzy
8460     #always do substring & fuzzy (unless they're explicity config'ed off)
8461     #getting complaints searches are not returning enough
8462     unless ( @cust_main  && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
8463
8464       #still some false laziness w/search (was search/cust_main.cgi)
8465
8466       #substring
8467
8468       my @hashrefs = (
8469         { 'company'      => { op=>'ILIKE', value=>"%$value%" }, },
8470         { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
8471       );
8472
8473       if ( $first && $last ) {
8474
8475         push @hashrefs,
8476           { 'first'        => { op=>'ILIKE', value=>"%$first%" },
8477             'last'         => { op=>'ILIKE', value=>"%$last%" },
8478           },
8479           { 'ship_first'   => { op=>'ILIKE', value=>"%$first%" },
8480             'ship_last'    => { op=>'ILIKE', value=>"%$last%" },
8481           },
8482         ;
8483
8484       } else {
8485
8486         push @hashrefs,
8487           { 'last'         => { op=>'ILIKE', value=>"%$value%" }, },
8488           { 'ship_last'    => { op=>'ILIKE', value=>"%$value%" }, },
8489         ;
8490       }
8491
8492       if ( $conf->exists('address1-search') ) {
8493         push @hashrefs,
8494           { 'address1'      => { op=>'ILIKE', value=>"%$value%" }, },
8495           { 'ship_address1' => { op=>'ILIKE', value=>"%$value%" }, },
8496         ;
8497       }
8498
8499       foreach my $hashref ( @hashrefs ) {
8500
8501         push @cust_main, qsearch( {
8502           'table'     => 'cust_main',
8503           'hashref'   => { %$hashref,
8504                            %options,
8505                          },
8506           'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
8507         } );
8508
8509       }
8510
8511       #fuzzy
8512       my @fuzopts = (
8513         \%options,                #hashref
8514         '',                       #select
8515         " AND $agentnums_sql",    #extra_sql  #agent virtualization
8516       );
8517
8518       if ( $first && $last ) {
8519         push @cust_main, FS::cust_main->fuzzy_search(
8520           { 'last'   => $last,    #fuzzy hashref
8521             'first'  => $first }, #
8522           @fuzopts
8523         );
8524       }
8525       foreach my $field ( 'last', 'company' ) {
8526         push @cust_main,
8527           FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
8528       }
8529       if ( $conf->exists('address1-search') ) {
8530         push @cust_main,
8531           FS::cust_main->fuzzy_search( { 'address1' => $value }, @fuzopts );
8532       }
8533
8534     }
8535
8536   }
8537
8538   #eliminate duplicates
8539   my %saw = ();
8540   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8541
8542   @cust_main;
8543
8544 }
8545
8546 =item email_search
8547
8548 Accepts the following options: I<email>, the email address to search for.  The
8549 email address will be searched for as an email invoice destination and as an
8550 svc_acct account.
8551
8552 #Any additional options are treated as an additional qualifier on the search
8553 #(i.e. I<agentnum>).
8554
8555 Returns a (possibly empty) array of FS::cust_main objects (but usually just
8556 none or one).
8557
8558 =cut
8559
8560 sub email_search {
8561   my %options = @_;
8562
8563   local($DEBUG) = 1;
8564
8565   my $email = delete $options{'email'};
8566
8567   #we're only being used by RT at the moment... no agent virtualization yet
8568   #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
8569
8570   my @cust_main = ();
8571
8572   if ( $email =~ /([^@]+)\@([^@]+)/ ) {
8573
8574     my ( $user, $domain ) = ( $1, $2 );
8575
8576     warn "$me smart_search: searching for $user in domain $domain"
8577       if $DEBUG;
8578
8579     push @cust_main,
8580       map $_->cust_main,
8581           qsearch( {
8582                      'table'     => 'cust_main_invoice',
8583                      'hashref'   => { 'dest' => $email },
8584                    }
8585                  );
8586
8587     push @cust_main,
8588       map  $_->cust_main,
8589       grep $_,
8590       map  $_->cust_svc->cust_pkg,
8591           qsearch( {
8592                      'table'     => 'svc_acct',
8593                      'hashref'   => { 'username' => $user, },
8594                      'extra_sql' =>
8595                        'AND ( SELECT domain FROM svc_domain
8596                                 WHERE svc_acct.domsvc = svc_domain.svcnum
8597                             ) = '. dbh->quote($domain),
8598                    }
8599                  );
8600   }
8601
8602   my %saw = ();
8603   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8604
8605   warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
8606     if $DEBUG;
8607
8608   @cust_main;
8609
8610 }
8611
8612 =item check_and_rebuild_fuzzyfiles
8613
8614 =cut
8615
8616 sub check_and_rebuild_fuzzyfiles {
8617   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8618   rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
8619 }
8620
8621 =item rebuild_fuzzyfiles
8622
8623 =cut
8624
8625 sub rebuild_fuzzyfiles {
8626
8627   use Fcntl qw(:flock);
8628
8629   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8630   mkdir $dir, 0700 unless -d $dir;
8631
8632   foreach my $fuzzy ( @fuzzyfields ) {
8633
8634     open(LOCK,">>$dir/cust_main.$fuzzy")
8635       or die "can't open $dir/cust_main.$fuzzy: $!";
8636     flock(LOCK,LOCK_EX)
8637       or die "can't lock $dir/cust_main.$fuzzy: $!";
8638
8639     open (CACHE,">$dir/cust_main.$fuzzy.tmp")
8640       or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
8641
8642     foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
8643       my $sth = dbh->prepare("SELECT $field FROM cust_main".
8644                              " WHERE $field != '' AND $field IS NOT NULL");
8645       $sth->execute or die $sth->errstr;
8646
8647       while ( my $row = $sth->fetchrow_arrayref ) {
8648         print CACHE $row->[0]. "\n";
8649       }
8650
8651     }
8652
8653     close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
8654
8655     rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
8656     close LOCK;
8657   }
8658
8659 }
8660
8661 =item all_X
8662
8663 =cut
8664
8665 sub all_X {
8666   my( $self, $field ) = @_;
8667   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8668   open(CACHE,"<$dir/cust_main.$field")
8669     or die "can't open $dir/cust_main.$field: $!";
8670   my @array = map { chomp; $_; } <CACHE>;
8671   close CACHE;
8672   \@array;
8673 }
8674
8675 =item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
8676
8677 =cut
8678
8679 sub append_fuzzyfiles {
8680   #my( $first, $last, $company ) = @_;
8681
8682   &check_and_rebuild_fuzzyfiles;
8683
8684   use Fcntl qw(:flock);
8685
8686   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8687
8688   foreach my $field (@fuzzyfields) {
8689     my $value = shift;
8690
8691     if ( $value ) {
8692
8693       open(CACHE,">>$dir/cust_main.$field")
8694         or die "can't open $dir/cust_main.$field: $!";
8695       flock(CACHE,LOCK_EX)
8696         or die "can't lock $dir/cust_main.$field: $!";
8697
8698       print CACHE "$value\n";
8699
8700       flock(CACHE,LOCK_UN)
8701         or die "can't unlock $dir/cust_main.$field: $!";
8702       close CACHE;
8703     }
8704
8705   }
8706
8707   1;
8708 }
8709
8710 =item batch_charge
8711
8712 =cut
8713
8714 sub batch_charge {
8715   my $param = shift;
8716   #warn join('-',keys %$param);
8717   my $fh = $param->{filehandle};
8718   my $agentnum = $param->{agentnum};
8719   my $format = $param->{format};
8720
8721   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
8722
8723   my @fields;
8724   if ( $format eq 'simple' ) {
8725     @fields = qw( custnum agent_custid amount pkg );
8726   } else {
8727     die "unknown format $format";
8728   }
8729
8730   eval "use Text::CSV_XS;";
8731   die $@ if $@;
8732
8733   my $csv = new Text::CSV_XS;
8734   #warn $csv;
8735   #warn $fh;
8736
8737   my $imported = 0;
8738   #my $columns;
8739
8740   local $SIG{HUP} = 'IGNORE';
8741   local $SIG{INT} = 'IGNORE';
8742   local $SIG{QUIT} = 'IGNORE';
8743   local $SIG{TERM} = 'IGNORE';
8744   local $SIG{TSTP} = 'IGNORE';
8745   local $SIG{PIPE} = 'IGNORE';
8746
8747   my $oldAutoCommit = $FS::UID::AutoCommit;
8748   local $FS::UID::AutoCommit = 0;
8749   my $dbh = dbh;
8750
8751   #while ( $columns = $csv->getline($fh) ) {
8752   my $line;
8753   while ( defined($line=<$fh>) ) {
8754
8755     $csv->parse($line) or do {
8756       $dbh->rollback if $oldAutoCommit;
8757       return "can't parse: ". $csv->error_input();
8758     };
8759
8760     my @columns = $csv->fields();
8761     #warn join('-',@columns);
8762
8763     my %row = ();
8764     foreach my $field ( @fields ) {
8765       $row{$field} = shift @columns;
8766     }
8767
8768     if ( $row{custnum} && $row{agent_custid} ) {
8769       dbh->rollback if $oldAutoCommit;
8770       return "can't specify custnum with agent_custid $row{agent_custid}";
8771     }
8772
8773     my %hash = ();
8774     if ( $row{agent_custid} && $agentnum ) {
8775       %hash = ( 'agent_custid' => $row{agent_custid},
8776                 'agentnum'     => $agentnum,
8777               );
8778     }
8779
8780     if ( $row{custnum} ) {
8781       %hash = ( 'custnum' => $row{custnum} );
8782     }
8783
8784     unless ( scalar(keys %hash) ) {
8785       $dbh->rollback if $oldAutoCommit;
8786       return "can't find customer without custnum or agent_custid and agentnum";
8787     }
8788
8789     my $cust_main = qsearchs('cust_main', { %hash } );
8790     unless ( $cust_main ) {
8791       $dbh->rollback if $oldAutoCommit;
8792       my $custnum = $row{custnum} || $row{agent_custid};
8793       return "unknown custnum $custnum";
8794     }
8795
8796     if ( $row{'amount'} > 0 ) {
8797       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
8798       if ( $error ) {
8799         $dbh->rollback if $oldAutoCommit;
8800         return $error;
8801       }
8802       $imported++;
8803     } elsif ( $row{'amount'} < 0 ) {
8804       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
8805                                       $row{'pkg'}                         );
8806       if ( $error ) {
8807         $dbh->rollback if $oldAutoCommit;
8808         return $error;
8809       }
8810       $imported++;
8811     } else {
8812       #hmm?
8813     }
8814
8815   }
8816
8817   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
8818
8819   return "Empty file!" unless $imported;
8820
8821   ''; #no error
8822
8823 }
8824
8825 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8826
8827 Deprecated.  Use event notification and message templates
8828 (L<FS::msg_template>) instead.
8829
8830 Sends a templated email notification to the customer (see L<Text::Template>).
8831
8832 OPTIONS is a hash and may include
8833
8834 I<from> - the email sender (default is invoice_from)
8835
8836 I<to> - comma-separated scalar or arrayref of recipients
8837    (default is invoicing_list)
8838
8839 I<subject> - The subject line of the sent email notification
8840    (default is "Notice from company_name")
8841
8842 I<extra_fields> - a hashref of name/value pairs which will be substituted
8843    into the template
8844
8845 The following variables are vavailable in the template.
8846
8847 I<$first> - the customer first name
8848 I<$last> - the customer last name
8849 I<$company> - the customer company
8850 I<$payby> - a description of the method of payment for the customer
8851             # would be nice to use FS::payby::shortname
8852 I<$payinfo> - the account information used to collect for this customer
8853 I<$expdate> - the expiration of the customer payment in seconds from epoch
8854
8855 =cut
8856
8857 sub notify {
8858   my ($self, $template, %options) = @_;
8859
8860   return unless $conf->exists($template);
8861
8862   my $from = $conf->config('invoice_from', $self->agentnum)
8863     if $conf->exists('invoice_from', $self->agentnum);
8864   $from = $options{from} if exists($options{from});
8865
8866   my $to = join(',', $self->invoicing_list_emailonly);
8867   $to = $options{to} if exists($options{to});
8868
8869   my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
8870     if $conf->exists('company_name', $self->agentnum);
8871   $subject = $options{subject} if exists($options{subject});
8872
8873   my $notify_template = new Text::Template (TYPE => 'ARRAY',
8874                                             SOURCE => [ map "$_\n",
8875                                               $conf->config($template)]
8876                                            )
8877     or die "can't create new Text::Template object: Text::Template::ERROR";
8878   $notify_template->compile()
8879     or die "can't compile template: Text::Template::ERROR";
8880
8881   $FS::notify_template::_template::company_name =
8882     $conf->config('company_name', $self->agentnum);
8883   $FS::notify_template::_template::company_address =
8884     join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
8885
8886   my $paydate = $self->paydate || '2037-12-31';
8887   $FS::notify_template::_template::first = $self->first;
8888   $FS::notify_template::_template::last = $self->last;
8889   $FS::notify_template::_template::company = $self->company;
8890   $FS::notify_template::_template::payinfo = $self->mask_payinfo;
8891   my $payby = $self->payby;
8892   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8893   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8894
8895   #credit cards expire at the end of the month/year of their exp date
8896   if ($payby eq 'CARD' || $payby eq 'DCRD') {
8897     $FS::notify_template::_template::payby = 'credit card';
8898     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8899     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8900     $expire_time--;
8901   }elsif ($payby eq 'COMP') {
8902     $FS::notify_template::_template::payby = 'complimentary account';
8903   }else{
8904     $FS::notify_template::_template::payby = 'current method';
8905   }
8906   $FS::notify_template::_template::expdate = $expire_time;
8907
8908   for (keys %{$options{extra_fields}}){
8909     no strict "refs";
8910     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
8911   }
8912
8913   send_email(from => $from,
8914              to => $to,
8915              subject => $subject,
8916              body => $notify_template->fill_in( PACKAGE =>
8917                                                 'FS::notify_template::_template'                                              ),
8918             );
8919
8920 }
8921
8922 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8923
8924 Generates a templated notification to the customer (see L<Text::Template>).
8925
8926 OPTIONS is a hash and may include
8927
8928 I<extra_fields> - a hashref of name/value pairs which will be substituted
8929    into the template.  These values may override values mentioned below
8930    and those from the customer record.
8931
8932 The following variables are available in the template instead of or in addition
8933 to the fields of the customer record.
8934
8935 I<$payby> - a description of the method of payment for the customer
8936             # would be nice to use FS::payby::shortname
8937 I<$payinfo> - the masked account information used to collect for this customer
8938 I<$expdate> - the expiration of the customer payment method in seconds from epoch
8939 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
8940
8941 =cut
8942
8943 # a lot like cust_bill::print_latex
8944 sub generate_letter {
8945   my ($self, $template, %options) = @_;
8946
8947   return unless $conf->exists($template);
8948
8949   my $letter_template = new Text::Template
8950                         ( TYPE       => 'ARRAY',
8951                           SOURCE     => [ map "$_\n", $conf->config($template)],
8952                           DELIMITERS => [ '[@--', '--@]' ],
8953                         )
8954     or die "can't create new Text::Template object: Text::Template::ERROR";
8955
8956   $letter_template->compile()
8957     or die "can't compile template: Text::Template::ERROR";
8958
8959   my %letter_data = map { $_ => $self->$_ } $self->fields;
8960   $letter_data{payinfo} = $self->mask_payinfo;
8961
8962   #my $paydate = $self->paydate || '2037-12-31';
8963   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
8964
8965   my $payby = $self->payby;
8966   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8967   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8968
8969   #credit cards expire at the end of the month/year of their exp date
8970   if ($payby eq 'CARD' || $payby eq 'DCRD') {
8971     $letter_data{payby} = 'credit card';
8972     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8973     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8974     $expire_time--;
8975   }elsif ($payby eq 'COMP') {
8976     $letter_data{payby} = 'complimentary account';
8977   }else{
8978     $letter_data{payby} = 'current method';
8979   }
8980   $letter_data{expdate} = $expire_time;
8981
8982   for (keys %{$options{extra_fields}}){
8983     $letter_data{$_} = $options{extra_fields}->{$_};
8984   }
8985
8986   unless(exists($letter_data{returnaddress})){
8987     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
8988                                                   $self->agent_template)
8989                      );
8990     if ( length($retadd) ) {
8991       $letter_data{returnaddress} = $retadd;
8992     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
8993       $letter_data{returnaddress} =
8994         join( "\n", map { s/( {2,})/'~' x length($1)/eg;
8995                           s/$/\\\\\*/;
8996                           $_;
8997                         }
8998                     ( $conf->config('company_name', $self->agentnum),
8999                       $conf->config('company_address', $self->agentnum),
9000                     )
9001         );
9002     } else {
9003       $letter_data{returnaddress} = '~';
9004     }
9005   }
9006
9007   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
9008
9009   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
9010
9011   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
9012
9013   my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
9014                            DIR      => $dir,
9015                            SUFFIX   => '.eps',
9016                            UNLINK   => 0,
9017                          ) or die "can't open temp file: $!\n";
9018   print $lh $conf->config_binary('logo.eps', $self->agentnum)
9019     or die "can't write temp file: $!\n";
9020   close $lh;
9021   $letter_data{'logo_file'} = $lh->filename;
9022
9023   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
9024                            DIR      => $dir,
9025                            SUFFIX   => '.tex',
9026                            UNLINK   => 0,
9027                          ) or die "can't open temp file: $!\n";
9028
9029   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
9030   close $fh;
9031   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
9032   return ($1, $letter_data{'logo_file'});
9033
9034 }
9035
9036 =item print_ps TEMPLATE
9037
9038 Returns an postscript letter filled in from TEMPLATE, as a scalar.
9039
9040 =cut
9041
9042 sub print_ps {
9043   my $self = shift;
9044   my($file, $lfile) = $self->generate_letter(@_);
9045   my $ps = FS::Misc::generate_ps($file);
9046   unlink($file.'.tex');
9047   unlink($lfile);
9048
9049   $ps;
9050 }
9051
9052 =item print TEMPLATE
9053
9054 Prints the filled in template.
9055
9056 TEMPLATE is the name of a L<Text::Template> to fill in and print.
9057
9058 =cut
9059
9060 sub queueable_print {
9061   my %opt = @_;
9062
9063   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
9064     or die "invalid customer number: " . $opt{custvnum};
9065
9066   my $error = $self->print( $opt{template} );
9067   die $error if $error;
9068 }
9069
9070 sub print {
9071   my ($self, $template) = (shift, shift);
9072   do_print [ $self->print_ps($template) ];
9073 }
9074
9075 #these three subs should just go away once agent stuff is all config overrides
9076
9077 sub agent_template {
9078   my $self = shift;
9079   $self->_agent_plandata('agent_templatename');
9080 }
9081
9082 sub agent_invoice_from {
9083   my $self = shift;
9084   $self->_agent_plandata('agent_invoice_from');
9085 }
9086
9087 sub _agent_plandata {
9088   my( $self, $option ) = @_;
9089
9090   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
9091   #agent-specific Conf
9092
9093   use FS::part_event::Condition;
9094
9095   my $agentnum = $self->agentnum;
9096
9097   my $regexp = regexp_sql();
9098
9099   my $part_event_option =
9100     qsearchs({
9101       'select'    => 'part_event_option.*',
9102       'table'     => 'part_event_option',
9103       'addl_from' => q{
9104         LEFT JOIN part_event USING ( eventpart )
9105         LEFT JOIN part_event_option AS peo_agentnum
9106           ON ( part_event.eventpart = peo_agentnum.eventpart
9107                AND peo_agentnum.optionname = 'agentnum'
9108                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
9109              )
9110         LEFT JOIN part_event_condition
9111           ON ( part_event.eventpart = part_event_condition.eventpart
9112                AND part_event_condition.conditionname = 'cust_bill_age'
9113              )
9114         LEFT JOIN part_event_condition_option
9115           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
9116                AND part_event_condition_option.optionname = 'age'
9117              )
9118       },
9119       #'hashref'   => { 'optionname' => $option },
9120       #'hashref'   => { 'part_event_option.optionname' => $option },
9121       'extra_sql' =>
9122         " WHERE part_event_option.optionname = ". dbh->quote($option).
9123         " AND action = 'cust_bill_send_agent' ".
9124         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
9125         " AND peo_agentnum.optionname = 'agentnum' ".
9126         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
9127         " ORDER BY
9128            CASE WHEN part_event_condition_option.optionname IS NULL
9129            THEN -1
9130            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
9131         " END
9132           , part_event.weight".
9133         " LIMIT 1"
9134     });
9135
9136   unless ( $part_event_option ) {
9137     return $self->agent->invoice_template || ''
9138       if $option eq 'agent_templatename';
9139     return '';
9140   }
9141
9142   $part_event_option->optionvalue;
9143
9144 }
9145
9146 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
9147
9148 Subroutine (not a method), designed to be called from the queue.
9149
9150 Takes a list of options and values.
9151
9152 Pulls up the customer record via the custnum option and calls bill_and_collect.
9153
9154 =cut
9155
9156 sub queued_bill {
9157   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
9158
9159   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
9160   warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
9161
9162   $cust_main->bill_and_collect( %args );
9163 }
9164
9165 sub process_bill_and_collect {
9166   my $job = shift;
9167   my $param = thaw(decode_base64(shift));
9168   my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
9169       or die "custnum '$param->{custnum}' not found!\n";
9170   $param->{'job'}   = $job;
9171   $param->{'fatal'} = 1; # runs from job queue, will be caught
9172   $param->{'retry'} = 1;
9173
9174   $cust_main->bill_and_collect( %$param );
9175 }
9176
9177 sub _upgrade_data { #class method
9178   my ($class, %opts) = @_;
9179
9180   my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
9181   my $sth = dbh->prepare($sql) or die dbh->errstr;
9182   $sth->execute or die $sth->errstr;
9183
9184   local($ignore_expired_card) = 1;
9185   local($skip_fuzzyfiles) = 1;
9186   $class->_upgrade_otaker(%opts);
9187
9188 }
9189
9190 =back
9191
9192 =head1 BUGS
9193
9194 The delete method.
9195
9196 The delete method should possibly take an FS::cust_main object reference
9197 instead of a scalar customer number.
9198
9199 Bill and collect options should probably be passed as references instead of a
9200 list.
9201
9202 There should probably be a configuration file with a list of allowed credit
9203 card types.
9204
9205 No multiple currency support (probably a larger project than just this module).
9206
9207 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
9208
9209 Birthdates rely on negative epoch values.
9210
9211 The payby for card/check batches is broken.  With mixed batching, bad
9212 things will happen.
9213
9214 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
9215
9216 =head1 SEE ALSO
9217
9218 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
9219 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
9220 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
9221
9222 =cut
9223
9224 1;
9225