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 $payable = $self->cust_bill_pkg->payable($self->setuprecur);
 107   my $taxable = $self->_is_taxable ? $payable : 0;
 108   my $part_pkg = $self->cust_bill_pkg->part_pkg;
 109   my $freq = $part_pkg ? $part_pkg->freq || 1 : 1;# assume unchanged
 110   my $taxable_per_month = sprintf("%.2f", $taxable / $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 = 'taxnum,year,month';
 115     my $sum = 'SUM(amount)';
 116     my @exemptions = qsearch(
 117       {
 118         'select'    => "$groupby, $sum AS amount",
 119         'table'     => 'cust_tax_exempt_pkg',
 120         'hashref'   => { billpkgnum => $self->billpkgnum },
 121         'extra_sql' => "GROUP BY $groupby HAVING $sum > 0",
 122       }
 123     );
 124     foreach my $exemption ( @exemptions ) {
 125       next if $taxable_per_month >= $exemption->amount;
 126       my $amount = $exemption->amount - $taxable_per_month;
 127       if ($amount > $credit_per_month) {
 128              "cust_bill_pkg ". $self->billpkgnum. "  Reducing.\n";
 129         $amount = $credit_per_month;
 130       }
 131       my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg {
 132         'billpkgnum'       => $self->billpkgnum,
 133         'creditbillpkgnum' => $self->creditbillpkgnum,
 134         'amount'           => 0-$amount,
 135         map { $_ => $exemption->$_ } split(',', $groupby)
 136       };
 137       my $error = $cust_tax_exempt_pkg->insert;
 138       if ( $error ) {
 139         $dbh->rollback if $oldAutoCommit;
 140         return "error inserting cust_tax_exempt_pkg: $error";
 141       }
 142     }
 143   }
 144
 145   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 146  '';
 147
 148 }
 149
 150 #helper functions for above
 151 sub _is_taxable {
 152   my $self = shift;
 153   my $part_pkg = $self->cust_bill_pkg->part_pkg;
 154
 155   return 0 unless $part_pkg; #XXX fails for tax on tax
 156
 157   my $method = $self->setuprecur. 'tax';
 158   return 0 if $part_pkg->$method =~ /^Y$/i;
 159
 160   if ($self->billpkgtaxlocationnum) {
 161     my $location_object = $self->cust_bill_pkg_tax_Xlocation;
 162     my $tax_object = $location_object->cust_main_county;
 163     return 0 if $tax_object && $self->tax_object->$method =~ /^Y$/i;
 164   } #elsif ($self->billpkgtaxratelocationnum) { ... }
 165
 166   1;
 167 }
 168
 169 =item delete
 170
 171 Delete this record from the database.
 172
 173 =cut
 174
 175 sub delete {
 176   my $self = shift;
 177
 178   local $SIG{HUP} = 'IGNORE';
 179   local $SIG{INT} = 'IGNORE';
 180   local $SIG{QUIT} = 'IGNORE';
 181   local $SIG{TERM} = 'IGNORE';
 182   local $SIG{TSTP} = 'IGNORE';
 183   local $SIG{PIPE} = 'IGNORE';
 184
 185   my $oldAutoCommit = $FS::UID::AutoCommit;
 186   local $FS::UID::AutoCommit = 0;
 187   my $dbh = dbh;
 188
 189   my $original_cust_bill_pkg = $self->cust_bill_pkg;
 190   my $cust_bill = $original_cust_bill_pkg->cust_bill;
 191
 192   my %hash = $original_cust_bill_pkg->hash;
 193   delete $hash{$_} for qw( billpkgnum setup recur );
 194   $hash{$self->setuprecur} = $self->amount;
 195   my $cust_bill_pkg = new FS::cust_bill_pkg { %hash };
 196
 197   use Data::Dumper;
 198   my @exemptions = qsearch( 'cust_tax_exempt_pkg',
 199                             { creditbillpkgnum => $self->creditbillpkgnum }
 200                           );
 201   my %seen = ();
 202   my @generated_exemptions = ();
 203   my @unseen_exemptions = ();
 204   foreach my $exemption ( @exemptions ) {
 205     my $error = $exemption->delete;
 206     if ( $error ) {
 207       $dbh->rollback if $oldAutoCommit;
 208       return "error deleting cust_tax_exempt_pkg: $error";
 209     }
 210
 211     next if $seen{$exemption->taxnum};
 212     $seen{$exemption->taxnum} = 1;
 213     push @unseen_exemptions, $exemption;
 214   }
 215
 216   foreach my $exemption ( @unseen_exemptions ) {
 217     my $tax_object = $exemption->cust_main_county;
 218     unless ($tax_object) {
 219       $dbh->rollback if $oldAutoCommit;
 220       return "can't find exempted tax";
 221     }
 222
 223     my $hashref_or_error =
 224       $tax_object->taxline( [ $cust_bill_pkg ],
 225                             'custnum'      => $cust_bill->custnum,
 226                             'invoice_time' => $cust_bill->_date,
 227                           );
 228     unless (ref($hashref_or_error)) {
 229       $dbh->rollback if $oldAutoCommit;
 230       return "error calculating taxes: $hashref_or_error";
 231     }
 232
 233     push @generated_exemptions, @{ $cust_bill_pkg->_cust_tax_exempt_pkg || [] };
 234   }
 235
 236   foreach my $taxnum ( keys %seen ) {
 237     my $sum = 0;
 238     $sum += $_->amount for grep {$_->taxnum == $taxnum} @exemptions;
 239     $sum -= $_->amount for grep {$_->taxnum == $taxnum} @generated_exemptions;
 240     $sum = sprintf("%.2f", $sum);
 241     unless ($sum eq '0.00' || $sum eq '-0.00') {
 242       $dbh->rollback if $oldAutoCommit;
 243       return "Can't unapply credit without charging tax";
 244     }
 245   }
 246
 247   my $error = $self->SUPER::delete(@_);
 248   if ( $error ) {
 249     $dbh->rollback if $oldAutoCommit;
 250     return $error;
 251   }
 252
 253   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 254
 255   '';
 256
 257 }
 258
 259 =item replace OLD_RECORD
 260
 261 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 262 returns the error, otherwise returns false.
 263
 264 =cut
 265
 266 # the replace method can be inherited from FS::Record
 267
 268 =item check
 269
 270 Checks all fields to make sure this is a valid credit applicaiton.  If there is
 271 an error, returns the error, otherwise returns false.  Called by the insert
 272 and replace methods.
 273
 274 =cut
 275
 276 # the check method should currently be supplied - FS::Record contains some
 277 # data checking routines
 278
 279 sub check {
 280   my $self = shift;
 281
 282   my $error =
 283     $self->ut_numbern('creditbillpkgnum')
 284     || $self->ut_foreign_key('creditbillnum', 'cust_credit_bill', 'creditbillnum')
 285     || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg', 'billpkgnum' )
 286     || $self->ut_foreign_keyn('billpkgtaxlocationnum',
 287                               'cust_bill_pkg_tax_location',
 288                               'billpkgtaxlocationnum')
 289     || $self->ut_foreign_keyn('billpkgtaxratelocationnum',
 290                               'cust_bill_pkg_tax_rate_location',
 291                               'billpkgtaxratelocationnum')
 292     || $self->ut_money('amount')
 293     || $self->ut_enum('setuprecur', [ 'setup', 'recur' ] )
 294     || $self->ut_numbern('sdate')
 295     || $self->ut_numbern('edate')
 296   ;
 297   return $error if $error;
 298
 299   $self->SUPER::check;
 300 }
 301
 302 sub cust_credit_bill {
 303   my $self = shift;
 304   qsearchs('cust_credit_bill', { 'creditbillnum' => $self->creditbillnum } );
 305 }
 306
 307 sub cust_bill_pkg {
 308   my $self = shift;
 309   qsearchs('cust_bill_pkg', { 'billpkgnum' => $self->billpkgnum } );
 310 }
 311
 312 sub cust_bill_pkg_tax_Xlocation {
 313   my $self = shift;
 314   if ($self->billpkg_tax_locationnum) {
 315     return qsearchs(
 316       'cust_bill_pkg_tax_location',
 317       { 'billpkgtaxlocationnum' => $self->billpkgtaxlocationnum },
 318     );
 319
 320   } elsif ($self->billpkg_tax_rate_locationnum) {
 321     return qsearchs(
 322       'cust_bill_pkg_tax_rate_location',
 323       { 'billpkgtaxratelocationnum' => $self->billpkgtaxratelocationnum },
 324     );
 325   } else {
 326     return undef;
 327   }
 328 }
 329
 330 =back
 331
 332 =head1 BUGS
 333
 334 B<setuprecur> field is a kludge to compensate for cust_bill_pkg having separate
 335 setup and recur fields.  It should be removed once that's fixed.
 336
 337 B<insert> method assumes that the frequency of the package associated with the
 338 associated line item remains unchanged during the lifetime of the system.
 339 It may get the tax exemption adjustments wrong if package definitions change
 340 frequency.  The presense of delete methods in FS::cust_main_county and
 341 FS::tax_rate makes crediting of old "texas tax" unreliable in the presense of
 342 changing taxes.  Explicit tax credit requests?  Carry 'taxable' onto line
 343 items?
 344
 345 =head1 SEE ALSO
 346
 347 L<FS::Record>, schema.html from the base documentation.
 348
 349 =cut
 350
 351 1;
 352