diff options
| -rw-r--r-- | FS/FS/cust_main/Billing.pm | 137 | ||||
| -rw-r--r-- | FS/FS/cust_main/Search.pm | 8 | ||||
| -rw-r--r-- | FS/FS/pay_batch/BoM.pm | 2 | ||||
| -rw-r--r-- | FS/FS/reason.pm | 37 | ||||
| -rwxr-xr-x | httemplate/search/cust_pay_pending.html | 5 | ||||
| -rw-r--r-- | httemplate/search/elements/cust_main_dayranges.html | 9 | ||||
| -rw-r--r-- | httemplate/search/elements/search-xls.html | 25 | ||||
| -rwxr-xr-x | httemplate/search/h_cust_pay.html | 5 | ||||
| -rwxr-xr-x | httemplate/search/unapplied_cust_pay.html | 5 | ||||
| -rwxr-xr-x | httemplate/view/cust_main/locations.html | 2 |
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 |