FS/FS/cust_credit_bill_pkg.pm

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