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 @negative_exemptions = qsearch('cust_tax_exempt_pkg', {
 227       'creditbillpkgnum' => $self->creditbillpkgnum
 228   });
 229
 230   # de-anti-exempt those negative exemptions
 231   my $error;
 232   foreach (@negative_exemptions) {
 233     $error = $_->delete;
 234     if ( $error ) {
 235       $dbh->rollback if $oldAutoCommit;
 236       return $error;
 237     }
 238   }
 239
 240   $error = $self->SUPER::delete(@_);
 241   if ( $error ) {
 242     $dbh->rollback if $oldAutoCommit;
 243     return $error;
 244   }
 245
 246   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 247
 248   '';
 249
 250 }
 251
 252 =item replace OLD_RECORD
 253
 254 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 255 returns the error, otherwise returns false.
 256
 257 =cut
 258
 259 # the replace method can be inherited from FS::Record
 260
 261 =item check
 262
 263 Checks all fields to make sure this is a valid credit applicaiton.  If there is
 264 an error, returns the error, otherwise returns false.  Called by the insert
 265 and replace methods.
 266
 267 =cut
 268
 269 # the check method should currently be supplied - FS::Record contains some
 270 # data checking routines
 271
 272 sub check {
 273   my $self = shift;
 274
 275   my $error =
 276     $self->ut_numbern('creditbillpkgnum')
 277     || $self->ut_foreign_key('creditbillnum', 'cust_credit_bill', 'creditbillnum')
 278     || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg', 'billpkgnum' )
 279     || $self->ut_foreign_keyn('billpkgtaxlocationnum',
 280                               'cust_bill_pkg_tax_location',
 281                               'billpkgtaxlocationnum')
 282     || $self->ut_foreign_keyn('billpkgtaxratelocationnum',
 283                               'cust_bill_pkg_tax_rate_location',
 284                               'billpkgtaxratelocationnum')
 285     || $self->ut_money('amount')
 286     || $self->ut_enum('setuprecur', [ 'setup', 'recur' ] )
 287     || $self->ut_numbern('sdate')
 288     || $self->ut_numbern('edate')
 289   ;
 290   return $error if $error;
 291
 292   $self->SUPER::check;
 293 }
 294
 295 sub cust_credit_bill {
 296   my $self = shift;
 297   qsearchs('cust_credit_bill', { 'creditbillnum' => $self->creditbillnum } );
 298 }
 299
 300 sub cust_bill_pkg {
 301   my $self = shift;
 302   qsearchs('cust_bill_pkg', { 'billpkgnum' => $self->billpkgnum } );
 303 }
 304
 305 sub cust_bill_pkg_tax_Xlocation {
 306   my $self = shift;
 307   if ($self->billpkgtaxlocationnum) {
 308     return qsearchs(
 309       'cust_bill_pkg_tax_location',
 310       { 'billpkgtaxlocationnum' => $self->billpkgtaxlocationnum },
 311     );
 312
 313   } elsif ($self->billpkgtaxratelocationnum) {
 314     return qsearchs(
 315       'cust_bill_pkg_tax_rate_location',
 316       { 'billpkgtaxratelocationnum' => $self->billpkgtaxratelocationnum },
 317     );
 318   } else {
 319     return undef;
 320   }
 321 }
 322
 323 =back
 324
 325 =head1 BUGS
 326
 327 B<setuprecur> field is a kludge to compensate for cust_bill_pkg having separate
 328 setup and recur fields.  It should be removed once that's fixed.
 329
 330 B<insert> method used to assume that the frequency of the package associated
 331 with the associated line item remained unchanged during the lifetime of the
 332 system.  That is still used as a fallback.  It may get the tax exemption
 333 adjustments wrong if package definitions change frequency.  The presense of
 334 delete methods in FS::cust_main_county and FS::tax_rate makes crediting of
 335 old "texas tax" unreliable in the presense of changing taxes.  Explicit tax
 336 credit requests?  Carry 'taxable' onto line items?
 337
 338 =head1 SEE ALSO
 339
 340 L<FS::Record>, schema.html from the base documentation.
 341
 342 =cut
 343
 344 1;
 345