'quotationpkgnum', 'int', '', '', '', '',
'format', 'char', 'NULL', 1, '', '', # not used for anything
'detail', 'varchar', '', 255, '', '',
+ 'copy_on_order', 'char', 'NULL', 1, '', '', # 'Y' to copy when ordering
],
'primary_key' => 'detailnum',
'unique' => [],
unapplied_sql();
}
+=item calculate_tax_adjustment PARAMS
+
+Calculate the amount of tax that needs to be credited as part of a lineitem
+credit.
+
+PARAMS must include:
+
+- billpkgnums: arrayref identifying the line items to credit
+- setuprecurs: arrayref of 'setup' or 'recur', indicating which part of
+ the lineitem charge is being credited
+- amounts: arrayref of the amounts to credit on each line item
+- custnum: the customer all of these invoices belong to, for error checking
+
+Returns a hash containing:
+- subtotal: the total non-tax amount to be credited (the sum of the 'amounts')
+- taxtotal: the total tax amount to be credited
+- taxlines: an arrayref of hashrefs for each tax line to be credited, each with:
+ - table: "cust_bill_pkg_tax_location" or "cust_bill_pkg_tax_rate_location"
+ - num: the key within that table
+ - credit: the credit amount to apply to that line
+
+=cut
+
+sub calculate_tax_adjustment {
+ my ($class, %arg) = @_;
+
+ my $error;
+ my @taxlines;
+ my $subtotal = 0;
+ my $taxtotal = 0;
+
+ my (%cust_bill_pkg, %cust_bill);
+
+ for (my $i = 0; ; $i++) {
+ my $billpkgnum = $arg{billpkgnums}[$i]
+ or last;
+ my $setuprecur = $arg{setuprecurs}[$i];
+ my $amount = $arg{amounts}[$i];
+ next if $amount == 0;
+ $subtotal += $amount;
+ my $cust_bill_pkg = $cust_bill_pkg{$billpkgnum}
+ ||= FS::cust_bill_pkg->by_key($billpkgnum)
+ or die "lineitem #$billpkgnum not found\n";
+
+ my $invnum = $cust_bill_pkg->invnum;
+ $cust_bill{ $invnum } ||= FS::cust_bill->by_key($invnum);
+ $cust_bill{ $invnum}->custnum == $arg{custnum}
+ or die "lineitem #$billpkgnum not found\n";
+
+ # calculate credit ratio.
+ # (First deduct any existing credits applied to this line item, to avoid
+ # rounding errors.)
+ my $charged = $cust_bill_pkg->get($setuprecur);
+ my $previously_credited =
+ $cust_bill_pkg->credited( '', '', setuprecur => $setuprecur) || 0;
+
+ $charged -= $previously_credited;
+ if ($charged < $amount) {
+ $error = "invoice #$invnum: tried to credit $amount, but only $charged was charged";
+ last;
+ }
+ my $ratio = $amount / $charged;
+
+ # gather taxes that apply to the selected item
+ foreach my $table (
+ qw(cust_bill_pkg_tax_location cust_bill_pkg_tax_rate_location)
+ ) {
+ foreach my $tax_link (
+ qsearch($table, { taxable_billpkgnum => $billpkgnum })
+ ) {
+ my $tax_amount = $tax_link->amount;
+ # deduct existing credits applied to the tax, for the same reason as
+ # above
+ foreach ($tax_link->cust_credit_bill_pkg) {
+ $tax_amount -= $_->amount;
+ }
+ my $tax_credit = sprintf('%.2f', $tax_amount * $ratio);
+ my $pkey = $tax_link->get($tax_link->primary_key);
+ push @taxlines, {
+ table => $table,
+ num => $pkey,
+ credit => $tax_credit,
+ };
+ $taxtotal += $tax_credit;
+
+ } #foreach cust_bill_pkg_tax_(rate_)?location
+ }
+ } # foreach $billpkgnum
+
+ return (
+ subtotal => sprintf('%.2f', $subtotal),
+ taxtotal => sprintf('%.2f', $taxtotal),
+ taxlines => \@taxlines,
+ );
+}
+
=item credit_lineitems
Example:
my %cust_credit_bill = ();
my %cust_bill_pkg = ();
my %cust_credit_bill_pkg = ();
- my %taxlisthash = ();
my %unapplied_payments = (); #invoice numbers, and then billpaynums
+
+ # determine the tax adjustments
+ my %tax_adjust = $class->calculate_tax_adjustment(%arg);
+
foreach my $billpkgnum ( @{$arg{billpkgnums}} ) {
my $setuprecur = shift @{$arg{setuprecurs}};
my $amount = shift @{$arg{amounts}};
my $invnum = $cust_bill_pkg->invnum;
- if ( $setuprecur eq 'setup' ) {
- $cust_bill_pkg->setup($amount);
- $cust_bill_pkg->recur(0);
- $cust_bill_pkg->unitrecur(0);
- $cust_bill_pkg->type('');
- } else {
- $setuprecur = 'recur'; #in case its a usage classnum?
- $cust_bill_pkg->recur($amount);
- $cust_bill_pkg->setup(0);
- $cust_bill_pkg->unitsetup(0);
- }
-
push @{$cust_bill_pkg{$invnum}}, $cust_bill_pkg;
- #unapply any payments applied to this line item (other credits too?)
- foreach my $cust_bill_pay_pkg ( $cust_bill_pkg->cust_bill_pay_pkg($setuprecur) ) {
+ $cust_credit_bill{$invnum} += $amount;
+ push @{ $cust_credit_bill_pkg{$invnum} },
+ new FS::cust_credit_bill_pkg {
+ 'billpkgnum' => $billpkgnum,
+ 'amount' => sprintf('%.2f',$amount),
+ 'setuprecur' => $setuprecur,
+ 'sdate' => $cust_bill_pkg->sdate,
+ 'edate' => $cust_bill_pkg->edate,
+ };
+ # unapply payments (but not other credits) from this line item
+ foreach my $cust_bill_pay_pkg (
+ $cust_bill_pkg->cust_bill_pay_pkg($setuprecur)
+ ) {
$error = $cust_bill_pay_pkg->delete;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
$unapplied_payments{$invnum}{$cust_bill_pay_pkg->billpaynum}
+= $cust_bill_pay_pkg->amount;
}
+ }
+
+ # do the same for taxes
+ foreach my $tax_credit ( @{ $tax_adjust{taxlines} } ) {
+ my $table = $tax_credit->{table};
+ my $tax_link = "FS::$table"->by_key( $tax_credit->{num} )
+ or die "tried to credit $table #$tax_credit->{num} but it doesn't exist";
+
+ my $billpkgnum = $tax_link->billpkgnum;
+ my $cust_bill_pkg = qsearchs({
+ 'table' => 'cust_bill_pkg',
+ 'hashref' => { 'billpkgnum' => $billpkgnum },
+ 'addl_from' => 'LEFT JOIN cust_bill USING (invnum)',
+ 'extra_sql' => 'AND custnum = '. $cust_main->custnum,
+ }) or die "unknown billpkgnum $billpkgnum";
+
+ my $invnum = $cust_bill_pkg->invnum;
+ push @{$cust_bill_pkg{$invnum}}, $cust_bill_pkg;
- #$subtotal += $amount;
+ my $amount = $tax_credit->{credit};
$cust_credit_bill{$invnum} += $amount;
+
+ # create a credit application record to the tax line item, earmarked
+ # to the specific cust_bill_pkg_Xlocation
push @{ $cust_credit_bill_pkg{$invnum} },
new FS::cust_credit_bill_pkg {
- 'billpkgnum' => $cust_bill_pkg->billpkgnum,
- 'amount' => sprintf('%.2f',$amount),
- 'setuprecur' => $setuprecur,
- 'sdate' => $cust_bill_pkg->sdate,
- 'edate' => $cust_bill_pkg->edate,
+ 'billpkgnum' => $billpkgnum,
+ 'amount' => sprintf('%.2f', $amount),
+ 'setuprecur' => 'setup',
+ $tax_link->primary_key, $tax_credit->{num}
};
-
- # recalculate taxes with new amounts
- $taxlisthash{$invnum} ||= {};
- if ( $cust_bill_pkg->pkgnum or $cust_bill_pkg->feepart ) {
- $cust_main->_handle_taxes( $taxlisthash{$invnum}, $cust_bill_pkg );
- } # otherwise the item itself is a tax, and assume the caller knows
- # what they're doing
+ # unapply any payments from the tax
+ foreach my $cust_bill_pay_pkg (
+ $cust_bill_pkg->cust_bill_pay_pkg('setup')
+ ) {
+ $error = $cust_bill_pay_pkg->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error unapplying payment: $error";
+ }
+ $unapplied_payments{$invnum}{$cust_bill_pay_pkg->billpaynum}
+ += $cust_bill_pay_pkg->amount;
+ }
}
###
foreach my $invnum ( sort { $a <=> $b } keys %cust_credit_bill ) {
- my $arrayref_or_error =
- $cust_main->calculate_taxes(
- $cust_bill_pkg{$invnum}, # list of taxable items that we're crediting
- $taxlisthash{$invnum}, # list of tax-item bindings
- $cust_bill_pkg{$invnum}->[0]->cust_bill->_date, # invoice time
- );
-
- unless ( ref( $arrayref_or_error ) ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error calculating taxes: $arrayref_or_error";
- }
-
- my %tax_links; # {tax billpkgnum}{nontax billpkgnum}
-
- #taxes
- foreach my $cust_bill_pkg ( @{ $cust_bill_pkg{$invnum} } ) {
- my $billpkgnum = $cust_bill_pkg->billpkgnum;
- my %hash = ( 'taxable_billpkgnum' => $billpkgnum );
- # gather up existing tax links (we need their billpkgtaxlocationnums)
- my @tax_links = qsearch('cust_bill_pkg_tax_location', \%hash),
- qsearch('cust_bill_pkg_tax_rate_location', \%hash);
-
- foreach ( @tax_links ) {
- $tax_links{$_->billpkgnum} ||= {};
- $tax_links{$_->billpkgnum}{$_->taxable_billpkgnum} = $_;
- }
- }
-
- foreach my $taxline ( @$arrayref_or_error ) {
-
- my $amount = $taxline->setup;
-
- # find equivalent tax line item on the existing invoice
- my $tax_item = qsearchs('cust_bill_pkg', {
- 'invnum' => $invnum,
- 'pkgnum' => 0,
- 'itemdesc' => $taxline->desc,
- });
- if (!$tax_item) {
- # or should we just exit if this happens?
- $cust_credit->set('amount',
- sprintf('%.2f', $cust_credit->get('amount') - $amount)
- );
- my $error = $cust_credit->replace;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error correcting credit for missing tax line: $error";
- }
- }
-
- # but in the new era, we no longer have the problem of uniquely
- # identifying the tax_Xlocation record. The billpkgnums of the
- # tax and the taxed item are known.
- foreach my $new_loc
- ( @{ $taxline->get('cust_bill_pkg_tax_location') },
- @{ $taxline->get('cust_bill_pkg_tax_rate_location') } )
- {
- # the existing tax_Xlocation object
- my $old_loc =
- $tax_links{$tax_item->billpkgnum}{$new_loc->taxable_cust_bill_pkg->billpkgnum};
-
- next if !$old_loc; # apply the leftover amount nonspecifically
-
- #support partial credits: use $amount if smaller
- # (so just distribute to the first location? perhaps should
- # do so evenly...)
- my $loc_amount = min( $amount, $new_loc->amount);
-
- $amount -= $loc_amount;
-
- $cust_credit_bill{$invnum} += $loc_amount;
- push @{ $cust_credit_bill_pkg{$invnum} },
- new FS::cust_credit_bill_pkg {
- 'billpkgnum' => $tax_item->billpkgnum,
- 'amount' => $loc_amount,
- 'setuprecur' => 'setup',
- 'billpkgtaxlocationnum' => $old_loc->billpkgtaxlocationnum,
- 'billpkgtaxratelocationnum' => $old_loc->billpkgtaxratelocationnum,
- };
-
- } #foreach my $new_loc
-
- # we still have to deal with the possibility that the tax links don't
- # cover the whole amount of tax because of an incomplete upgrade...
- if ($amount > 0.005) {
- $cust_credit_bill{$invnum} += $amount;
- push @{ $cust_credit_bill_pkg{$invnum} },
- new FS::cust_credit_bill_pkg {
- 'billpkgnum' => $tax_item->billpkgnum,
- 'amount' => sprintf('%.2f', $amount),
- 'setuprecur' => 'setup',
- };
-
- } # if $amount > 0
-
- #unapply any payments applied to the tax
- foreach my $cust_bill_pay_pkg
- ( $tax_item->cust_bill_pay_pkg('setup') )
- {
- $error = $cust_bill_pay_pkg->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error unapplying payment: $error";
- }
- $unapplied_payments{$invnum}{$cust_bill_pay_pkg->billpaynum}
- += $cust_bill_pay_pkg->amount;
- }
- } #foreach $taxline
-
# if we unapplied any payments from line items, also unapply that
# amount from the invoice
foreach my $billpaynum (keys %{$unapplied_payments{$invnum}}) {
}
}
+ # if a reasonnum was passed, get the actual reason object so we can check
+ # unused_credit
+
+ my $reason;
+ if ($options{'reason'} =~ /^\d+$/) {
+ $reason = FS::reason->by_key($options{'reason'});
+ }
+
unless ($date) {
- # credit remaining time if appropriate
+ # credit remaining time if any of these are true:
+ # - unused_credit => 1 was passed (this happens when canceling a package
+ # for a package change when unused_credit_change is set)
+ # - no unused_credit option, and there is a cancel reason, and the cancel
+ # reason says to credit the package
+ # - no unused_credit option, and the package definition says to credit the
+ # package on cancellation
my $do_credit;
if ( exists($options{'unused_credit'}) ) {
$do_credit = $options{'unused_credit'};
- }
- else {
+ } elsif ( defined($reason) && $reason->unused_credit ) {
+ $do_credit = 1;
+ } else {
$do_credit = $self->part_pkg->option('unused_credit_cancel', 1);
}
if ( $do_credit ) {
# Use sdate < $time and edate >= $time because when billing on
# cancellation, edate = $time.
my $credit = 0;
- foreach my $item (
+ foreach my $cust_bill_pkg (
qsearch('cust_bill_pkg', {
pkgnum => $cust_pkg->pkgnum,
- sdate => {op => '<' , value => $time},
edate => {op => '>=', value => $time},
recur => {op => '>' , value => 0},
})
) {
# hack to deal with the weird behavior of edate on package cancellation
- my $edate = $item->edate;
+ my $edate = $cust_bill_pkg->edate;
if ( $self->recur_temporality eq 'preceding' ) {
- $edate = $self->add_freq($item->sdate);
+ $edate = $self->add_freq($cust_bill_pkg->sdate);
}
- $credit += ($item->recur - $item->usage) *
- ($edate - $time) / ($edate - $item->sdate);
+
+ # this will also get any package charges that are _entirely_ after the
+ # cancellation date (can happen with advance billing). in that case,
+ # use the entire recurring charge:
+ my $amount = $cust_bill_pkg->recur - $cust_bill_pkg->usage;
+
+ # but if the cancellation happens during the interval, prorate it:
+ # (XXX obey prorate_round_day here?)
+ if ( $cust_bill_pkg->sdate < $time ) {
+ $amount = $amount * ($edate - $time) / ($edate - $cust_bill_pkg->sdate);
+ }
+
+ $credit += $amount;
}
sprintf('%.2f', $credit);
- #sprintf("%.2f", $self->base_recur($cust_pkg, \$time) * ( $next_bill - $time ) / $freq_sec );
}
}
-=item order
+=item order [ HASHREF ]
This method is for use with quotations which are already associated with a customer.
If there is an error, returns an error message, otherwise returns false.
+If HASHREF is passed, it will be filled with a hash mapping the
+C<quotationpkgnum> of each quoted package to the C<pkgnum> of the package
+as ordered.
+
=cut
sub order {
my $self = shift;
+ my $pkgnum_map = shift || {};
+ my $details_map = {};
tie my %all_cust_pkg, 'Tie::RefHash';
foreach my $quotation_pkg ($self->quotation_pkg) {
my $cust_pkg = FS::cust_pkg->new;
+ $pkgnum_map->{ $quotation_pkg->quotationpkgnum } = $cust_pkg;
+
+ # details will be copied below, after package is ordered
+ $details_map->{ $quotation_pkg->quotationpkgnum } = [
+ map { $_->copy_on_order ? $_->detail : () } $quotation_pkg->quotation_pkg_detail
+ ];
+
foreach (qw(pkgpart locationnum start_date contract_end quantity waive_setup)) {
$cust_pkg->set( $_, $quotation_pkg->get($_) );
}
$all_cust_pkg{$cust_pkg} = []; # no services
}
- $self->cust_main->order_pkgs( \%all_cust_pkg );
+ 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->cust_main->order_pkgs( \%all_cust_pkg );
+
+ unless ($error) {
+ # copy details (copy_on_order filtering handled above)
+ foreach my $quotationpkgnum (keys %$details_map) {
+ next unless @{$details_map->{$quotationpkgnum}};
+ $error = $pkgnum_map->{$quotationpkgnum}->set_cust_pkg_detail(
+ 'I',
+ @{$details_map->{$quotationpkgnum}}
+ );
+ last if $error;
+ }
+ }
+
+ foreach my $quotationpkgnum (keys %$pkgnum_map) {
+ # convert the objects to just pkgnums
+ my $cust_pkg = $pkgnum_map->{$quotationpkgnum};
+ $pkgnum_map->{$quotationpkgnum} = $cust_pkg->pkgnum;
+ }
+
+ if ($error) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ ''; #no error
}
}
-=item set_details [ DETAIL, DETAIL, ... ]
+=item set_details PARAM
-Sets quotation details for this package (see L<FS::quotation_pkg_detail>).
+Sets new quotation details for this package (see L<FS::quotation_pkg_detail>),
+removing existing details.
+
+Recognizes the following parameters:
+
+details - arrayref of strings, one for each new detail
+
+copy_on_order - if true, sets copy_on_order flag on new details
If there is an error, returns the error, otherwise returns false.
=cut
sub set_details {
- my( $self, @details ) = @_;
+ my $self = shift;
+ my %opt = @_;
+
+ $opt{'details'} ||= [];
+ my @details = @{$opt{'details'}};
my $oldAutoCommit = $FS::UID::AutoCommit;
local $FS::UID::AutoCommit = 0;
my $quotation_pkg_detail = new FS::quotation_pkg_detail {
'quotationpkgnum' => $self->quotationpkgnum,
'detail' => $detail,
+ 'copy_on_order' => $opt{'copy_on_order'} ? 'Y' : '',
};
$error = $quotation_pkg_detail->insert;
if ( $error ) {
FS::quotation->by_key($self->quotationnum);
}
+sub quotation_pkg_detail {
+ my $self = shift;
+ sort { $a->detailnum <=> $b->detailnum }
+ qsearch('quotation_pkg_detail', { quotationpkgnum => $self->quotationpkgnum });
+}
+
sub quotation_pkg_discount {
my $self = shift;
qsearch('quotation_pkg_discount', { quotationpkgnum => $self->quotationpkgnum });
detail text
+=item copy_on_order
+
+flag, indicates detail should be copied over when ordering
+
=cut
# 'format' field isn't used, there for TemplateItem_Mixin
$self->ut_numbern('detailnum')
|| $self->ut_foreign_key('quotationpkgnum', 'quotation_pkg', 'quotationpkgnum')
|| $self->ut_text('detail')
+ || $self->ut_flag('copy_on_order')
;
return $error if $error;
whether to bill the unsuspend package immediately ('') or to wait until
the customer's next invoice ('Y').
-=item unused_credit - 'Y' or ''. For suspension reasons only (for now).
+=item unused_credit - 'Y' or ''. For suspension or cancellation reasons.
If enabled, the customer will be credited for their remaining time on
suspension.
;
return $error if $error;
- if ( $self->reasontype->class eq 'S' ) {
+ my $class = $self->reasontype->class;
+
+ if ( $class eq 'S' ) {
$error = $self->ut_numbern('unsuspend_pkgpart')
|| $self->ut_foreign_keyn('unsuspend_pkgpart', 'part_pkg', 'pkgpart')
|| $self->ut_flag('unsuspend_hold')
- || $self->ut_flag('unused_credit')
|| $self->ut_foreign_keyn('feepart', 'part_fee', 'feepart')
|| $self->ut_flag('fee_on_unsuspend')
|| $self->ut_flag('fee_hold')
;
return $error if $error;
} else {
- foreach (qw(unsuspend_pkgpart unsuspend_hold unused_credit feepart
+ foreach (qw(unsuspend_pkgpart unsuspend_hold feepart
fee_on_unsuspend fee_hold)) {
$self->set($_ => '');
}
}
+ if ( $class eq 'S' or $class eq 'C' ) {
+ $error = $self->ut_flag('unused_credit');
+ } else {
+ $self->set('unused_credit', '');
+ }
+
$self->SUPER::check;
}
my $align = 'rll';
-if ( $class eq 'S' ) {
- push @header,
- 'Credit unused service',
- 'Suspension fee',
- ;
+if ( $class eq 'S' or $class eq 'C' ) {
+ push @header, 'Credit unused service';
push @fields,
sub {
my $reason = shift;
} else {
return '<SPAN STYLE="background-color:#ff0000">NO</SPAN>';
}
- },
+ };
+ $align .= 'c';
+}
+if ( $class eq 'S' ) {
+ push @header, 'Suspension fee';
+ push @fields,
sub {
my $reason = shift;
my $feepart = $reason->feepart;
$text .= '</FONT>';
}
;
- $align .= 'cl';
+ $align .= 'l';
}
# reason merge handling
if $param->{"detail$row"} =~ /\S/;
}
-my $error = $quotation_pkg->set_details(@details);
+my $error = $quotation_pkg->set_details(
+ details => \@details,
+ copy_on_order => scalar($cgi->param('copy_on_order')) ? 'Y' : ''
+ );
</%init>
<TD BGCOLOR="#ffffff"><% $part_pkg->comment |h %></TD>
</TR>
+ <TR>
+ <TD></TD>
+ <TD>
+ <SELECT NAME="copy_on_order">
+ <OPTION VALUE=""<% $copy_on_order ? '' : ' SELECTED' %>>
+ <% emt('Details will only appear on quotation') %>
+ </OPTION>
+ <OPTION VALUE="Y"<% $copy_on_order ? ' SELECTED' : '' %>>
+ <% emt('Copy details to invoice when placing order') %>
+ </OPTION>
+ </SELECT>
+ </TD>
+ </TR>
+
% my $row = 0;
% for ( @details ) {
my @details = $quotation_pkg->details;
+my $copy_on_order = 0;
+if (@details) {
+
+ # currently, they should either all have this flag, or none
+ # but just in case, erring on the side of not copying to invoice
+ # unless every existing detail has copy_on_order
+ # (anyway, user has to submit change, this is just for autofill)
+
+ my @quotation_pkg_detail = $quotation_pkg->quotation_pkg_detail;
+ my @copy_on_order = grep { $_->copy_on_order } @quotation_pkg_detail;
+ $copy_on_order = 1 if @copy_on_order;
+ my @no_copy_on_order = grep { !$_->copy_on_order } @quotation_pkg_detail;
+ $copy_on_order = 0 if @no_copy_on_order;
+}
+
my $title = ( scalar(@details) ? 'Edit ' : 'Add ' ). 'Quotation Details';
</%init>
},
);
-if ( $class eq 'S' ) {
+if ( $class eq 'S' or $class eq 'C' ) {
push @fields,
{ 'field' => 'unused_credit',
'type' => 'checkbox',
'value' => 'Y',
- },
+ };
+}
+if ( $class eq 'S' ) {
{ 'type' => 'tablebreak-tr-title' },
{ 'field' => 'feepart',
'type' => 'select-table',
&>
% } # scalar(@types)
+% if ( $class eq 'C' ) {
+ <& tr-checkbox.html,
+ label => 'Credit the unused portion of service when canceling',
+ field => $id.'_new_unused_credit',
+ value => 'Y'
+ &>
+% }
% if ( $class eq 'S' ) {
<& tr-checkbox.html,
label => 'Credit the unused portion of service when suspending',
my $curuser = $FS::CurrentUser::CurrentUser;
die "access denied" unless $curuser->access_right('Credit line items');
-my $DEBUG = 0;
+my $DEBUG = 1;
my $conf = new FS::Conf;
my $return = {};
-if ( $sub eq 'calculate_taxes' ) {
+die "unknown sub '$sub'" if $sub ne 'calculate_taxes';
- {
+my %arg = $cgi->param('arg');
+warn join('', map "$_: $arg{$_}\n", keys %arg )
+ if $DEBUG;
- my %arg = $cgi->param('arg');
- $return = \%arg;
- warn join('', map "$_: $arg{$_}\n", keys %arg )
- if $DEBUG;
+#some false laziness w/cust_credit::credit_lineitems
- #some false laziness w/cust_credit::credit_lineitems
+my $cust_main = qsearchs({
+ 'table' => 'cust_main',
+ 'hashref' => { 'custnum' => $arg{custnum} },
+ 'extra_sql' => ' AND '. $curuser->agentnums_sql,
+}) or die 'unknown customer';
- my $cust_main = qsearchs({
- 'table' => 'cust_main',
- 'hashref' => { 'custnum' => $arg{custnum} },
- 'extra_sql' => ' AND '. $curuser->agentnums_sql,
- }) or die 'unknown customer';
+$arg{billpkgnums} = [ split(',', $arg{billpkgnums}) ];
+$arg{setuprecurs} = [ split(',', $arg{setuprecurs}) ];
+$arg{amounts} = [ split(',', $arg{amounts}) ];
- my @billpkgnums = split(',', $arg{billpkgnums});
- my @setuprecurs = split(',', $arg{setuprecurs});
- my @amounts = split(',', $arg{amounts});
+my %results = FS::cust_credit->calculate_tax_adjustment(%arg);
- my @cust_bill_pkg = ();
- my $taxlisthash = {};
- while ( @billpkgnums ) {
- my $billpkgnum = shift @billpkgnums;
- my $setuprecur = shift @setuprecurs;
- my $amount = shift @amounts;
+$return = {
+ %arg,
+ %results
+};
- my $cust_bill_pkg = qsearchs({
- 'table' => 'cust_bill_pkg',
- 'hashref' => { 'billpkgnum' => $billpkgnum },
- 'addl_from' => 'LEFT JOIN cust_bill USING (invnum)',
- 'extra_sql' => 'AND custnum = '. $cust_main->custnum,
- }) or die "unknown billpkgnum $billpkgnum";
-
- #shouldn't be passed# next if $cust_bill_pkg->pkgnum == 0;
-
- if ( $setuprecur eq 'setup' ) {
- $cust_bill_pkg->setup($amount);
- $cust_bill_pkg->recur(0);
- $cust_bill_pkg->unitrecur(0);
- $cust_bill_pkg->type('');
- } else {
- $cust_bill_pkg->recur($amount);
- $cust_bill_pkg->setup(0);
- $cust_bill_pkg->unitsetup(0);
- }
-
- push @cust_bill_pkg, $cust_bill_pkg;
-
- $cust_main->_handle_taxes( $taxlisthash, $cust_bill_pkg );
- }
-
- if ( @cust_bill_pkg ) {
-
- my $listref_or_error =
- $cust_main->calculate_taxes( \@cust_bill_pkg, $taxlisthash, $cust_bill_pkg[0]->cust_bill->_date );
-
- unless ( ref( $listref_or_error ) ) {
- $return->{error} = $listref_or_error;
- last;
- }
-
- my @taxlines = ();
- my $taxtotal = 0;
- $return->{taxlines} = \@taxlines;
- foreach my $taxline ( @$listref_or_error ) {
- my $amount = $taxline->setup;
- my $desc = $taxline->desc;
- foreach my $location (
- @{$taxline->get('cust_bill_pkg_tax_location')},
- @{$taxline->get('cust_bill_pkg_tax_rate_location')} )
- {
- my $taxlocnum = $location->locationnum || '';
- my $taxratelocnum = $location->taxratelocationnum || '';
- $location->cust_bill_pkg_desc($taxline->desc); #ugh @ that kludge
- $taxtotal += $location->amount;
- push @taxlines,
- #[ $location->desc, $taxline->setup, $taxlocnum, $taxratelocnum ];
- [ $location->desc, $location->amount, $taxlocnum, $taxratelocnum ];
- $amount -= $location->amount;
- }
- if ($amount > 0) {
- $taxtotal += $amount;
- push @taxlines,
- [ $taxline->itemdesc. ' (default)', sprintf('%.2f', $amount), '', '' ];
- }
- }
-
- $return->{taxlines} = \@taxlines;
- $return->{taxtotal} = sprintf('%.2f', $taxtotal);
-
- } else {
-
- $return->{taxlines} = [];
- $return->{taxtotal} = '0.00';
-
- }
-
- }
-
-}
+warn Dumper $return if $DEBUG;
</%init>
projects / freeside.git / commitdiff