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