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