FS/FS/cust_main/Billing.pm

   1 package FS::cust_main::Billing;
   2
   3 use strict;
   4 use feature 'state';
   5 use vars qw( $conf $DEBUG $me );
   6 use Carp;
   7 use Data::Dumper;
   8 use List::Util qw( min );
   9 use FS::UID qw( dbh );
  10 use FS::Record qw( qsearch qsearchs dbdef );
  11 use FS::Misc::DateTime qw( day_end );
  12 use Tie::RefHash;
  13 use FS::cust_bill;
  14 use FS::cust_bill_pkg;
  15 use FS::cust_bill_pkg_display;
  16 use FS::cust_bill_pay;
  17 use FS::cust_credit_bill;
  18 use FS::cust_tax_adjustment;
  19 use FS::tax_rate;
  20 use FS::tax_rate_location;
  21 use FS::cust_bill_pkg_tax_location;
  22 use FS::cust_bill_pkg_tax_rate_location;
  23 use FS::part_event;
  24 use FS::part_event_condition;
  25 use FS::pkg_category;
  26 use FS::FeeOrigin_Mixin;
  27 use FS::Log;
  28 use FS::TaxEngine;
  29 use FS::Misc::Savepoint;
  30
  31 # 1 is mostly method/subroutine entry and options
  32 # 2 traces progress of some operations
  33 # 3 is even more information including possibly sensitive data
  34 $DEBUG = 0;
  35 $me = '[FS::cust_main::Billing]';
  36
  37 install_callback FS::UID sub {
  38   $conf = new FS::Conf;
  39   #yes, need it for stuff below (prolly should be cached)
  40 };
  41
  42 =head1 NAME
  43
  44 FS::cust_main::Billing - Billing mixin for cust_main
  45
  46 =head1 SYNOPSIS
  47
  48 =head1 DESCRIPTION
  49
  50 These methods are available on FS::cust_main objects.
  51
  52 =head1 METHODS
  53
  54 =over 4
  55
  56 =item bill_and_collect
  57
  58 Cancels and suspends any packages due, generates bills, applies payments and
  59 credits, and applies collection events to run cards, send bills and notices,
  60 etc.
  61
  62 Any errors prevent subsequent operations from continuing and die (but see the
  63 "fatal" flag below).
  64
  65 Options are passed as name-value pairs.  Currently available options are:
  66
  67 =over 4
  68
  69 =item time
  70
  71 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:
  72
  73  use Date::Parse;
  74  ...
  75  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
  76
  77 =item invoice_time
  78
  79 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.
  80
  81 =item check_freq
  82
  83 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
  84
  85 =item resetup
  86
  87 If set true, re-charges setup fees.
  88
  89 =item fatal
  90
  91 If set any errors prevent subsequent operations from continusing.  If set
  92 specifically to "return", returns the error (or false, if there is no error).
  93 Any other true value causes errors to die.
  94
  95 =item debug
  96
  97 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)
  98
  99 =item job
 100
 101 Optional FS::queue entry to receive status updates.
 102
 103 =back
 104
 105 Options are passed to the B<bill> and B<collect> methods verbatim, so all
 106 options of those methods are also available.
 107
 108 =cut
 109
 110 sub bill_and_collect {
 111   my( $self, %options ) = @_;
 112
 113   my $log = FS::Log->new('FS::cust_main::Billing::bill_and_collect');
 114   my %logopt = (object => $self);
 115   $log->debug('start', %logopt);
 116
 117   my $error;
 118
 119   #$options{actual_time} not $options{time} because freeside-daily -d is for
 120   #pre-printing invoices
 121
 122   $options{'actual_time'} ||= time;
 123   my $job = $options{'job'};
 124
 125   my $actual_time = ( $conf->exists('next-bill-ignore-time')
 126                         ? day_end( $options{actual_time} )
 127                         : $options{actual_time}
 128                     );
 129
 130   $job->update_statustext('0,cleaning expired packages') if $job;
 131   $log->debug('canceling expired packages', %logopt);
 132   $error = $self->cancel_expired_pkgs( $actual_time );
 133   if ( $error ) {
 134     $error = "Error expiring custnum ". $self->custnum. ": $error";
 135     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
 136     else                                                     { die    $error; }
 137   }
 138
 139   $log->debug('suspending adjourned packages', %logopt);
 140   $error = $self->suspend_adjourned_pkgs( $actual_time );
 141   if ( $error ) {
 142     $error = "Error adjourning custnum ". $self->custnum. ": $error";
 143     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
 144     else                                                     { die    $error; }
 145   }
 146
 147   $log->debug('unsuspending resumed packages', %logopt);
 148   $error = $self->unsuspend_resumed_pkgs( $actual_time );
 149   if ( $error ) {
 150     $error = "Error resuming custnum ".$self->custnum. ": $error";
 151     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
 152     else                                                     { die    $error; }
 153   }
 154
 155   my $tax_district_method = $conf->config('tax_district_method');
 156   if ( $tax_district_method && $tax_district_method eq 'wa_sales' ) {
 157     # When using Washington State Sales Tax Districts,
 158     # Bail out of billing customer if sales tax district for location is missing
 159
 160     $log->debug('checking cust_location tax districts', %logopt);
 161
 162     if (
 163       my @cust_locations_missing_district =
 164         $self->cust_locations_missing_district
 165     ) {
 166       $error = sprintf
 167         'cust_location missing tax district: '.
 168         join( ', ' => (
 169           map(
 170             {
 171               sprintf
 172                 'locationnum(%s) %s %s %s %s',
 173                  $_->locationnum,
 174                  $_->address1,
 175                  $_->city,
 176                  $_->state,
 177                  $_->zip
 178             }
 179             @cust_locations_missing_district
 180           )
 181         ));
 182     }
 183   }
 184   if ( $error ) {
 185     $error = "Error calculating taxes ".$self->custnum. ": $error";
 186     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
 187     else                                                     { die    $error; }
 188   }
 189
 190   $job->update_statustext('20,billing packages') if $job;
 191   $log->debug('billing packages', %logopt);
 192   $error = $self->bill( %options );
 193   if ( $error ) {
 194     $error = "Error billing custnum ". $self->custnum. ": $error";
 195     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
 196     else                                                     { die    $error; }
 197   }
 198
 199   $job->update_statustext('50,applying payments and credits') if $job;
 200   $log->debug('applying payments and credits', %logopt);
 201   $error = $self->apply_payments_and_credits;
 202   if ( $error ) {
 203     $error = "Error applying custnum ". $self->custnum. ": $error";
 204     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
 205     else                                                     { die    $error; }
 206   }
 207
 208   # In a batch tax environment, do not run collection if any pending
 209   # invoices were created.  Collection will run after the next tax batch.
 210   state $is_batch_tax = FS::TaxEngine->new->info->{batch} ? 1 : 0;
 211   if ( $is_batch_tax && $self->pending_invoice_count ) {
 212     warn "skipped collection for custnum ".$self->custnum.
 213          " due to pending invoices\n" if $DEBUG;
 214   } elsif ( $conf->exists('cancelled_cust-noevents')
 215              && ! $self->num_ncancelled_pkgs )
 216   {
 217     warn "skipped collection for custnum ".$self->custnum.
 218          " because they have no active packages\n" if $DEBUG;
 219   } else {
 220     # run collection normally
 221     $job->update_statustext('70,running collection events') if $job;
 222     $log->debug('running collection events', %logopt);
 223     $error = $self->collect( %options );
 224     if ( $error ) {
 225       $error = "Error collecting custnum ". $self->custnum. ": $error";
 226       if    ($options{fatal} && $options{fatal} eq 'return') { return $error; }
 227       else                                                   { die    $error; }
 228     }
 229   }
 230
 231   $job->update_statustext('100,finished') if $job;
 232   $log->debug('finish', %logopt);
 233
 234   '';
 235
 236 }
 237
 238 sub cancel_expired_pkgs {
 239   my ( $self, $time, %options ) = @_;
 240
 241   my @cancel_pkgs = $self->ncancelled_pkgs( {
 242     'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time "
 243   } );
 244
 245   my @errors = ();
 246
 247   my @really_cancel_pkgs = ();
 248   my @cancel_reasons = ();
 249
 250   CUST_PKG: foreach my $cust_pkg ( @cancel_pkgs ) {
 251     my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
 252
 253     if ( $cust_pkg->change_to_pkgnum ) {
 254
 255       my $new_pkg = FS::cust_pkg->by_key($cust_pkg->change_to_pkgnum);
 256       if ( !$new_pkg ) {
 257         push @errors, 'can\'t change pkgnum '.$cust_pkg->pkgnum.' to pkgnum '.
 258                       $cust_pkg->change_to_pkgnum.'; not expiring';
 259         next CUST_PKG;
 260       }
 261       my $error = $cust_pkg->change( 'cust_pkg'        => $new_pkg,
 262                                      'unprotect_svcs'  => 1,
 263                                    );
 264       push @errors, $error if $error && ref($error) ne 'FS::cust_pkg';
 265
 266     } else { # just cancel it
 267
 268       push @really_cancel_pkgs, $cust_pkg;
 269       push @cancel_reasons, $cpr;
 270
 271     }
 272   }
 273
 274   if (@really_cancel_pkgs) {
 275
 276     my %cancel_opt = ( 'cust_pkg' => \@really_cancel_pkgs,
 277                        'cust_pkg_reason' => \@cancel_reasons,
 278                        'time' => $time,
 279                      );
 280
 281     push @errors, $self->cancel_pkgs(%cancel_opt);
 282
 283   }
 284
 285   join(' / ', @errors);
 286
 287 }
 288
 289 sub suspend_adjourned_pkgs {
 290   my ( $self, $time, %options ) = @_;
 291
 292   my @susp_pkgs = $self->ncancelled_pkgs( {
 293     'extra_sql' =>
 294       " AND ( susp IS NULL OR susp = 0 )
 295         AND (    ( bill    IS NOT NULL AND bill    != 0 AND bill    <  $time )
 296               OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time )
 297             )
 298       ",
 299   } );
 300
 301   #only because there's no SQL test for is_prepaid :/
 302   @susp_pkgs =
 303     grep {     (    $_->part_pkg->is_prepaid
 304                  && $_->bill
 305                  && $_->bill < $time
 306                )
 307             || (    $_->adjourn
 308                  && $_->adjourn <= $time
 309                )
 310
 311          }
 312          @susp_pkgs;
 313
 314   my @errors = ();
 315
 316   foreach my $cust_pkg ( @susp_pkgs ) {
 317     my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
 318       if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
 319     my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
 320                                             'reason_otaker' => $cpr->otaker
 321                                           )
 322                                         : ()
 323                                   );
 324     push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
 325   }
 326
 327   join(' / ', @errors);
 328
 329 }
 330
 331 sub unsuspend_resumed_pkgs {
 332   my ( $self, $time, %options ) = @_;
 333
 334   my @unsusp_pkgs = $self->ncancelled_pkgs( {
 335     'extra_sql' => " AND resume IS NOT NULL AND resume > 0 AND resume <= $time "
 336   } );
 337
 338   my @errors = ();
 339
 340   foreach my $cust_pkg ( @unsusp_pkgs ) {
 341     my $error = $cust_pkg->unsuspend( 'time' => $time );
 342     push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
 343   }
 344
 345   join(' / ', @errors);
 346
 347 }
 348
 349 =item bill OPTIONS
 350
 351 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
 352 conjunction with the collect method by calling B<bill_and_collect>.
 353
 354 If there is an error, returns the error, otherwise returns false.
 355
 356 Options are passed as name-value pairs.  Currently available options are:
 357
 358 =over 4
 359
 360 =item resetup
 361
 362 If set true, re-charges setup fees.
 363
 364 =item recurring_only
 365
 366 If set true then only bill recurring charges, not setup, usage, one time
 367 charges, etc.
 368
 369 =item freq_override
 370
 371 If set, then override the normal frequency and look for a part_pkg_discount
 372 to take at that frequency.  This is appropriate only when the normal
 373 frequency for all packages is monthly, and is an error otherwise.  Use
 374 C<pkg_list> to limit the set of packages included in billing.
 375
 376 =item time
 377
 378 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:
 379
 380  use Date::Parse;
 381  ...
 382  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
 383
 384 =item pkg_list
 385
 386 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
 387
 388  $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
 389
 390 =item not_pkgpart
 391
 392 A hashref of pkgparts to exclude from this billing run (can also be specified as a comma-separated scalar).
 393
 394 =item no_prepaid
 395
 396 Do not bill prepaid packages.  Used by freeside-daily.
 397
 398 =item invoice_time
 399
 400 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.
 401
 402 =item cancel
 403
 404 This boolean value informs the us that the package is being cancelled.  This
 405 typically might mean not charging the normal recurring fee but only usage
 406 fees since the last billing. Setup charges may be charged.  Not all package
 407 plans support this feature (they tend to charge 0).
 408
 409 =item no_usage_reset
 410
 411 Prevent the resetting of usage limits during this call.
 412
 413 =item no_commit
 414
 415 Do not save the generated bill in the database.  Useful with return_bill
 416
 417 =item return_bill
 418
 419 A list reference on which the generated bill(s) will be returned.
 420
 421 =item estimate
 422
 423 Boolean value; indicates that this is an estimate rather than a "tax invoice".
 424 This will be passed through to the tax engine, as online tax services
 425 sometimes need to know it for reporting purposes. Otherwise it has no effect.
 426
 427 =item invoice_terms
 428
 429 Optional terms to be printed on this invoice.  Otherwise, customer-specific
 430 terms or the default terms are used.
 431
 432 =back
 433
 434 =cut
 435
 436 sub bill {
 437   my( $self, %options ) = @_;
 438
 439   return '' if $self->complimentary eq 'Y';
 440
 441   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
 442   my $log = FS::Log->new('FS::cust_main::Billing::bill');
 443   my %logopt = (object => $self);
 444
 445   $log->debug('start', %logopt);
 446   warn "$me bill customer ". $self->custnum. "\n"
 447     if $DEBUG;
 448
 449   my $time = $options{'time'} || time;
 450   my $invoice_time = $options{'invoice_time'} || $time;
 451
 452   my $cmp_time = ( $conf->exists('next-bill-ignore-time')
 453                      ? day_end( $time )
 454                      : $time
 455                  );
 456
 457   $options{'not_pkgpart'} ||= {};
 458   $options{'not_pkgpart'} = { map { $_ => 1 }
 459                                   split(/\s*,\s*/, $options{'not_pkgpart'})
 460                             }
 461     unless ref($options{'not_pkgpart'});
 462
 463   local $SIG{HUP} = 'IGNORE';
 464   local $SIG{INT} = 'IGNORE';
 465   local $SIG{QUIT} = 'IGNORE';
 466   local $SIG{TERM} = 'IGNORE';
 467   local $SIG{TSTP} = 'IGNORE';
 468   local $SIG{PIPE} = 'IGNORE';
 469
 470   my $oldAutoCommit = $FS::UID::AutoCommit;
 471   local $FS::UID::AutoCommit = 0;
 472   my $dbh = dbh;
 473
 474   $log->debug('acquiring lock', %logopt);
 475   warn "$me acquiring lock on customer ". $self->custnum. "\n"
 476     if $DEBUG;
 477
 478   $self->select_for_update; #mutex
 479
 480   $log->debug('running pre-bill events', %logopt);
 481   warn "$me running pre-bill events for customer ". $self->custnum. "\n"
 482     if $DEBUG;
 483
 484   my $error = $self->do_cust_event(
 485     'debug'      => ( $options{'debug'} || 0 ),
 486     'time'       => $invoice_time,
 487     'check_freq' => $options{'check_freq'},
 488     'stage'      => 'pre-bill',
 489   )
 490     unless $options{no_commit};
 491   if ( $error ) {
 492     $dbh->rollback if $oldAutoCommit && !$options{no_commit};
 493     return $error;
 494   }
 495
 496   $log->debug('done running pre-bill events', %logopt);
 497   warn "$me done running pre-bill events for customer ". $self->custnum. "\n"
 498     if $DEBUG;
 499
 500   #keep auto-charge and non-auto-charge line items separate
 501   my @passes = ( '', 'no_auto' );
 502
 503   my %cust_bill_pkg = map { $_ => [] } @passes;
 504
 505   ###
 506   # find the packages which are due for billing, find out how much they are
 507   # & generate invoice database.
 508   ###
 509
 510   my %total_setup   = map { my $z = 0; $_ => \$z; } @passes;
 511   my %total_recur   = map { my $z = 0; $_ => \$z; } @passes;
 512
 513   my @precommit_hooks = ();
 514
 515   $options{'pkg_list'} ||= [ $self->ncancelled_pkgs ];  #param checks?
 516
 517   my %tax_engines;
 518   my $tax_is_batch = '';
 519   foreach (@passes) {
 520     $tax_engines{$_} = FS::TaxEngine->new(cust_main    => $self,
 521                                           invoice_time => $invoice_time,
 522                                           cancel       => $options{cancel},
 523                                           estimate     => $options{estimate},
 524                                          );
 525     $tax_is_batch ||= $tax_engines{$_}->info->{batch};
 526   }
 527
 528   foreach my $cust_pkg ( @{ $options{'pkg_list'} } ) {
 529
 530     next if $options{'not_pkgpart'}->{$cust_pkg->pkgpart};
 531
 532     my $part_pkg = $cust_pkg->part_pkg;
 533
 534     next if $options{'no_prepaid'} && $part_pkg->is_prepaid;
 535
 536     $log->debug('bill package '. $cust_pkg->pkgnum, %logopt);
 537     warn "  bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG;
 538
 539     #? to avoid use of uninitialized value errors... ?
 540     $cust_pkg->setfield('bill', '')
 541       unless defined($cust_pkg->bill);
 542
 543     my $real_pkgpart = $cust_pkg->pkgpart;
 544     my %hash = $cust_pkg->hash;
 545
 546     # we could implement this bit as FS::part_pkg::has_hidden, but we already
 547     # suffer from performance issues
 548     $options{has_hidden} = 0;
 549     my @part_pkg = $part_pkg->self_and_bill_linked;
 550     $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
 551
 552     # if this package was changed from another package,
 553     # and it hasn't been billed since then,
 554     # and package balances are enabled,
 555     if ( $cust_pkg->change_pkgnum
 556         and $cust_pkg->change_date >= ($cust_pkg->last_bill || 0)
 557         and $cust_pkg->change_date <  $invoice_time
 558       and $conf->exists('pkg-balances') )
 559     {
 560       # _transfer_balance will also create the appropriate credit
 561       my @transfer_items = $self->_transfer_balance($cust_pkg);
 562       # $part_pkg[0] is the "real" part_pkg
 563       my $pass = ($cust_pkg->no_auto || $part_pkg[0]->no_auto) ?
 564                   'no_auto' : '';
 565       push @{ $cust_bill_pkg{$pass} }, @transfer_items;
 566       # treating this as recur, just because most charges are recur...
 567       ${$total_recur{$pass}} += $_->recur foreach @transfer_items;
 568
 569       # currently not considering separate_bill here, as it's for
 570       # one-time charges only
 571     }
 572
 573     foreach my $part_pkg ( @part_pkg ) {
 574
 575       my $this_cust_pkg = $cust_pkg;
 576       # for add-on packages, copy the object to avoid leaking changes back to
 577       # the caller if pkg_list is in use; see RT#73607
 578       if ( $part_pkg->get('pkgpart') != $real_pkgpart ) {
 579         $this_cust_pkg = FS::cust_pkg->new({ %hash });
 580       }
 581
 582       my $pass = '';
 583       if ( $this_cust_pkg->separate_bill ) {
 584         # if no_auto is also set, that's fine. we just need to not have
 585         # invoices that are both auto and no_auto, and since the package
 586         # gets an invoice all to itself, it will only be one or the other.
 587         $pass = $this_cust_pkg->pkgnum;
 588         if (!exists $cust_bill_pkg{$pass}) { # it may not exist yet
 589           push @passes, $pass;
 590           $total_setup{$pass} = do { my $z = 0; \$z };
 591           $total_recur{$pass} = do { my $z = 0; \$z };
 592           # it also needs its own tax context
 593           $tax_engines{$pass} = FS::TaxEngine->new(
 594                                   cust_main    => $self,
 595                                   invoice_time => $invoice_time,
 596                                   cancel       => $options{cancel},
 597                                   estimate     => $options{estimate},
 598                                 );
 599           $cust_bill_pkg{$pass} = [];
 600         }
 601       } elsif ( ($this_cust_pkg->no_auto || $part_pkg->no_auto) ) {
 602         $pass = 'no_auto';
 603       }
 604
 605       my $next_bill = $this_cust_pkg->getfield('bill') || 0;
 606       my $error;
 607       # let this run once if this is the last bill upon cancellation
 608       while ( $next_bill <= $cmp_time or $options{cancel} ) {
 609         $error =
 610           $self->_make_lines( 'part_pkg'            => $part_pkg,
 611                               'cust_pkg'            => $this_cust_pkg,
 612                               'precommit_hooks'     => \@precommit_hooks,
 613                               'line_items'          => $cust_bill_pkg{$pass},
 614                               'setup'               => $total_setup{$pass},
 615                               'recur'               => $total_recur{$pass},
 616                               'tax_engine'          => $tax_engines{$pass},
 617                               'time'                => $time,
 618                               'real_pkgpart'        => $real_pkgpart,
 619                               'options'             => \%options,
 620                             );
 621
 622         # Stop if anything goes wrong
 623         last if $error;
 624
 625         # or if we're not incrementing the bill date.
 626         last if ($this_cust_pkg->getfield('bill') || 0) == $next_bill;
 627
 628         # or if we're letting it run only once
 629         last if $options{cancel};
 630
 631         $next_bill = $this_cust_pkg->getfield('bill') || 0;
 632
 633         #stop if -o was passed to freeside-daily
 634         last if $options{'one_recur'};
 635       }
 636       if ($error) {
 637         $dbh->rollback if $oldAutoCommit && !$options{no_commit};
 638         return $error;
 639       }
 640
 641     } #foreach my $part_pkg
 642
 643   } #foreach my $cust_pkg
 644
 645   foreach my $pass (@passes) { # keys %cust_bill_pkg )
 646
 647     my @cust_bill_pkg = _omit_zero_value_bundles(@{ $cust_bill_pkg{$pass} });
 648
 649     warn "$me billing pass $pass\n"
 650            #.Dumper(\@cust_bill_pkg)."\n"
 651       if $DEBUG > 2;
 652
 653     ###
 654     # process fees
 655     ###
 656
 657     my @pending_fees = FS::FeeOrigin_Mixin->by_cust($self->custnum,
 658       hashref => { 'billpkgnum' => '' }
 659     );
 660     warn "$me found pending fees:\n".Dumper(\@pending_fees)."\n"
 661       if @pending_fees and $DEBUG > 1;
 662
 663     # determine whether to generate an invoice
 664     my $generate_bill = scalar(@cust_bill_pkg) > 0;
 665
 666     foreach my $fee (@pending_fees) {
 667       $generate_bill = 1 unless $fee->nextbill;
 668     }
 669
 670     # don't create an invoice with no line items, or where the only line
 671     # items are fees that are supposed to be held until the next invoice
 672     next if !$generate_bill;
 673
 674     # calculate fees...
 675     my @fee_items;
 676     foreach my $fee_origin (@pending_fees) {
 677       my $part_fee = $fee_origin->part_fee;
 678
 679       # check whether the fee is applicable before doing anything expensive:
 680       #
 681       # if the fee def belongs to a different agent, don't charge the fee.
 682       # event conditions should prevent this, but just in case they don't,
 683       # skip the fee.
 684       if ( $part_fee->agentnum and $part_fee->agentnum != $self->agentnum ) {
 685         warn "tried to charge fee#".$part_fee->feepart .
 686              " on customer#".$self->custnum." from a different agent.\n";
 687         next;
 688       }
 689       # also skip if it's disabled
 690       next if $part_fee->disabled eq 'Y';
 691
 692       # Decide which invoice to base the fee on.
 693       my $cust_bill = $fee_origin->cust_bill;
 694       if (!$cust_bill) {
 695         # Then link it to the current invoice. This isn't the real cust_bill
 696         # object that will be inserted--in particular there are no taxes yet.
 697         # If you want to charge a fee on the total invoice amount including
 698         # taxes, you have to put the fee on the next invoice.
 699         $cust_bill = FS::cust_bill->new({
 700             'custnum'       => $self->custnum,
 701             'cust_bill_pkg' => \@cust_bill_pkg,
 702             'charged'       => ${ $total_setup{$pass} } +
 703                                ${ $total_recur{$pass} },
 704         });
 705
 706         # If the origin is for a specific package, then only apply the fee to
 707         # line items from that package.
 708         if ( my $cust_pkg = $fee_origin->cust_pkg ) {
 709           my @charge_fee_on_item;
 710           my $charge_fee_on_amount = 0;
 711           foreach (@cust_bill_pkg) {
 712             if ($_->pkgnum == $cust_pkg->pkgnum) {
 713               push @charge_fee_on_item, $_;
 714               $charge_fee_on_amount += $_->setup + $_->recur;
 715             }
 716           }
 717           $cust_bill->set('cust_bill_pkg', \@charge_fee_on_item);
 718           $cust_bill->set('charged', $charge_fee_on_amount);
 719         }
 720
 721       } # $cust_bill is now set
 722       # calculate the fee
 723       my $fee_item = $part_fee->lineitem($cust_bill) or next;
 724       # link this so that we can clear the marker on inserting the line item
 725       $fee_item->set('fee_origin', $fee_origin);
 726       push @fee_items, $fee_item;
 727
 728     }
 729
 730     # add fees to the invoice
 731     foreach my $fee_item (@fee_items) {
 732
 733       push @cust_bill_pkg, $fee_item;
 734       ${ $total_setup{$pass} } += $fee_item->setup;
 735       ${ $total_recur{$pass} } += $fee_item->recur;
 736
 737       my $part_fee = $fee_item->part_fee;
 738       my $fee_location = $self->ship_location; # I think?
 739
 740       my $error = $tax_engines{''}->add_sale($fee_item);
 741
 742       return $error if $error;
 743
 744     }
 745
 746     # XXX implementation of fees is supposed to make this go away...
 747     if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
 748            !$conf->exists('postal_invoice-recurring_only')
 749        )
 750     {
 751
 752       my $postal_pkg = $self->charge_postal_fee();
 753       if ( $postal_pkg && !ref( $postal_pkg ) ) {
 754
 755         $dbh->rollback if $oldAutoCommit && !$options{no_commit};
 756         return "can't charge postal invoice fee for customer ".
 757           $self->custnum. ": $postal_pkg";
 758
 759       } elsif ( $postal_pkg ) {
 760
 761         my $real_pkgpart = $postal_pkg->pkgpart;
 762         # we could implement this bit as FS::part_pkg::has_hidden, but we already
 763         # suffer from performance issues
 764         $options{has_hidden} = 0;
 765         my @part_pkg = $postal_pkg->part_pkg->self_and_bill_linked;
 766         $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
 767
 768         foreach my $part_pkg ( @part_pkg ) {
 769           my %postal_options = %options;
 770           delete $postal_options{cancel};
 771           my $error =
 772             $self->_make_lines( 'part_pkg'            => $part_pkg,
 773                                 'cust_pkg'            => $postal_pkg,
 774                                 'precommit_hooks'     => \@precommit_hooks,
 775                                 'line_items'          => \@cust_bill_pkg,
 776                                 'setup'               => $total_setup{$pass},
 777                                 'recur'               => $total_recur{$pass},
 778                                 'tax_engine'          => $tax_engines{$pass},
 779                                 'time'                => $time,
 780                                 'real_pkgpart'        => $real_pkgpart,
 781                                 'options'             => \%postal_options,
 782                               );
 783           if ($error) {
 784             $dbh->rollback if $oldAutoCommit && !$options{no_commit};
 785             return $error;
 786           }
 787         }
 788
 789         # it's silly to have a zero value postal_pkg, but....
 790         @cust_bill_pkg = _omit_zero_value_bundles(@cust_bill_pkg);
 791
 792       }
 793
 794     }
 795
 796     #add tax adjustments
 797     #XXX does this work with batch tax engines?
 798     warn "adding tax adjustments...\n" if $DEBUG > 2;
 799     foreach my $cust_tax_adjustment (
 800       qsearch('cust_tax_adjustment', { 'custnum'    => $self->custnum,
 801                                        'billpkgnum' => '',
 802                                      }
 803              )
 804     ) {
 805
 806       my $tax = sprintf('%.2f', $cust_tax_adjustment->amount );
 807
 808       my $itemdesc = $cust_tax_adjustment->taxname;
 809       $itemdesc = '' if $itemdesc eq 'Tax';
 810
 811       push @cust_bill_pkg, new FS::cust_bill_pkg {
 812         'pkgnum'      => 0,
 813         'setup'       => $tax,
 814         'recur'       => 0,
 815         'sdate'       => '',
 816         'edate'       => '',
 817         'itemdesc'    => $itemdesc,
 818         'itemcomment' => $cust_tax_adjustment->comment,
 819         'cust_tax_adjustment' => $cust_tax_adjustment,
 820         #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
 821       };
 822
 823     }
 824
 825     my $charged = sprintf('%.2f', ${ $total_setup{$pass} } + ${ $total_recur{$pass} } );
 826
 827     my $balance = $self->balance;
 828
 829     my $previous_bill = qsearchs({ 'table'     => 'cust_bill',
 830                                    'hashref'   => { custnum=>$self->custnum },
 831                                    'extra_sql' => 'ORDER BY _date DESC LIMIT 1',
 832                                 });
 833     my $previous_balance =
 834       $previous_bill
 835         ? ( $previous_bill->billing_balance + $previous_bill->charged )
 836         : 0;
 837
 838     $log->debug('creating the new invoice', %logopt);
 839     warn "creating the new invoice\n" if $DEBUG;
 840     #create the new invoice
 841     my $cust_bill = new FS::cust_bill ( {
 842       'custnum'             => $self->custnum,
 843       '_date'               => $invoice_time,
 844       'charged'             => $charged,
 845       'billing_balance'     => $balance,
 846       'previous_balance'    => $previous_balance,
 847       'invoice_terms'       => $options{'invoice_terms'},
 848       'cust_bill_pkg'       => \@cust_bill_pkg,
 849       'pending'             => 'Y', # clear this after doing taxes
 850     } );
 851
 852     if (!$options{no_commit}) {
 853       # probably we ought to insert it as pending, and then rollback
 854       # without ever un-pending it
 855       $error = $cust_bill->insert;
 856       if ( $error ) {
 857         $dbh->rollback if $oldAutoCommit && !$options{no_commit};
 858         return "can't create invoice for customer #". $self->custnum. ": $error";
 859       }
 860
 861     }
 862
 863     # calculate and append taxes
 864     if ( ! $tax_is_batch) {
 865       local $@;
 866       my $arrayref = eval { $tax_engines{$pass}->calculate_taxes($cust_bill) };
 867
 868       if ( $@ ) {
 869         $dbh->rollback if $oldAutoCommit && !$options{no_commit};
 870         return $@;
 871       }
 872
 873       # or should this be in TaxEngine?
 874       my $total_tax = 0;
 875       foreach my $taxline ( @$arrayref ) {
 876         $total_tax += $taxline->setup;
 877         $taxline->set('invnum' => $cust_bill->invnum); # just to be sure
 878         push @cust_bill_pkg, $taxline; # for return_bill
 879
 880         if (!$options{no_commit}) {
 881           my $error = $taxline->insert;
 882           if ( $error ) {
 883             $dbh->rollback if $oldAutoCommit;
 884             return $error;
 885           }
 886         }
 887
 888       }
 889
 890       # add tax to the invoice amount and finalize it
 891       ${ $total_setup{$pass} } = sprintf('%.2f', ${ $total_setup{$pass} } + $total_tax);
 892       $charged = sprintf('%.2f', $charged + $total_tax);
 893       $cust_bill->set('charged', $charged);
 894       $cust_bill->set('pending', '');
 895
 896       if (!$options{no_commit}) {
 897         my $error = $cust_bill->replace;
 898         if ( $error ) {
 899           $dbh->rollback if $oldAutoCommit;
 900           return $error;
 901         }
 902       }
 903
 904     } # if !$tax_is_batch
 905       # if it IS batch, then we'll do all this in process_tax_batch
 906
 907     push @{$options{return_bill}}, $cust_bill if $options{return_bill};
 908
 909   } #foreach my $pass ( keys %cust_bill_pkg )
 910
 911   foreach my $hook ( @precommit_hooks ) {
 912     eval {
 913       &{$hook}; #($self) ?
 914     } unless $options{no_commit};
 915     if ( $@ ) {
 916       $dbh->rollback if $oldAutoCommit && !$options{no_commit};
 917       return "$@ running precommit hook $hook\n";
 918     }
 919   }
 920
 921   $dbh->commit or die $dbh->errstr if $oldAutoCommit && !$options{no_commit};
 922
 923   ''; #no error
 924 }
 925
 926 #discard bundled packages of 0 value
 927 # XXX we should reconsider whether we even need this
 928 sub _omit_zero_value_bundles {
 929   my @in = @_;
 930
 931   my @out = ();
 932   my @bundle = ();
 933   my $discount_show_always = $conf->exists('discount-show-always');
 934   my $show_this = 0;
 935
 936   # Sort @in the same way we do during invoice rendering, so we can identify
 937   # bundles.  See FS::Template_Mixin::_items_nontax.
 938   @in = sort { $a->pkgnum <=> $b->pkgnum        or
 939                $a->sdate  <=> $b->sdate         or
 940                ($a->pkgpart_override ? 0 : -1)  or
 941                ($b->pkgpart_override ? 0 : 1)   or
 942                $b->hidden cmp $a->hidden        or
 943                $a->pkgpart_override <=> $b->pkgpart_override
 944              } @in;
 945
 946   # this is a pack-and-deliver pattern. every time there's a cust_bill_pkg
 947   # _without_ pkgpart_override, that's the start of the new bundle. if there's
 948   # an existing bundle, and it contains a nonzero amount (or a zero amount
 949   # that's displayable anyway), push all line items in the bundle.
 950   foreach my $cust_bill_pkg ( @in ) {
 951
 952     if (scalar(@bundle) and !$cust_bill_pkg->pkgpart_override) {
 953       # ship out this bundle and reset it
 954       if ( $show_this ) {
 955         push @out, @bundle;
 956       }
 957       @bundle = ();
 958       $show_this = 0;
 959     }
 960
 961     # add this item to the current bundle
 962     push @bundle, $cust_bill_pkg;
 963
 964     # determine if it makes the bundle displayable
 965     if (   $cust_bill_pkg->setup > 0
 966         or $cust_bill_pkg->recur > 0
 967         or $cust_bill_pkg->setup_show_zero
 968         or $cust_bill_pkg->recur_show_zero
 969         or ($discount_show_always
 970           and scalar(@{ $cust_bill_pkg->get('discounts')})
 971           )
 972     ) {
 973       $show_this++;
 974     }
 975   }
 976
 977   # last bundle
 978   if ( $show_this) {
 979     push @out, @bundle;
 980   }
 981
 982   warn "  _omit_zero_value_bundles: ". scalar(@in).
 983        '->'. scalar(@out). "\n" #. Dumper(@out). "\n"
 984     if $DEBUG > 2;
 985
 986   @out;
 987 }
 988
 989 sub _make_lines {
 990   my ($self, %params) = @_;
 991
 992   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
 993
 994   my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
 995   my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
 996   my $cust_location = $cust_pkg->tax_location;
 997   my $precommit_hooks = $params{precommit_hooks} or die "no precommit_hooks specified";
 998   my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
 999   my $total_setup = $params{setup} or die "no setup accumulator specified";
1000   my $total_recur = $params{recur} or die "no recur accumulator specified";
1001   my $time = $params{'time'} or die "no time specified";
1002   my (%options) = %{$params{options}};
1003
1004   my $tax_engine = $params{tax_engine};
1005
1006   if ( $part_pkg->freq ne '1' and ($options{'freq_override'} || 0) > 0 ) {
1007     # this should never happen
1008     die 'freq_override billing attempted on non-monthly package '.
1009       $cust_pkg->pkgnum;
1010   }
1011
1012   my $dbh = dbh;
1013   my $real_pkgpart = $params{real_pkgpart};
1014   my %hash = $cust_pkg->hash;
1015   my $old_cust_pkg = new FS::cust_pkg \%hash;
1016
1017   my @details = ();
1018   my $lineitems = 0;
1019
1020   $cust_pkg->pkgpart($part_pkg->pkgpart);
1021
1022   my $cmp_time = ( $conf->exists('next-bill-ignore-time')
1023                      ? day_end( $time )
1024                      : $time
1025                  );
1026
1027   ###
1028   # bill setup
1029   ###
1030
1031   my $setup = 0;
1032   my $unitsetup = 0;
1033   my @setup_discounts = ();
1034   my %setup_param = ( 'discounts'     => \@setup_discounts,
1035                       'real_pkgpart'  => $params{real_pkgpart}
1036                     );
1037   my $setup_billed_currency = '';
1038   my $setup_billed_amount = 0;
1039   # Conditions for setting setup date and charging the setup fee:
1040   # - this is not a recurring-only billing run
1041   # - and the package is not currently being canceled
1042   # - and, unless we're specifically told otherwise via 'resetup':
1043   #   - it doesn't already HAVE a setup date
1044   #   - or a start date in the future
1045   #   - and it's not suspended
1046   # - and it doesn't have an expire date in the past
1047   #
1048   # The "disable_setup_suspended" option is now obsolete; we never set the
1049   # setup date on a suspended package.
1050   if (     ! $options{recurring_only}
1051        and ! $options{cancel}
1052        and ( $options{'resetup'}
1053              || ( ! $cust_pkg->setup
1054                   && ( ! $cust_pkg->start_date
1055                        || $cust_pkg->start_date <= $cmp_time
1056                      )
1057                   && ( ! $cust_pkg->getfield('susp') )
1058                 )
1059            )
1060        and ( ! $cust_pkg->expire
1061              || $cust_pkg->expire > $cmp_time )
1062      )
1063   {
1064
1065     warn "    bill setup\n" if $DEBUG > 1;
1066
1067     unless ( $cust_pkg->waive_setup ) {
1068         $lineitems++;
1069
1070         $setup = eval { $cust_pkg->calc_setup( $time, \@details, \%setup_param ) };
1071         return "$@ running calc_setup for $cust_pkg\n"
1072           if $@;
1073
1074         # Only increment unitsetup here if there IS a setup fee.
1075         # prorate_defer_bill may cause calc_setup on a setup-stage package
1076         # to return zero, and the setup fee to be charged later. (This happens
1077         # when it's first billed on the prorate cutoff day. RT#31276.)
1078         if ( $setup ) {
1079           $unitsetup = $cust_pkg->base_setup()
1080                          || $setup; #XXX uuh
1081         }
1082
1083         if ( $setup_param{'billed_currency'} ) {
1084           $setup_billed_currency = delete $setup_param{'billed_currency'};
1085           $setup_billed_amount   = delete $setup_param{'billed_amount'};
1086         }
1087     }
1088
1089     $lineitems++
1090       if $cust_pkg->waive_setup
1091       && $part_pkg->can('prorate_setup')
1092       && $part_pkg->prorate_setup($cust_pkg, $time);
1093
1094     if ( $cust_pkg->get('setup') ) {
1095       # don't change it
1096     } elsif ( $cust_pkg->get('start_date') ) {
1097       # this allows start_date to be used to set the first bill date
1098       $cust_pkg->set('setup', $cust_pkg->get('start_date'));
1099     } else {
1100       # if unspecified, start it right now
1101       $cust_pkg->set('setup', $time);
1102     }
1103
1104     $cust_pkg->setfield('start_date', '')
1105       if $cust_pkg->start_date;
1106
1107   }
1108
1109   ###
1110   # bill recurring fee
1111   ###
1112
1113   my $recur = 0;
1114   my $unitrecur = 0;
1115   my @recur_discounts = ();
1116   my $recur_billed_currency = '';
1117   my $recur_billed_amount = 0;
1118   my $sdate;
1119
1120   my $override_quantity;
1121
1122   # Conditions for billing the recurring fee:
1123   # - the package doesn't have a future start date
1124   # - and it's not suspended
1125   #   - unless suspend_bill is enabled on the package or package def
1126   #     - but still not, if the package is on hold
1127   #   - or it's suspended for a delayed cancellation
1128   # - and its next bill date is in the past
1129   #   - or it doesn't have a next bill date yet
1130   #   - or it's a one-time charge
1131   #   - or it's a CDR plan with the "bill_every_call" option
1132   #   - or it's being canceled
1133   # - and it doesn't have an expire date in the past (this can happen with
1134   #   advance billing)
1135   #   - again, unless it's being canceled
1136   if (     ! $cust_pkg->start_date
1137        and
1138            ( ! $cust_pkg->susp
1139                || ( $cust_pkg->susp != $cust_pkg->order_date
1140                       && (    $cust_pkg->option('suspend_bill',1)
1141                            || ( $part_pkg->option('suspend_bill', 1)
1142                                  && ! $cust_pkg->option('no_suspend_bill',1)
1143                               )
1144                          )
1145                   )
1146                || $cust_pkg->is_status_delay_cancel
1147            )
1148        and
1149             ( $part_pkg->freq ne '0' && ( $cust_pkg->bill || 0 ) <= $cmp_time )
1150          || ( $part_pkg->plan eq 'voip_cdr'
1151                && $part_pkg->option('bill_every_call')
1152             )
1153          || $options{cancel}
1154
1155        and
1156           ( ! $cust_pkg->expire
1157             || $cust_pkg->expire > $cmp_time
1158             || $options{cancel}
1159           )
1160   ) {
1161
1162     # XXX should this be a package event?  probably.  events are called
1163     # at collection time at the moment, though...
1164     $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
1165       if $part_pkg->can('reset_usage') && !$options{'no_usage_reset'};
1166       #don't want to reset usage just cause we want a line item??
1167       #&& $part_pkg->pkgpart == $real_pkgpart;
1168
1169     warn "    bill recur\n" if $DEBUG > 1;
1170     $lineitems++;
1171
1172     # XXX shared with $recur_prog
1173     $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
1174              || $cust_pkg->setup
1175              || $time;
1176
1177     #over two params!  lets at least switch to a hashref for the rest...
1178     my $increment_next_bill = ( $part_pkg->freq ne '0'
1179                                 && ( $cust_pkg->getfield('bill') || 0 ) <= $cmp_time
1180                                 && !$options{cancel}
1181                               );
1182     my %param = ( %setup_param,
1183                   'precommit_hooks'     => $precommit_hooks,
1184                   'increment_next_bill' => $increment_next_bill,
1185                   'discounts'           => \@recur_discounts,
1186                   'real_pkgpart'        => $real_pkgpart,
1187                   'freq_override'       => $options{freq_override} || '',
1188                   'setup_fee'           => 0,
1189                 );
1190
1191     my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
1192
1193     # There may be some part_pkg for which this is wrong.  Only those
1194     # which can_discount are supported.
1195     # (the UI should prevent adding discounts to these at the moment)
1196
1197     warn "calling $method on cust_pkg ". $cust_pkg->pkgnum.
1198          " for pkgpart ". $cust_pkg->pkgpart.
1199          " with params ". join(' / ', map "$_=>$param{$_}", keys %param). "\n"
1200       if $DEBUG > 2;
1201
1202     $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
1203     return "$@ running $method for $cust_pkg\n"
1204       if ( $@ );
1205
1206     if ($recur eq 'NOTHING') {
1207       # then calc_cancel (or calc_recur but that's not used) has declined to
1208       # generate a recurring lineitem at all. treat this as zero, but also
1209       # try not to generate a lineitem.
1210       $recur = 0;
1211       $lineitems--;
1212     }
1213
1214     #base_cancel???
1215     $unitrecur = $cust_pkg->base_recur( \$sdate ) || $recur; #XXX uuh, better
1216
1217     if ( $param{'billed_currency'} ) {
1218       $recur_billed_currency = delete $param{'billed_currency'};
1219       $recur_billed_amount   = delete $param{'billed_amount'};
1220     }
1221
1222     if ( $param{'override_quantity'} ) {
1223       $override_quantity = $param{'override_quantity'};
1224       $unitrecur = $recur / $override_quantity;
1225     }
1226
1227     if ( $increment_next_bill ) {
1228
1229       my $next_bill;
1230
1231       if ( my $main_pkg = $cust_pkg->main_pkg ) {
1232         # supplemental package
1233         # to keep in sync with the main package, simulate billing at
1234         # its frequency
1235         my $main_pkg_freq = $main_pkg->part_pkg->freq;
1236         my $supp_pkg_freq = $part_pkg->freq;
1237         if ( $supp_pkg_freq == 0 or $main_pkg_freq == 0 ) {
1238           # the UI should prevent setting up packages like this, but just
1239           # in case
1240           return "unable to calculate supplemental package period ratio";
1241         }
1242         my $ratio = $supp_pkg_freq / $main_pkg_freq;
1243         if ( $ratio == int($ratio) ) {
1244           # simple case: main package is X months, supp package is X*A months,
1245           # advance supp package to where the main package will be in A cycles.
1246           $next_bill = $sdate;
1247           for (1..$ratio) {
1248             $next_bill = $part_pkg->add_freq( $next_bill, $main_pkg_freq );
1249           }
1250         } else {
1251           # harder case: main package is X months, supp package is Y months.
1252           # advance supp package by Y months. then if they're within half a
1253           # month of each other, resync them. this may result in the period
1254           # not being exactly Y months.
1255           $next_bill = $part_pkg->add_freq( $sdate, $supp_pkg_freq );
1256           my $main_next_bill = $main_pkg->bill;
1257           if ( $main_pkg->bill <= $time ) {
1258             # then the main package has not yet been billed on this cycle;
1259             # predict what its bill date will be.
1260             $main_next_bill =
1261               $part_pkg->add_freq( $main_next_bill, $main_pkg_freq );
1262           }
1263           if ( abs($main_next_bill - $next_bill) < 86400*15 ) {
1264             $next_bill = $main_next_bill;
1265           }
1266         }
1267
1268       } else {
1269       # the normal case, not a supplemental package
1270       $next_bill = $part_pkg->add_freq($sdate, $options{freq_override} || 0);
1271       return "unparsable frequency: ".
1272         ($options{freq_override} || $part_pkg->freq)
1273         if $next_bill == -1;
1274       }
1275
1276       #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
1277       # only for figuring next bill date, nothing else, so, reset $sdate again
1278       # here
1279       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1280       #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
1281       $cust_pkg->last_bill($sdate);
1282
1283       $cust_pkg->setfield('bill', $next_bill );
1284
1285     }
1286
1287     if ( $param{'setup_fee'} ) {
1288       # Add an additional setup fee at the billing stage.
1289       # Used for prorate_defer_bill.
1290       $setup += $param{'setup_fee'};
1291       $unitsetup = $cust_pkg->base_setup();
1292       $lineitems++;
1293     }
1294
1295     if ( defined $param{'discount_left_setup'} ) {
1296         foreach my $discount_setup ( values %{$param{'discount_left_setup'}} ) {
1297             $setup -= $discount_setup;
1298         }
1299     }
1300
1301   } # end of recurring fee
1302
1303   warn "\$setup is undefined" unless defined($setup);
1304   warn "\$recur is undefined" unless defined($recur);
1305   warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1306
1307   ###
1308   # If there's line items, create em cust_bill_pkg records
1309   # If $cust_pkg has been modified, update it (if we're a real pkgpart)
1310   ###
1311
1312   if ( $lineitems ) {
1313
1314     if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
1315       # hmm.. and if just the options are modified in some weird price plan?
1316
1317       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n"
1318         if $DEBUG >1;
1319
1320       my $error = $cust_pkg->replace( $old_cust_pkg,
1321                                       'depend_jobnum'=>$options{depend_jobnum},
1322                                       'options' => { $cust_pkg->options },
1323                                     )
1324         unless $options{no_commit};
1325       return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
1326         if $error; #just in case
1327     }
1328
1329     $setup = sprintf( "%.2f", $setup );
1330     $recur = sprintf( "%.2f", $recur );
1331     if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1332       return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1333     }
1334     if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1335       return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1336     }
1337
1338     my $discount_show_always = $conf->exists('discount-show-always')
1339                                && (    ($setup == 0 && scalar(@setup_discounts))
1340                                     || ($recur == 0 && scalar(@recur_discounts))
1341                                   );
1342
1343     if (    $setup != 0
1344          || $recur != 0
1345          || (!$part_pkg->hidden && $options{has_hidden}) #include some $0 lines
1346          || $discount_show_always
1347          || ($setup == 0 && $cust_pkg->_X_show_zero('setup'))
1348          || ($recur == 0 && $cust_pkg->_X_show_zero('recur'))
1349        )
1350     {
1351
1352       warn "    charges (setup=$setup, recur=$recur); adding line items\n"
1353         if $DEBUG > 1;
1354
1355       my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
1356       if ( $DEBUG > 1 ) {
1357         warn "      adding customer package invoice detail: $_\n"
1358           foreach @cust_pkg_detail;
1359       }
1360       push @details, @cust_pkg_detail;
1361
1362       my $cust_bill_pkg = new FS::cust_bill_pkg {
1363         'pkgnum'                => $cust_pkg->pkgnum,
1364         'setup'                 => $setup,
1365         'unitsetup'             => sprintf('%.2f', $unitsetup),
1366         'setup_billed_currency' => $setup_billed_currency,
1367         'setup_billed_amount'   => $setup_billed_amount,
1368         'recur'                 => $recur,
1369         'unitrecur'             => sprintf('%.2f', $unitrecur),
1370         'recur_billed_currency' => $recur_billed_currency,
1371         'recur_billed_amount'   => $recur_billed_amount,
1372         'quantity'              => $override_quantity || $cust_pkg->quantity,
1373         'details'               => \@details,
1374         'discounts'             => [ @setup_discounts, @recur_discounts ],
1375         'hidden'                => $part_pkg->hidden,
1376         'freq'                  => $part_pkg->freq,
1377       };
1378
1379       if ( $part_pkg->option('prorate_defer_bill',1)
1380            and !$hash{last_bill} ) {
1381         # both preceding and upcoming, technically
1382         $cust_bill_pkg->sdate( $cust_pkg->setup );
1383         $cust_bill_pkg->edate( $cust_pkg->bill );
1384       } elsif ( $part_pkg->recur_temporality eq 'preceding' ) {
1385         $cust_bill_pkg->sdate( $hash{last_bill} );
1386         $cust_bill_pkg->edate( $sdate - 86399   ); #60s*60m*24h-1
1387         $cust_bill_pkg->edate( $time ) if $options{cancel};
1388       } else { #if ( $part_pkg->recur_temporality eq 'upcoming' )
1389         $cust_bill_pkg->sdate( $sdate );
1390         $cust_bill_pkg->edate( $cust_pkg->bill );
1391         #$cust_bill_pkg->edate( $time ) if $options{cancel};
1392       }
1393
1394       $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
1395         unless $part_pkg->pkgpart == $real_pkgpart;
1396
1397       $$total_setup += $setup;
1398       $$total_recur += $recur;
1399
1400       ###
1401       # handle taxes
1402       ###
1403
1404       my $error = $tax_engine->add_sale($cust_bill_pkg);
1405       return $error if $error;
1406
1407       $cust_bill_pkg->set_display(
1408         part_pkg     => $part_pkg,
1409         real_pkgpart => $real_pkgpart,
1410       );
1411
1412       push @$cust_bill_pkgs, $cust_bill_pkg;
1413
1414     } #if $setup != 0 || $recur != 0
1415
1416   } #if $line_items
1417
1418   '';
1419
1420 }
1421
1422 =item _transfer_balance TO_PKG [ FROM_PKGNUM ]
1423
1424 Takes one argument, a cust_pkg object that is being billed.  This will
1425 be called only if the package was created by a package change, and has
1426 not been billed since the package change, and package balance tracking
1427 is enabled.  The second argument can be an alternate package number to
1428 transfer the balance from; this should not be used externally.
1429
1430 Transfers the balance from the previous package (now canceled) to
1431 this package, by crediting one package and creating an invoice item for
1432 the other.  Inserts the credit and returns the invoice item (so that it
1433 can be added to an invoice that's being built).
1434
1435 If the previous package was never billed, and was also created by a package
1436 change, then this will also transfer the balance from I<its> previous
1437 package, and so on, until reaching a package that either has been billed
1438 or was not created by a package change.
1439
1440 =cut
1441
1442 my $balance_transfer_reason;
1443
1444 sub _transfer_balance {
1445   my $self = shift;
1446   my $cust_pkg = shift;
1447   my $from_pkgnum = shift || $cust_pkg->change_pkgnum;
1448   my $from_pkg = FS::cust_pkg->by_key($from_pkgnum);
1449
1450   my @transfers;
1451
1452   # if $from_pkg is not the first package in the chain, and it was never
1453   # billed, walk back
1454   if ( $from_pkg->change_pkgnum and scalar($from_pkg->cust_bill_pkg) == 0 ) {
1455     @transfers = $self->_transfer_balance($cust_pkg, $from_pkg->change_pkgnum);
1456   }
1457
1458   my $prev_balance = $self->balance_pkgnum($from_pkgnum);
1459   if ( $prev_balance != 0 ) {
1460     $balance_transfer_reason ||= FS::reason->new_or_existing(
1461       'reason' => 'Package balance transfer',
1462       'type'   => 'Internal adjustment',
1463       'class'  => 'R'
1464     );
1465
1466     my $credit = FS::cust_credit->new({
1467         'custnum'   => $self->custnum,
1468         'amount'    => abs($prev_balance),
1469         'reasonnum' => $balance_transfer_reason->reasonnum,
1470         '_date'     => $cust_pkg->change_date,
1471     });
1472
1473     my $cust_bill_pkg = FS::cust_bill_pkg->new({
1474         'setup'     => 0,
1475         'recur'     => abs($prev_balance),
1476         #'sdate'     => $from_pkg->last_bill, # not sure about this
1477         #'edate'     => $cust_pkg->change_date,
1478         'itemdesc'  => $self->mt('Previous Balance, [_1]',
1479                                  $from_pkg->part_pkg->pkg),
1480     });
1481
1482     if ( $prev_balance > 0 ) {
1483       # credit the old package, charge the new one
1484       $credit->set('pkgnum', $from_pkgnum);
1485       $cust_bill_pkg->set('pkgnum', $cust_pkg->pkgnum);
1486     } else {
1487       # the reverse
1488       $credit->set('pkgnum', $cust_pkg->pkgnum);
1489       $cust_bill_pkg->set('pkgnum', $from_pkgnum);
1490     }
1491     my $error = $credit->insert;
1492     die "error transferring package balance from #".$from_pkgnum.
1493         " to #".$cust_pkg->pkgnum.": $error\n" if $error;
1494
1495     push @transfers, $cust_bill_pkg;
1496   } # $prev_balance != 0
1497
1498   return @transfers;
1499 }
1500
1501 #### vestigial code ####
1502
1503 =item handle_taxes TAXLISTHASH CUST_BILL_PKG [ OPTIONS ]
1504
1505 This is _handle_taxes.  It's called once for each cust_bill_pkg generated
1506 from _make_lines.
1507
1508 TAXLISTHASH is a hashref shared across the entire invoice.  It looks like
1509 this:
1510 {
1511   'cust_main_county 1001' => [ [FS::cust_main_county], ... ],
1512   'cust_main_county 1002' => [ [FS::cust_main_county], ... ],
1513 }
1514
1515 'cust_main_county' can also be 'tax_rate'.  The first object in the array
1516 is always the cust_main_county or tax_rate identified by the key.
1517
1518 That "..." is a list of FS::cust_bill_pkg objects that will be fed to
1519 the 'taxline' method to calculate the amount of the tax.  This doesn't
1520 happen until calculate_taxes, though.
1521
1522 OPTIONS may include:
1523 - part_item: a part_pkg or part_fee object to be used as the package/fee
1524   definition.
1525 - location: a cust_location to be used as the billing location.
1526 - cancel: true if this package is being billed on cancellation.  This
1527   allows tax to be calculated on usage charges only.
1528
1529 If not supplied, part_item will be inferred from the pkgnum or feepart of the
1530 cust_bill_pkg, and location from the pkgnum (or, for fees, the invnum and
1531 the customer's default service location).
1532
1533 This method will also calculate exemptions for any taxes that apply to the
1534 line item (using the C<set_exemptions> method of L<FS::cust_bill_pkg>) and
1535 attach them.  This is the only place C<set_exemptions> is called in normal
1536 invoice processing.
1537
1538 =cut
1539
1540 sub _handle_taxes {
1541   my $self = shift;
1542   my $taxlisthash = shift;
1543   my $cust_bill_pkg = shift;
1544   my %options = @_;
1545
1546   # at this point I realize that we have enough information to infer all this
1547   # stuff, instead of passing around giant honking argument lists
1548   my $location = $options{location} || $cust_bill_pkg->tax_location;
1549   my $part_item = $options{part_item} || $cust_bill_pkg->part_X;
1550
1551   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1552
1553   return if ( $self->payby eq 'COMP' ); #dubious
1554
1555   if ( $conf->config('enable_taxproducts')
1556        && ( scalar($part_item->part_pkg_taxoverride)
1557             || $part_item->has_taxproduct
1558           )
1559      )
1560     {
1561
1562     # EXTERNAL TAX RATES (via tax_rate)
1563     my %cust_bill_pkg = ();
1564     my %taxes = ();
1565
1566     my @classes;
1567     my $usage = $cust_bill_pkg->usage || 0;
1568     push @classes, $cust_bill_pkg->usage_classes if $usage;
1569     push @classes, 'setup' if $cust_bill_pkg->setup and !$options{cancel};
1570     push @classes, 'recur' if ($cust_bill_pkg->recur - $usage)
1571         and !$options{cancel};
1572     # that's better--probably don't even need $options{cancel} now
1573     # but leave it for now, just to be safe
1574     #
1575     # About $options{cancel}: This protects against charging per-line or
1576     # per-customer or other flat-rate surcharges on a package that's being
1577     # billed on cancellation (which is an out-of-cycle bill and should only
1578     # have usage charges).  See RT#29443.
1579
1580     # customer exemption is now handled in the 'taxline' method
1581     #my $exempt = $conf->exists('cust_class-tax_exempt')
1582     #               ? ( $self->cust_class ? $self->cust_class->tax : '' )
1583     #               : $self->tax;
1584     # standardize this just to be sure
1585     #$exempt = ($exempt eq 'Y') ? 'Y' : '';
1586     #
1587     #if ( !$exempt ) {
1588
1589     unless (exists $taxes{''}) {
1590       # unsure what purpose this serves, but last time I deleted something
1591       # from here just because I didn't see the point, it actually did
1592       # something important.
1593       my $err_or_ref = $self->_gather_taxes($part_item, '', $location);
1594       return $err_or_ref unless ref($err_or_ref);
1595       $taxes{''} = $err_or_ref;
1596     }
1597
1598     # NO DISINTEGRATIONS.
1599     # my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
1600     #
1601     # do not call taxline() with any argument except the entire set of
1602     # cust_bill_pkgs on an invoice that are eligible for the tax.
1603
1604     # only calculate exemptions once for each tax rate, even if it's used
1605     # for multiple classes
1606     my %tax_seen = ();
1607
1608     foreach my $class (@classes) {
1609       my $err_or_ref = $self->_gather_taxes($part_item, $class, $location);
1610       return $err_or_ref unless ref($err_or_ref);
1611       my @taxes = @$err_or_ref;
1612
1613       next if !@taxes;
1614
1615       foreach my $tax ( @taxes ) {
1616
1617         my $tax_id = ref( $tax ). ' '. $tax->taxnum;
1618         # $taxlisthash: keys are tax identifiers ('FS::tax_rate 123456').
1619         # Values are arrayrefs, first the tax object (cust_main_county
1620         # or tax_rate), then the cust_bill_pkg object that the
1621         # tax applies to, then the tax class (setup, recur, usage classnum).
1622         $taxlisthash->{ $tax_id } ||= [ $tax ];
1623         push @{ $taxlisthash->{ $tax_id  } }, $cust_bill_pkg, $class;
1624
1625         # determine any exemptions that apply
1626         if (!$tax_seen{$tax_id}) {
1627           $cust_bill_pkg->set_exemptions( $tax, custnum => $self->custnum );
1628           $tax_seen{$tax_id} = 1;
1629         }
1630
1631         # tax on tax will be done later, when we actually create the tax
1632         # line items
1633
1634       }
1635     }
1636
1637   } else {
1638
1639     # INTERNAL TAX RATES (cust_main_county)
1640
1641     # We fetch taxes even if the customer is completely exempt,
1642     # because we need to record that fact.
1643
1644     my @loc_keys = qw( district city county state country );
1645     my %taxhash = map { $_ => $location->$_ } @loc_keys;
1646
1647     $taxhash{'taxclass'} = $part_item->taxclass;
1648
1649     warn "taxhash:\n". Dumper(\%taxhash) if $DEBUG > 2;
1650
1651     my @taxes = (); # entries are cust_main_county objects
1652     my %taxhash_elim = %taxhash;
1653     my @elim = qw( district city county state );
1654
1655     # WA state district city names are not stable in the WA tax tables
1656     # Allow districts to match with just a district id
1657     if ( $taxhash{district} ) {
1658       @taxes = qsearch( cust_main_county => {
1659         district => $taxhash{district},
1660         taxclass => $taxhash{taxclass},
1661       });
1662       if ( !scalar(@taxes) && $taxhash{taxclass} ) {
1663         qsearch( cust_main_county => {
1664           district => $taxhash{district},
1665           taxclass => '',
1666         });
1667       }
1668     }
1669
1670     do {
1671
1672       #first try a match with taxclass
1673       if ( !scalar(@taxes) ) {
1674         @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
1675       }
1676
1677       if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) {
1678         #then try a match without taxclass
1679         my %no_taxclass = %taxhash_elim;
1680         $no_taxclass{ 'taxclass' } = '';
1681         @taxes = qsearch( 'cust_main_county', \%no_taxclass );
1682       }
1683
1684       $taxhash_elim{ shift(@elim) } = '';
1685
1686     } while ( !scalar(@taxes) && scalar(@elim) );
1687
1688     foreach (@taxes) {
1689       my $tax_id = 'cust_main_county '.$_->taxnum;
1690       $taxlisthash->{$tax_id} ||= [ $_ ];
1691       $cust_bill_pkg->set_exemptions($_, custnum => $self->custnum);
1692       push @{ $taxlisthash->{$tax_id} }, $cust_bill_pkg;
1693     }
1694
1695   }
1696   '';
1697 }
1698
1699 =item _gather_taxes PART_ITEM CLASS CUST_LOCATION
1700
1701 Internal method used with vendor-provided tax tables.  PART_ITEM is a part_pkg
1702 or part_fee (which will define the tax eligibility of the product), CLASS is
1703 'setup', 'recur', null, or a C<usage_class> number, and CUST_LOCATION is the
1704 location where the service was provided (or billed, depending on
1705 configuration).  Returns an arrayref of L<FS::tax_rate> objects that
1706 can apply to this line item.
1707
1708 =cut
1709
1710 sub _gather_taxes {
1711   my $self = shift;
1712   my $part_item = shift;
1713   my $class = shift;
1714   my $location = shift;
1715
1716   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1717
1718   my $geocode = $location->geocode('cch');
1719
1720   [ $part_item->tax_rates('cch', $geocode, $class) ]
1721
1722 }
1723
1724 #### end vestigial code ####
1725
1726 =item collect [ HASHREF | OPTION => VALUE ... ]
1727
1728 (Attempt to) collect money for this customer's outstanding invoices (see
1729 L<FS::cust_bill>).  Usually used after the bill method.
1730
1731 Actions are now triggered by billing events; see L<FS::part_event> and the
1732 billing events web interface.  Old-style invoice events (see
1733 L<FS::part_bill_event>) have been deprecated.
1734
1735 If there is an error, returns the error, otherwise returns false.
1736
1737 Options are passed as name-value pairs.
1738
1739 Currently available options are:
1740
1741 =over 4
1742
1743 =item invoice_time
1744
1745 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.
1746
1747 =item retry
1748
1749 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1750
1751 =item check_freq
1752
1753 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1754
1755 =item quiet
1756
1757 set true to surpress email card/ACH decline notices.
1758
1759 =item debug
1760
1761 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)
1762
1763 =back
1764
1765 # =item payby
1766 #
1767 # allows for one time override of normal customer billing method
1768
1769 =cut
1770
1771 sub collect {
1772   my( $self, %options ) = @_;
1773
1774   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1775
1776   my $invoice_time = $options{'invoice_time'} || time;
1777
1778   #put below somehow?
1779   local $SIG{HUP} = 'IGNORE';
1780   local $SIG{INT} = 'IGNORE';
1781   local $SIG{QUIT} = 'IGNORE';
1782   local $SIG{TERM} = 'IGNORE';
1783   local $SIG{TSTP} = 'IGNORE';
1784   local $SIG{PIPE} = 'IGNORE';
1785
1786   my $oldAutoCommit = $FS::UID::AutoCommit;
1787   local $FS::UID::AutoCommit = 0;
1788   my $dbh = dbh;
1789
1790   $self->select_for_update; #mutex
1791
1792   if ( $DEBUG ) {
1793     my $balance = $self->balance;
1794     warn "$me collect customer ". $self->custnum. ": balance $balance\n"
1795   }
1796
1797   if ( exists($options{'retry_card'}) ) {
1798     carp 'retry_card option passed to collect is deprecated; use retry';
1799     $options{'retry'} ||= $options{'retry_card'};
1800   }
1801   if ( exists($options{'retry'}) && $options{'retry'} ) {
1802     my $error = $self->retry_realtime;
1803     if ( $error ) {
1804       $dbh->rollback if $oldAutoCommit;
1805       return $error;
1806     }
1807   }
1808
1809   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1810
1811   #never want to roll back an event just because it returned an error
1812   # unless $FS::UID::ForceObeyAutoCommit is set
1813   local $FS::UID::AutoCommit = 1
1814     unless !$oldAutoCommit
1815         && $FS::UID::ForceObeyAutoCommit;
1816
1817   $self->do_cust_event(
1818     'debug'      => ( $options{'debug'} || 0 ),
1819     'time'       => $invoice_time,
1820     'check_freq' => $options{'check_freq'},
1821     'stage'      => 'collect',
1822   );
1823
1824 }
1825
1826 =item retry_realtime
1827
1828 Schedules realtime / batch  credit card / electronic check / LEC billing
1829 events for for retry.  Useful if card information has changed or manual
1830 retry is desired.  The 'collect' method must be called to actually retry
1831 the transaction.
1832
1833 Implementation details: For either this customer, or for each of this
1834 customer's open invoices, changes the status of the first "done" (with
1835 statustext error) realtime processing event to "failed".
1836
1837 =cut
1838
1839 sub retry_realtime {
1840   my $self = shift;
1841
1842   local $SIG{HUP} = 'IGNORE';
1843   local $SIG{INT} = 'IGNORE';
1844   local $SIG{QUIT} = 'IGNORE';
1845   local $SIG{TERM} = 'IGNORE';
1846   local $SIG{TSTP} = 'IGNORE';
1847   local $SIG{PIPE} = 'IGNORE';
1848
1849   my $oldAutoCommit = $FS::UID::AutoCommit;
1850   local $FS::UID::AutoCommit = 0;
1851   my $dbh = dbh;
1852
1853   #a little false laziness w/due_cust_event (not too bad, really)
1854
1855   # I guess this is always as of now?
1856   my $join = FS::part_event_condition->join_conditions_sql('', 'time' => time);
1857   my $order = FS::part_event_condition->order_conditions_sql;
1858   my $mine =
1859   '( '
1860    . join ( ' OR ' , map {
1861     my $cust_join = FS::part_event->eventtables_cust_join->{$_} || '';
1862     my $custnum = FS::part_event->eventtables_custnum->{$_};
1863     "( part_event.eventtable = " . dbh->quote($_)
1864     . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key
1865     . " from $_ $cust_join"
1866     . " where $custnum = " . dbh->quote( $self->custnum ) . "))" ;
1867    } FS::part_event->eventtables)
1868    . ') ';
1869
1870   #here is the agent virtualization
1871   my $agent_virt = " (    part_event.agentnum IS NULL
1872                        OR part_event.agentnum = ". $self->agentnum. ' )';
1873
1874   #XXX this shouldn't be hardcoded, actions should declare it...
1875   my @realtime_events = qw(
1876     cust_bill_realtime_card
1877     cust_bill_realtime_check
1878     cust_bill_realtime_lec
1879     cust_bill_batch
1880   );
1881
1882   my $is_realtime_event =
1883     ' part_event.action IN ( '.
1884         join(',', map "'$_'", @realtime_events ).
1885     ' ) ';
1886
1887   my $batch_or_statustext =
1888     "( part_event.action = 'cust_bill_batch'
1889        OR ( statustext IS NOT NULL AND statustext != '' )
1890      )";
1891
1892
1893   my @cust_event = qsearch({
1894     'table'     => 'cust_event',
1895     'select'    => 'cust_event.*',
1896     'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
1897     'hashref'   => { 'status' => 'done' },
1898     'extra_sql' => " AND $batch_or_statustext ".
1899                    " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
1900   });
1901
1902   my %seen_invnum = ();
1903   foreach my $cust_event (@cust_event) {
1904
1905     #max one for the customer, one for each open invoice
1906     my $cust_X = $cust_event->cust_X;
1907     next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
1908                           ? $cust_X->invnum
1909                           : 0
1910                         }++
1911          or $cust_event->part_event->eventtable eq 'cust_bill'
1912             && ! $cust_X->owed;
1913
1914     my $error = $cust_event->retry;
1915     if ( $error ) {
1916       $dbh->rollback if $oldAutoCommit;
1917       return "error scheduling event for retry: $error";
1918     }
1919
1920   }
1921
1922   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1923   '';
1924
1925 }
1926
1927 =item do_cust_event [ HASHREF | OPTION => VALUE ... ]
1928
1929 Runs billing events; see L<FS::part_event> and the billing events web
1930 interface.
1931
1932 If there is an error, returns the error, otherwise returns false.
1933
1934 Options are passed as name-value pairs.
1935
1936 Currently available options are:
1937
1938 =over 4
1939
1940 =item time
1941
1942 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.
1943
1944 =item check_freq
1945
1946 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1947
1948 =item stage
1949
1950 "collect" (the default) or "pre-bill"
1951
1952 =item quiet
1953
1954 set true to surpress email card/ACH decline notices.
1955
1956 =item debug
1957
1958 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)
1959
1960 =back
1961 =cut
1962
1963 # =item payby
1964 #
1965 # allows for one time override of normal customer billing method
1966
1967 # =item retry
1968 #
1969 # Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1970
1971 sub do_cust_event {
1972   my( $self, %options ) = @_;
1973
1974   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1975
1976   my $time = $options{'time'} || time;
1977
1978   #put below somehow?
1979   local $SIG{HUP} = 'IGNORE';
1980   local $SIG{INT} = 'IGNORE';
1981   local $SIG{QUIT} = 'IGNORE';
1982   local $SIG{TERM} = 'IGNORE';
1983   local $SIG{TSTP} = 'IGNORE';
1984   local $SIG{PIPE} = 'IGNORE';
1985
1986   my $oldAutoCommit = $FS::UID::AutoCommit;
1987   local $FS::UID::AutoCommit = 0;
1988   my $dbh = dbh;
1989
1990   $self->select_for_update; #mutex
1991
1992   if ( $DEBUG ) {
1993     my $balance = $self->balance;
1994     warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
1995   }
1996
1997 #  if ( exists($options{'retry_card'}) ) {
1998 #    carp 'retry_card option passed to collect is deprecated; use retry';
1999 #    $options{'retry'} ||= $options{'retry_card'};
2000 #  }
2001 #  if ( exists($options{'retry'}) && $options{'retry'} ) {
2002 #    my $error = $self->retry_realtime;
2003 #    if ( $error ) {
2004 #      $dbh->rollback if $oldAutoCommit;
2005 #      return $error;
2006 #    }
2007 #  }
2008
2009   # false laziness w/pay_batch::import_results
2010
2011   my $due_cust_event = $self->due_cust_event(
2012     'debug'      => ( $options{'debug'} || 0 ),
2013     'time'       => $time,
2014     'check_freq' => $options{'check_freq'},
2015     'stage'      => ( $options{'stage'} || 'collect' ),
2016   );
2017   unless( ref($due_cust_event) ) {
2018     $dbh->rollback if $oldAutoCommit;
2019     return $due_cust_event;
2020   }
2021
2022   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2023
2024   #never want to roll back an event just because it or a different one
2025   # returned an error
2026   # unless $FS::UID::ForceObeyAutoCommit is set
2027   local $FS::UID::AutoCommit = 1
2028     unless !$oldAutoCommit
2029         && $FS::UID::ForceObeyAutoCommit;
2030
2031   foreach my $cust_event ( @$due_cust_event ) {
2032
2033     #XXX lock event
2034
2035     #re-eval event conditions (a previous event could have changed things)
2036     unless ( $cust_event->test_conditions ) {
2037       #don't leave stray "new/locked" records around
2038       my $error = $cust_event->delete;
2039       return $error if $error;
2040       next;
2041     }
2042
2043     {
2044       local $FS::cust_main::Billing_Realtime::realtime_bop_decline_quiet = 1
2045         if $options{'quiet'};
2046       warn "  running cust_event ". $cust_event->eventnum. "\n"
2047         if $DEBUG > 1;
2048
2049       #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
2050       if ( my $error = $cust_event->do_event( 'time' => $time ) ) {
2051         #XXX wtf is this?  figure out a proper dealio with return value
2052         #from do_event
2053         return $error;
2054       }
2055     }
2056
2057   }
2058
2059   '';
2060
2061 }
2062
2063 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
2064
2065 Inserts database records for and returns an ordered listref of new events due
2066 for this customer, as FS::cust_event objects (see L<FS::cust_event>).  If no
2067 events are due, an empty listref is returned.  If there is an error, returns a
2068 scalar error message.
2069
2070 To actually run the events, call each event's test_condition method, and if
2071 still true, call the event's do_event method.
2072
2073 Options are passed as a hashref or as a list of name-value pairs.  Available
2074 options are:
2075
2076 =over 4
2077
2078 =item check_freq
2079
2080 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.
2081
2082 =item stage
2083
2084 "collect" (the default) or "pre-bill"
2085
2086 =item time
2087
2088 "Current time" for the events.
2089
2090 =item debug
2091
2092 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)
2093
2094 =item eventtable
2095
2096 Only return events for the specified eventtable (by default, events of all eventtables are returned)
2097
2098 =item objects
2099
2100 Explicitly pass the objects to be tested (typically used with eventtable).
2101
2102 =item testonly
2103
2104 Set to true to return the objects, but not actually insert them into the
2105 database.
2106
2107 =back
2108
2109 =cut
2110
2111 sub due_cust_event {
2112   my $self = shift;
2113   my %opt = ref($_[0]) ? %{ $_[0] } : @_;
2114
2115   #???
2116   #my $DEBUG = $opt{'debug'}
2117   $opt{'debug'} ||= 0; # silence some warnings
2118   local($DEBUG) = $opt{'debug'}
2119     if $opt{'debug'} > $DEBUG;
2120   $DEBUG = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
2121
2122   warn "$me due_cust_event called with options ".
2123        join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
2124     if $DEBUG;
2125
2126   $opt{'time'} ||= time;
2127
2128   local $SIG{HUP} = 'IGNORE';
2129   local $SIG{INT} = 'IGNORE';
2130   local $SIG{QUIT} = 'IGNORE';
2131   local $SIG{TERM} = 'IGNORE';
2132   local $SIG{TSTP} = 'IGNORE';
2133   local $SIG{PIPE} = 'IGNORE';
2134
2135   my $oldAutoCommit = $FS::UID::AutoCommit;
2136   local $FS::UID::AutoCommit = 0;
2137   my $dbh = dbh;
2138
2139   $self->select_for_update #mutex
2140     unless $opt{testonly};
2141
2142   ###
2143   # find possible events (initial search)
2144   ###
2145
2146   my @cust_event = ();
2147
2148   my @eventtable = $opt{'eventtable'}
2149                      ? ( $opt{'eventtable'} )
2150                      : FS::part_event->eventtables_runorder;
2151
2152   my $check_freq = $opt{'check_freq'} || '1d';
2153
2154   foreach my $eventtable ( @eventtable ) {
2155
2156     my @objects;
2157     if ( $opt{'objects'} ) {
2158
2159       @objects = @{ $opt{'objects'} };
2160
2161     } elsif ( $eventtable eq 'cust_main' ) {
2162
2163       @objects = ( $self );
2164
2165     } else {
2166
2167       my $cm_join = " LEFT JOIN cust_main USING ( custnum )";
2168       # linkage not needed here because FS::cust_main->$eventtable will
2169       # already supply it
2170
2171       #some false laziness w/Cron::bill bill_where
2172
2173       my $join  = FS::part_event_condition->join_conditions_sql( $eventtable,
2174         'time' => $opt{'time'});
2175       my $where = FS::part_event_condition->where_conditions_sql($eventtable,
2176         'time'=>$opt{'time'},
2177       );
2178       $where = $where ? "AND $where" : '';
2179
2180       my $are_part_event =
2181       "EXISTS ( SELECT 1 FROM part_event $join
2182         WHERE check_freq = '$check_freq'
2183         AND eventtable = '$eventtable'
2184         AND ( disabled = '' OR disabled IS NULL )
2185         $where
2186         )
2187       ";
2188       #eofalse
2189
2190       @objects = $self->$eventtable(
2191         'addl_from' => $cm_join,
2192         'extra_sql' => " AND $are_part_event",
2193       );
2194     } # if ( !$opt{objects} and $eventtable ne 'cust_main' )
2195
2196     my @e_cust_event = ();
2197
2198     my $linkage = FS::part_event->eventtables_cust_join->{$eventtable} || '';
2199
2200     my $cross = "CROSS JOIN $eventtable $linkage";
2201     $cross .= ' LEFT JOIN cust_main USING ( custnum )'
2202       unless $eventtable eq 'cust_main';
2203
2204     foreach my $object ( @objects ) {
2205
2206       #this first search uses the condition_sql magic for optimization.
2207       #the more possible events we can eliminate in this step the better
2208
2209       my $cross_where = '';
2210       my $pkey = $object->primary_key;
2211       $cross_where = "$eventtable.$pkey = ". $object->$pkey();
2212
2213       my $join = FS::part_event_condition->join_conditions_sql( $eventtable,
2214         'time' => $opt{'time'});
2215       my $extra_sql =
2216         FS::part_event_condition->where_conditions_sql( $eventtable,
2217                                                         'time'=>$opt{'time'}
2218                                                       );
2219       my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
2220
2221       $extra_sql = "AND $extra_sql" if $extra_sql;
2222
2223       #here is the agent virtualization
2224       $extra_sql .= " AND (    part_event.agentnum IS NULL
2225                             OR part_event.agentnum = ". $self->agentnum. ' )';
2226
2227       $extra_sql .= " $order";
2228
2229       warn "searching for events for $eventtable ". $object->$pkey. "\n"
2230         if $opt{'debug'} > 2;
2231       my @part_event = qsearch( {
2232         'debug'     => ( $opt{'debug'} > 3 ? 1 : 0 ),
2233         'select'    => 'part_event.*',
2234         'table'     => 'part_event',
2235         'addl_from' => "$cross $join",
2236         'hashref'   => { 'check_freq' => $check_freq,
2237                          'eventtable' => $eventtable,
2238                          'disabled'   => '',
2239                        },
2240         'extra_sql' => "AND $cross_where $extra_sql",
2241       } );
2242
2243       if ( $DEBUG > 2 ) {
2244         my $pkey = $object->primary_key;
2245         warn "      ". scalar(@part_event).
2246              " possible events found for $eventtable ". $object->$pkey(). "\n";
2247       }
2248
2249       push @e_cust_event, map {
2250         $_->new_cust_event($object, 'time' => $opt{'time'})
2251       } @part_event;
2252
2253     }
2254
2255     warn "    ". scalar(@e_cust_event).
2256          " subtotal possible cust events found for $eventtable\n"
2257       if $DEBUG > 1;
2258
2259     push @cust_event, @e_cust_event;
2260
2261   }
2262
2263   warn "  ". scalar(@cust_event).
2264        " total possible cust events found in initial search\n"
2265     if $DEBUG; # > 1;
2266
2267
2268   ##
2269   # test stage
2270   ##
2271
2272   $opt{stage} ||= 'collect';
2273   @cust_event =
2274     grep { my $stage = $_->part_event->event_stage;
2275            $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
2276          }
2277          @cust_event;
2278
2279   ##
2280   # test conditions
2281   ##
2282
2283   my %unsat = ();
2284
2285   @cust_event = grep $_->test_conditions( 'stats_hashref' => \%unsat ),
2286                      @cust_event;
2287
2288   warn "  ". scalar(@cust_event). " cust events left satisfying conditions\n"
2289     if $DEBUG; # > 1;
2290
2291   warn "    invalid conditions not eliminated with condition_sql:\n".
2292        join('', map "      $_: ".$unsat{$_}."\n", keys %unsat )
2293     if keys %unsat && $DEBUG; # > 1;
2294
2295   ##
2296   # insert
2297   ##
2298
2299   unless( $opt{testonly} ) {
2300     foreach my $cust_event ( @cust_event ) {
2301
2302       my $error = $cust_event->insert();
2303       if ( $error ) {
2304         $dbh->rollback if $oldAutoCommit;
2305         return $error;
2306       }
2307
2308     }
2309   }
2310
2311   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2312
2313   ##
2314   # return
2315   ##
2316
2317   warn "  returning events: ". Dumper(@cust_event). "\n"
2318     if $DEBUG > 2;
2319
2320   \@cust_event;
2321
2322 }
2323
2324 =item apply_payments_and_credits [ OPTION => VALUE ... ]
2325
2326 Applies unapplied payments and credits.
2327 Payments with the no_auto_apply flag set will not be applied.
2328
2329 In most cases, this new method should be used in place of sequential
2330 apply_payments and apply_credits methods.
2331
2332 A hash of optional arguments may be passed.  Currently "manual" is supported.
2333 If true, a payment receipt is sent instead of a statement when
2334 'payment_receipt_email' configuration option is set.
2335
2336 If there is an error, returns the error, otherwise returns false.
2337
2338 =cut
2339
2340 sub apply_payments_and_credits {
2341   my( $self, %options ) = @_;
2342
2343   local $SIG{HUP} = 'IGNORE';
2344   local $SIG{INT} = 'IGNORE';
2345   local $SIG{QUIT} = 'IGNORE';
2346   local $SIG{TERM} = 'IGNORE';
2347   local $SIG{TSTP} = 'IGNORE';
2348   local $SIG{PIPE} = 'IGNORE';
2349
2350   my $oldAutoCommit = $FS::UID::AutoCommit;
2351   local $FS::UID::AutoCommit = 0;
2352   my $dbh = dbh;
2353
2354   my $savepoint_label = 'Billing__apply_payments_and_credits';
2355   savepoint_create( $savepoint_label );
2356
2357   $self->select_for_update; #mutex
2358
2359   foreach my $cust_bill ( $self->open_cust_bill ) {
2360     my $error = $cust_bill->apply_payments_and_credits(%options);
2361     if ( $error ) {
2362       savepoint_rollback_and_release( $savepoint_label );
2363       $dbh->rollback if $oldAutoCommit;
2364       return "Error applying: $error";
2365     }
2366   }
2367
2368   savepoint_release( $savepoint_label );
2369   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2370   ''; #no error
2371
2372 }
2373
2374 =item apply_credits OPTION => VALUE ...
2375
2376 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2377 to outstanding invoice balances in chronological order (or reverse
2378 chronological order if the I<order> option is set to B<newest>) and returns the
2379 value of any remaining unapplied credits available for refund (see
2380 L<FS::cust_refund>).
2381
2382 Dies if there is an error.
2383
2384 =cut
2385
2386 sub apply_credits {
2387   my $self = shift;
2388   my %opt = @_;
2389
2390   local $SIG{HUP} = 'IGNORE';
2391   local $SIG{INT} = 'IGNORE';
2392   local $SIG{QUIT} = 'IGNORE';
2393   local $SIG{TERM} = 'IGNORE';
2394   local $SIG{TSTP} = 'IGNORE';
2395   local $SIG{PIPE} = 'IGNORE';
2396
2397   my $oldAutoCommit = $FS::UID::AutoCommit;
2398   local $FS::UID::AutoCommit = 0;
2399   my $dbh = dbh;
2400
2401   $self->select_for_update; #mutex
2402
2403   unless ( $self->total_unapplied_credits ) {
2404     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2405     return 0;
2406   }
2407
2408   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2409       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2410
2411   my @invoices = $self->open_cust_bill;
2412   @invoices = sort { $b->_date <=> $a->_date } @invoices
2413     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2414
2415   if ( $conf->exists('pkg-balances') ) {
2416     # limit @credits to those w/ a pkgnum grepped from $self
2417     my %pkgnums = ();
2418     foreach my $i (@invoices) {
2419       foreach my $li ( $i->cust_bill_pkg ) {
2420         $pkgnums{$li->pkgnum} = 1;
2421       }
2422     }
2423     @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
2424   }
2425
2426   my $credit;
2427
2428   foreach my $cust_bill ( @invoices ) {
2429
2430     if ( !defined($credit) || $credit->credited == 0) {
2431       $credit = pop @credits or last;
2432     }
2433
2434     my $owed;
2435     if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
2436       $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
2437     } else {
2438       $owed = $cust_bill->owed;
2439     }
2440     unless ( $owed > 0 ) {
2441       push @credits, $credit;
2442       next;
2443     }
2444
2445     my $amount = min( $credit->credited, $owed );
2446
2447     my $cust_credit_bill = new FS::cust_credit_bill ( {
2448       'crednum' => $credit->crednum,
2449       'invnum'  => $cust_bill->invnum,
2450       'amount'  => $amount,
2451     } );
2452     $cust_credit_bill->pkgnum( $credit->pkgnum )
2453       if $conf->exists('pkg-balances') && $credit->pkgnum;
2454     my $error = $cust_credit_bill->insert;
2455     if ( $error ) {
2456       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2457       die $error;
2458     }
2459
2460     redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2461
2462   }
2463
2464   my $total_unapplied_credits = $self->total_unapplied_credits;
2465
2466   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2467
2468   return $total_unapplied_credits;
2469 }
2470
2471 =item apply_payments  [ OPTION => VALUE ... ]
2472
2473 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2474 to outstanding invoice balances in chronological order.
2475 Payments with the no_auto_apply flag set will not be applied.
2476
2477  #and returns the value of any remaining unapplied payments.
2478
2479 A hash of optional arguments may be passed.  Currently "manual" is supported.
2480 If true, a payment receipt is sent instead of a statement when
2481 'payment_receipt_email' configuration option is set.
2482
2483 Dies if there is an error.
2484
2485 =cut
2486
2487 sub apply_payments {
2488   my( $self, %options ) = @_;
2489
2490   local $SIG{HUP} = 'IGNORE';
2491   local $SIG{INT} = 'IGNORE';
2492   local $SIG{QUIT} = 'IGNORE';
2493   local $SIG{TERM} = 'IGNORE';
2494   local $SIG{TSTP} = 'IGNORE';
2495   local $SIG{PIPE} = 'IGNORE';
2496
2497   my $oldAutoCommit = $FS::UID::AutoCommit;
2498   local $FS::UID::AutoCommit = 0;
2499   my $dbh = dbh;
2500
2501   $self->select_for_update; #mutex
2502
2503   #return 0 unless
2504
2505   my @payments = grep { !$_->no_auto_apply } $self->unapplied_cust_pay;
2506
2507   my @invoices = $self->open_cust_bill;
2508
2509   if ( $conf->exists('pkg-balances') ) {
2510     # limit @payments to those w/ a pkgnum grepped from $self
2511     my %pkgnums = ();
2512     foreach my $i (@invoices) {
2513       foreach my $li ( $i->cust_bill_pkg ) {
2514         $pkgnums{$li->pkgnum} = 1;
2515       }
2516     }
2517     @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
2518   }
2519
2520   my $payment;
2521
2522   foreach my $cust_bill ( @invoices ) {
2523
2524     if ( !defined($payment) || $payment->unapplied == 0 ) {
2525       $payment = pop @payments or last;
2526     }
2527
2528     my $owed;
2529     if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
2530       $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
2531     } else {
2532       $owed = $cust_bill->owed;
2533     }
2534     unless ( $owed > 0 ) {
2535       push @payments, $payment;
2536       next;
2537     }
2538
2539     my $amount = min( $payment->unapplied, $owed );
2540
2541     my $cbp = {
2542       'paynum' => $payment->paynum,
2543       'invnum' => $cust_bill->invnum,
2544       'amount' => $amount,
2545     };
2546     $cbp->{_date} = $payment->_date
2547         if $options{'manual'} && $options{'backdate_application'};
2548     my $cust_bill_pay = new FS::cust_bill_pay($cbp);
2549     $cust_bill_pay->pkgnum( $payment->pkgnum )
2550       if $conf->exists('pkg-balances') && $payment->pkgnum;
2551     my $error = $cust_bill_pay->insert(%options);
2552     if ( $error ) {
2553       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2554       die $error;
2555     }
2556
2557     redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2558
2559   }
2560
2561   my $total_unapplied_payments = $self->total_unapplied_payments;
2562
2563   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2564
2565   return $total_unapplied_payments;
2566 }
2567
2568 =back
2569
2570 =head1 FLOW
2571
2572   bill_and_collect
2573
2574     cancel_expired_pkgs
2575     suspend_adjourned_pkgs
2576     unsuspend_resumed_pkgs
2577
2578     bill
2579       (do_cust_event pre-bill)
2580       _make_lines
2581       _omit_zero_value_bundles
2582       calculate_taxes
2583
2584     apply_payments_and_credits
2585     collect
2586       do_cust_event
2587         due_cust_event
2588
2589 =head1 BUGS
2590
2591 =head1 SEE ALSO
2592
2593 L<FS::cust_main>, L<FS::cust_main::Billing_Realtime>
2594
2595 =cut
2596
2597 1;