FS/FS/cust_credit_bill_pkg.pm

   1 package FS::cust_credit_bill_pkg;
   2
   3 use strict;
   4 use vars qw( @ISA );
   5 use FS::Record qw( qsearch qsearchs dbh );
   6 use FS::cust_main_Mixin;
   7 use FS::cust_credit_bill;
   8 use FS::cust_bill_pkg;
   9 use FS::cust_bill_pkg_tax_location;
  10 use FS::cust_bill_pkg_tax_rate_location;
  11 use FS::cust_tax_exempt_pkg;
  12
  13 @ISA = qw( FS::cust_main_Mixin FS::Record );
  14
  15 =head1 NAME
  16
  17 FS::cust_credit_bill_pkg - Object methods for cust_credit_bill_pkg records
  18
  19 =head1 SYNOPSIS
  20
  21   use FS::cust_credit_bill_pkg;
  22
  23   $record = new FS::cust_credit_bill_pkg \%hash;
  24   $record = new FS::cust_credit_bill_pkg { 'column' => 'value' };
  25
  26   $error = $record->insert;
  27
  28   $error = $new_record->replace($old_record);
  29
  30   $error = $record->delete;
  31
  32   $error = $record->check;
  33
  34 =head1 DESCRIPTION
  35
  36 An FS::cust_credit_bill_pkg object represents application of a credit (see
  37 L<FS::cust_credit_bill>) to a specific line item within an invoice
  38 (see L<FS::cust_bill_pkg>).  FS::cust_credit_bill_pkg inherits from FS::Record.
  39 The following fields are currently supported:
  40
  41 =over 4
  42
  43 =item creditbillpkgnum -  primary key
  44
  45 =item creditbillnum - Credit application to the overall invoice (see L<FS::cust_credit::bill>)
  46
  47 =item billpkgnum - Line item to which credit is applied (see L<FS::cust_bill_pkg>)
  48
  49 =item amount - Amount of the credit applied to this line item.
  50
  51 =item setuprecur - 'setup' or 'recur', designates whether the payment was applied to the setup or recurring portion of the line item.
  52
  53 =item sdate - starting date of recurring fee
  54
  55 =item edate - ending date of recurring fee
  56
  57 =back
  58
  59 sdate and edate are specified as UNIX timestamps; see L<perlfunc/"time">.  Also
  60 see L<Time::Local> and L<Date::Parse> for conversion functions.
  61
  62 =head1 METHODS
  63
  64 =over 4
  65
  66 =item new HASHREF
  67
  68 Creates a new example.  To add the example to the database, see L<"insert">.
  69
  70 Note that this stores the hash reference, not a distinct copy of the hash it
  71 points to.  You can ask the object for a copy with the I<hash> method.
  72
  73 =cut
  74
  75 # the new method can be inherited from FS::Record, if a table method is defined
  76
  77 sub table { 'cust_credit_bill_pkg'; }
  78
  79 =item insert
  80
  81 Adds this record to the database.  If there is an error, returns the error,
  82 otherwise returns false.
  83
  84 =cut
  85
  86 sub insert {
  87   my $self = shift;
  88
  89   local $SIG{HUP} = 'IGNORE';
  90   local $SIG{INT} = 'IGNORE';
  91   local $SIG{QUIT} = 'IGNORE';
  92   local $SIG{TERM} = 'IGNORE';
  93   local $SIG{TSTP} = 'IGNORE';
  94   local $SIG{PIPE} = 'IGNORE';
  95
  96   my $oldAutoCommit = $FS::UID::AutoCommit;
  97   local $FS::UID::AutoCommit = 0;
  98   my $dbh = dbh;
  99
 100   my $error = $self->SUPER::insert;
 101   if ( $error ) {
 102     $dbh->rollback if $oldAutoCommit;
 103     return $error;
 104   }
 105
 106   my $cust_bill_pkg = $self->cust_bill_pkg;
 107   #'payable' is the amount charged (either setup or recur)
 108   # minus any credit applications, including this one
 109   my $payable = $cust_bill_pkg->payable($self->setuprecur);
 110   my $part_pkg = $cust_bill_pkg->part_pkg;
 111   my $freq = $cust_bill_pkg->freq;
 112   unless ($freq) {
 113     $freq = $part_pkg ? ($part_pkg->freq || 1) : 1;#fallback.. assumes unchanged
 114   }
 115   my $taxable_per_month = sprintf("%.2f", $payable / $freq );
 116   my $credit_per_month = sprintf("%.2f", $self->amount / $freq ); #pennies?
 117
 118   if ($taxable_per_month >= 0) {  #panic if its subzero?
 119     my $groupby = join(',',
 120       qw(taxnum year month exempt_monthly exempt_cust
 121          exempt_cust_taxname exempt_setup exempt_recur));
 122     my $sum = 'SUM(amount)';
 123     my @exemptions = qsearch(
 124       {
 125         'select'    => "$groupby, $sum AS amount",
 126         'table'     => 'cust_tax_exempt_pkg',
 127         'hashref'   => { billpkgnum => $self->billpkgnum },
 128         'extra_sql' => "GROUP BY $groupby HAVING $sum > 0",
 129       }
 130     );
 131     # each $exemption is now the sum of all monthly exemptions applied to
 132     # this line item for a particular taxnum and month.
 133     foreach my $exemption ( @exemptions ) {
 134       my $amount = 0;
 135       if ( $exemption->exempt_monthly ) {
 136         # finite exemptions
 137         # $taxable_per_month is AFTER inserting the credit application, so
 138         # if it's still larger than the exemption, we don't need to adjust
 139         next if $taxable_per_month >= $exemption->amount;
 140         # the amount of 'excess' exemption already in place (above the
 141         # remaining charged amount).  We'll de-exempt that much, or the
 142         # amount of the new credit, whichever is smaller.
 143         $amount = $exemption->amount - $taxable_per_month;
 144         # $amount is the amount of 'excess' exemption already existing
 145         # (above the remaining taxable charge amount).  We'll "de-exempt"
 146         # that much, or the amount of the new credit, whichever is smaller.
 147         if ($amount > $credit_per_month) {
 148                "cust_bill_pkg ". $self->billpkgnum. "  Reducing.\n";
 149           $amount = $credit_per_month;
 150         }
 151       } elsif ( $exemption->exempt_setup or $exemption->exempt_recur ) {
 152         # package defined exemptions: may be setup only, recur only, or both
 153         my $method = 'exempt_'.$self->setuprecur;
 154         if ( $exemption->$method ) {
 155           # then it's exempt from the portion of the charge that this
 156           # credit is being applied to
 157           $amount = $self->amount;
 158         }
 159       } else {
 160         # other types of exemptions: always equal to the amount of
 161         # the charge
 162         $amount = $self->amount;
 163       }
 164       next if $amount == 0;
 165
 166       # create a negative exemption
 167       my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg {
 168          $exemption->hash, # for exempt_ flags, taxnum, month/year
 169         'billpkgnum'       => $self->billpkgnum,
 170         'creditbillpkgnum' => $self->creditbillpkgnum,
 171         'amount'           => sprintf('%.2f', 0-$amount),
 172       };
 173
 174       my $error = $cust_tax_exempt_pkg->insert;
 175       if ( $error ) {
 176         $dbh->rollback if $oldAutoCommit;
 177         return "error inserting cust_tax_exempt_pkg: $error";
 178       }
 179     } #foreach $exemption
 180   }
 181
 182   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 183  '';
 184
 185 }
 186
 187 #helper functions for above
 188 sub _is_taxable {
 189   my $self = shift;
 190   my $part_pkg = $self->cust_bill_pkg->part_pkg;
 191
 192   return 0 unless $part_pkg; #XXX fails for tax on tax
 193
 194   my $method = $self->setuprecur. 'tax';
 195   return 0 if $part_pkg->$method =~ /^Y$/i;
 196
 197   if ($self->billpkgtaxlocationnum) {
 198     my $location_object = $self->cust_bill_pkg_tax_Xlocation;
 199     my $tax_object = $location_object->cust_main_county;
 200     return 0 if $tax_object && $self->tax_object->$method =~ /^Y$/i;
 201   } #elsif ($self->billpkgtaxratelocationnum) { ... }
 202
 203   1;
 204 }
 205
 206 =item delete
 207
 208 Delete this record from the database.
 209
 210 =cut
 211
 212 sub delete {
 213   my $self = shift;
 214
 215   local $SIG{HUP} = 'IGNORE';
 216   local $SIG{INT} = 'IGNORE';
 217   local $SIG{QUIT} = 'IGNORE';
 218   local $SIG{TERM} = 'IGNORE';
 219   local $SIG{TSTP} = 'IGNORE';
 220   local $SIG{PIPE} = 'IGNORE';
 221
 222   my $oldAutoCommit = $FS::UID::AutoCommit;
 223   local $FS::UID::AutoCommit = 0;
 224   my $dbh = dbh;
 225
 226   my $original_cust_bill_pkg = $self->cust_bill_pkg;
 227   my $cust_bill = $original_cust_bill_pkg->cust_bill;
 228
 229   my %hash = $original_cust_bill_pkg->hash;
 230   delete $hash{$_} for qw( billpkgnum setup recur );
 231   $hash{$self->setuprecur} = $self->amount;
 232   my $cust_bill_pkg = new FS::cust_bill_pkg { %hash };
 233
 234   use Data::Dumper;
 235   my @exemptions = qsearch( 'cust_tax_exempt_pkg',
 236                             { creditbillpkgnum => $self->creditbillpkgnum }
 237                           );
 238   my %seen = ();
 239   my @generated_exemptions = ();
 240   my @unseen_exemptions = ();
 241   foreach my $exemption ( @exemptions ) {
 242     my $error = $exemption->delete;
 243     if ( $error ) {
 244       $dbh->rollback if $oldAutoCommit;
 245       return "error deleting cust_tax_exempt_pkg: $error";
 246     }
 247
 248     next if $seen{$exemption->taxnum};
 249     $seen{$exemption->taxnum} = 1;
 250     push @unseen_exemptions, $exemption;
 251   }
 252
 253   foreach my $exemption ( @unseen_exemptions ) {
 254     my $tax_object = $exemption->cust_main_county;
 255     unless ($tax_object) {
 256       $dbh->rollback if $oldAutoCommit;
 257       return "can't find exempted tax";
 258     }
 259
 260     my $hashref_or_error =
 261       $tax_object->taxline( [ $cust_bill_pkg ],
 262                             'custnum'      => $cust_bill->custnum,
 263                             'invoice_time' => $cust_bill->_date,
 264                           );
 265     unless (ref($hashref_or_error)) {
 266       $dbh->rollback if $oldAutoCommit;
 267       return "error calculating taxes: $hashref_or_error";
 268     }
 269
 270     push @generated_exemptions, @{ $cust_bill_pkg->cust_tax_exempt_pkg };
 271   }
 272
 273   foreach my $taxnum ( keys %seen ) {
 274     my $sum = 0;
 275     $sum += $_->amount for grep {$_->taxnum == $taxnum} @exemptions;
 276     $sum -= $_->amount for grep {$_->taxnum == $taxnum} @generated_exemptions;
 277     $sum = sprintf("%.2f", $sum);
 278     unless ($sum eq '0.00' || $sum eq '-0.00') {
 279       $dbh->rollback if $oldAutoCommit;
 280       return "Can't unapply credit without charging tax of $sum";
 281     }
 282   }
 283
 284   my $error = $self->SUPER::delete(@_);
 285   if ( $error ) {
 286     $dbh->rollback if $oldAutoCommit;
 287     return $error;
 288   }
 289
 290   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 291
 292   '';
 293
 294 }
 295
 296 =item replace OLD_RECORD
 297
 298 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 299 returns the error, otherwise returns false.
 300
 301 =cut
 302
 303 # the replace method can be inherited from FS::Record
 304
 305 =item check
 306
 307 Checks all fields to make sure this is a valid credit applicaiton.  If there is
 308 an error, returns the error, otherwise returns false.  Called by the insert
 309 and replace methods.
 310
 311 =cut
 312
 313 # the check method should currently be supplied - FS::Record contains some
 314 # data checking routines
 315
 316 sub check {
 317   my $self = shift;
 318
 319   my $error =
 320     $self->ut_numbern('creditbillpkgnum')
 321     || $self->ut_foreign_key('creditbillnum', 'cust_credit_bill', 'creditbillnum')
 322     || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg', 'billpkgnum' )
 323     || $self->ut_foreign_keyn('billpkgtaxlocationnum',
 324                               'cust_bill_pkg_tax_location',
 325                               'billpkgtaxlocationnum')
 326     || $self->ut_foreign_keyn('billpkgtaxratelocationnum',
 327                               'cust_bill_pkg_tax_rate_location',
 328                               'billpkgtaxratelocationnum')
 329     || $self->ut_money('amount')
 330     || $self->ut_enum('setuprecur', [ 'setup', 'recur' ] )
 331     || $self->ut_numbern('sdate')
 332     || $self->ut_numbern('edate')
 333   ;
 334   return $error if $error;
 335
 336   $self->SUPER::check;
 337 }
 338
 339 sub cust_credit_bill {
 340   my $self = shift;
 341   qsearchs('cust_credit_bill', { 'creditbillnum' => $self->creditbillnum } );
 342 }
 343
 344 sub cust_bill_pkg {
 345   my $self = shift;
 346   qsearchs('cust_bill_pkg', { 'billpkgnum' => $self->billpkgnum } );
 347 }
 348
 349 sub cust_bill_pkg_tax_Xlocation {
 350   my $self = shift;
 351   if ($self->billpkg_tax_locationnum) {
 352     return qsearchs(
 353       'cust_bill_pkg_tax_location',
 354       { 'billpkgtaxlocationnum' => $self->billpkgtaxlocationnum },
 355     );
 356
 357   } elsif ($self->billpkg_tax_rate_locationnum) {
 358     return qsearchs(
 359       'cust_bill_pkg_tax_rate_location',
 360       { 'billpkgtaxratelocationnum' => $self->billpkgtaxratelocationnum },
 361     );
 362   } else {
 363     return undef;
 364   }
 365 }
 366
 367 =back
 368
 369 =head1 BUGS
 370
 371 B<setuprecur> field is a kludge to compensate for cust_bill_pkg having separate
 372 setup and recur fields.  It should be removed once that's fixed.
 373
 374 B<insert> method used to assume that the frequency of the package associated
 375 with the associated line item remained unchanged during the lifetime of the
 376 system.  That is still used as a fallback.  It may get the tax exemption
 377 adjustments wrong if package definitions change frequency.  The presense of
 378 delete methods in FS::cust_main_county and FS::tax_rate makes crediting of
 379 old "texas tax" unreliable in the presense of changing taxes.  Explicit tax
 380 credit requests?  Carry 'taxable' onto line items?
 381
 382 =head1 SEE ALSO
 383
 384 L<FS::Record>, schema.html from the base documentation.
 385
 386 =cut
 387
 388 1;
 389