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