[freeside-commits] freeside/FS/FS part_pkg_discount.pm, NONE, 1.1 Conf.pm, 1.385, 1.386 Mason.pm, 1.53, 1.54 Schema.pm, 1.233, 1.234 cust_bill.pm, 1.293, 1.294 cust_credit_bill_pkg.pm, 1.7, 1.8 cust_main_county.pm, 1.24, 1.25 cust_pay.pm, 1.86, 1.87 cust_pkg.pm, 1.170, 1.171 discount.pm, 1.4, 1.5 part_pkg.pm, 1.107, 1.108

Jeff Finucane,420,, jeff at wavetail.420.am
Wed Sep 22 12:16:20 PDT 2010


Update of /home/cvs/cvsroot/freeside/FS/FS
In directory wavetail.420.am:/tmp/cvs-serv19099/FS/FS

Modified Files:
	Conf.pm Mason.pm Schema.pm cust_bill.pm 
	cust_credit_bill_pkg.pm cust_main_county.pm cust_pay.pm 
	cust_pkg.pm discount.pm part_pkg.pm 
Added Files:
	part_pkg_discount.pm 
Log Message:
prepayment discounts rt#5318

Index: cust_pay.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_pay.pm,v
retrieving revision 1.86
retrieving revision 1.87
diff -u -w -d -r1.86 -r1.87
--- cust_pay.pm	19 Sep 2010 05:55:09 -0000	1.86
+++ cust_pay.pm	22 Sep 2010 19:16:17 -0000	1.87
@@ -141,6 +141,10 @@
 is defined, an FS::cust_bill_pay record for the full amount of the payment
 will be created.  In this case, custnum is optional.
 
+If the additional field discount_term is defined then a prepayment discount
+is taken for that length of time.  It is an error for the customer to owe
+after this payment is made.
+
 A hash of optional arguments may be passed.  Currently "manual" is supported.
 If true, a payment receipt is sent instead of a statement when
 'payment_receipt_email' configuration option is set.
@@ -183,6 +187,51 @@
     return "error inserting cust_pay: $error";
   }
 
+  if ( my $credit_type = $conf->config('prepayment_discounts-credit_type') ) {
+    if ( my $months = $self->discount_term ) {
+      #hmmm... error handling
+      my ($credit, $savings, $total) = 
+        $cust_main->discount_term_values($months);
+      my $cust_credit = new FS::cust_credit {
+        'custnum' => $self->custnum,
+        'amount'  => $credit,
+        'reason'  => 'customer chose to prepay for discount',
+      };
+      $error = $cust_credit->insert('reason_type' => $credit_type);
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "error inserting cust_pay: $error";
+      }
+      my @pkgs = $cust_main->_discount_pkgs_and_bill;
+      my $cust_bill = shift(@pkgs);
+      @pkgs = &FS::cust_main::Billing::_discountable_pkgs_at_term($months, @pkgs);
+      $_->bill($_->last_bill) foreach @pkgs;
+      $error = $cust_main->bill( 
+        'recurring_only' => 1,
+        'time'           => $cust_bill->invoice_date,
+        'no_usage_reset' => 1,
+        'pkg_list'       => \@pkgs,
+        'freq_override'   => $months,
+      );
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "error inserting cust_pay: $error";
+      }
+      $error = $cust_main->apply_payments_and_credits;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "error inserting cust_pay: $error";
+      }
+      my $new_balance = $cust_main->balance;
+      if ($new_balance > 0) {
+        $dbh->rollback if $oldAutoCommit;
+        return "balance after prepay discount attempt: $new_balance";
+      }
+      
+    }
+
+  }
+
   if ( $self->invnum ) {
     my $cust_bill_pay = new FS::cust_bill_pay {
       'invnum' => $self->invnum,
@@ -388,6 +437,7 @@
     || $self->ut_enum('closed', [ '', 'Y' ])
     || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
     || $self->payinfo_check()
+    || $self->ut_numbern('discount_term')
   ;
   return $error if $error;
 
@@ -399,6 +449,9 @@
 
   $self->_date(time) unless $self->_date;
 
+  return "invalid discount_term"
+   if ($self->discount_term && $self->discount_term < 2);
+
 #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it
 #  # UNIQUE index should catch this too, without race conditions, but this
 #  # should give a better error message the other 99.9% of the time...

Index: Mason.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Mason.pm,v
retrieving revision 1.53
retrieving revision 1.54
diff -u -w -d -r1.53 -r1.54
--- Mason.pm	17 Sep 2010 23:32:33 -0000	1.53
+++ Mason.pm	22 Sep 2010 19:16:17 -0000	1.54
@@ -254,6 +254,7 @@
   use FS::msg_template;
   use FS::part_tag;
   use FS::acct_snarf;
+  use FS::part_pkg_discount;
   # Sammath Naur
 
   if ( $FS::Mason::addl_handler_use ) {

Index: cust_main_county.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_main_county.pm,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -w -d -r1.24 -r1.25
--- cust_main_county.pm	12 Oct 2009 01:45:12 -0000	1.24
+++ cust_main_county.pm	22 Sep 2010 19:16:17 -0000	1.25
@@ -256,7 +256,10 @@
       my ($mon,$year) =
         (localtime( $cust_bill_pkg->sdate || $invoice_date ) )[4,5];
       $mon++;
-      my $freq = $part_pkg->freq || 1;
+      my $freq = $cust_bill_pkg->freq;
+      unless ($freq) {
+        $freq = $part_pkg->freq || 1;  # less trustworthy fallback
+      }
       if ( $freq !~ /(\d+)$/ ) {
         $dbh->rollback if $oldAutoCommit;
         return "daily/weekly package definitions not (yet?)".

Index: cust_credit_bill_pkg.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_credit_bill_pkg.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -w -d -r1.7 -r1.8
--- cust_credit_bill_pkg.pm	10 Jul 2010 09:43:13 -0000	1.7
+++ cust_credit_bill_pkg.pm	22 Sep 2010 19:16:17 -0000	1.8
@@ -106,7 +106,10 @@
   my $payable = $self->cust_bill_pkg->payable($self->setuprecur);
   my $taxable = $self->_is_taxable ? $payable : 0;
   my $part_pkg = $self->cust_bill_pkg->part_pkg;
-  my $freq = $part_pkg ? $part_pkg->freq || 1 : 1;# assume unchanged
+  my $freq = $self->cust_bill_pkg->freq;
+  unless ($freq) {
+    $freq = $part_pkg ? ($part_pkg->freq || 1) : 1;#fallback.. assumes unchanged
+  }
   my $taxable_per_month = sprintf("%.2f", $taxable / $freq );
   my $credit_per_month = sprintf("%.2f", $self->amount / $freq ); #pennies?
 
@@ -334,13 +337,13 @@
 B<setuprecur> field is a kludge to compensate for cust_bill_pkg having separate
 setup and recur fields.  It should be removed once that's fixed.
 
-B<insert> method assumes that the frequency of the package associated with the
-associated line item remains unchanged during the lifetime of the system.
-It may get the tax exemption adjustments wrong if package definitions change
-frequency.  The presense of delete methods in FS::cust_main_county and
-FS::tax_rate makes crediting of old "texas tax" unreliable in the presense of
-changing taxes.  Explicit tax credit requests?  Carry 'taxable' onto line
-items?
+B<insert> method used to assume that the frequency of the package associated
+with the associated line item remained unchanged during the lifetime of the
+system.  That is still used as a fallback.  It may get the tax exemption
+adjustments wrong if package definitions change frequency.  The presense of
+delete methods in FS::cust_main_county and FS::tax_rate makes crediting of
+old "texas tax" unreliable in the presense of changing taxes.  Explicit tax
+credit requests?  Carry 'taxable' onto line items?
 
 =head1 SEE ALSO
 

Index: cust_pkg.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_pkg.pm,v
retrieving revision 1.170
retrieving revision 1.171
diff -u -w -d -r1.170 -r1.171
--- cust_pkg.pm	9 Sep 2010 00:35:29 -0000	1.170
+++ cust_pkg.pm	22 Sep 2010 19:16:17 -0000	1.171
@@ -1371,6 +1371,18 @@
   $self->part_pkg->calc_recur($self, @_);
 }
 
+=item base_recur
+
+Calls the I<base_recur> of the FS::part_pkg object associated with this billing
+item.
+
+=cut
+
+sub base_recur {
+  my $self = shift;
+  $self->part_pkg->base_recur($self, @_);
+}
+
 =item calc_remain
 
 Calls the I<calc_remain> of the FS::part_pkg object associated with this

--- NEW FILE: part_pkg_discount.pm ---
package FS::part_pkg_discount;

use strict;
use base qw( FS::Record );
use FS::Record qw( qsearch qsearchs );
use FS::discount;
use FS::part_pkg;

=head1 NAME

FS::part_pkg_discount - Object methods for part_pkg_discount records

=head1 SYNOPSIS

  use FS::part_pkg_discount;

  $record = new FS::part_pkg_discount \%hash;
  $record = new FS::part_pkg_discount { 'column' => 'value' };

  $error = $record->insert;

  $error = $new_record->replace($old_record);

  $error = $record->delete;

  $error = $record->check;

=head1 DESCRIPTION

An FS::part_pkg_discount object represents a link from a package definition
to a discount.  This permits discounts for lengthened terms.  FS::part_pkg_discount inherits from
FS::Record.  The following fields are currently supported:

=over 4

=item pkgdiscountnum

primary key

=item pkgpart

pkgpart

=item discountnum

discountnum


=back

=head1 METHODS

=over 4

=item new HASHREF

Creates a new part_pkg_discount.  To add the example to the database, see L<"insert">.

Note that this stores the hash reference, not a distinct copy of the hash it
points to.  You can ask the object for a copy with the I<hash> method.

=cut

sub table { 'part_pkg_discount'; }

=item insert

Adds this record to the database.  If there is an error, returns the error,
otherwise returns false.

=cut

=item delete

Delete this record from the database.

=cut

=item replace OLD_RECORD

Replaces the OLD_RECORD with this one in the database.  If there is an error,
returns the error, otherwise returns false.

=cut

=item check

Checks all fields to make sure this is a valid example.  If there is
an error, returns the error, otherwise returns false.  Called by the insert
and replace methods.

=cut

sub check {
  my $self = shift;

  my $error = 
    $self->ut_numbern('pkgdiscountnum')
    || $self->ut_number('pkgpart')
    || $self->ut_number('discountnum')
  ;
  return $error if $error;

  $self->SUPER::check;
}

=item discount

Returns the discount associated with this part_pkg_discount.

=cut

sub discount {
  my $self = shift;
  qsearch('discount', { 'discountnum' => $self->discountnum });
}

=back

=head1 BUGS

=head1 SEE ALSO

L<FS::Record>, schema.html from the base documentation.

=cut

1;


Index: Conf.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Conf.pm,v
retrieving revision 1.385
retrieving revision 1.386
diff -u -w -d -r1.385 -r1.386
--- Conf.pm	19 Sep 2010 05:50:28 -0000	1.385
+++ Conf.pm	22 Sep 2010 19:16:17 -0000	1.386
@@ -3162,6 +3162,26 @@
   },
 
   {
+    'key'         => 'prepayment_discounts-credit_type',
+    'section'     => 'billing',
+    'description' => 'Enables the offering of prepayment discounts and establishes the credit reason type.',
+    'type'        => 'select-sub',
+    'options_sub' => sub { require FS::Record;
+                           require FS::reason_type;
+                           map { $_->typenum => $_->type }
+                               FS::Record::qsearch('reason_type', { class=>'R' } );
+                         },
+    'option_sub'  => sub { require FS::Record;
+                           require FS::reason_type;
+                           my $reason_type = FS::Record::qsearchs(
+                             'reason_type', { 'typenum' => shift }
+                           );
+                           $reason_type ? $reason_type->type : '';
+                         },
+
+  },
+
+  {
     'key'         => 'cust_main-agent_custid-format',
     'section'     => '',
     'description' => 'Enables searching of various formatted values in cust_main.agent_custid',

Index: part_pkg.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/part_pkg.pm,v
retrieving revision 1.107
retrieving revision 1.108
diff -u -w -d -r1.107 -r1.108
--- part_pkg.pm	17 Sep 2010 20:19:41 -0000	1.107
+++ part_pkg.pm	22 Sep 2010 19:16:17 -0000	1.108
@@ -20,6 +20,7 @@
 use FS::part_pkg_taxoverride;
 use FS::part_pkg_taxproduct;
 use FS::part_pkg_link;
+use FS::part_pkg_discount;
 
 @ISA = qw( FS::m2m_Common FS::option_Common );
 $DEBUG = 0;
@@ -1126,6 +1127,18 @@
          } );
 }
 
+=item part_pkg_discount
+
+Returns the package to discount m2m records (see L<FS::part_pkg_discount>)
+for this package.
+
+=cut
+
+sub part_pkg_discount {
+  my $self = shift;
+  qsearch('part_pkg_discount', { 'pkgpart' => $self->pkgpart });
+}
+
 =item _rebless
 
 Reblesses the object into the FS::part_pkg::PLAN class (if available), where

Index: cust_bill.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_bill.pm,v
retrieving revision 1.293
retrieving revision 1.294
diff -u -w -d -r1.293 -r1.294
--- cust_bill.pm	18 Sep 2010 04:25:37 -0000	1.293
+++ cust_bill.pm	22 Sep 2010 19:16:17 -0000	1.294
@@ -162,6 +162,45 @@
 Adds this invoice to the database ("Posts" the invoice).  If there is an error,
 returns the error, otherwise returns false.
 
+=cut
+
+sub insert {
+  my $self = shift;
+  warn "$me insert called\n" if $DEBUG;
+
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  my $error = $self->SUPER::insert;
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  if ( $self->get('cust_bill_pkg') ) {
+    foreach my $cust_bill_pkg ( @{$self->get('cust_bill_pkg')} ) {
+      $cust_bill_pkg->invnum($self->invnum);
+      my $error = $cust_bill_pkg->insert;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "can't create invoice line item: $error";
+      }
+    }
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+
+}
+
 =item delete
 
 This method now works but you probably shouldn't use it.  Instead, apply a

Index: Schema.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Schema.pm,v
retrieving revision 1.233
retrieving revision 1.234
diff -u -w -d -r1.233 -r1.234
--- Schema.pm	17 Sep 2010 19:57:50 -0000	1.233
+++ Schema.pm	22 Sep 2010 19:16:17 -0000	1.234
@@ -570,6 +570,7 @@
         'itemdesc',         'varchar', 'NULL', $char_d, '', '', 
         'itemcomment',      'varchar', 'NULL', $char_d, '', '', 
         'section',          'varchar', 'NULL', $char_d, '', '', 
+        'freq',             'varchar', 'NULL', $char_d, '', '',
         'quantity',             'int', 'NULL',      '', '', '',
         'unitsetup',           @money_typen,            '', '', 
         'unitrecur',           @money_typen,            '', '', 
@@ -1512,6 +1513,17 @@
     # XXX somewhat borked unique: we don't really want a hidden and unhidden
     # it turns out we'd prefer to use svc, bill, and invisibill (or something)
 
+    'part_pkg_discount' => {
+      'columns' => [
+        'pkgdiscountnum', 'serial',   '',      '', '', '',
+        'pkgpart',        'int',      '',      '', '', '',
+        'discountnum',    'int',      '',      '', '', '', 
+      ],
+      'primary_key' => 'pkgdiscountnum',
+      'unique' => [ [ 'pkgpart', 'discountnum' ] ],
+      'index'  => [],
+    },
+
     'part_pkg_taxclass' => {
       'columns' => [
         'taxclassnum',  'serial', '',       '', '', '',

Index: discount.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/discount.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -d -r1.4 -r1.5
--- discount.pm	5 Feb 2010 02:39:31 -0000	1.4
+++ discount.pm	22 Sep 2010 19:16:17 -0000	1.5
@@ -133,6 +133,17 @@
   ;
   return $error if $error;
 
+  #discourage non-integer months for package discounts
+  if ($self->discountnum) {
+    my $sql =
+      "SELECT count(*) FROM part_pkg_discount WHERE part_pkg_discount.discountnum = ".
+      $self->discountnum;
+
+    my $count = $self->scalar_sql($sql); 
+    return "months must be integers greater than 1"
+      if ( $count && ($self->ut_number('months') || $self->months < 2) );
+  }
+    
   $self->SUPER::check;
 }
 



More information about the freeside-commits mailing list