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 OPTIONS
  38
  39 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
  40 conjunction with the collect method by calling B<bill_and_collect>.
  41
  42 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 resetup
  49
  50 If set true, re-charges setup fees.
  51
  52 =item time
  53
  54 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:
  55
  56  use Date::Parse;
  57  ...
  58  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
  59
  60 =item pkg_list
  61
  62 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
  63
  64  $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
  65
  66 =item invoice_time
  67
  68 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.
  69
  70 =item backbill
  71
  72 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
  73
  74 =back
  75
  76 =cut
  77
  78 sub bill {
  79   my( $self, %options ) = @_;
  80
  81   bless $self, 'cust_main_special';
  82   return '' if $self->payby eq 'COMP';
  83   warn "$me backbill usage for customer ". $self->custnum. "\n"
  84     if $DEBUG;
  85
  86   my $time = $options{'time'} || time;
  87   my $invoice_time = $options{'invoice_time'} || $time;
  88
  89   #put below somehow?
  90   local $SIG{HUP} = 'IGNORE';
  91   local $SIG{INT} = 'IGNORE';
  92   local $SIG{QUIT} = 'IGNORE';
  93   local $SIG{TERM} = 'IGNORE';
  94   local $SIG{TSTP} = 'IGNORE';
  95   local $SIG{PIPE} = 'IGNORE';
  96
  97   my $oldAutoCommit = $FS::UID::AutoCommit;
  98   local $FS::UID::AutoCommit = 0;
  99   my $dbh = dbh;
 100
 101   $self->select_for_update; #mutex
 102
 103   my @cust_bill_pkg = ();
 104
 105   ###
 106   # find the packages which are due for billing, find out how much they are
 107   # & generate invoice database.
 108   ###
 109
 110   my( $total_setup, $total_recur, $postal_charge ) = ( 0, 0, 0 );
 111   my %taxlisthash;
 112   my @precommit_hooks = ();
 113
 114   my @cust_pkgs = qsearch('cust_pkg', { 'custnum' => $self->custnum } );
 115   foreach my $cust_pkg (@cust_pkgs) {
 116
 117     #NO!! next if $cust_pkg->cancel;
 118     next if $cust_pkg->getfield('cancel');
 119
 120     warn "  bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
 121
 122     #? to avoid use of uninitialized value errors... ?
 123     $cust_pkg->setfield('bill', '')
 124       unless defined($cust_pkg->bill);
 125
 126     #my $part_pkg = $cust_pkg->part_pkg;
 127
 128     my $real_pkgpart = $cust_pkg->pkgpart;
 129     my %hash = $cust_pkg->hash;
 130
 131     foreach my $part_pkg ( $cust_pkg->part_pkg->self_and_bill_linked ) {
 132
 133       $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
 134
 135       my $error =
 136         $self->_make_lines( 'part_pkg'            => $part_pkg,
 137                             'cust_pkg'            => $cust_pkg,
 138                             'precommit_hooks'     => \@precommit_hooks,
 139                             'line_items'          => \@cust_bill_pkg,
 140                             'setup'               => \$total_setup,
 141                             'recur'               => \$total_recur,
 142                             'tax_matrix'          => \%taxlisthash,
 143                             'time'                => $time,
 144                             'options'             => \%options,
 145                           );
 146       if ($error) {
 147         $dbh->rollback if $oldAutoCommit;
 148         return $error;
 149       }
 150
 151     } #foreach my $part_pkg
 152
 153   } #foreach my $cust_pkg
 154
 155   unless ( @cust_bill_pkg ) { #don't create an invoice w/o line items
 156     unless ( $options{backbill} ) {
 157       #but do commit any package date cycling that happened
 158       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 159     } else {
 160       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 161     }
 162     return '';
 163   }
 164
 165   my $postal_pkg = $self->charge_postal_fee();
 166   if ( $postal_pkg && !ref( $postal_pkg ) ) {
 167     $dbh->rollback if $oldAutoCommit;
 168     return "can't charge postal invoice fee for customer ".
 169       $self->custnum. ": $postal_pkg";
 170   }
 171   if ( !$options{backbill} && $postal_pkg &&
 172        ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
 173          !$conf->exists('postal_invoice-recurring_only')
 174        )
 175      )
 176   {
 177     foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) {
 178       my $error =
 179         $self->_make_lines( 'part_pkg'            => $part_pkg,
 180                             'cust_pkg'            => $postal_pkg,
 181                             'precommit_hooks'     => \@precommit_hooks,
 182                             'line_items'          => \@cust_bill_pkg,
 183                             'setup'               => \$total_setup,
 184                             'recur'               => \$total_recur,
 185                             'tax_matrix'          => \%taxlisthash,
 186                             'time'                => $time,
 187                             'options'             => \%options,
 188                           );
 189       if ($error) {
 190         $dbh->rollback if $oldAutoCommit;
 191         return $error;
 192       }
 193     }
 194   }
 195
 196   warn "having a look at the taxes we found...\n" if $DEBUG > 2;
 197
 198   # keys are tax names (as printed on invoices / itemdesc )
 199   # values are listrefs of taxlisthash keys (internal identifiers)
 200   my %taxname = ();
 201
 202   # keys are taxlisthash keys (internal identifiers)
 203   # values are (cumulative) amounts
 204   my %tax = ();
 205
 206   # keys are taxlisthash keys (internal identifiers)
 207   # values are listrefs of cust_bill_pkg_tax_location hashrefs
 208   my %tax_location = ();
 209
 210   foreach my $tax ( keys %taxlisthash ) {
 211     my $tax_object = shift @{ $taxlisthash{$tax} };
 212     warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
 213     warn " ". join('/', @{ $taxlisthash{$tax} } ). "\n" if $DEBUG > 2;
 214     my $hashref_or_error =
 215       $tax_object->taxline( $taxlisthash{$tax},
 216                             'custnum'      => $self->custnum,
 217                             'invoice_time' => $invoice_time
 218                           );
 219     unless ( ref($hashref_or_error) ) {
 220       $dbh->rollback if $oldAutoCommit;
 221       return $hashref_or_error;
 222     }
 223     unshift @{ $taxlisthash{$tax} }, $tax_object;
 224
 225     my $name   = $hashref_or_error->{'name'};
 226     my $amount = $hashref_or_error->{'amount'};
 227
 228     #warn "adding $amount as $name\n";
 229     $taxname{ $name } ||= [];
 230     push @{ $taxname{ $name } }, $tax;
 231
 232     $tax{ $tax } += $amount;
 233
 234     $tax_location{ $tax } ||= [];
 235     if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) {
 236       push @{ $tax_location{ $tax }  },
 237         {
 238           'taxnum'      => $tax_object->taxnum,
 239           'taxtype'     => ref($tax_object),
 240           'pkgnum'      => $tax_object->get('pkgnum'),
 241           'locationnum' => $tax_object->get('locationnum'),
 242           'amount'      => sprintf('%.2f', $amount ),
 243         };
 244     }
 245
 246   }
 247
 248   #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
 249   my %packagemap = map { $_->pkgnum => $_ } @cust_bill_pkg;
 250   foreach my $tax ( keys %taxlisthash ) {
 251     foreach ( @{ $taxlisthash{$tax} }[1 ... scalar(@{ $taxlisthash{$tax} })] ) {
 252       next unless ref($_) eq 'FS::cust_bill_pkg';
 253
 254       push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
 255         splice( @{ $_->_cust_tax_exempt_pkg } );
 256     }
 257   }
 258
 259   #consolidate and create tax line items
 260   warn "consolidating and generating...\n" if $DEBUG > 2;
 261   foreach my $taxname ( keys %taxname ) {
 262     my $tax = 0;
 263     my %seen = ();
 264     my @cust_bill_pkg_tax_location = ();
 265     warn "adding $taxname\n" if $DEBUG > 1;
 266     foreach my $taxitem ( @{ $taxname{$taxname} } ) {
 267       next if $seen{$taxitem}++;
 268       warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
 269       $tax += $tax{$taxitem};
 270       push @cust_bill_pkg_tax_location,
 271         map { new FS::cust_bill_pkg_tax_location $_ }
 272             @{ $tax_location{ $taxitem } };
 273     }
 274     next unless $tax;
 275
 276     $tax = sprintf('%.2f', $tax );
 277     $total_setup = sprintf('%.2f', $total_setup+$tax );
 278
 279     push @cust_bill_pkg, new FS::cust_bill_pkg {
 280       'pkgnum'   => 0,
 281       'setup'    => $tax,
 282       'recur'    => 0,
 283       'sdate'    => '',
 284       'edate'    => '',
 285       'itemdesc' => $taxname,
 286       'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
 287     };
 288
 289   }
 290
 291   my $charged = sprintf('%.2f', $total_setup + $total_recur );
 292
 293   #create the new invoice
 294   my $cust_bill = new FS::cust_bill ( {
 295     'custnum' => $self->custnum,
 296     '_date'   => ( $invoice_time ),
 297     'charged' => $charged,
 298   } );
 299   my $error = $cust_bill->insert;
 300   if ( $error ) {
 301     $dbh->rollback if $oldAutoCommit;
 302     return "can't create invoice for customer #". $self->custnum. ": $error";
 303   }
 304
 305   foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
 306     $cust_bill_pkg->invnum($cust_bill->invnum);
 307     my $error = $cust_bill_pkg->insert;
 308     if ( $error ) {
 309       $dbh->rollback if $oldAutoCommit;
 310       return "can't create invoice line item: $error";
 311     }
 312   }
 313
 314
 315   #foreach my $hook ( @precommit_hooks ) {
 316   #  eval {
 317   #    &{$hook}; #($self) ?
 318   #  };
 319   #  if ( $@ ) {
 320   #    $dbh->rollback if $oldAutoCommit;
 321   #    return "$@ running precommit hook $hook\n";
 322   #  }
 323   #}
 324
 325   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 326   ''; #no error
 327 }
 328
 329
 330 sub _make_lines {
 331   my ($self, %params) = @_;
 332
 333   warn "    making lines\n" if $DEBUG > 1;
 334   my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
 335   my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
 336   my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
 337   my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
 338   my $total_setup = $params{setup} or die "no setup accumulator specified";
 339   my $total_recur = $params{recur} or die "no recur accumulator specified";
 340   my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
 341   my $time = $params{'time'} or die "no time specified";
 342   my (%options) = %{$params{options}};
 343
 344   my $dbh = dbh;
 345   my $real_pkgpart = $cust_pkg->pkgpart;
 346   my %hash = $cust_pkg->hash;
 347   my $old_cust_pkg = new FS::cust_pkg \%hash;
 348   my $backbill = $options{backbill} || 0;
 349
 350   my @details = ();
 351
 352   my $lineitems = 0;
 353
 354   $cust_pkg->pkgpart($part_pkg->pkgpart);
 355
 356   ###
 357   # bill setup
 358   ###
 359
 360   my $setup = 0;
 361   my $unitsetup = 0;
 362   if ( ! $cust_pkg->setup &&
 363        (
 364          ( $conf->exists('disable_setup_suspended_pkgs') &&
 365           ! $cust_pkg->getfield('susp')
 366         ) || ! $conf->exists('disable_setup_suspended_pkgs')
 367        )
 368     || $options{'resetup'}
 369   ) {
 370
 371     warn "    bill setup\n" if $DEBUG > 1;
 372     $lineitems++;
 373
 374     $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
 375     return "$@ running calc_setup for $cust_pkg\n"
 376       if $@;
 377
 378     $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
 379
 380     $cust_pkg->setfield('setup', $time)
 381       unless $cust_pkg->setup;
 382           #do need it, but it won't get written to the db
 383           #|| $cust_pkg->pkgpart != $real_pkgpart;
 384
 385   }
 386
 387   ###
 388   # bill recurring fee
 389   ###
 390
 391   #XXX unit stuff here too
 392   my $recur = 0;
 393   my $unitrecur = 0;
 394   my $sdate;
 395   if ( ! $cust_pkg->getfield('susp') and
 396            ( $part_pkg->getfield('freq') ne '0' &&
 397              ( $cust_pkg->getfield('bill') || 0 ) <= $time
 398            )
 399         || ( $part_pkg->plan eq 'voip_cdr'
 400               && $part_pkg->option('bill_every_call')
 401            )
 402         || $backbill
 403   ) {
 404
 405     # XXX should this be a package event?  probably.  events are called
 406     # at collection time at the moment, though...
 407     $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
 408       if $part_pkg->can('reset_usage');
 409       #don't want to reset usage just cause we want a line item??
 410       #&& $part_pkg->pkgpart == $real_pkgpart;
 411
 412     warn "    bill recur\n" if $DEBUG > 1;
 413     $lineitems++;
 414
 415     # XXX shared with $recur_prog
 416     $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
 417     $sdate = $cust_pkg->lastbill || $backbill if $backbill;
 418
 419     #over two params!  lets at least switch to a hashref for the rest...
 420     my $increment_next_bill = ( $part_pkg->freq ne '0'
 421                                 && ( $cust_pkg->getfield('bill') || 0 ) <= $time
 422                               );
 423     my %param = ( 'precommit_hooks'     => $precommit_hooks,
 424                   'increment_next_bill' => $increment_next_bill,
 425                 );
 426
 427     $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
 428     return "$@ running calc_recur for $cust_pkg\n"
 429       if ( $@ );
 430
 431
 432     warn "details is now: \n" if $DEBUG > 2;
 433     warn Dumper(\@details) if $DEBUG > 2;
 434
 435     if ( $increment_next_bill ) {
 436
 437       my $next_bill = $part_pkg->add_freq($sdate);
 438       return "unparsable frequency: ". $part_pkg->freq
 439         if $next_bill == -1;
 440
 441       #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
 442       # only for figuring next bill date, nothing else, so, reset $sdate again
 443       # here
 444       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
 445       $sdate = $cust_pkg->lastbill || $backbill if $backbill;
 446       #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
 447       $cust_pkg->last_bill($sdate);
 448
 449       $cust_pkg->setfield('bill', $next_bill );
 450
 451     }
 452
 453   }
 454
 455   warn "\$setup is undefined" unless defined($setup);
 456   warn "\$recur is undefined" unless defined($recur);
 457   warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
 458
 459   ###
 460   # If there's line items, create em cust_bill_pkg records
 461   # If $cust_pkg has been modified, update it (if we're a real pkgpart)
 462   ###
 463
 464   if ( $lineitems ) {
 465
 466     if ( !$backbill && $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
 467       # hmm.. and if just the options are modified in some weird price plan?
 468
 469       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n"
 470         if $DEBUG >1;
 471
 472       my $error = $cust_pkg->replace( $old_cust_pkg,
 473                                       'options' => { $cust_pkg->options },
 474                                     );
 475       return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
 476         if $error; #just in case
 477     }
 478
 479     my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
 480     if ( $DEBUG > 1 ) {
 481       warn "      tentatively adding customer package invoice detail: $_\n"
 482         foreach @cust_pkg_detail;
 483     }
 484     push @details, @cust_pkg_detail;
 485
 486     $setup = sprintf( "%.2f", $setup );
 487     $recur = sprintf( "%.2f", $recur );
 488     my $cust_bill_pkg = new FS::cust_bill_pkg {
 489       'pkgnum'    => $cust_pkg->pkgnum,
 490       'setup'     => $setup,
 491       'unitsetup' => $unitsetup,
 492       'recur'     => $recur,
 493       'unitrecur' => $unitrecur,
 494       'quantity'  => $cust_pkg->quantity,
 495       'details'   => \@details,
 496     };
 497
 498     warn "created cust_bill_pkg which looks like:\n" if $DEBUG > 2;
 499     warn Dumper($cust_bill_pkg) if $DEBUG > 2;
 500     if ($backbill) {
 501       my %usage_cust_bill_pkg = $cust_bill_pkg->disintegrate;
 502       $recur = 0;
 503       foreach my $key (keys %usage_cust_bill_pkg) {
 504         next if ($key eq 'setup' || $key eq 'recur');
 505         $recur += $usage_cust_bill_pkg{$key}->recur;
 506       }
 507       $setup = 0;
 508     }
 509
 510     $setup = sprintf( "%.2f", $setup );
 511     $recur = sprintf( "%.2f", $recur );
 512     if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
 513       return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
 514     }
 515     if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
 516       return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
 517     }
 518
 519
 520     if ( $setup != 0 || $recur != 0 ) {
 521
 522       warn "    charges (setup=$setup, recur=$recur); adding line items\n"
 523         if $DEBUG > 1;
 524
 525       $cust_bill_pkg->setup($setup);
 526       $cust_bill_pkg->recur($recur);
 527
 528       warn "cust_bill_pkg now looks like:\n" if $DEBUG > 2;
 529       warn Dumper($cust_bill_pkg) if $DEBUG > 2;
 530
 531       if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
 532         $cust_bill_pkg->sdate( $hash{last_bill} );
 533         $cust_bill_pkg->edate( $sdate - 86399   ); #60s*60m*24h-1
 534       } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
 535         $cust_bill_pkg->sdate( $sdate );
 536         $cust_bill_pkg->edate( $cust_pkg->bill );
 537       }
 538
 539       $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
 540         unless $part_pkg->pkgpart == $real_pkgpart;
 541
 542       $$total_setup += $setup;
 543       $$total_recur += $recur;
 544
 545       ###
 546       # handle taxes
 547       ###
 548
 549       my $error =
 550         $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time});
 551       return $error if $error;
 552
 553       push @$cust_bill_pkgs, $cust_bill_pkg;
 554
 555     } #if $setup != 0 || $recur != 0
 556
 557   } #if $line_items
 558
 559   '';
 560
 561 }
 562
 563
 564 sub _gather_taxes {
 565   my $self = shift;
 566   my $part_pkg = shift;
 567   my $class = shift;
 568
 569   my @taxes = ();
 570   my $geocode = $self->geocode('cch');
 571
 572   my @taxclassnums = map { $_->taxclassnum }
 573                      $part_pkg->part_pkg_taxoverride($class);
 574
 575   unless (@taxclassnums) {
 576     @taxclassnums = map { $_->taxclassnum }
 577                     $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
 578   }
 579   warn "Found taxclassnum values of ". join(',', @taxclassnums)
 580     if $DEBUG;
 581
 582   my $extra_sql =
 583     "AND (".
 584     join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
 585
 586   @taxes = grep { ($_->fee  || 0 ) == 0 }   #ignore unit based taxes
 587            qsearch({ 'table' => 'tax_rate',
 588                      'hashref' => { 'geocode' => $geocode, },
 589                      'extra_sql' => $extra_sql,
 590                   })
 591     if scalar(@taxclassnums);
 592
 593   warn "Found taxes ".
 594        join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
 595    if $DEBUG;
 596
 597   [ @taxes ];
 598
 599 }
 600
 601
 602 =back
 603
 604
 605 =cut
 606
 607 1;
 608