httemplate/search/elements/search-xls.html

   1 <%init>
   2
   3 my %args = @_;
   4 my $header = $args{'header'};
   5 my $rows   = $args{'rows'};
   6 my %opt    = %{ $args{'opt'} };
   7
   8 my $override = scalar(@$rows) >= 65536 ? 'XLSX' : '';
   9
  10 my $format = $FS::CurrentUser::CurrentUser->spreadsheet_format($override);
  11
  12 my $filename = $opt{'name'} || PL($opt{'name_singular'});
  13 $filename .= $format->{extension};
  14
  15 #http_header('Content-Type' => 'application/excel' ); #eww
  16 #http_header('Content-Type' => 'application/msexcel' ); #alas
  17 #http_header('Content-Type' => 'application/x-msexcel' ); #?
  18
  19 #http://support.microsoft.com/kb/199841
  20 http_header('Content-Type' => $format->{mime_type} );
  21 http_header('Content-Disposition' => qq!attachment;filename="$filename"! );
  22
  23 #http://support.microsoft.com/kb/812935
  24 #http://support.microsoft.com/kb/323308
  25 $HTML::Mason::Commands::r->headers_out->{'Cache-control'} = 'max-age=0';
  26
  27 my $data = '';
  28 my $XLS = new IO::Scalar \$data;
  29 my $workbook = $format->{class}->new($XLS)
  30   or die "Error opening Excel file: $!";
  31
  32 my $title = $opt{'title'};
  33 $title =~ s/[\[\]\:\*\?\/\/]//g;
  34 $title = substr($title, 0, 31);
  35
  36 # append a single worksheet
  37 $m->comp( 'SELF:worksheet',
  38   workbook  => $workbook,
  39   title     => $title,
  40   opt       => \%opt,
  41   header    => $header,
  42   rows      => $rows
  43 );
  44
  45 $workbook->close();# or die "Error creating .xls file: $!";
  46
  47 http_header('Content-Length' => length($data) );
  48 $m->clear_buffer();
  49 $m->print($data);
  50
  51 </%init>
  52 <%method worksheet>
  53 <%args>
  54 $workbook
  55 $title
  56 %opt
  57 $header
  58 $rows
  59 </%args>
  60 <%perl>
  61
  62 my $worksheet = $workbook->add_worksheet($title);
  63
  64 #$worksheet->protect();
  65
  66 my $style = $opt{style};
  67
  68 my($r,$c) = (0,0);
  69
  70 my $header_format = $workbook->add_format(
  71   bold     => 1,
  72   locked   => 1,
  73   bg_color => 55, #22,
  74   bottom   => 3,
  75 );
  76 my $footer_format = $workbook->add_format(
  77   italic   => 1,
  78   locked   => 1,
  79   bg_color => 55,
  80   top      => 3,
  81 );
  82 my $default_format = $workbook->add_format(locked => 0);
  83
  84 my %money_format;
  85 my $money_char = FS::Conf->new->config('money_char') || '$';
  86
  87 my %date_format;
  88 xl_parse_date_init();
  89
  90 my %bold_format;
  91
  92 my @widths;
  93
  94 my $writer;
  95 $writer = sub {
  96   # Wrapper for $worksheet->write.
  97   # Do any massaging of the value/format here.
  98   my ($r, $c, $value, $format) = @_;
  99   #warn "writer called with format $format\n";
 100
 101   if ( ref $value eq 'ARRAY' ) {
 102     # imitate the write_row() method: write the array into a column starting
 103     # with $r.
 104     # (currently only used in the footer; to use it anywhere else we'd need
 105     # some way to return the number of rows written)
 106     foreach my $v (@$value) {
 107       $writer->($r, $c, $v, $format);
 108       $r++;
 109     }
 110     return;
 111   }
 112
 113   my $bold = 0;
 114   my $date = 0;
 115   if ( $style->[$c] eq 'b' or $value =~ /<b>/i ) { # the only one in common use
 116     $value =~ s[</?b>][]ig;
 117     if ( !exists($bold_format{$format}) ) {
 118       $bold_format{$format} = $workbook->add_format();
 119       $bold_format{$format}->copy($format);
 120       $bold_format{$format}->set_bold();
 121     }
 122     $format = $bold_format{$format};
 123     $bold = 1;
 124   }
 125
 126   # convert HTML entities
 127   # both Spreadsheet::WriteExcel and Excel::Writer::XLSX accept UTF-8 strings
 128   $value = decode_entities($value);
 129
 130   if ( $value =~ /^\Q$money_char\E(-?\d+\.?\d*)$/ ) {
 131     # Currency: strip the symbol, clone the requested format,
 132     # and format it for currency
 133     $value = $1;
 134 #    warn "formatting $value as money\n";
 135     if ( !exists($money_format{$format}) ) {
 136       $money_format{$format} = $workbook->add_format();
 137       $money_format{$format}->copy($format);
 138       $money_format{$format}->set_num_format($money_char.'#0.00#');
 139     }
 140     $format = $money_format{$format};
 141   }
 142   elsif ( $value =~ /^([A-Z][a-z]{2}) (\d{2}) (\d{4})$/ ) {
 143     # Date: convert the value to an Excel date number and set
 144     # the format
 145     $value = xl_parse_date($value);
 146 #    warn "formatting $value as date\n";
 147     if ( !exists($date_format{$format}) ) {
 148       $date_format{$format} = $workbook->add_format();
 149       $date_format{$format}->copy($format);
 150       $date_format{$format}->set_num_format('mmm dd yyyy');
 151     }
 152     $format = $date_format{$format};
 153     $date = 1;
 154   }
 155   else {
 156     # String: replace line breaks with newlines
 157     $value =~ s/<BR>/\n/gi;
 158   }
 159   #warn "writing with format $format\n";
 160   $worksheet->write($r, $c, $value, $format);
 161
 162   # estimate width
 163   # use Font::TTFMetrics; # would work, but we can't redistribute the font...
 164   my $width = length($value);
 165   $width = 11 if $date;
 166   $width *= 1.1 if $bold;
 167   $width += 1; # pad it a little
 168   $widths[$c] = $width if $width > ($widths[$c] || 0);
 169 };
 170
 171 $writer->( $r, $c++, $_, $header_format ) foreach @$header;
 172
 173 foreach my $row ( @$rows ) {
 174   $r++;
 175   $c = 0;
 176
 177   if ( $opt{'fields'} ) {
 178
 179     #my $links = $opt{'links'} ? [ @{$opt{'links'}} ] : '';
 180     #my $aligns = $opt{'align'} ? [ @{$opt{'align'}} ] : '';
 181     #could also translate color, size, style into xls equivalents?
 182     my $formats = $opt{'xls_format'} ? [ @{$opt{'xls_format'}} ] : [];
 183
 184     foreach my $field ( @{$opt{'fields'}} ) {
 185
 186       my $xls_format = $default_format;
 187
 188       if ( my $format = shift @$formats ) {
 189         $format = &{$format}($row) if ref($format) eq 'CODE';
 190         $format ||= {};
 191         $xls_format = $workbook->add_format(locked=>0, %$format);
 192       }
 193
 194       if ( ref($field) eq 'CODE' ) {
 195         foreach my $value ( &{$field}($row) ) {
 196           if ( ref($value) eq 'ARRAY' ) {
 197             $writer->($r, $c++, '(N/A)' ); #unimplemented
 198           } else {
 199             $writer->($r, $c++, $value, $xls_format );
 200           }
 201         }
 202       } else {
 203         $writer->( $r, $c++, $row->$field(), $xls_format );
 204       }
 205     }
 206
 207   } else {
 208     # no need for each row to need a new format
 209     #my $xls_format = $workbook->add_format(locked=>0);
 210     $writer->( $r, $c++, $_, $default_format ) foreach @$row;
 211   }
 212
 213 }
 214
 215 if ( $opt{'footer'} ) {
 216   $r++;
 217   $c = 0;
 218   foreach my $item (@{ $opt{'footer'} }) {
 219     if ( ref($item) eq 'CODE' ) {
 220       $item = &{$item}();
 221     }
 222     $writer->( $r, $c++, $item, $footer_format );
 223   }
 224 }
 225
 226 for ( my $x = 0; $x < scalar @widths; $x++ ) {
 227   $worksheet->set_column($x, $x, $widths[$x]);
 228 }
 229
 230 </%perl>
 231 </%method>