refactor and fix customer accounting summary report, #24112 and #40103
authorMark Wells <mark@freeside.biz>
Fri, 5 Feb 2016 23:16:12 +0000 (15:16 -0800)
committerMark Wells <mark@freeside.biz>
Sat, 6 Feb 2016 00:09:09 +0000 (16:09 -0800)
httemplate/search/customer_accounting_summary.html
httemplate/search/elements/grid-report.html [new file with mode: 0644]

index 744b313..a8e5033 100644 (file)
@@ -1,120 +1,8 @@
-% if ( $cgi->param('_type') =~ /(xls)$/ ) {
-<%perl>
-  # egregious false laziness w/ search/report_tax-xls.cgi
-  my $format = $FS::CurrentUser::CurrentUser->spreadsheet_format;
-  my $filename = $cgi->url(-relative => 1);
-  $filename =~ s/\.html$//;
-  $filename .= $format->{extension};
-  http_header('Content-Type' => $format->{mime_type});
-  http_header('Content-Disposition' => qq!attachment;filename="$filename"!);
-
-  my $output = '';
-  my $XLS = IO::String->new($output);
-  my $workbook = $format->{class}->new($XLS)
-    or die "Error opening .xls file: $!";
-
-  my $worksheet = $workbook->add_worksheet('Summary');
-
-  my %format = (
-    header => {
-      size      => 11,
-      bold      => 1,
-      align     => 'center',
-      valign    => 'vcenter',
-      text_wrap => 1,
-    },
-    money => {
-      size      => 11,
-      align     => 'right',
-      valign    => 'bottom',
-      num_format=> 8,
-    },
-    '' => {},
-  );
-  my %default = (
-      font      => 'Calibri',
-      border    => 1,
-  );
-  foreach (keys %format) {
-    my %f = (%default, %{$format{$_}});
-    $format{$_} = $workbook->add_format(%f);
-    $format{"m_$_"} = $workbook->add_format(%f);
-  }
-
-  my ($r, $c) = (0, 0);
-  for my $row (@rows) {
-    $c = 0;
-    my $thisrow = shift @cells;
-    for my $cell (@$thisrow) {
-      if (!ref($cell)) {
-        # placeholder, so increment $c so that we write to the correct place
-        $c++;
-        next;
-      }
-      # format name
-      my $f = '';
-      $f = 'header' if $row->{header} or $cell->{header};
-      $f = 'money' if $cell->{format} eq 'money';
-      if ( $cell->{rowspan} > 1 or $cell->{colspan} > 1 ) {
-        my $range = xl_range_formula(
-          'Summary',
-          $r, $r - 1 + ($cell->{rowspan} || 1),
-          $c, $c - 1 + ($cell->{colspan} || 1)
-        );
-        #warn "merging $range\n";
-        $worksheet->merge_range($range, $cell->{value}, $format{"m_$f"});
-      } else {
-      #warn "writing ".xl_rowcol_to_cell($r, $c)."\n";
-        $worksheet->write( $r, $c, $cell->{value}, $format{$f} );
-      }
-      $c++;
-    } #$cell
-  $r++;
-  } #$row
-  $workbook->close;
-
-  http_header('Content-Length' => length($output));
-  $m->print($output);
-</%perl>
-% } else {
-<& /elements/header.html, $title &>
-% my $myself = $cgi->self_url;
-<P ALIGN="right" CLASS="noprint">
-Download full reports<BR>
-as <A HREF="<% "$myself;_type=xls" %>">Excel spreadsheet</A><BR>
-% # as <A HREF="<% "$myself;_type=csv" %>">CSV file</A> # is this still needed?
-</P>
-<style type="text/css">
-.report * {
-  background-color: #f8f8f8;
-  border: 1px solid #999999;
-  padding: 2px;
-}
-.report td {
-  text-align: right;
-}
-.total * { background-color: #f5f6be; }
-.shaded * { background-color: #c8c8c8; }
-.totalshaded * { background-color: #bfc094; }
-</style>
-<table class="report" width="100%" cellspacing=0>
-% foreach my $rowinfo (@rows) {
-  <tr<% $rowinfo->{class} ? ' class="'.$rowinfo->{class}.'"' : ''%>>
-%   my $thisrow = shift @cells;
-%   foreach my $cell (@$thisrow) {
-%     next if !ref($cell); # placeholders
-%     my $td = $cell->{header} ? 'th' : 'td';
-%     my $style = '';
-%     $style .= " rowspan=".$cell->{rowspan} if $cell->{rowspan} > 1;
-%     $style .= " colspan=".$cell->{colspan} if $cell->{colspan} > 1;
-      <<%$td%><%$style%>><% $cell->{value} |h %></<%$td%>>
-%   }
-  </tr>
-% }
-</table>
-
-<& /elements/footer.html &>
-% }
+<& elements/grid-report.html,
+  title => $title,
+  rows  => \@rows,
+  cells => \@cells,
+&>
 <%init>
 
 die "access denied"
@@ -224,17 +112,14 @@ my @cells; # arrayrefs of cell info
 $rows[0] = {};
 $cells[0] = [
   { header => 1, rowspan => 2, colspan => ($setuprecur ? 4 : 3) },
-  ($setuprecur ? '' : ()),
   map {
     { header => 1, colspan => ($grossdiscount ? 3 : 2), value => time2str('%b %Y', $_) },
-    ''
   } @{ $data->{speriod} }
 ];
 my $ncols = scalar(@{ $data->{speriod} });
 
 $rows[1] = {};
-$cells[1] = [ '',
-  ($setuprecur ? '' : ()),
+$cells[1] = [
   map { 
   ( ($grossdiscount 
       ? (
@@ -270,8 +155,6 @@ foreach my $cust_main (@cust_main) { # correspond to cross_params
           rowspan => ($setuprecur ? 2 : 1),
         },
       ;
-    } else {
-      push @thisrow, '';
     }
     if ( $setuprecur ) {
       # subheading
@@ -310,8 +193,6 @@ for my $subrow (0..($setuprecur ? 1 : 0)) {
         header => 1,
         colspan => 3,
         rowspan => ($setuprecur ? 2 : 1), };
-  } else {
-    push @thisrow, '';
   }
   if ( $setuprecur ) {
     push @thisrow,
diff --git a/httemplate/search/elements/grid-report.html b/httemplate/search/elements/grid-report.html
new file mode 100644 (file)
index 0000000..cb06b2b
--- /dev/null
@@ -0,0 +1,187 @@
+<%doc>
+
+Simple display front-end for reports that produce some kind of data table,
+which the user can request as an Excel spreadsheet. /elements/header.html
+and /elements/footer.html are included automatically, so don't include them
+again.
+
+Usage:
+
+<& elements/grid-report.html,
+  title => 'My Report',
+  rows => [
+    { header => 1, },
+    ...
+  ],
+  cells => [
+    [ # row 0
+      { value => '123.45',
+        # optional
+        format => 'money',
+        header => 1,
+        rowspan => 2,
+        colspan => 3,
+        class => 'highlight',
+      },
+      ...
+    ],
+  ],
+  head => q[<div>Thing to insert before the table</div>],
+  foot => q[<span>That's all folks!</span>].
+&>
+</%doc>
+% if ( $cgi->param('_type') =~ /(xls)$/ ) {
+<%perl>
+  # egregious false laziness w/ search/report_tax-xls.cgi
+  # and search/customer_cdr_profit.html
+  my $format = $FS::CurrentUser::CurrentUser->spreadsheet_format;
+  my $filename = $cgi->url(-relative => 1);
+  $filename =~ s/\.html$//;
+  $filename .= $format->{extension};
+  http_header('Content-Type' => $format->{mime_type});
+  http_header('Content-Disposition' => qq!attachment;filename="$filename"!);
+
+  my $output = '';
+  my $XLS = IO::String->new($output);
+  my $workbook = $format->{class}->new($XLS)
+    or die "Error opening .xls file: $!";
+
+  my $worksheet = $workbook->add_worksheet('Summary');
+
+  my %format = (
+    header => {
+      size      => 11,
+      bold      => 1,
+      align     => 'center',
+      valign    => 'vcenter',
+      text_wrap => 1,
+    },
+    money => {
+      size      => 11,
+      align     => 'right',
+      valign    => 'bottom',
+      num_format=> 8,
+    },
+    '' => {},
+  );
+  my %default = (
+      font      => 'Calibri',
+      border    => 1,
+  );
+  foreach (keys %format) {
+    my %f = (%default, %{$format{$_}});
+    $format{$_} = $workbook->add_format(%f);
+    $format{"m_$_"} = $workbook->add_format(%f);
+  }
+
+  my ($r, $c) = (0, 0);
+  # indices in these correspond to column positions
+  my @rowspans;
+  my @widths;
+  
+  for my $row (@rows) {
+    $c = 0;
+    my $thisrow = shift @cells;
+    for my $cell (@$thisrow) {
+      # skip over cells that are occupied by rowspans above them
+      while ($rowspans[$c]) {
+        $rowspans[$c]--;
+        $c++;
+      }
+
+      # skip this cell if it's empty, also
+      next if !ref($cell);
+      # format name
+      my $f = '';
+      $f = 'header' if $row->{header} or $cell->{header};
+      $f = 'money' if $cell->{format} eq 'money';
+      if ( $cell->{rowspan} > 1 or $cell->{colspan} > 1 ) {
+        my $range = xl_range_formula(
+          'Summary',
+          $r, $r - 1 + ($cell->{rowspan} || 1),
+          $c, $c - 1 + ($cell->{colspan} || 1)
+        );
+        #warn "merging $range\n";
+        $worksheet->merge_range($range, $cell->{value}, $format{"m_$f"});
+      } else {
+      #warn "writing ".xl_rowcol_to_cell($r, $c)."\n";
+        $worksheet->write( $r, $c, $cell->{value}, $format{$f} );
+      }
+
+      # estimate column width, as in search-xls, but without date formats
+      my $width = length($cell->{value}) / ($cell->{colspan} || 1);
+      $width *= 1.1 if $f eq 'header';
+      $width++ if $f eq 'money'; # for money symbol
+      $width += 2; # pad it
+
+      for (1 .. ($cell->{colspan} || 1)) {
+        # adjust minimum widths to allow for this cell's contents
+        $widths[$c] = $width if $width > ($widths[$c] || 0);
+
+        # and if this cell has a rowspan, block off that many rows below it
+        if ( $cell->{rowspan} > 1 ) {
+          $rowspans[$c] = $cell->{rowspan} - 1;
+        }
+        $c++;
+      }
+    } #$cell
+  $r++;
+  } #$row
+
+  $c = 0;
+  for my $c (0 .. scalar(@widths) - 1) {
+    $worksheet->set_column($c, $c, $widths[$c]);
+  }
+  $workbook->close;
+
+  http_header('Content-Length' => length($output));
+  $m->print($output);
+</%perl>
+% } else {
+<& /elements/header.html, $title &>
+<% $head %>
+% my $myself = $cgi->self_url;
+<P ALIGN="right" CLASS="noprint">
+Download full reports<BR>
+as <A HREF="<% "$myself;_type=xls" %>">Excel spreadsheet</A><BR>
+% # as <A HREF="<% "$myself;_type=csv" %>">CSV file</A> # is this still needed?
+</P>
+<style type="text/css">
+.report * {
+  background-color: #f8f8f8;
+  border: 1px solid #999999;
+  padding: 2px;
+}
+.report td {
+  text-align: right;
+}
+.total * { background-color: #f5f6be; }
+.shaded * { background-color: #c8c8c8; }
+.totalshaded * { background-color: #bfc094; }
+</style>
+<table class="report" width="100%" cellspacing=0>
+% foreach my $rowinfo (@rows) {
+  <tr<% $rowinfo->{class} ? ' class="'.$rowinfo->{class}.'"' : ''%>>
+%   my $thisrow = shift @cells;
+%   foreach my $cell (@$thisrow) {
+%     next if !ref($cell); # placeholders
+%     my $td = $cell->{header} ? 'th' : 'td';
+%     my $style = '';
+%     $style .= " rowspan=".$cell->{rowspan} if $cell->{rowspan} > 1;
+%     $style .= " colspan=".$cell->{colspan} if $cell->{colspan} > 1;
+%     $style .= ' class="' . $cell->{class} . '"' if $cell->{class};
+      <<%$td%><%$style%>><% $cell->{value} |h %></<%$td%>>
+%   }
+  </tr>
+% }
+</table>
+<% $foot %>
+<& /elements/footer.html &>
+% }
+<%args>
+$title
+@rows
+@cells
+$head => ''
+$foot => ''
+</%args>