[freeside-commits] freeside/FS/FS Schema.pm, 1.114, 1.115 cust_credit.pm, 1.35, 1.36 Conf.pm, 1.252, 1.253 cust_pkg.pm, 1.102, 1.103 part_event.pm, 1.2, 1.3 cust_main.pm, 1.386, 1.387
Ivan,,,
ivan at wavetail.420.am
Sat Nov 22 14:17:28 PST 2008
Update of /home/cvs/cvsroot/freeside/FS/FS
In directory wavetail.420.am:/tmp/cvs-serv30261/FS/FS
Modified Files:
Schema.pm cust_credit.pm Conf.pm cust_pkg.pm part_event.pm
cust_main.pm
Log Message:
referral credits overhaul, use billing events, agents can self-configure, limit to once-per-customer, depend on any time from referred package, referred customer payment, specific packages, partial staged credits, RT#3983
Index: Conf.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Conf.pm,v
retrieving revision 1.252
retrieving revision 1.253
diff -u -d -r1.252 -r1.253
--- Conf.pm 9 Nov 2008 09:14:40 -0000 1.252
+++ Conf.pm 22 Nov 2008 22:17:26 -0000 1.253
@@ -1823,8 +1823,8 @@
},
{ 'key' => 'referral_credit',
- 'section' => 'billing',
- 'description' => "Enables one-time referral credits in the amount of one month <i>referred</i> customer's recurring fee (irregardless of frequency).",
+ 'section' => 'deprecated',
+ 'description' => "Used to enable one-time referral credits in the amount of one month <i>referred</i> customer's recurring fee (irregardless of frequency). Replace with a billing event on appropriate packages.",
'type' => 'checkbox',
},
@@ -2340,8 +2340,8 @@
{
'key' => 'referral_credit_type',
- 'section' => 'billing',
- 'description' => 'The group to use for new, automatically generated credit reasons resulting from referrals.',
+ 'section' => 'deprecated',
+ 'description' => 'Used to be the group to use for new, automatically generated credit reasons resulting from referrals. Now set in a package billing event for the referral.',
'type' => 'select-sub',
'options_sub' => sub { require FS::Record;
require FS::reason_type;
Index: cust_credit.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_credit.pm,v
retrieving revision 1.35
retrieving revision 1.36
diff -u -d -r1.35 -r1.36
--- cust_credit.pm 19 Feb 2008 02:28:33 -0000 1.35
+++ cust_credit.pm 22 Nov 2008 22:17:26 -0000 1.36
@@ -87,6 +87,10 @@
Reason (see L<FS::reason>)
+=item addlinfo
+
+Text
+
=item closed
Books closed flag, empty or `Y'
@@ -288,6 +292,7 @@
|| $self->ut_alpha('otaker')
|| $self->ut_textn('reason')
|| $self->ut_foreign_key('reasonnum', 'reason', 'reasonnum')
+ || $self->ut_textn('addlinfo')
|| $self->ut_enum('closed', [ '', 'Y' ])
;
return $error if $error;
@@ -412,7 +417,8 @@
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
- $reason ? $reason->reason : '';
+ ( $reason ? $reason->reason : '' ).
+ ( $self->addlinfo ? ' '.$self->addlinfo : '' );
}
# _upgrade_data
Index: cust_pkg.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_pkg.pm,v
retrieving revision 1.102
retrieving revision 1.103
diff -u -d -r1.102 -r1.103
--- cust_pkg.pm 11 Oct 2008 00:32:17 -0000 1.102
+++ cust_pkg.pm 22 Nov 2008 22:17:26 -0000 1.103
@@ -104,38 +104,76 @@
=over 4
-=item pkgnum - primary key (assigned automatically for new billing items)
+=item pkgnum
-=item custnum - Customer (see L<FS::cust_main>)
+primary key (assigned automatically for new billing items)
-=item pkgpart - Billing item definition (see L<FS::part_pkg>)
+=item custnum
-=item setup - date
+Customer (see L<FS::cust_main>)
-=item bill - date (next bill date)
+=item pkgpart
-=item last_bill - last bill date
+Billing item definition (see L<FS::part_pkg>)
-=item adjourn - date
+=item setup
-=item susp - date
+date
-=item expire - date
+=item bill
-=item cancel - date
+date (next bill date)
-=item otaker - order taker (assigned automatically if null, see L<FS::UID>)
+=item last_bill
-=item manual_flag - If this field is set to 1, disables the automatic
-unsuspension of this package when using the B<unsuspendauto> config file.
+last bill date
-=item quantity - If not set, defaults to 1
+=item adjourn
+
+date
+
+=item susp
+
+date
+
+=item expire
+
+date
+
+=item cancel
+
+date
+
+=item otaker
+
+order taker (assigned automatically if null, see L<FS::UID>)
+
+=item manual_flag
+
+If this field is set to 1, disables the automatic
+unsuspension of this package when using the B<unsuspendauto> config option.
+
+=item quantity
+
+If not set, defaults to 1
+
+=item change_date
+
+Date of change from previous package
+
+=item change_pkgnum
+
+Previous pkgnum
+
+=item change_pkgpart
+
+Previous pkgpart
=back
-Note: setup, bill, adjourn, susp, expire and cancel are specified as UNIX timestamps;
-see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for
-conversion functions.
+Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
+are specified as UNIX timestamps; see L<perlfunc/"time">. Also see
+L<Time::Local> and L<Date::Parse> for conversion functions.
=head1 METHODS
@@ -223,42 +261,6 @@
#}
my $conf = new FS::Conf;
- my $cust_main = $self->cust_main;
- my $part_pkg = $self->part_pkg;
- if ( $conf->exists('referral_credit')
- && $cust_main->referral_custnum
- && ! $options{'change'}
- && $part_pkg->freq !~ /^0\D?$/
- )
- {
- my $referring_cust_main = $cust_main->referring_cust_main;
- if ( $referring_cust_main->status ne 'cancelled' ) {
- my $error;
- if ( $part_pkg->freq !~ /^\d+$/ ) {
- warn 'WARNING: Not crediting customer '. $cust_main->referral_custnum.
- ' for package '. $self->pkgnum.
- ' ( customer '. $self->custnum. ')'.
- ' - One-time referral credits not (yet) available for '.
- ' packages with '. $part_pkg->freq_pretty. ' frequency';
- } else {
-
- my $amount = sprintf( "%.2f", $part_pkg->base_recur / $part_pkg->freq );
- my $error =
- $referring_cust_main->
- credit( $amount,
- 'Referral credit for '.$cust_main->name,
- 'reason_type' => $conf->config('referral_credit_type')
- );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error crediting customer ". $cust_main->referral_custnum.
- " for referral: $error";
- }
-
- }
-
- }
- }
if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
my $queue = new FS::queue {
Index: cust_main.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_main.pm,v
retrieving revision 1.386
retrieving revision 1.387
diff -u -d -r1.386 -r1.387
--- cust_main.pm 9 Nov 2008 08:51:00 -0000 1.386
+++ cust_main.pm 22 Nov 2008 22:17:26 -0000 1.387
@@ -4246,7 +4246,9 @@
die $error;
}
- my $unapplied = $self->total_credited + $self->total_unapplied_payments + $self->in_transit_payments;
+ my $unapplied = $self->total_unapplied_credits
+ + $self->total_unapplied_payments
+ + $self->in_transit_payments;
foreach my $cust_bill ($self->open_cust_bill) {
#$dbh->commit or die $dbh->errstr if $oldAutoCommit;
my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
@@ -4273,39 +4275,6 @@
'';
}
-=item total_owed
-
-Returns the total owed for this customer on all invoices
-(see L<FS::cust_bill/owed>).
-
-=cut
-
-sub total_owed {
- my $self = shift;
- $self->total_owed_date(2145859200); #12/31/2037
-}
-
-=item total_owed_date TIME
-
-Returns the total owed for this customer on all invoices with date earlier than
-TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
-see L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=cut
-
-sub total_owed_date {
- my $self = shift;
- my $time = shift;
- my $total_bill = 0;
- foreach my $cust_bill (
- grep { $_->_date <= $time }
- qsearch('cust_bill', { 'custnum' => $self->custnum, } )
- ) {
- $total_bill += $cust_bill->owed;
- }
- sprintf( "%.2f", $total_bill );
-}
-
=item apply_payments_and_credits
Applies unapplied payments and credits.
@@ -4375,7 +4344,7 @@
$self->select_for_update; #mutex
- unless ( $self->total_credited ) {
+ unless ( $self->total_unapplied_credits ) {
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
return 0;
}
@@ -4416,11 +4385,11 @@
}
- my $total_credited = $self->total_credited;
+ my $total_unapplied_credits = $self->total_unapplied_credits;
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
- return $total_credited;
+ return $total_unapplied_credits;
}
=item apply_payments
@@ -4452,11 +4421,13 @@
#return 0 unless
- my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
- qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
+ my @payments = sort { $b->_date <=> $a->_date }
+ grep { $_->unapplied > 0 }
+ $self->cust_pay;
- my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
- qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
+ my @invoices = sort { $a->_date <=> $b->_date}
+ grep { $_->owed > 0 }
+ $self->cust_bill;
my $payment;
@@ -4495,21 +4466,72 @@
return $total_unapplied_payments;
}
-=item total_credited
+=item total_owed
+
+Returns the total owed for this customer on all invoices
+(see L<FS::cust_bill/owed>).
+
+=cut
+
+sub total_owed {
+ my $self = shift;
+ $self->total_owed_date(2145859200); #12/31/2037
+}
+
+=item total_owed_date TIME
+
+Returns the total owed for this customer on all invoices with date earlier than
+TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
+see L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=cut
+
+sub total_owed_date {
+ my $self = shift;
+ my $time = shift;
+ my $total_bill = 0;
+ foreach my $cust_bill (
+ grep { $_->_date <= $time }
+ qsearch('cust_bill', { 'custnum' => $self->custnum, } )
+ ) {
+ $total_bill += $cust_bill->owed;
+ }
+ sprintf( "%.2f", $total_bill );
+}
+
+=item total_paid
+
+Returns the total amount of all payments.
+
+=cut
+
+sub total_paid {
+ my $self = shift;
+ my $total = 0;
+ $total += $_->paid foreach $self->cust_pay;
+ sprintf( "%.2f", $total );
+}
+
+=item total_unapplied_credits
Returns the total outstanding credit (see L<FS::cust_credit>) for this
customer. See L<FS::cust_credit/credited>.
+=item total_credited
+
+Old name for total_unapplied_credits. Don't use.
+
=cut
sub total_credited {
+ #carp "total_credited deprecated, use total_unapplied_credits";
+ shift->total_unapplied_credits(@_);
+}
+
+sub total_unapplied_credits {
my $self = shift;
my $total_credit = 0;
- foreach my $cust_credit ( qsearch('cust_credit', {
- 'custnum' => $self->custnum,
- } ) ) {
- $total_credit += $cust_credit->credited;
- }
+ $total_credit += $_->credited foreach $self->cust_credit;
sprintf( "%.2f", $total_credit );
}
@@ -4523,11 +4545,7 @@
sub total_unapplied_payments {
my $self = shift;
my $total_unapplied = 0;
- foreach my $cust_pay ( qsearch('cust_pay', {
- 'custnum' => $self->custnum,
- } ) ) {
- $total_unapplied += $cust_pay->unapplied;
- }
+ $total_unapplied += $_->unapplied foreach $self->cust_pay;
sprintf( "%.2f", $total_unapplied );
}
@@ -4541,18 +4559,14 @@
sub total_unapplied_refunds {
my $self = shift;
my $total_unapplied = 0;
- foreach my $cust_refund ( qsearch('cust_refund', {
- 'custnum' => $self->custnum,
- } ) ) {
- $total_unapplied += $cust_refund->unapplied;
- }
+ $total_unapplied += $_->unapplied foreach $self->cust_refund;
sprintf( "%.2f", $total_unapplied );
}
=item balance
Returns the balance for this customer (total_owed plus total_unrefunded, minus
-total_credited minus total_unapplied_payments).
+total_unapplied_credits minus total_unapplied_payments).
=cut
@@ -4561,7 +4575,7 @@
sprintf( "%.2f",
$self->total_owed
+ $self->total_unapplied_refunds
- - $self->total_credited
+ - $self->total_unapplied_credits
- $self->total_unapplied_payments
);
}
@@ -4582,7 +4596,7 @@
sprintf( "%.2f",
$self->total_owed_date($time)
+ $self->total_unapplied_refunds
- - $self->total_credited
+ - $self->total_unapplied_credits
- $self->total_unapplied_payments
);
}
@@ -4870,21 +4884,47 @@
qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
}
-=item credit AMOUNT, REASON
+=item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
Applies a credit to this customer. If there is an error, returns the error,
otherwise returns false.
+REASON can be a text string, an FS::reason object, or a scalar reference to
+a reasonnum. If a text string, it will be automatically inserted as a new
+reason, and a 'reason_type' option must be passed to indicate the
+FS::reason_type for the new reason.
+
+An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
+
+Any other options are passed to FS::cust_credit::insert.
+
=cut
sub credit {
my( $self, $amount, $reason, %options ) = @_;
+
my $cust_credit = new FS::cust_credit {
'custnum' => $self->custnum,
'amount' => $amount,
- 'reason' => $reason,
};
+
+ if ( ref($reason) ) {
+
+ if ( ref($reason) eq 'SCALAR' ) {
+ $cust_credit->reasonnum( $$reason );
+ } else {
+ $cust_credit->reasonnum( $reason->reasonnum );
+ }
+
+ } else {
+ $cust_credit->set('reason', $reason)
+ }
+
+ $cust_credit->addlinfo( delete $options{'addlinfo'} )
+ if exists($options{'addlinfo'});
+
$cust_credit->insert(%options);
+
}
=item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
@@ -5474,7 +5514,7 @@
Returns an SQL fragment to retreive the balance for this customer, only
considering invoices with date earlier than START_TIME, and optionally not
-later than END_TIME (total_owed_date minus total_credited minus
+later than END_TIME (total_owed_date minus total_unapplied_credits minus
total_unapplied_payments).
Times are specified as SQL fragments or numeric
Index: Schema.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Schema.pm,v
retrieving revision 1.114
retrieving revision 1.115
diff -u -d -r1.114 -r1.115
--- Schema.pm 19 Nov 2008 14:55:58 -0000 1.114
+++ Schema.pm 22 Nov 2008 22:17:26 -0000 1.115
@@ -558,6 +558,7 @@
'otaker', 'varchar', '', 32, '', '',
'reason', 'text', 'NULL', '', '', '',
'reasonnum', 'int', 'NULL', '', '', '',
+ 'addlinfo', 'text', 'NULL', '', '', '',
'closed', 'char', 'NULL', 1, '', '',
],
'primary_key' => 'crednum',
Index: part_event.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/part_event.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- part_event.pm 24 Sep 2007 00:56:50 -0000 1.2
+++ part_event.pm 22 Nov 2008 22:17:26 -0000 1.3
@@ -286,18 +286,32 @@
=cut
sub eventtable_pkey_sql {
- #my $class = shift;
+ my $class = shift;
- my %hash = (
- 'cust_main' => 'cust_main.custnum',
- 'cust_bill' => 'cust_bill.invnum',
- 'cust_pkg' => 'cust_pkg.pkgnum',
- 'cust_pay_batch' => 'cust_pay_batch.paybatchnum',
- );
+ my $hashref = $class->eventtable_pkey;
+
+ my %hash = map { $_ => "$_.". $hashref->{$_} } keys %$hashref;
\%hash;
}
+=item eventtable_pkey
+
+Returns a hash reference of full SQL primary key names for eventtable values,
+i.e. 'cust_main'=>'custnum'
+
+=cut
+
+sub eventtable_pkey {
+ #my $class = shift;
+
+ {
+ 'cust_main' => 'custnum',
+ 'cust_bill' => 'invnum',
+ 'cust_pkg' => 'pkgnum',
+ 'cust_pay_batch' => 'paybatchnum',
+ };
+}
=item eventtables
More information about the freeside-commits
mailing list