$return{support_services} = \@support_services;
}
+ if ( $conf->config('prepayment_discounts-credit_type') ) {
+ #need to eval?
+ $return{discount_terms_hash} = { $cust_main->discount_terms_hash };
+ }
+
} elsif ( $session->{'svcnum'} ) { #no customer record
my $svc_acct = qsearchs('svc_acct', { 'svcnum' => $session->{'svcnum'} } )
#generic
##
+ my $conf = new FS::Conf;
use vars qw($payment_info); #cache for performance
unless ( $payment_info ) {
- my $conf = new FS::Conf;
my %states = map { $_->state => 1 }
qsearch('cust_main_county', {
'country' => $conf->config('countrydefault') || 'US'
}
+ if ( $conf->config('prepayment_discounts-credit_type') ) {
+ #need to eval?
+ $return{discount_terms_hash} = { $cust_main->discount_terms_hash };
+ }
+
#doubleclick protection
my $_date = time;
$return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
my $amount = $1;
return { error => 'Amount must be greater than 0' } unless $amount > 0;
+ $p->{'discount_term'} =~ /^\s*(\d+)\s*$/
+ or return { 'error' => gettext('illegal_discount_term'). ': '. $p->{'discount_term'} };
+ my $discount_term = $1;
+
$p->{'payname'} =~ /^([\w \,\.\-\']+)$/
or return { 'error' => gettext('illegal_name'). " payname: ". $p->{'payname'} };
my $payname = $1;
'paybatch' => $paybatch, #this doesn't actually do anything
'paycvv' => $paycvv,
'pkgnum' => $session->{'pkgnum'},
+ 'discount_term' => $discount_term,
map { $_ => $p->{$_} } @{ $payby2fields{$payby} }
);
return { 'error' => $error } if $error;
$custnum = $p->{'custnum'};
} else {
+ $context = 'error';
return ( 'error' => "Can't resume session" ); #better error message
}
},
{
+ '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',
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 ) {
'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, '', '',
# 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', '', '', '', '',
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
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?
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
If set true, re-charges setup fees.
+=item recurring_only
+
+If set true then only bill recurring charges, not setup, usage, one time
+charges, etc.
+
+=item freq_override
+
+If set, then override the normal frequency and look for a part_pkg_discount
+to take at that frequency.
+
=item time
Bills the customer as if it were that time. Specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions. For example:
fees since the last billing. Setup charges may be charged. Not all package
plans support this feature (they tend to charge 0).
+=item no_usage_reset
+
+Prevent the resetting of usage limits during this call.
+
+=item no_commit
+
+Do not save the generated bill in the database. Useful with return_bill
+
+=item return_bill
+
+A list reference on which the generated bill(s) will be returned.
+
=item invoice_terms
Optional terms to be printed on this invoice. Otherwise, customer-specific
'time' => $invoice_time,
'check_freq' => $options{'check_freq'},
'stage' => 'pre-bill',
- );
+ )
+ unless $options{no_commit};
if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
+ $dbh->rollback if $oldAutoCommit && !$options{no_commit};
return $error;
}
'options' => \%options,
);
if ($error) {
- $dbh->rollback if $oldAutoCommit;
+ $dbh->rollback if $oldAutoCommit && !$options{no_commit};
return $error;
}
my $postal_pkg = $self->charge_postal_fee();
if ( $postal_pkg && !ref( $postal_pkg ) ) {
- $dbh->rollback if $oldAutoCommit;
+ $dbh->rollback if $oldAutoCommit && !$options{no_commit};
return "can't charge postal invoice fee for customer ".
$self->custnum. ": $postal_pkg";
'options' => \%postal_options,
);
if ($error) {
- $dbh->rollback if $oldAutoCommit;
+ $dbh->rollback if $oldAutoCommit && !$options{no_commit};
return $error;
}
}
$self->calculate_taxes( \@cust_bill_pkg, $taxlisthash{$pass}, $invoice_time);
unless ( ref( $listref_or_error ) ) {
- $dbh->rollback if $oldAutoCommit;
+ $dbh->rollback if $oldAutoCommit && !$options{no_commit};
return $listref_or_error;
}
#my $balance_adjustments =
# sprintf('%.2f', $balance - $prior_prior_balance - $prior_charged);
+ warn "creating the new invoice\n" if $DEBUG;
#create the new invoice
my $cust_bill = new FS::cust_bill ( {
'custnum' => $self->custnum,
'billing_balance' => $balance,
'previous_balance' => $previous_balance,
'invoice_terms' => $options{'invoice_terms'},
+ 'cust_bill_pkg' => \@cust_bill_pkg,
} );
- $error = $cust_bill->insert;
+ $error = $cust_bill->insert unless $options{no_commit};
if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
+ $dbh->rollback if $oldAutoCommit && !$options{no_commit};
return "can't create invoice for customer #". $self->custnum. ": $error";
}
-
- foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
- $cust_bill_pkg->invnum($cust_bill->invnum);
- my $error = $cust_bill_pkg->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't create invoice line item: $error";
- }
- }
+ push @{$options{return_bill}}, $cust_bill if $options{return_bill};
} #foreach my $pass ( keys %cust_bill_pkg )
foreach my $hook ( @precommit_hooks ) {
eval {
&{$hook}; #($self) ?
- };
+ } unless $options{no_commit};
if ( $@ ) {
- $dbh->rollback if $oldAutoCommit;
+ $dbh->rollback if $oldAutoCommit && !$options{no_commit};
return "$@ running precommit hook $hook\n";
}
}
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit && !$options{no_commit};
+
''; #no error
}
)
)
)
+ and !$options{recurring_only}
)
{
# XXX should this be a package event? probably. events are called
# at collection time at the moment, though...
$part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
- if $part_pkg->can('reset_usage');
+ if $part_pkg->can('reset_usage') && !$options{'no_usage_reset'};
#don't want to reset usage just cause we want a line item??
#&& $part_pkg->pkgpart == $real_pkgpart;
'increment_next_bill' => $increment_next_bill,
'discounts' => \@discounts,
'real_pkgpart' => $real_pkgpart,
+ 'freq_override' => $options{freq_override} || '',
);
my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
+
+ # There may be some part_pkg for which this is wrong. Only those
+ # which can_discount are supported.
+
$recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
return "$@ running $method for $cust_pkg\n"
if ( $@ );
if ( $increment_next_bill ) {
- my $next_bill = $part_pkg->add_freq($sdate);
+ my $next_bill = $part_pkg->add_freq($sdate, $options{freq_override} || 0);
return "unparsable frequency: ". $part_pkg->freq
if $next_bill == -1;
my $error = $cust_pkg->replace( $old_cust_pkg,
'options' => { $cust_pkg->options },
- );
+ )
+ unless $options{no_commit};
return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
if $error; #just in case
}
'details' => \@details,
'discounts' => \@discounts,
'hidden' => $part_pkg->hidden,
+ 'freq' => $part_pkg->freq,
};
if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
+=back
=cut
# =item payby
Set to true to return the objects, but not actually insert them into the
database.
+=item discount_terms
+
+Returns a list of lengths for term discounts
+
+=cut
+
+sub _discount_pkgs_and_bill {
+my $self = shift;
+
+ my @cust_bill = $self->cust_bill;
+ my $cust_bill = pop @cust_bill;
+ return () unless $cust_bill && $cust_bill->owed;
+
+ my @where = ();
+ push @where, "cust_bill_pkg.invnum = ". $cust_bill->invnum;
+ push @where, "cust_bill_pkg.pkgpart_override IS NULL";
+ push @where, "part_pkg.freq = 1";
+ push @where, "(cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0)";
+ push @where, "(cust_pkg.susp IS NULL OR cust_pkg.susp = 0)";
+ push @where, "0<(SELECT count(*) FROM part_pkg_discount
+ WHERE part_pkg.pkgpart = part_pkg_discount.pkgpart)";
+ push @where,
+ "0=(SELECT count(*) FROM cust_bill_pkg_discount
+ WHERE cust_bill_pkg.billpkgnum = cust_bill_pkg_discount.billpkgnum)";
+
+ my $extra_sql = 'WHERE '. join(' AND ', @where);
+
+ my @cust_pkg =
+ qsearch({
+ 'table' => 'cust_pkg',
+ 'select' => "DISTINCT cust_pkg.*",
+ 'addl_from' => 'JOIN cust_bill_pkg USING(pkgnum) '.
+ 'JOIN part_pkg USING(pkgpart)',
+ 'hashref' => {},
+ 'extra_sql' => $extra_sql,
+ });
+
+ ($cust_bill, @cust_pkg);
+}
+
+sub _discountable_pkgs_at_term {
+ my ($term, @pkgs) = @_;
+ my $part_pkg = new FS::part_pkg { freq => $term - 1 };
+ grep { ( !$_->adjourn || $_->adjourn > $part_pkg->add_freq($_->bill) ) &&
+ ( !$_->expire || $_->expire > $part_pkg->add_freq($_->bill) )
+ }
+ @pkgs;
+}
+
+=item discount_terms
+
+Returns a list of lengths for term discounts
+
+=cut
+
+sub discount_terms {
+my $self = shift;
+
+ my %terms = ();
+
+ my @discount_pkgs = $self->_discount_pkgs_and_bill;
+ shift @discount_pkgs; #discard bill;
+
+ map { $terms{$_->months} = 1 }
+ grep { $_->months && $_->months > 1 }
+ map { $_->discount }
+ map { $_->part_pkg->part_pkg_discount }
+ @discount_pkgs;
+
+ return sort { $a <=> $b } keys %terms;
+
+}
+
+=back
+
+=item discount_term_values MONTHS
+
+Returns a list with credit, dollar amount saved, and total bill acheived
+by prepaying the most recent invoice for MONTHS.
+
+=cut
+
+sub discount_term_values {
+ my $self = shift;
+ my $term = shift;
+ warn "$me discount_term_values called with $term\n" if $DEBUG;
+
+ my %result = ();
+
+ my @packages = $self->_discount_pkgs_and_bill;
+ my $cust_bill = shift(@packages);
+ @packages = _discountable_pkgs_at_term( $term, @packages );
+ return () unless scalar(@packages);
+
+ $_->bill($_->last_bill) foreach @packages;
+ my @final = map { new FS::cust_pkg { $_->hash } } @packages;
+
+ my %options = (
+ 'recurring_only' => 1,
+ 'no_usage_reset' => 1,
+ 'no_commit' => 1,
+ );
+
+ my %params = (
+ 'return_bill' => [],
+ 'pkg_list' => \@packages,
+ 'time' => $cust_bill->_date,
+ );
+
+ my $error = $self->bill(%options, %params);
+ die $error if $error; # XXX think about this a bit more
+
+ my $credit = 0;
+ $credit += $_->charged foreach @{$params{return_bill}};
+ $credit = sprintf('%.2f', $credit);
+ warn "$me discount_term_values $term credit: $credit\n" if $DEBUG;
+
+ %params = (
+ 'return_bill' => [],
+ 'pkg_list' => \@packages,
+ 'time' => $packages[0]->part_pkg->add_freq($cust_bill->_date)
+ );
+
+ $error = $self->bill(%options, %params);
+ die $error if $error; # XXX think about this a bit more
+
+ my $next = 0;
+ $next += $_->charged foreach @{$params{return_bill}};
+ warn "$me discount_term_values $term next: $next\n" if $DEBUG;
+
+ %params = (
+ 'return_bill' => [],
+ 'pkg_list' => \@final,
+ 'time' => $cust_bill->_date,
+ 'freq_override' => $term,
+ );
+
+ $error = $self->bill(%options, %params);
+ die $error if $error; # XXX think about this a bit more
+
+ my $final = $self->balance - $credit;
+ $final += $_->charged foreach @{$params{return_bill}};
+ $final = sprintf('%.2f', $final);
+ warn "$me discount_term_values $term final: $final\n" if $DEBUG;
+
+ my $savings = sprintf('%.2f', $self->balance + ($term - 1) * $next - $final);
+
+ ( $credit, $savings, $final );
+
+}
+
+sub discount_terms_hash {
+ my $self = shift;
+
+ my %result = ();
+ my @terms = $self->discount_terms;
+ foreach my $term (@terms) {
+ my @result = $self->discount_term_values($term);
+ $result{$term} = [ @result ] if scalar(@result);
+ }
+
+ return %result;
+
+}
+
=back
=cut
I<depend_jobnum> allows payment capture to unlock export jobs
+I<discount_term> attempts to take a discount by prepaying for discount_term
+
(moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
=cut
'paybatch' => $paybatch,
'paydate' => $cust_pay_pending->paydate,
'pkgnum' => $cust_pay_pending->pkgnum,
+ 'discount_term' => $options{'discount_term'},
} );
#doesn't hurt to know, even though the dup check is in cust_pay_pending now
$cust_pay->payunique( $options{payunique} )
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?)".
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.
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,
|| $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;
$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...
$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
;
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;
}
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;
} );
}
+=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
}
else {
my $charge = $self->base_recur($cust_pkg);
+ $charge *= $param->{freq_override} if $param->{freq_override};
my $discount = $self->calc_discount($cust_pkg, $sdate, $details, $param);
return sprintf('%.2f', $charge - $discount);
my $tot_discount = 0;
#UI enforces just 1 for now, will need ordering when they can be stacked
+
+ if ( $param->{freq_override} ) {
+ my $real_part_pkg = new FS::part_pkg { $self->hash };
+ $real_part_pkg->pkgpart($param->{real_pkgpart} || $self->pkgpart);
+ my @discount = grep { $_->months == $param->{freq_override} }
+ map { $_->discount }
+ $real_part_pkg->part_pkg_discount;
+ my $discount = shift @discount;
+ $param->{months} = $param->{freq_override} unless $param->{months};
+ my $error;
+ if ($discount) {
+ if ($discount->months == $param->{months}) {
+ $cust_pkg->discountnum($discount->discountnum);
+ $error = $cust_pkg->insert_discount;
+ } else {
+ $cust_pkg->discountnum(-1);
+ foreach ( qw( amount percent months ) ) {
+ my $method = "discountnum_$_";
+ $cust_pkg->$method($discount->$_);
+ }
+ $error = $cust_pkg->insert_discount;
+ }
+ die "error discounting using part_pkg_discount: $error" if $error;
+ }
+ }
+
my @cust_pkg_discount = $cust_pkg->cust_pkg_discount_active;
foreach my $cust_pkg_discount ( @cust_pkg_discount ) {
my $discount = $cust_pkg_discount->discount;
$discount->months - $cust_pkg_discount->months_used )
: $chg_months;
- my $error = $cust_pkg_discount->increment_months_used($months);
+ my $error = $cust_pkg_discount->increment_months_used($months)
+ if $cust_pkg->pkgpart == $param->{real_pkgpart};
die "error discounting: $error" if $error;
$amount *= $months;
--- /dev/null
+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;
+
FS/svc_CGPRule_Mixin.pm
FS/svc_cert.pm
t/svc_cert.t
+FS/part_pkg_discount.pm
+t/part_pkg_discount.t
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::part_pkg_discount;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+<%=
+if ( scalar(keys %discount_terms_hash) ) {
+ $OUT .= '<TR>';
+ $OUT .= '<TD ALIGN="right">Prepayment for</TD>';
+ $OUT .= '<TD>';
+ $OUT .= '<SELECT NAME="discount_term">';
+ $OUT .= qq(<OPTION VALUE="">1 month\n);
+ foreach ( keys %discount_terms_hash ) {
+ $selected = $discount_term eq $_ ? ' SELECTED' : '';
+ $OUT .= qq(<OPTION$selected VALUE="$_">$_ months\n);
+ }
+ $OUT .= '</SELECT>';
+ $OUT .= '</TD>';
+ $OUT .= '</TR>';
+}
+$OUT .= '';
+%>
</TD></TR></TABLE>
</TD>
</TR>
+<%= include('discount_term') %>
<%= include('check') %>
<TR>
<TD COLSPAN=2>
$<INPUT TYPE="text" NAME="amount" SIZE=8 VALUE="<%=sprintf("%.2f",$balance)%>">
</TD></TR></TABLE>
</TD>
-</TR><TR>
+</TR>
+<%= include('discount_term') %>
+<TR>
<TH ALIGN="right">Card type</TH>
<TD COLSPAN=7>
<SELECT NAME="card_type"><OPTION></OPTION>
if (scalar(grep $_, @hide_payment_fields)) {
$OUT .= qq! <B><A HREF="${url}make_thirdparty_payment&payby_method=CC">Make a payment</A></B><BR><BR>!;
} else {
- $OUT .= qq! <B><A HREF="${url}make_payment">Make a payment</A></B><BR><BR>!;
+ $OUT .= qq! <B><A HREF="${url}make_payment">Make a payment</A></B><BR>!;
+ foreach my $term ( sort { $b <=> $a } keys %discount_terms_hash ) {
+ my $saved = $discount_terms_hash{$term}->[1];
+ my $amount = $discount_terms_hash{$term}->[2];
+ my $savings = ( $amount + $saved > 0 )
+ ? sprintf('%d', $saved / ( $amount + $saved ) * 100 ) : '0';
+ $OUT .= qq! <B><A HREF="${url}make_term_payment;discount_term=$term;amount=$amount">Save $savings\% by paying for $term months: $amount</A></B><BR>!;
+ }
+ $OUT .= qq! <BR>!;
}
} %>
<%=
#order|pw_list XXX ???
$cgi->param('action') =~
- /^(myaccount|view_invoice|make_payment|make_ach_payment|make_thirdparty_payment|payment_results|ach_payment_results|recharge_prepay|recharge_results|logout|change_bill|change_ship|change_pay|process_change_bill|process_change_ship|process_change_pay|customer_order_pkg|process_order_pkg|customer_change_pkg|process_change_pkg|process_order_recharge|provision|provision_svc|process_svc_acct|process_svc_external|delete_svc|view_usage|view_usage_details|view_cdr_details|view_support_details|change_password|process_change_password)$/
+ /^(myaccount|view_invoice|make_payment|make_ach_payment|make_term_payment|make_thirdparty_payment|payment_results|ach_payment_results|recharge_prepay|recharge_results|logout|change_bill|change_ship|change_pay|process_change_bill|process_change_ship|process_change_pay|customer_order_pkg|process_order_pkg|customer_change_pkg|process_change_pkg|process_order_recharge|provision|provision_svc|process_svc_acct|process_svc_external|delete_svc|view_usage|view_usage_details|view_cdr_details|view_support_details|change_password|process_change_password)$/
or die "unknown action ". $cgi->param('action');
my $action = $1;
#--
-sub myaccount { customer_info( 'session_id' => $session_id ); }
+use Data::Dumper;
+sub myaccount { my $result = customer_info( 'session_id' => $session_id ); warn Dumper($result); $result;}
sub change_bill { my $payment_info =
payment_info( 'session_id' => $session_id );
$cgi->param('paybatch') =~ /^([\w\-\.]+)$/ or die "illegal paybatch";
my $paybatch = $1;
+ $cgi->param('discount_term') =~ /^(\d*)$/ or die "illegal discount_term";
+ my $discount_term = $1;
+
+
process_payment(
'session_id' => $session_id,
'payby' => 'CARD',
'save' => $save,
'auto' => $auto,
'paybatch' => $paybatch,
+ 'discount_term' => $discount_term,
);
}
realtime_collect( 'session_id' => $session_id, 'method' => $1 );
}
+sub make_term_payment {
+ $cgi->param('amount') =~ /^(\d+\.\d{2})$/
+ or die "illegal payment amount";
+ my $balance = $1;
+ $cgi->param('discount_term') =~ /^(\d+)$/
+ or die "illegal discount term";
+ my $discount_term = $1;
+ $action = 'make_payment';
+ ({ %{payment_info( 'session_id' => $session_id )},
+ 'balance' => $balance,
+ 'discount_term' => $discount_term,
+ })
+}
+
sub recharge_prepay {
customer_info( 'session_id' => $session_id );
}
my $part_pkg = shift;
(my $plan = $plan_labels{$part_pkg->plan} ) =~ s/ / /g;
my $is_recur = ( $part_pkg->freq ne '0' );
+ my @discounts = sort { $a->months <=> $b->months }
+ map { $_->discount }
+ $part_pkg->part_pkg_discount;
[
[
}
$part_pkg->bill_part_pkg_link
),
+ ( scalar(@discounts)
+ ? [
+ { data => '<b>Discounts</b>',
+ align=>'center', #?
+ colspan=>2,
+ }
+ ]
+ : ()
+ ),
+ ( scalar(@discounts)
+ ? map {
+ [
+ { data => $_->months. ':',
+ align => 'right',
+ },
+ { data => $_->amount ? '$'. $_->amount : $_->percent. '%'
+ }
+ ]
+ }
+ @discounts
+ : ()
+ ),
];
# $plan_labels{$part_pkg->plan}.'<BR>'.
<TD><INPUT TYPE="text" NAME="paid" VALUE="<% $paid %>" SIZE=8 MAXLENGTH=8> by <B><% FS::payby->payname($payby) %></B></TD>
</TR>
+ <% include('/elements/tr-select-discount_term.html',
+ 'custnum' => $custnum,
+ 'cgi' => $cgi
+ )
+ %>
+
% if ( $payby eq 'BILL' ) {
<TR>
<TD ALIGN="right">Check #</TD>
'agentnum' => 'Agent',
'setup_fee' => 'Setup fee',
'recur_fee' => 'Recurring fee',
+ 'discountnum' => 'Offer discounts for longer terms',
'bill_dst_pkgpart' => 'Include line item(s) from package',
'svc_dst_pkgpart' => 'Include services of package',
'report_option' => 'Report classes',
type => 'selectlayers-select',
options => [ keys %plan_labels ],
labels => \%plan_labels,
+ onchange => 'aux_planchanged(what);',
},
{ field => 'setup_fee',
type => 'money',
'multiple' => 1,
},
+ { 'type' => 'tablebreak-tr-title',
+ 'value' => 'Term discounts',
+ },
+ { 'field' => 'discountnum',
+ 'type' => 'select-table',
+ 'table' => 'discount',
+ 'name_col' => 'name',
+ 'hashref' => { %$discountnum_hashref },
+ #'extra_sql' => 'AND (months IS NOT NULL OR months != 0)',
+ 'empty_label'=> 'Select discount',
+ 'm2_label' => 'Offer discounts for longer terms',
+ 'm2m_method' => 'part_pkg_discount',
+ 'm2m_dstcol' => 'discountnum',
+ 'm2_error_callback' => $discount_error_callback,
+ },
{ 'type' => 'tablebreak-tr-title',
'value' => 'Pricing add-ons',
$recur_disabled = $object->freq ? 0 : 1;
};
+my $discount_error_callback = sub {
+ my( $cgi, $object ) = @_;
+ map {
+ if ( /^discountnum(\d+)$/ &&
+ ( my $discountnum = $cgi->param("discountnum$1") ) )
+ {
+ new FS::part_pkg_discount {
+ 'pkgpart' => $object->pkgpart,
+ 'discountnum' => $discountnum,
+ };
+ } else {
+ ();
+ }
+ }
+ $cgi->param;
+};
+
my $m2_error_callback_maker = sub {
my $link_type = shift; #yay closures
return sub {
}
+ function aux_planchanged(what) {
+
+ alert('called!');
+ var plan = what.options[what.selectedIndex].value;
+ var table = document.getElementById('TableNumber7') // XXX NOT ROBUST
+
+ if ( plan == 'flat' || plan == 'prorate' || plan == 'subscription' ) {
+ //table.disabled = false;
+ table.style.visibility = '';
+ } else {
+ //table.disabled = true;
+ table.style.visibility = 'hidden';
+ }
+
+ }
+
</SCRIPT>
END
}
};
+my $discountnum_hashref = {
+ 'disabled' => '',
+ 'months' => { 'op' => '>', 'value' => 1 },
+ };
+
</%init>
map {
$_, scalar($cgi->param($_));
} qw( paid payby payinfo paybatch
- pkgnum
+ pkgnum discount_term
)
#} fields('cust_pay')
} );
'target_table' => 'tax_class',
'params' => \@tax_overrides,
},
+ { 'link_table' => 'part_pkg_discount',
+ 'target_table' => 'discount',
+ 'params' => [ map $cgi->param($_),
+ grep /^discountnum/, $cgi->param
+ ],
+ },
{ 'link_table' => 'part_pkg_link',
'target_table' => 'part_pkg',
'base_field' => 'src_pkgpart',
###
'name_singular' => 'customer', #label
+ 'custnum_update_callback' => 'name_of_js_callback' #passed a rownum
#listrefs
'types' => ['immutable', ''], # immutable or ''/text
if ( name.length > 0 ) {
customer.value = name;
customer.setAttribute('magic', 'nosearch');
+% if ( $opt{custnum_update_callback} ) {
+ <% $opt{custnum_update_callback} %>(searchrow, '<% $opt{prefix} %>')
+% }
} else {
customer.value = 'Not found';
customer.style.color = '#ff0000';
customer_obj.style.display = '';
customer_select.style.display = 'none';
+% if ( $opt{custnum_update_callback} ) {
+ <% $opt{custnum_update_callback} %>(searchrow, '<% $opt{prefix} %>')
+% }
} else {
this.style.display = 'none';
customer_obj.style.display = '';
+% if ( $opt{custnum_update_callback} ) {
+ <% $opt{custnum_update_callback} %>(searchrow, '<% $opt{prefix} %>')
+% }
+
}
}
>
% } elsif ($types->[$col] eq 'immutable') {
<% $font %><% $value %><% $font ? '</FONT>' : '' %>
- <INPUT TYPE="hidden" NAME="<% $name %>" VALUE="<% $value %>" >
+ <INPUT TYPE="hidden" ID="<% $name %>" NAME="<% $name %>" VALUE="<% $value %>" >
% } else {
Cannot represent unknown type: <% $types->[$col] %>
% }
--- /dev/null
+% if ( scalar(@discount_term) ) {
+ <SELECT NAME="discount_term">
+ <OPTION VALUE="">1 month
+% foreach my $discount_term (@discount_term) {
+% my $sel = ( $cgi->param('discount_term') == $discount_term ) ? 'SELECTED' : '';
+ <OPTION <% $sel %> VALUE="<% $discount_term %>"><% $discount_term. " months" %>
+% }
+ </SELECT>
+% }
+<%init>
+
+my %opt = @_;
+
+my $cgi = $opt{'cgi'};
+
+my @discount_term;
+if ( $opt{discount_term} ) {
+
+ @discount_term = @{ $opt{discount_term} };
+
+} else {
+
+ my $custnum = $opt{'custnum'};
+
+ my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } )
+ or die "unknown custnum $custnum\n";
+
+ @discount_term = $cust_main->discount_terms;
+
+}
+
+</%init>
--- /dev/null
+% if ( scalar(@discount_term) ) {
+ <TR>
+ <TD ALIGN="right">Prepayment for</TD>
+ <TD COLSPAN=2>
+ <% include('select-discount_term.html',
+ 'discount_term' => \@discount_term,
+ 'cgi' => $opt{'cgi'},
+ )
+ %>
+ </TD>
+ </TR>
+
+% }
+
+<%init>
+my %opt = @_;
+
+my $custnum = $opt{'custnum'};
+
+my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } )
+ or die "unknown custnum $custnum\n";
+
+my @discount_term = $cust_main->discount_terms;
+
+</%init>
}
}
window.onbeforeunload = warnUnload;
+
+function select_discount_term(row, prefix) {
+ var custnum_obj = document.getElementById('custnum'+prefix+row);
+ var select_obj = document.getElementById('discount_term'+prefix+row);
+
+ var value = '';
+ if (select_obj.type == 'hidden') {
+ value = select_obj.value;
+ }
+
+ var term_select = document.createElement('SELECT');
+ term_select.setAttribute('name', 'discount_term'+row);
+ term_select.setAttribute('id', 'discount_term'+row);
+ term_select.setAttribute('rownum', row);
+ term_select.style.display = '';
+ select_obj.parentNode.replaceChild(term_select, select_obj);
+ opt(term_select, '', '1 month');
+
+ function select_discount_term_update(discount_terms) {
+
+ var termArray = eval('(' + discount_terms + ')');
+ for ( var t = 0; t < termArray.length; t++ ) {
+ opt(term_select, termArray[t][0], termArray[t][1]);
+ if (termArray[t][0] == value) {
+ term_select.selectedIndex = t+1;
+ }
+ }
+
+ }
+
+ discount_terms(custnum_obj.value, select_discount_term_update);
+
+}
</SCRIPT>
+<% include('/elements/xmlhttp.html',
+ 'url' => $p. 'misc/xmlhttp-cust_main-discount_terms.cgi',
+ 'subs' => [qw( discount_terms )],
+ )
+%>
+
<FORM ACTION="process/batch-cust_pay.cgi" NAME="OneTrueForm" METHOD="POST" onsubmit="document.OneTrueForm.submit.disabled=true;window.onbeforeunload = null;">
<!-- <B>Batch</B> <INPUT TYPE="text" NAME="paybatch"><BR><BR> -->
<% include( "/elements/customer-table.html",
name_singular => 'payment',
- header => [ '', 'Amount', 'Check #', '' ],
- fields => [ sub {'$'}, 'paid', 'payinfo', 'error', ],
- types => [ 'immutable', '', '', 'immutable', ],
- align => [ 'c', 'r', 'r', 'l' ],
- sizes => [ 0, 8, 10, 0, ],
- colors => [ '', '', '', '#ff0000' ],
- param => { () },
- footer => [ '$', '_TOTAL', '', '' ],
- footer_align => [ 'c', 'r', 'r', '' ],
+ header => \@header,
+ fields => \@fields,
+ types => \@types,
+ align => \@align,
+ sizes => \@sizes,
+ colors => \@colors,
+ param => \%param,
+ footer => \@footer,
+ footer_align => \@footer_align,
+ custnum_update_callback => $custnum_update_callback,
)
%>
</FORM>
+%if ( $cgi->param('error') ) {
+<SCRIPT TYPE="text/javascript">
+% for ( my $row = 0; defined($cgi->param("custnum$row")); $row++ ) {
+ select_discount_term(<% $row %>, '');
+% }
+</SCRIPT>
+%}
+
<% include('/elements/footer.html') %>
<%init>
die "access denied"
unless $FS::CurrentUser::CurrentUser->access_right('Post payment batch');
+my @header = ( '', 'Amount', 'Check #' );
+my @fields = ( sub {'$'}, 'paid', 'payinfo' );
+my @types = ( 'immutable', '', '' );
+my @align = ( 'c', 'r', 'r' );
+my @sizes = ( 0, 8, 10 );
+my @colors = ( '', '', '' );
+my %param = ();
+my @footer = ( '$', '_TOTAL', '' );
+my @footer_align = ( 'c', 'r', 'r' );
+my $custnum_update_callback = '';
+
+if ( FS::Record->scalar_sql('SELECT count(*) FROM part_pkg_discount') ) {
+ push @header, '';
+ push @fields, 'discount_term';
+ push @types, 'immutable';
+ push @align, 'r';
+ push @sizes, '0';
+ push @colors, '';
+ push @footer, '';
+ push @footer_align, '';
+ $custnum_update_callback = 'select_discount_term';
+}
+
+push @header, '';
+push @fields, 'error';
+push @types, 'immutable';
+push @align, 'l';
+push @sizes, '0';
+push @colors, '#ff0000';
+push @footer, '';
+push @footer_align, '';
+
</%init>
% }
+<% include('/elements/tr-select-discount_term.html',
+ 'custnum' => $custnum,
+ 'cgi' => $cgi
+ )
+%>
% if ( $payby eq 'CARD' ) {
%
% #while ( exists($param->{"custnum$row"}) ) {
% for ( my $row = 0; exists($param->{"custnum$row"}); $row++ ) {
% push @cust_pay, new FS::cust_pay {
-% 'custnum' => $param->{"custnum$row"},
-% 'paid' => $param->{"paid$row"},
-% 'payby' => 'BILL',
-% 'payinfo' => $param->{"payinfo$row"},
-% 'paybatch' => $paybatch,
-% }
+% 'custnum' => $param->{"custnum$row"},
+% 'paid' => $param->{"paid$row"},
+% 'payby' => 'BILL',
+% 'payinfo' => $param->{"payinfo$row"},
+% 'discount_term' => $param->{"discount_term$row"},
+% 'paybatch' => $paybatch,
+% }
% if $param->{"custnum$row"}
% || $param->{"paid$row"}
% || $param->{"payinfo$row"};
die "unknown payby $payby";
}
+$cgi->param('discount_term') =~ /^\d*$/
+ or errorpage("illegal discount_term");
+my $discount_term = $1;
+
my $error = '';
my $paynum = '';
if ( $cgi->param('batch') ) {
- $error = $cust_main->batch_card(
- 'payby' => $payby,
- 'amount' => $amount,
- 'payinfo' => $payinfo,
- 'paydate' => "$year-$month-01",
- 'payname' => $payname,
- map { $_ => $cgi->param($_) }
- @{$payby2fields{$payby}}
- );
+ $error = 'Prepayment discounts not supported with batched payments'
+ if $discount_term;
+
+ $error ||= $cust_main->batch_card(
+ 'payby' => $payby,
+ 'amount' => $amount,
+ 'payinfo' => $payinfo,
+ 'paydate' => "$year-$month-01",
+ 'payname' => $payname,
+ map { $_ => $cgi->param($_) }
+ @{$payby2fields{$payby}}
+ );
errorpage($error) if $error;
} else {
'payunique' => $payunique,
'paycvv' => $paycvv,
'paynum_ref' => \$paynum,
+ 'discount_term' => $discount_term,
map { $_ => $cgi->param($_) } @{$payby2fields{$payby}}
);
errorpage($error) if $error;
--- /dev/null
+% if ( $sub eq 'discount_terms' ) {
+%
+% my $return = [];
+% my $custnum = $cgi->param('arg');
+% my $cust_main = '';
+% $cust_main = qsearchs({
+% 'table' => 'cust_main',
+% 'hashref' => { 'custnum' => $custnum },
+% 'extra_sql' => ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql,
+% });
+%
+% if ($cust_main) {
+% $return = [ map [ $_, "$_ months" ], $cust_main->discount_terms ];
+% }
+%
+<% objToJson($return) %>
+% }
+<%init>
+
+my $conf = new FS::Conf;
+
+my $sub = $cgi->param('sub');
+
+</%init>
% if ( $curuser->access_right('Discount customer package')
% && $part_pkg->can_discount
% && ! scalar($cust_pkg->cust_pkg_discount_active)
+% && ! scalar($cust_pkg->part_pkg->part_pkg_discount)
% )
% {
% $br=1;
projects / freeside.git / commitdiff