bin/cust_main_special.pm

   1 package cust_main_special;
   2
   3 require 5.006;
   4 use strict;
   5 use vars qw( @ISA $DEBUG $me $conf );
   6 use Safe;
   7 use Carp;
   8 use Data::Dumper;
   9 use Date::Format;
  10 use FS::UID qw( dbh );
  11 use FS::Record qw( qsearchs qsearch );
  12 use FS::payby;
  13 use FS::cust_pkg;
  14 use FS::cust_bill;
  15 use FS::cust_bill_pkg;
  16 use FS::cust_bill_pkg_display;
  17 use FS::cust_bill_pkg_tax_location;
  18 use FS::cust_main_county;
  19 use FS::cust_location;
  20 use FS::tax_rate;
  21 use FS::cust_tax_location;
  22 use FS::part_pkg_taxrate;
  23 use FS::queue;
  24 use FS::part_pkg;
  25
  26 @ISA = qw ( FS::cust_main );
  27
  28 $DEBUG = 0;
  29 $me = '[emergency billing program]';
  30
  31 $conf = new FS::Conf;
  32
  33 =head1 METHODS
  34
  35 =over 4
  36
  37 =item bill_and_collect
  38
  39 Cancels and suspends any packages due, generates bills, applies payments and
  40 cred
  41
  42 Warns on errors (Does not currently: If there is an error, returns the error, otherwise returns false.)
  43
  44 Options are passed as name-value pairs.  Currently available options are:
  45
  46 =over 4
  47
  48 =item time
  49
  50 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:
  51
  52  use Date::Parse;
  53  ...
  54  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
  55
  56 =item invoice_time
  57
  58 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.
  59
  60 =item check_freq
  61
  62 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
  63
  64 =item resetup
  65
  66 If set true, re-charges setup fees.
  67
  68 =item debug
  69
  70 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)
  71
  72 =back
  73
  74 =cut
  75
  76 sub bill_and_collect {
  77   my( $self, %options ) = @_;
  78
  79   #$options{actual_time} not $options{time} because freeside-daily -d is for
  80   #pre-printing invoices
  81   $self->cancel_expired_pkgs( $options{actual_time} );
  82   $self->suspend_adjourned_pkgs( $options{actual_time} );
  83
  84   my $error = $self->bill( %options );
  85   warn "Error billing, custnum ". $self->custnum. ": $error" if $error;
  86
  87   $self->apply_payments_and_credits;
  88
  89   unless ( $conf->exists('cancelled_cust-noevents')
  90            && ! $self->num_ncancelled_pkgs
  91   ) {
  92
  93     $error = $self->collect( %options );
  94     warn "Error collecting, custnum". $self->custnum. ": $error" if $error;
  95
  96   }
  97
  98 }
  99
 100 =item bill OPTIONS
 101
 102 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
 103 conjunction with the collect method by calling B<bill_and_collect>.
 104
 105 If there is an error, returns the error, otherwise returns false.
 106
 107 Options are passed as name-value pairs.  Currently available options are:
 108
 109 =over 4
 110
 111 =item resetup
 112
 113 If set true, re-charges setup fees.
 114
 115 =item time
 116
 117 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:
 118
 119  use Date::Parse;
 120  ...
 121  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
 122
 123 =item pkg_list
 124
 125 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
 126
 127  $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
 128
 129 =item invoice_time
 130
 131 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.
 132
 133 =item backbill
 134
 135 Used to specify the period starting date and preventing normal billing.  Instead all outstanding cdrs/usage are processed as if from the unix timestamp in backbill and without changing the dates in the customer packages.  Useful in those situations when cdrs were not imported before a billing run
 136
 137 =back
 138
 139 =cut
 140
 141 sub bill {
 142   my( $self, %options ) = @_;
 143
 144   bless $self, 'cust_main_special';
 145   return '' if $self->payby eq 'COMP';
 146   warn "$me backbill usage for customer ". $self->custnum. "\n"
 147     if $DEBUG;
 148
 149   my $time = $options{'time'} || time;
 150   my $invoice_time = $options{'invoice_time'} || $time;
 151
 152   #put below somehow?
 153   local $SIG{HUP} = 'IGNORE';
 154   local $SIG{INT} = 'IGNORE';
 155   local $SIG{QUIT} = 'IGNORE';
 156   local $SIG{TERM} = 'IGNORE';
 157   local $SIG{TSTP} = 'IGNORE';
 158   local $SIG{PIPE} = 'IGNORE';
 159
 160   my $oldAutoCommit = $FS::UID::AutoCommit;
 161   local $FS::UID::AutoCommit = 0;
 162   my $dbh = dbh;
 163
 164   $self->select_for_update; #mutex
 165
 166   my @cust_bill_pkg = ();
 167
 168   ###
 169   # find the packages which are due for billing, find out how much they are
 170   # & generate invoice database.
 171   ###
 172
 173   my( $total_setup, $total_recur, $postal_charge ) = ( 0, 0, 0 );
 174   my %taxlisthash;
 175   my @precommit_hooks = ();
 176
 177   my @cust_pkgs = qsearch('cust_pkg', { 'custnum' => $self->custnum } );
 178   foreach my $cust_pkg (@cust_pkgs) {
 179
 180     #NO!! next if $cust_pkg->cancel;
 181     next if $cust_pkg->getfield('cancel');
 182
 183     warn "  bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
 184
 185     #? to avoid use of uninitialized value errors... ?
 186     $cust_pkg->setfield('bill', '')
 187       unless defined($cust_pkg->bill);
 188
 189     #my $part_pkg = $cust_pkg->part_pkg;
 190
 191     my $real_pkgpart = $cust_pkg->pkgpart;
 192     my %hash = $cust_pkg->hash;
 193
 194     foreach my $part_pkg ( $cust_pkg->part_pkg->self_and_bill_linked ) {
 195
 196       $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
 197
 198       my $error =
 199         $self->_make_lines( 'part_pkg'            => $part_pkg,
 200                             'cust_pkg'            => $cust_pkg,
 201                             'precommit_hooks'     => \@precommit_hooks,
 202                             'line_items'          => \@cust_bill_pkg,
 203                             'setup'               => \$total_setup,
 204                             'recur'               => \$total_recur,
 205                             'tax_matrix'          => \%taxlisthash,
 206                             'time'                => $time,
 207                             'options'             => \%options,
 208                           );
 209       if ($error) {
 210         $dbh->rollback if $oldAutoCommit;
 211         return $error;
 212       }
 213
 214     } #foreach my $part_pkg
 215
 216   } #foreach my $cust_pkg
 217
 218   unless ( @cust_bill_pkg ) { #don't create an invoice w/o line items
 219     unless ( $options{backbill} ) {
 220       #but do commit any package date cycling that happened
 221       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 222     } else {
 223       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 224     }
 225     return '';
 226   }
 227
 228   my $postal_pkg = $self->charge_postal_fee();
 229   if ( $postal_pkg && !ref( $postal_pkg ) ) {
 230     $dbh->rollback if $oldAutoCommit;
 231     return "can't charge postal invoice fee for customer ".
 232       $self->custnum. ": $postal_pkg";
 233   }
 234   if ( !$options{backbill} && $postal_pkg &&
 235        ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
 236          !$conf->exists('postal_invoice-recurring_only')
 237        )
 238      )
 239   {
 240     foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) {
 241       my $error =
 242         $self->_make_lines( 'part_pkg'            => $part_pkg,
 243                             'cust_pkg'            => $postal_pkg,
 244                             'precommit_hooks'     => \@precommit_hooks,
 245                             'line_items'          => \@cust_bill_pkg,
 246                             'setup'               => \$total_setup,
 247                             'recur'               => \$total_recur,
 248                             'tax_matrix'          => \%taxlisthash,
 249                             'time'                => $time,
 250                             'options'             => \%options,
 251                           );
 252       if ($error) {
 253         $dbh->rollback if $oldAutoCommit;
 254         return $error;
 255       }
 256     }
 257   }
 258
 259   warn "having a look at the taxes we found...\n" if $DEBUG > 2;
 260
 261   # keys are tax names (as printed on invoices / itemdesc )
 262   # values are listrefs of taxlisthash keys (internal identifiers)
 263   my %taxname = ();
 264
 265   # keys are taxlisthash keys (internal identifiers)
 266   # values are (cumulative) amounts
 267   my %tax = ();
 268
 269   # keys are taxlisthash keys (internal identifiers)
 270   # values are listrefs of cust_bill_pkg_tax_location hashrefs
 271   my %tax_location = ();
 272
 273   foreach my $tax ( keys %taxlisthash ) {
 274     my $tax_object = shift @{ $taxlisthash{$tax} };
 275     warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
 276     warn " ". join('/', @{ $taxlisthash{$tax} } ). "\n" if $DEBUG > 2;
 277     my $hashref_or_error =
 278       $tax_object->taxline( $taxlisthash{$tax},
 279                             'custnum'      => $self->custnum,
 280                             'invoice_time' => $invoice_time
 281                           );
 282     unless ( ref($hashref_or_error) ) {
 283       $dbh->rollback if $oldAutoCommit;
 284       return $hashref_or_error;
 285     }
 286     unshift @{ $taxlisthash{$tax} }, $tax_object;
 287
 288     my $name   = $hashref_or_error->{'name'};
 289     my $amount = $hashref_or_error->{'amount'};
 290
 291     #warn "adding $amount as $name\n";
 292     $taxname{ $name } ||= [];
 293     push @{ $taxname{ $name } }, $tax;
 294
 295     $tax{ $tax } += $amount;
 296
 297     $tax_location{ $tax } ||= [];
 298     if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) {
 299       push @{ $tax_location{ $tax }  },
 300         {
 301           'taxnum'      => $tax_object->taxnum,
 302           'taxtype'     => ref($tax_object),
 303           'pkgnum'      => $tax_object->get('pkgnum'),
 304           'locationnum' => $tax_object->get('locationnum'),
 305           'amount'      => sprintf('%.2f', $amount ),
 306         };
 307     }
 308
 309   }
 310
 311   #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
 312   my %packagemap = map { $_->pkgnum => $_ } @cust_bill_pkg;
 313   foreach my $tax ( keys %taxlisthash ) {
 314     foreach ( @{ $taxlisthash{$tax} }[1 ... scalar(@{ $taxlisthash{$tax} })] ) {
 315       next unless ref($_) eq 'FS::cust_bill_pkg';
 316
 317       push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
 318         splice( @{ $_->_cust_tax_exempt_pkg } );
 319     }
 320   }
 321
 322   #consolidate and create tax line items
 323   warn "consolidating and generating...\n" if $DEBUG > 2;
 324   foreach my $taxname ( keys %taxname ) {
 325     my $tax = 0;
 326     my %seen = ();
 327     my @cust_bill_pkg_tax_location = ();
 328     warn "adding $taxname\n" if $DEBUG > 1;
 329     foreach my $taxitem ( @{ $taxname{$taxname} } ) {
 330       next if $seen{$taxitem}++;
 331       warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
 332       $tax += $tax{$taxitem};
 333       push @cust_bill_pkg_tax_location,
 334         map { new FS::cust_bill_pkg_tax_location $_ }
 335             @{ $tax_location{ $taxitem } };
 336     }
 337     next unless $tax;
 338
 339     $tax = sprintf('%.2f', $tax );
 340     $total_setup = sprintf('%.2f', $total_setup+$tax );
 341
 342     push @cust_bill_pkg, new FS::cust_bill_pkg {
 343       'pkgnum'   => 0,
 344       'setup'    => $tax,
 345       'recur'    => 0,
 346       'sdate'    => '',
 347       'edate'    => '',
 348       'itemdesc' => $taxname,
 349       'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
 350     };
 351
 352   }
 353
 354   my $charged = sprintf('%.2f', $total_setup + $total_recur );
 355
 356   #create the new invoice
 357   my $cust_bill = new FS::cust_bill ( {
 358     'custnum' => $self->custnum,
 359     '_date'   => ( $invoice_time ),
 360     'charged' => $charged,
 361   } );
 362   my $error = $cust_bill->insert;
 363   if ( $error ) {
 364     $dbh->rollback if $oldAutoCommit;
 365     return "can't create invoice for customer #". $self->custnum. ": $error";
 366   }
 367
 368   foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
 369     $cust_bill_pkg->invnum($cust_bill->invnum);
 370     my $error = $cust_bill_pkg->insert;
 371     if ( $error ) {
 372       $dbh->rollback if $oldAutoCommit;
 373       return "can't create invoice line item: $error";
 374     }
 375   }
 376
 377
 378   #foreach my $hook ( @precommit_hooks ) {
 379   #  eval {
 380   #    &{$hook}; #($self) ?
 381   #  };
 382   #  if ( $@ ) {
 383   #    $dbh->rollback if $oldAutoCommit;
 384   #    return "$@ running precommit hook $hook\n";
 385   #  }
 386   #}
 387
 388   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 389   ''; #no error
 390 }
 391
 392
 393 sub _make_lines {
 394   my ($self, %params) = @_;
 395
 396   warn "    making lines\n" if $DEBUG > 1;
 397   my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
 398   my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
 399   my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
 400   my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
 401   my $total_setup = $params{setup} or die "no setup accumulator specified";
 402   my $total_recur = $params{recur} or die "no recur accumulator specified";
 403   my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
 404   my $time = $params{'time'} or die "no time specified";
 405   my (%options) = %{$params{options}};
 406
 407   my $dbh = dbh;
 408   my $real_pkgpart = $cust_pkg->pkgpart;
 409   my %hash = $cust_pkg->hash;
 410   my $old_cust_pkg = new FS::cust_pkg \%hash;
 411   my $backbill = $options{backbill} || 0;
 412
 413   my @details = ();
 414
 415   my $lineitems = 0;
 416
 417   $cust_pkg->pkgpart($part_pkg->pkgpart);
 418
 419   ###
 420   # bill setup
 421   ###
 422
 423   my $setup = 0;
 424   my $unitsetup = 0;
 425   if ( ! $cust_pkg->setup &&
 426        (
 427          ( $conf->exists('disable_setup_suspended_pkgs') &&
 428           ! $cust_pkg->getfield('susp')
 429         ) || ! $conf->exists('disable_setup_suspended_pkgs')
 430        )
 431     || $options{'resetup'}
 432   ) {
 433
 434     warn "    bill setup\n" if $DEBUG > 1;
 435     $lineitems++;
 436
 437     $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
 438     return "$@ running calc_setup for $cust_pkg\n"
 439       if $@;
 440
 441     $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
 442
 443     $cust_pkg->setfield('setup', $time)
 444       unless $cust_pkg->setup;
 445           #do need it, but it won't get written to the db
 446           #|| $cust_pkg->pkgpart != $real_pkgpart;
 447
 448   }
 449
 450   ###
 451   # bill recurring fee
 452   ###
 453
 454   #XXX unit stuff here too
 455   my $recur = 0;
 456   my $unitrecur = 0;
 457   my $sdate;
 458   if ( ! $cust_pkg->getfield('susp') and
 459            ( $part_pkg->getfield('freq') ne '0' &&
 460              ( $cust_pkg->getfield('bill') || 0 ) <= $time
 461            )
 462         || ( $part_pkg->plan eq 'voip_cdr'
 463               && $part_pkg->option('bill_every_call')
 464            )
 465         || $backbill
 466   ) {
 467
 468     # XXX should this be a package event?  probably.  events are called
 469     # at collection time at the moment, though...
 470     $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
 471       if $part_pkg->can('reset_usage');
 472       #don't want to reset usage just cause we want a line item??
 473       #&& $part_pkg->pkgpart == $real_pkgpart;
 474
 475     warn "    bill recur\n" if $DEBUG > 1;
 476     $lineitems++;
 477
 478     # XXX shared with $recur_prog
 479     $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
 480     $sdate = $cust_pkg->lastbill || $backbill if $backbill;
 481
 482     #over two params!  lets at least switch to a hashref for the rest...
 483     my $increment_next_bill = ( $part_pkg->freq ne '0'
 484                                 && ( $cust_pkg->getfield('bill') || 0 ) <= $time
 485                               );
 486     my %param = ( 'precommit_hooks'     => $precommit_hooks,
 487                   'increment_next_bill' => $increment_next_bill,
 488                 );
 489
 490     $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
 491     return "$@ running calc_recur for $cust_pkg\n"
 492       if ( $@ );
 493
 494
 495     warn "details is now: \n" if $DEBUG > 2;
 496     warn Dumper(\@details) if $DEBUG > 2;
 497
 498     if ( $increment_next_bill ) {
 499
 500       my $next_bill = $part_pkg->add_freq($sdate);
 501       return "unparsable frequency: ". $part_pkg->freq
 502         if $next_bill == -1;
 503
 504       #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
 505       # only for figuring next bill date, nothing else, so, reset $sdate again
 506       # here
 507       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
 508       $sdate = $cust_pkg->lastbill || $backbill if $backbill;
 509       #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
 510       $cust_pkg->last_bill($sdate);
 511
 512       $cust_pkg->setfield('bill', $next_bill );
 513
 514     }
 515
 516   }
 517
 518   warn "\$setup is undefined" unless defined($setup);
 519   warn "\$recur is undefined" unless defined($recur);
 520   warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
 521
 522   ###
 523   # If there's line items, create em cust_bill_pkg records
 524   # If $cust_pkg has been modified, update it (if we're a real pkgpart)
 525   ###
 526
 527   if ( $lineitems ) {
 528
 529     if ( !$backbill && $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
 530       # hmm.. and if just the options are modified in some weird price plan?
 531
 532       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n"
 533         if $DEBUG >1;
 534
 535       my $error = $cust_pkg->replace( $old_cust_pkg,
 536                                       'options' => { $cust_pkg->options },
 537                                     );
 538       return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
 539         if $error; #just in case
 540     }
 541
 542     my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
 543     if ( $DEBUG > 1 ) {
 544       warn "      tentatively adding customer package invoice detail: $_\n"
 545         foreach @cust_pkg_detail;
 546     }
 547     push @details, @cust_pkg_detail;
 548
 549     $setup = sprintf( "%.2f", $setup );
 550     $recur = sprintf( "%.2f", $recur );
 551     my $cust_bill_pkg = new FS::cust_bill_pkg {
 552       'pkgnum'    => $cust_pkg->pkgnum,
 553       'setup'     => $setup,
 554       'unitsetup' => $unitsetup,
 555       'recur'     => $recur,
 556       'unitrecur' => $unitrecur,
 557       'quantity'  => $cust_pkg->quantity,
 558       'details'   => \@details,
 559     };
 560
 561     warn "created cust_bill_pkg which looks like:\n" if $DEBUG > 2;
 562     warn Dumper($cust_bill_pkg) if $DEBUG > 2;
 563     if ($backbill) {
 564       my %usage_cust_bill_pkg = $cust_bill_pkg->disintegrate;
 565       $recur = 0;
 566       foreach my $key (keys %usage_cust_bill_pkg) {
 567         next if ($key eq 'setup' || $key eq 'recur');
 568         $recur += $usage_cust_bill_pkg{$key}->recur;
 569       }
 570       $setup = 0;
 571     }
 572
 573     $setup = sprintf( "%.2f", $setup );
 574     $recur = sprintf( "%.2f", $recur );
 575     if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
 576       return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
 577     }
 578     if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
 579       return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
 580     }
 581
 582
 583     if ( $setup != 0 || $recur != 0 ) {
 584
 585       warn "    charges (setup=$setup, recur=$recur); adding line items\n"
 586         if $DEBUG > 1;
 587
 588       $cust_bill_pkg->setup($setup);
 589       $cust_bill_pkg->recur($recur);
 590
 591       warn "cust_bill_pkg now looks like:\n" if $DEBUG > 2;
 592       warn Dumper($cust_bill_pkg) if $DEBUG > 2;
 593
 594       if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
 595         $cust_bill_pkg->sdate( $hash{last_bill} );
 596         $cust_bill_pkg->edate( $sdate - 86399   ); #60s*60m*24h-1
 597       } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
 598         $cust_bill_pkg->sdate( $sdate );
 599         $cust_bill_pkg->edate( $cust_pkg->bill );
 600       }
 601
 602       $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
 603         unless $part_pkg->pkgpart == $real_pkgpart;
 604
 605       $$total_setup += $setup;
 606       $$total_recur += $recur;
 607
 608       ###
 609       # handle taxes
 610       ###
 611
 612       my $error =
 613         $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time});
 614       return $error if $error;
 615
 616       push @$cust_bill_pkgs, $cust_bill_pkg;
 617
 618     } #if $setup != 0 || $recur != 0
 619
 620   } #if $line_items
 621
 622   '';
 623
 624 }
 625
 626 =item collect OPTIONS
 627
 628 (Attempt to) collect money for this customer's outstanding invoices (see
 629 L<FS::cust_bill>).  Usually used after the bill method.
 630
 631 Actions are now triggered by billing events; see L<FS::part_event> and the
 632 billing events web interface.  Old-style invoice events (see
 633 L<FS::part_bill_event>) have been deprecated.
 634
 635 If there is an error, returns the error, otherwise returns false.
 636
 637 Options are passed as name-value pairs.
 638
 639 Currently available options are:
 640
 641 =over 4
 642
 643 =item invoice_time
 644
 645 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.
 646
 647 =item retry
 648
 649 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
 650
 651 =item quiet
 652
 653 set true to surpress email card/ACH decline notices.
 654
 655 =item check_freq
 656
 657 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
 658
 659 =item payby
 660
 661 allows for one time override of normal customer billing method
 662
 663 =item debug
 664
 665 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)
 666
 667
 668 =back
 669
 670 =cut
 671
 672 sub collect {
 673   my( $self, %options ) = @_;
 674   my $invoice_time = $options{'invoice_time'} || time;
 675
 676   #put below somehow?
 677   local $SIG{HUP} = 'IGNORE';
 678   local $SIG{INT} = 'IGNORE';
 679   local $SIG{QUIT} = 'IGNORE';
 680   local $SIG{TERM} = 'IGNORE';
 681   local $SIG{TSTP} = 'IGNORE';
 682   local $SIG{PIPE} = 'IGNORE';
 683
 684   my $oldAutoCommit = $FS::UID::AutoCommit;
 685   local $FS::UID::AutoCommit = 0;
 686   my $dbh = dbh;
 687
 688   $self->select_for_update; #mutex
 689
 690   if ( $DEBUG ) {
 691     my $balance = $self->balance;
 692     warn "$me collect customer ". $self->custnum. ": balance $balance\n"
 693   }
 694
 695   if ( exists($options{'retry_card'}) ) {
 696     carp 'retry_card option passed to collect is deprecated; use retry';
 697     $options{'retry'} ||= $options{'retry_card'};
 698   }
 699   if ( exists($options{'retry'}) && $options{'retry'} ) {
 700     my $error = $self->retry_realtime;
 701     if ( $error ) {
 702       $dbh->rollback if $oldAutoCommit;
 703       return $error;
 704     }
 705   }
 706
 707   # false laziness w/pay_batch::import_results
 708
 709   my $due_cust_event = $self->due_cust_event(
 710     'debug'      => ( $options{'debug'} || 0 ),
 711     'time'       => $invoice_time,
 712     'check_freq' => $options{'check_freq'},
 713   );
 714   unless( ref($due_cust_event) ) {
 715     $dbh->rollback if $oldAutoCommit;
 716     return $due_cust_event;
 717   }
 718
 719   foreach my $cust_event ( @$due_cust_event ) {
 720
 721     #XXX lock event
 722
 723     #re-eval event conditions (a previous event could have changed things)
 724     unless ( $cust_event->test_conditions( 'time' => $invoice_time ) ) {
 725       #don't leave stray "new/locked" records around
 726       my $error = $cust_event->delete;
 727       if ( $error ) {
 728         #gah, even with transactions
 729         $dbh->commit if $oldAutoCommit; #well.
 730         return $error;
 731       }
 732       next;
 733     }
 734
 735     {
 736       local $FS::cust_main::realtime_bop_decline_quiet = 1 if $options{'quiet'};
 737       warn "  running cust_event ". $cust_event->eventnum. "\n"
 738         if $DEBUG > 1;
 739
 740
 741       #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
 742       if ( my $error = $cust_event->do_event() ) {
 743         #XXX wtf is this?  figure out a proper dealio with return value
 744         #from do_event
 745           # gah, even with transactions.
 746           $dbh->commit if $oldAutoCommit; #well.
 747           return $error;
 748         }
 749     }
 750
 751   }
 752
 753   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 754   '';
 755
 756 }
 757
 758
 759
 760 sub queued_bill {
 761   ## actual sub, not a method, designed to be called from the queue.
 762   ## sets up the customer, and calls the bill_and_collect
 763   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
 764   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
 765       $cust_main->bill_and_collect(
 766         %args,
 767       );
 768 }
 769
 770 =back
 771
 772
 773 =cut
 774
 775 1;
 776