[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
- Previous message: [freeside-commits] freeside/FS/t part_pkg_discount.t,NONE,1.1
- Next message: [freeside-commits] freeside/fs_selfservice/FS-SelfService/cgi discount_term.html, NONE, 1.1 make_ach_payment.html, 1.6, 1.7 make_payment.html, 1.19, 1.20 myaccount.html, 1.17, 1.18 selfservice.cgi, 1.45, 1.46
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
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;
}
- Previous message: [freeside-commits] freeside/FS/t part_pkg_discount.t,NONE,1.1
- Next message: [freeside-commits] freeside/fs_selfservice/FS-SelfService/cgi discount_term.html, NONE, 1.1 make_ach_payment.html, 1.6, 1.7 make_payment.html, 1.19, 1.20 myaccount.html, 1.17, 1.18 selfservice.cgi, 1.45, 1.46
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
More information about the freeside-commits
mailing list