Merge branch 'master' of git.freeside.biz:/home/git/freeside
authorIvan Kohler <ivan@freeside.biz>
Sat, 4 May 2013 07:21:14 +0000 (00:21 -0700)
committerIvan Kohler <ivan@freeside.biz>
Sat, 4 May 2013 07:21:14 +0000 (00:21 -0700)
FS/FS/cust_main/Billing.pm
FS/FS/cust_main/Search.pm
FS/FS/pay_batch/BoM.pm
FS/FS/reason.pm
httemplate/search/cust_pay_pending.html
httemplate/search/elements/cust_main_dayranges.html
httemplate/search/elements/search-xls.html
httemplate/search/h_cust_pay.html
httemplate/search/unapplied_cust_pay.html
httemplate/view/cust_main/locations.html

index 939a625..814802b 100644 (file)
@@ -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;
index 7dbb7a8..e0c7080 100644 (file)
@@ -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;
 
 }
 
index a3708d4..b609df3 100644 (file)
@@ -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", "");
   },
 );
index a9a7d74..e6b20db 100644 (file)
@@ -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.
index 2afce0c..54c9935 100755 (executable)
@@ -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 = (
index cf2d495..4933652 100644 (file)
@@ -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(),
                                     '',
index 26a51c4..bc844a5 100644 (file)
@@ -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 );
   }
 }
 
index 99330fa..6d2dd99 100755 (executable)
@@ -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' ],
-          )
-%>
+&>
index e232291..f5c2bf0 100755 (executable)
@@ -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"
index b29d0ce..689c9a3 100755 (executable)
@@ -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