summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorIvan Kohler <ivan@freeside.biz>2013-05-04 00:21:14 -0700
committerIvan Kohler <ivan@freeside.biz>2013-05-04 00:21:14 -0700
commit1daf1a670d3cdfb307271fb7c7c98c83fb1fb464 (patch)
treef2bfe6b8a9deeb81878ceb62f7a50164a5bba6b4
parent71c6403be78e91e34d4124da35c9d0d284ad197d (diff)
parent6b1b3797e7136fb617c32d467bb3281920318436 (diff)
Merge branch 'master' of git.freeside.biz:/home/git/freeside
-rw-r--r--FS/FS/cust_main/Billing.pm137
-rw-r--r--FS/FS/cust_main/Search.pm8
-rw-r--r--FS/FS/pay_batch/BoM.pm2
-rw-r--r--FS/FS/reason.pm37
-rwxr-xr-xhttemplate/search/cust_pay_pending.html5
-rw-r--r--httemplate/search/elements/cust_main_dayranges.html9
-rw-r--r--httemplate/search/elements/search-xls.html25
-rwxr-xr-xhttemplate/search/h_cust_pay.html5
-rwxr-xr-xhttemplate/search/unapplied_cust_pay.html5
-rwxr-xr-xhttemplate/view/cust_main/locations.html2
10 files changed, 199 insertions, 36 deletions
diff --git a/FS/FS/cust_main/Billing.pm b/FS/FS/cust_main/Billing.pm
index 939a625c7..814802b34 100644
--- a/FS/FS/cust_main/Billing.pm
+++ b/FS/FS/cust_main/Billing.pm
@@ -437,6 +437,24 @@ sub bill {
my @part_pkg = $cust_pkg->part_pkg->self_and_bill_linked;
$options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
+ # if this package was changed from another package,
+ # and it hasn't been billed since then,
+ # and package balances are enabled,
+ if ( $cust_pkg->change_pkgnum
+ and $cust_pkg->change_date >= ($cust_pkg->last_bill || 0)
+ and $cust_pkg->change_date < $invoice_time
+ and $conf->exists('pkg-balances') )
+ {
+ # _transfer_balance will also create the appropriate credit
+ my @transfer_items = $self->_transfer_balance($cust_pkg);
+ # $part_pkg[0] is the "real" part_pkg
+ my $pass = ($cust_pkg->no_auto || $part_pkg[0]->no_auto) ?
+ 'no_auto' : '';
+ push @{ $cust_bill_pkg{$pass} }, @transfer_items;
+ # treating this as recur, just because most charges are recur...
+ ${$total_recur{$pass}} += $_->recur foreach @transfer_items;
+ }
+
foreach my $part_pkg ( @part_pkg ) {
$cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
@@ -1220,24 +1238,107 @@ sub _make_lines {
}
-# This is _handle_taxes. It's called once for each cust_bill_pkg generated
-# from _make_lines, along with the part_pkg, cust_pkg, invoice time, the
-# non-overridden pkgpart, a flag indicating whether the package is being
-# canceled, and a partridge in a pear tree.
-#
-# The most important argument is 'taxlisthash'. This is shared across the
-# entire invoice. It looks like this:
-# {
-# 'cust_main_county 1001' => [ [FS::cust_main_county], ... ],
-# 'cust_main_county 1002' => [ [FS::cust_main_county], ... ],
-# }
-#
-# 'cust_main_county' can also be 'tax_rate'. The first object in the array
-# is always the cust_main_county or tax_rate identified by the key.
-#
-# That "..." is a list of FS::cust_bill_pkg objects that will be fed to
-# the 'taxline' method to calculate the amount of the tax. This doesn't
-# happen until calculate_taxes, though.
+=item _transfer_balance TO_PKG [ FROM_PKGNUM ]
+
+Takes one argument, a cust_pkg object that is being billed. This will
+be called only if the package was created by a package change, and has
+not been billed since the package change, and package balance tracking
+is enabled. The second argument can be an alternate package number to
+transfer the balance from; this should not be used externally.
+
+Transfers the balance from the previous package (now canceled) to
+this package, by crediting one package and creating an invoice item for
+the other. Inserts the credit and returns the invoice item (so that it
+can be added to an invoice that's being built).
+
+If the previous package was never billed, and was also created by a package
+change, then this will also transfer the balance from I<its> previous
+package, and so on, until reaching a package that either has been billed
+or was not created by a package change.
+
+=cut
+
+my $balance_transfer_reason;
+
+sub _transfer_balance {
+ my $self = shift;
+ my $cust_pkg = shift;
+ my $from_pkgnum = shift || $cust_pkg->change_pkgnum;
+ my $from_pkg = FS::cust_pkg->by_key($from_pkgnum);
+
+ my @transfers;
+
+ # if $from_pkg is not the first package in the chain, and it was never
+ # billed, walk back
+ if ( $from_pkg->change_pkgnum and scalar($from_pkg->cust_bill_pkg) == 0 ) {
+ @transfers = $self->_transfer_balance($cust_pkg, $from_pkg->change_pkgnum);
+ }
+
+ my $prev_balance = $self->balance_pkgnum($from_pkgnum);
+ if ( $prev_balance != 0 ) {
+ $balance_transfer_reason ||= FS::reason->new_or_existing(
+ 'reason' => 'Package balance transfer',
+ 'type' => 'Internal adjustment',
+ 'class' => 'R'
+ );
+
+ my $credit = FS::cust_credit->new({
+ 'custnum' => $self->custnum,
+ 'amount' => abs($prev_balance),
+ 'reasonnum' => $balance_transfer_reason->reasonnum,
+ '_date' => $cust_pkg->change_date,
+ });
+
+ my $cust_bill_pkg = FS::cust_bill_pkg->new({
+ 'setup' => 0,
+ 'recur' => abs($prev_balance),
+ #'sdate' => $from_pkg->last_bill, # not sure about this
+ #'edate' => $cust_pkg->change_date,
+ 'itemdesc' => $self->mt('Previous Balance, [_1]',
+ $from_pkg->part_pkg->pkg),
+ });
+
+ if ( $prev_balance > 0 ) {
+ # credit the old package, charge the new one
+ $credit->set('pkgnum', $from_pkgnum);
+ $cust_bill_pkg->set('pkgnum', $cust_pkg->pkgnum);
+ } else {
+ # the reverse
+ $credit->set('pkgnum', $cust_pkg->pkgnum);
+ $cust_bill_pkg->set('pkgnum', $from_pkgnum);
+ }
+ my $error = $credit->insert;
+ die "error transferring package balance from #".$from_pkgnum.
+ " to #".$cust_pkg->pkgnum.": $error\n" if $error;
+
+ push @transfers, $cust_bill_pkg;
+ } # $prev_balance != 0
+
+ return @transfers;
+}
+
+=item _handle_taxes PART_PKG TAXLISTHASH CUST_BILL_PKG CUST_PKG TIME PKGPART [ OPTIONS ]
+
+This is _handle_taxes. It's called once for each cust_bill_pkg generated
+from _make_lines, along with the part_pkg, cust_pkg, invoice time, the
+non-overridden pkgpart, a flag indicating whether the package is being
+canceled, and a partridge in a pear tree.
+
+The most important argument is 'taxlisthash'. This is shared across the
+entire invoice. It looks like this:
+{
+ 'cust_main_county 1001' => [ [FS::cust_main_county], ... ],
+ 'cust_main_county 1002' => [ [FS::cust_main_county], ... ],
+}
+
+'cust_main_county' can also be 'tax_rate'. The first object in the array
+is always the cust_main_county or tax_rate identified by the key.
+
+That "..." is a list of FS::cust_bill_pkg objects that will be fed to
+the 'taxline' method to calculate the amount of the tax. This doesn't
+happen until calculate_taxes, though.
+
+=cut
sub _handle_taxes {
my $self = shift;
diff --git a/FS/FS/cust_main/Search.pm b/FS/FS/cust_main/Search.pm
index 7dbb7a859..e0c7080fe 100644
--- a/FS/FS/cust_main/Search.pm
+++ b/FS/FS/cust_main/Search.pm
@@ -624,14 +624,14 @@ sub search {
# parse without census tract checkbox
##
- push @where, "(censustract = '' or censustract is null)"
+ push @where, "(ship_location.censustract = '' or ship_location.censustract is null)"
if $params->{'no_censustract'};
##
# parse with hardcoded tax location checkbox
##
- push @where, "geocode is not null"
+ push @where, "ship_location.geocode is not null"
if $params->{'with_geocode'};
##
@@ -841,7 +841,7 @@ sub search {
'ON (cust_main.'.$pre.'locationnum = '.$pre.'location.locationnum) ';
}
- my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
+ my $count_query = "SELECT COUNT(*) FROM cust_main $addl_from $extra_sql";
my @select = (
'cust_main.custnum',
@@ -927,6 +927,8 @@ sub search {
'extra_headers' => \@extra_headers,
'extra_fields' => \@extra_fields,
};
+ warn Data::Dumper::Dumper($sql_query);
+ $sql_query;
}
diff --git a/FS/FS/pay_batch/BoM.pm b/FS/FS/pay_batch/BoM.pm
index a3708d477..b609df351 100644
--- a/FS/FS/pay_batch/BoM.pm
+++ b/FS/FS/pay_batch/BoM.pm
@@ -59,7 +59,7 @@ $name = 'BoM';
footer => sub {
my ($pay_batch, $batchcount, $batchtotal) = @_;
sprintf( "YD%08u%014.0f%55s\n", $batchcount, $batchtotal*100, ""). #80
- sprintf( "Z%014u%05u%014u%05u%40s", #80 now
+ sprintf( "Z%014.0f%05u%014u%05u%40s", #80 now
$batchtotal*100, $batchcount, "0", "0", "");
},
);
diff --git a/FS/FS/reason.pm b/FS/FS/reason.pm
index a9a7d745d..e6b20db8f 100644
--- a/FS/FS/reason.pm
+++ b/FS/FS/reason.pm
@@ -139,6 +139,43 @@ sub reasontype {
=back
+=head1 CLASS METHODS
+
+=over 4
+
+=item new_or_existing reason => REASON, type => TYPE, class => CLASS
+
+Fetches the reason matching these parameters if there is one. If not,
+inserts one. Will also insert the reason type if necessary. CLASS must
+be one of 'C' (cancel reasons), 'R' (credit reasons), or 'S' (suspend reasons).
+
+This will die if anything fails.
+
+=cut
+
+sub new_or_existing {
+ my $class = shift;
+ my %opt = @_;
+
+ my $error = '';
+ my %hash = ('class' => $opt{'class'}, 'type' => $opt{'type'});
+ my $reason_type = qsearchs('reason_type', \%hash)
+ || FS::reason_type->new(\%hash);
+
+ $error = $reason_type->insert unless $reason_type->typenum;
+ die "error inserting reason type: $error\n" if $error;
+
+ %hash = ('reason_type' => $reason_type->typenum, 'reason' => $opt{'reason'});
+ my $reason = qsearchs('reason', \%hash)
+ || FS::reason->new(\%hash);
+
+ $error = $reason->insert unless $reason->reasonnum;
+ die "error inserting reason: $error\n" if $error;
+
+ $reason;
+}
+
+
=head1 BUGS
Here by termintes. Don't use on wooden computers.
diff --git a/httemplate/search/cust_pay_pending.html b/httemplate/search/cust_pay_pending.html
index 2afce0ce9..54c9935ef 100755
--- a/httemplate/search/cust_pay_pending.html
+++ b/httemplate/search/cust_pay_pending.html
@@ -1,4 +1,4 @@
-<% include( 'elements/cust_pay_or_refund.html',
+<& elements/cust_pay_or_refund.html,
'thing' => 'pay_pending',
'amount_field' => 'paid',
'name_singular' => 'pending payment',
@@ -10,8 +10,7 @@
$status_sub,
],
'redirect_empty' => $redirect_empty,
- )
-%>
+&>
<%init>
my %statusaction = (
diff --git a/httemplate/search/elements/cust_main_dayranges.html b/httemplate/search/elements/cust_main_dayranges.html
index cf2d495b1..493365281 100644
--- a/httemplate/search/elements/cust_main_dayranges.html
+++ b/httemplate/search/elements/cust_main_dayranges.html
@@ -2,10 +2,10 @@
Example:
- include( 'elements/cust_main_dayranges.html',
+ <& elements/cust_main_dayranges.html,
'title' => 'Accounts Receivable Aging Summary',
'range_sub' => $mysub,
- )
+ &>
my $mysub = sub {
my( $start, $end ) = @_;
@@ -44,7 +44,7 @@ Example:
$row->{'rangecol_60_90'} ),
sprintf( $money_char.'%.2f',
$row->{'rangecol_90_0'} ),
- sprintf( '<b>'. $money_char.'%.2f'. '</b>',
+ sprintf( '<b>'.$money_char.'%.2f</b>',
$row->{'rangecol_0_0'} ),
('') x @pay_labels,
],
@@ -81,6 +81,9 @@ Example:
'', '', '', '', 'b',
( map '', @pay_labels ),
],
+ 'xls_format' => [ (map '', FS::UI::Web::cust_styles),
+ '', '', '', '', { bold => 1 },
+ ],
'color' => [
FS::UI::Web::cust_colors(),
'',
diff --git a/httemplate/search/elements/search-xls.html b/httemplate/search/elements/search-xls.html
index 26a51c4c7..bc844a579 100644
--- a/httemplate/search/elements/search-xls.html
+++ b/httemplate/search/elements/search-xls.html
@@ -6,6 +6,8 @@ my $header = $args{'header'};
my $rows = $args{'rows'};
my %opt = %{ $args{'opt'} };
+my $style = $opt{'style'};
+
my $override = scalar(@$rows) >= 65536 ? 'XLSX' : '';
my $format = $FS::CurrentUser::CurrentUser->spreadsheet_format($override);
@@ -42,6 +44,12 @@ my $header_format = $workbook->add_format(
bg_color => 55, #22,
bottom => 3,
);
+my $footer_format = $workbook->add_format(
+ italic => 1,
+ locked => 1,
+ bg_color => 55,
+ top => 3,
+);
my $default_format = $workbook->add_format(locked => 0);
my %money_format;
@@ -50,10 +58,24 @@ my $money_char = FS::Conf->new->config('money_char') || '$';
my %date_format;
xl_parse_date_init();
+my %bold_format;
+
my $writer = sub {
# Wrapper for $worksheet->write.
# Do any massaging of the value/format here.
my ($r, $c, $value, $format) = @_;
+ #warn "writer called with format $format\n";
+
+ if ( $style->[$c] eq 'b' or $value =~ /<b>/i ) { # the only one in common use
+ $value =~ s[</?b>][]ig;
+ if ( !exists($bold_format{$format}) ) {
+ $bold_format{$format} = $workbook->add_format();
+ $bold_format{$format}->copy($format);
+ $bold_format{$format}->set_bold();
+ }
+ $format = $bold_format{$format};
+ }
+
# convert HTML entities
# both Spreadsheet::WriteExcel and Excel::Writer::XLSX accept UTF-8 strings
$value = decode_entities($value);
@@ -86,6 +108,7 @@ my $writer = sub {
# String: replace line breaks with newlines
$value =~ s/<BR>/\n/gi;
}
+ #warn "writing with format $format\n";
$worksheet->write($r, $c, $value, $format);
};
@@ -140,7 +163,7 @@ if ( $opt{'footer'} ) {
if ( ref($item) eq 'CODE' ) {
$item = &{$item}();
}
- $writer->( $r, $c++, $item, $header_format );
+ $writer->( $r, $c++, $item, $footer_format );
}
}
diff --git a/httemplate/search/h_cust_pay.html b/httemplate/search/h_cust_pay.html
index 99330fadd..6d2dd9955 100755
--- a/httemplate/search/h_cust_pay.html
+++ b/httemplate/search/h_cust_pay.html
@@ -1,9 +1,8 @@
-<% include( 'elements/cust_pay_or_refund.html',
+<& elements/cust_pay_or_refund.html,
'table' => 'h_cust_pay',
'amount_field' => 'paid',
'name_singular' => 'payment',
'name_verb' => 'paid',
'pre_header' => [ 'Transaction', 'By' ],
'pre_fields' => [ 'history_action', 'history_user' ],
- )
-%>
+&>
diff --git a/httemplate/search/unapplied_cust_pay.html b/httemplate/search/unapplied_cust_pay.html
index e232291fe..f5c2bf0f9 100755
--- a/httemplate/search/unapplied_cust_pay.html
+++ b/httemplate/search/unapplied_cust_pay.html
@@ -1,9 +1,8 @@
-<% include( 'elements/cust_main_dayranges.html',
+<& elements/cust_main_dayranges.html,
#'title' => 'Prepaid Balance Aging Summary', #???
'title' => 'Unapplied Payments Aging Summary',
'range_sub' => \&unapplied_payments,
- )
-%>
+&>
<%init>
die "access denied"
diff --git a/httemplate/view/cust_main/locations.html b/httemplate/view/cust_main/locations.html
index b29d0ce4d..689c9a390 100755
--- a/httemplate/view/cust_main/locations.html
+++ b/httemplate/view/cust_main/locations.html
@@ -36,7 +36,7 @@ STYLE="padding-bottom: 0px;
% }
</SPAN></TH></TR>
% if (@$packages) {
-<& packages/section.html, 'packages' => $packages &>
+<& packages/section.html, 'packages' => $packages, 'cust_main' => $cust_main &>
% }
</TABLE><BR>
% } #foreach $locationnum