httemplate/graph/elements/report.html

   1 <%doc>
   2
   3 Example:
   4
   5   include('elements/report.html',
   6     #required
   7     'title'           => 'Page title',
   8     'items'           => \@items,
   9     'data'            => [ \@item1 \@item2 ... ],
  10
  11     #these run parallel to items, and can be given as hashes
  12     'row_labels'      => \@row_labels,    #required
  13     'colors'          => \@colors,        #required
  14     'bgcolors'        => \@bgcolors,      #optional
  15     'graph_labels'    => \@graph_labels,  #defaults to row_labels
  16
  17     'links'           => \@links,         #optional
  18     'no_graph'        => \@no_graph,      #optional
  19
  20     #these run parallel to the elements of each @item
  21     'col_labels'      => \@col_labels,    #required
  22     'axis_labels'     => \@axis_labels,   #defaults to col_labels
  23
  24     #optional
  25     'nototal'         => 1,
  26     'graph_type'      => 'LinesPoints',   #can be 'none' for no graph
  27     'bottom_total'    => 1,
  28     'sprintf'         => '%u', #sprintf format, overrides default %.2f
  29     'disable_money'   => 1,
  30   );
  31
  32 About @links: Each element must be an arrayref, corresponding to an element of
  33 @items.  Within the array, the first element is a URL prefix, and the rest
  34 are suffixes corresponding to data elements.  These will be joined without
  35 any delimiter and linked from the elements in @data.
  36
  37 </%doc>
  38 % if ( $cgi->param('_type') =~ /^(csv)$/ ) {
  39 %
  40 %   #http_header('Content-Type' => 'text/comma-separated-values' ); #IE chokes
  41 %   #http_header('Content-Type' => 'text/plain' );
  42 %   http_header('Content-Type' => 'text/csv');
  43 %   http_header('Content-Disposition' => "attachment;filename=$filename.csv");
  44 %
  45 %   my $csv = new Text::CSV_XS { 'always_quote' => 1,
  46 %                                'eol'          => "\n", #"\015\012", #"\012"
  47 %                              };
  48 %
  49 %   $csv->combine('', @col_labels, $opt{'nototal'} ? () : 'Total');
  50 %
  51 <% $csv->string %>
  52 %
  53 %   my @bottom_total = ();
  54 %   my $row = 0;
  55 %   foreach ( @items ) {
  56 %
  57 %     my $col = 0;
  58 %     my @row = map { sprintf($sprintf, $_) } @{ shift(@data) };
  59 %     my $total = sum(@row);
  60 %     push @row, sprintf($sprintf, $total) unless $opt{'nototal'};
  61 %     unless ($opt{'no_graph'}[$row]) {
  62 %       foreach (@row) {
  63 %         $bottom_total[$col++] += $_;
  64 %       }
  65 %     }
  66 %     $csv->combine(shift(@row_labels), @row);
  67 <% $csv->string %>
  68 %
  69 %   }
  70 %
  71 %   if ( $opt{'bottom_total'} ) {
  72 %     $csv->combine(
  73 %       'Total',
  74 %       map { sprintf($sprintf, $_) } @bottom_total,
  75 %     );
  76 %
  77 <% $csv->string %>
  78 %
  79 %   }
  80 %
  81 % } elsif ( $cgi->param('_type') =~ /(xls)$/ ) {
  82 %   #false laziness w/  search/elements/search-xls
  83 %   my $format = $FS::CurrentUser::CurrentUser->spreadsheet_format;
  84 %   $filename .= $format->{extension};
  85 %
  86 %   http_header('Content-Type' => $format->{mime_type} );
  87 %   http_header('Content-Disposition' => qq!attachment;filename="$filename"! );
  88 %
  89 %   my $output = '';
  90 %   my $XLS = new IO::Scalar \$output;
  91 %   my $workbook = $format->{class}->new($XLS)
  92 %     or die "Error opening .xls file: $!";
  93 %
  94 %   my $worksheet = $workbook->add_worksheet(substr($opt{'title'},0,31));
  95 %
  96 %   my($row,$col) = (0,0);
  97 %
  98 %   foreach ('', @col_labels, ($opt{'nototal'} ? () : 'Total') ) {
  99 %     my $header = $_;
 100 %     $worksheet->write($row, $col++, $header)
 101 %   }
 102 %
 103 %   my @bottom_total = ();
 104 %   foreach ( @items ) {
 105 %     $row++;
 106 %     $col = 0;
 107 %     my $total = 0;
 108 %     $worksheet->write( $row, $col++, shift( @row_labels ) );
 109 %     foreach ( @{ shift( @data ) } ) {
 110 %       $total += $_;
 111 %       $bottom_total[$col-1] += $_ unless $opt{no_graph}[$row];
 112 %       $worksheet->write_number($row, $col++,  sprintf($sprintf, $_) );
 113 %     }
 114 %     if ( !$opt{'nototal'} ) {
 115 %       $bottom_total[$col-1] += $total unless $opt{no_graph}[$row];
 116 %       $worksheet->write_number($row, $col++,  sprintf($sprintf, $total) );
 117 %     }
 118 %   }
 119 %
 120 %   $col = 0;
 121 %   if ( $opt{'bottom_total'} ) {
 122 %     $row++;
 123 %     $worksheet->write($row, $col++, 'Total');
 124 %     $worksheet->write_number($row, $col++, sprintf($sprintf, $_)) foreach @bottom_total;
 125 %   }
 126 %
 127 %   $workbook->close();# or die "Error creating .xls file: $!";
 128 %
 129 %   http_header('Content-Length' => length($output) );
 130 %   $m->print($output);
 131 %
 132 % } elsif ( $cgi->param('_type') eq 'png' ) {
 133 %   # delete any items that shouldn't be on the graph
 134 %   if ( my $no_graph = $opt{'no_graph'} ) {
 135 %     my $i = 0;
 136 %     while (@$no_graph) {
 137 %       if ( shift @$no_graph ) {
 138 %         splice @data, $i, 1;
 139 %         splice @{$opt{'graph_labels'}}, $i, 1;
 140 %         splice @{$opt{'colors'}}, $i, 1;
 141 %         $i--; # because everything is shifted down
 142 %       }
 143 %       $i++;
 144 %     }
 145 %   }
 146 %   my $graph_type = 'LinesPoints';
 147 %   if ( $opt{'graph_type'} =~ /^(LinesPoints|Mountain|Bars)$/ ) {
 148 %     $graph_type = $1;
 149 %   }
 150 %   my $class = "Chart::$graph_type";
 151 %
 152 %   my $chart = $class->new(976,384);
 153 % # the chart area itself is 900 pixels wide, and the date labels are ~60 each.
 154 % # staggered, we can fit about 28 of them.
 155 % # they're about 12 pixels high, so vertically, we can fit about 60 (allowing
 156 % # space for them to be readable).
 157 % # after that we have to start skipping labels. also remove the dots, since
 158 % # they're just a blob at that point.
 159 %   my $num_labels = scalar(@{ $opt{axis_labels} });
 160 %   my %chart_opt = %{ $opt{chart_options} || {} };
 161 %   if ( $num_labels > 28 ) {
 162 %     $chart_opt{x_ticks} = 'vertical';
 163 %     if ( $num_labels > 60 ) {
 164 %       $chart_opt{skip_x_ticks} = int($num_labels / 60) + 1;
 165 %       $chart_opt{pt_size} = 1;
 166 %     }
 167 %   }
 168 %   my $d = 0;
 169 %   $chart->set(
 170 %     #'min_val' => 0,
 171 %     'legend' => 'bottom',
 172 %     'colors' => { (
 173 %                     map { my $color = $_;
 174 %                           'dataset'.$d++ =>
 175 %                             [ map hex($_), unpack 'a2a2a2', $color ]
 176 %                         }
 177 %                         @{ $opt{'colors'} }
 178 %                   ),
 179 %                   'grey_background' => 'white',
 180 %                   'background' => [ 0xe8, 0xe8, 0xe8 ], #grey
 181 %                 },
 182 %     'legend_labels' => $opt{'graph_labels'},
 183 %     'brush_size' => 4,
 184 %     %chart_opt,
 185 %   );
 186 %
 187 %   http_header('Content-Type' => 'image/png' );
 188 %   http_header('Cache-Control' => 'no-cache' );
 189 %
 190 %   $chart->_set_colors();
 191 %
 192 <% $chart->scalar_png([ $opt{'axis_labels'}, @data ]) %>
 193 %
 194 % } else {
 195 % # image and download links should use the cached data
 196 % # just directly reference this component
 197 % my $myself = $p.'graph/elements/report.html?session='.$session;
 198 %
 199 <% include('/elements/header.html', $opt{'title'} ) %>
 200 % unless ( $opt{'graph_type'} eq 'none' ) {
 201
 202 <IMG SRC="<% "$myself;_type=png" %>" WIDTH="976" HEIGHT="384"
 203  STYLE="page-break-after:always;">
 204 % }
 205 <P ALIGN="right" CLASS="noprint">
 206
 207 % unless ( $opt{'disable_download'} ) {
 208             Download full results<BR>
 209             as <A HREF="<% "$myself;_type=xls" %>">Excel spreadsheet</A><BR>
 210             as <A HREF="<% "$myself;_type=csv" %>">CSV file</A></P>
 211 % }
 212 %
 213 </P>
 214 %# indexed by item, then by entry (the element indices of @{$data[$i]}).
 215 % my @cell = ();
 216 % my @styles;
 217 % my $num_entries = scalar(@col_labels);
 218 % my $num_items = scalar(@items);
 219 % $cell[0] = ['']; #top left corner
 220 % foreach my $column ( @col_labels ) {
 221 %   $column =~ s/ /\<BR\>/;
 222 %   push @{$cell[0]}, $column;
 223 % }
 224 % if ( ! $opt{'nototal'} ) {
 225 %   $num_entries++;
 226 %   push @{$cell[0]}, emt('Total');
 227 % }
 228
 229 % # i for item, e for entry
 230 % my $i = 1;
 231 % my @bottom_total = map {0} @col_labels;
 232 % foreach my $row ( @items ) {
 233 % #make a style
 234 %   my $color = shift @{ $opt{'colors'} };
 235 %   my $bgcolor = $opt{'bgcolors'} ? (shift @{ $opt{'bgcolors'} }) : 'ffffff';
 236 %   push @styles, ".i$i { text-align: right; color: #$color; background: #$bgcolor; }";
 237 % #create the data row
 238 %   my $links = shift @{$opt{'links'}} || [''];
 239 %   my $link_prefix = shift @$links;
 240 %   $link_prefix = '<A CLASS="cell" HREF="'.$link_prefix if $link_prefix;
 241 %   my $label = shift @row_labels;
 242 %   $cell[$i] = [ $label ];
 243 %
 244 %   my $data_row = $data[$i-1];
 245 %#   my $data_row = shift @data;
 246 %   if ( ! $opt{'nototal'} ) {
 247 %     push @$data_row, sum(@$data_row);
 248 %   }
 249 %   my $e = 0;
 250 %   foreach ( @$data_row ) {
 251 %     my $entry = $_;
 252 %     $entry = $money_char . sprintf($sprintf_fields->{$row} ? $sprintf_fields->{$row} : $sprintf, $entry);
 253 %     $entry = $link_prefix . shift(@$links) . "\">$entry</A>" if $link_prefix;
 254 %     push @{$cell[$i]}, $entry;
 255 %     $bottom_total[$e++] += $_ unless $opt{no_graph}[$i-1];
 256 %   }
 257 %   $i++;
 258 % }
 259 % if ( $opt{'bottom_total'} ) {
 260 %   # it's an extra item
 261 %   $num_items++;
 262 %   push @styles, ".i$i { text-align: right; background-color: #f5f6be; }";
 263 %   my $links = $opt{'bottom_link'} || [];
 264 %   my $link_prefix = shift @$links;
 265 %   $link_prefix = '<A CLASS="cell" HREF="'.$link_prefix if $link_prefix;
 266 %   $cell[$i] = [ emt('Total') ];
 267 %   for (my $e = 0; $e < $num_entries + 1; $e++) {
 268 %     my $entry = $bottom_total[$e];
 269 %     $entry = $money_char . sprintf($sprintf, $entry);
 270 %     $entry = $link_prefix . shift(@$links) . "\">$entry</A>" if $link_prefix;
 271 %     push @{$cell[$i]}, $entry;
 272 %   }
 273 % }
 274
 275 <STYLE type="text/css">
 276 a.cell {
 277   color: inherit !important;
 278 }
 279 td.cell {
 280   border-color: #000;
 281 }
 282 <% join("\n", @styles) %>
 283 %# item labels
 284 .e0 {
 285   text-align: center;
 286   font-weight: bold;
 287 }
 288 %# totals
 289 % if ( ! $opt{'nototal'} ) {
 290 .e<% $num_entries %> {
 291   text-align: right;
 292   background-color: #f5f6be;
 293 }
 294 % }
 295 %# date labels
 296 .i0 {
 297   text-align: center;
 298   font-weight: bold;
 299 }
 300 </STYLE>
 301
 302 <% include('/elements/table.html', 'f8f8f8') %>
 303 % if ( $opt{'transpose'} ) {
 304 %   for ( my $e = 0; $e < $num_entries + 1; $e++ ) {
 305   <TR>
 306 %     for ( my $i = 0; $i < $num_items + 1; $i++ ) {
 307     <TD CLASS="<%"cell i$i e$e"%>"><% $cell[$i][$e] %></TD>
 308 %     }
 309   </TR>
 310 %   }
 311 %
 312 % } else { #!transpose
 313 %
 314 %   for (my $i = 0; $i < $num_items + 1; $i++) {
 315   <TR>
 316 %     for (my $e = 0; $e < $num_entries + 1; $e++) {
 317     <TD CLASS="<%"cell i$i e$e"%>"><% $cell[$i][$e] %></TD>
 318 %     }
 319   </TR>
 320 %   }
 321 </TABLE>
 322 % }
 323
 324 <% include('/elements/footer.html') %>
 325 % }
 326 <%init>
 327
 328 my(%opt) = @_;
 329 my $session;
 330 # load from cache if possible, to avoid recalculating
 331 if ( $cgi->param('session') =~ /^(\d+)$/ ) {
 332   $session = $1;
 333   %opt = %{ $m->cache->get($session) };
 334 }
 335 else {
 336   $session = sprintf("%010d", random_id(10));
 337   $m->cache->set($session, \%opt, '1h');
 338 }
 339
 340 my $sprintf = $opt{'sprintf'} || '%.2f';
 341
 342 my $conf = new FS::Conf;
 343 my $money_char = $opt{'disable_money'} ? '' : $conf->config('money_char');
 344
 345 my @items = @{ $opt{'items'} };
 346 my $sprintf_fields = $opt{'sprintf_fields'};
 347
 348 foreach my $other (qw( col_labels row_labels graph_labels axis_labels colors links )) {
 349   if ( ref($opt{$other}) eq 'HASH' ) {
 350     $opt{$other} = [ map $opt{$other}{$_}, @items ];
 351   }
 352 }
 353
 354 my @col_labels = @{$opt{'col_labels'}};
 355 my @row_labels = @{$opt{'row_labels'}};
 356 my @data       = @{$opt{'data'}};
 357
 358 $opt{'axis_labels'}  ||= $opt{'col_labels'};
 359 $opt{'graph_labels'} ||= $opt{'row_labels'};
 360
 361 my $filename = $cgi->url(-relative => 1);
 362 $filename =~ s/\.(cgi|html)$//;
 363
 364 </%init>