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