Changelog
[Spreadsheet-Read.git] / examples / xlscat
1 #!/pro/bin/perl
2
3 # xlscat:  show XLS/SXC file as Text
4 # xlsgrep: grep pattern
5 #          (m)'14 [09-11-2014] Copyright H.M.Brand 2005-2014
6
7 use strict;
8 use warnings;
9
10 our $VERSION = "2.6";
11
12 my $is_grep = $0 =~ m/grep$/;
13
14 sub usage
15 {
16     my $err = shift and select STDERR;
17     (my $scrpt = $0) =~ s{.*[\/]}{};
18     my $p = $is_grep ? " pattern" : "";
19     print
20         "usage: $scrpt\t[-s <sep>] [-L] [-n] [-A] [-u] [Selection]$p file.xls\n",
21         "             \t[-c | -m]                 [-u] [Selection]$p file.xls\n",
22         "             \t -i                            [-S sheets]$p file.xls\n",
23         "    Generic options:\n",
24         "       -v[#]       Set verbose level (xlscat/xlsgrep)\n",
25         "       -d[#]       Set debug   level (Spreadsheet::Read)\n",
26         "       -u          Use unformatted values\n",
27         "       --noclip    Do not strip empty sheets and\n",
28         "                   trailing empty rows and columns\n",
29         "       -e <enc>    Set encoding for input and output\n",
30         "       -b <enc>    Set encoding for input\n",
31         "       -a <enc>    Set encoding for output\n",
32         "    Input CSV:\n",
33         "       --in-sep=c  Set input sep_char for CSV\n",
34         "    Input XLS:\n",
35         "       --dtfmt=fmt Specify the default date format to replace 'm-d-yy'\n",
36         "                   the default replacement is 'yyyy-mm-dd'\n",
37         "    Output Text (default):\n",
38         "       -s <sep>    Use separator <sep>. Default '|', \\n allowed\n",
39         "       -L          Line up the columns\n",
40         "       -n [skip]   Number lines (prefix with column number)\n",
41         "                   optionally skip <skip> (header) lines\n",
42         "       -A          Show field attributes in ANSI escapes\n",
43         $is_grep ? (
44         "    Grep options:\n",
45         "       -i          Ignore case\n",
46         "       -w          Match whole words only\n",
47         "       -h[#]       Show # header lines\n") : (
48         "    Output Index only:\n",
49         "       -i          Show sheet names and size only\n"),
50         "    Output CSV:\n",
51         "       -c          Output CSV, separator = ','\n",
52         "       -m          Output CSV, separator = ';'\n",
53         "    Output HTML:\n",
54         "       -H          Output HTML\n",
55         "    Selection:\n",
56         "       -S <sheets> Only print sheets <sheets>. 'all' is a valid set\n",
57         "                   Default only prints the first sheet\n",
58         "       -R <rows>   Only print rows    <rows>. Default is 'all'\n",
59         "       -C <cols>   Only print columns <cols>. Default is 'all'\n",
60         "       -F <flds>   Only fields <flds> e.g. -FA3,B16\n";
61     @_ and print join "\n", @_, "";
62     exit $err;
63     } # usage
64
65 use Getopt::Long qw(:config bundling noignorecase);
66 my $opt_c;              # Generate CSV
67 my $opt_s;              # Text separator
68 my $opt_S;              # Sheets to print
69 my $opt_R;              # Rows to print
70 my $opt_C;              # Columns to print
71 my $dtfmt;              # Default date-format for Excel
72 my $opt_F = "";         # Fields to print
73 my $opt_i = 0;          # Index (cat) | ignore_case (grep)
74 my $opt_L = 0;          # Auto-size/align columns
75 my $opt_n;              # Prefix lines with column number
76 my $opt_u = 0;          # Show unformatted values
77 my $opt_v = 0;          # Verbosity for xlscat
78 my $opt_d = 0;          # Debug level for Spreadsheet::Read
79 my $opt_A = 0;          # Show field colors in ANSI escapes
80 my $opt_H = 0;          # Output in HTML
81 my $opt_h = 0;          # Number of header lines for grep
82 my $opt_w = 0;          # Grep words
83 my $clip  = 1;
84 my $enc_i;              # Input  encoding
85 my $enc_o;              # Output encoding
86 my $sep;                # Input field sep for CSV
87 GetOptions (
88     "help|?"            => sub { usage (0); },
89
90     # Input CSV
91     "c|csv"             => sub { $opt_c = "," },
92     "m|ms"              => sub { $opt_c = ";" },
93     "insepchar".
94      "|in-sep".
95      "|in-sep-char=s"   => \$sep,
96
97     # Input XLS
98     "dtfmt".
99      "|date-format=s"   => \$dtfmt,
100
101     # Output
102     "i|index"           => \$opt_i,
103     "s|separator".
104      "|outsepchar".
105      "|out-sep".
106      "|out-sep-char=s"  => \$opt_s,
107     "S|sheets=s"        => \$opt_S,
108     "R|rows=s"          => \$opt_R,
109     "C|columns=s"       => \$opt_C,
110     "F|fields=s"        => \$opt_F,
111     "L|fit|align!"      => \$opt_L,
112     "n|number:0"        => \$opt_n,
113     "A|ansi|color!"     => \$opt_A,
114     "u|unformatted!"    => \$opt_u,
115     "v|verbose:1"       => \$opt_v,
116     "d|debug:1"         => \$opt_d,
117     "H|html:1"          => \$opt_H,
118       "noclip"          => sub { $clip = 0 },
119
120     # Encoding
121     "e|encoding=s"      => sub { $enc_i = $enc_o = $_[1] },
122     "b|encoding-in=s"   => \$enc_i,
123     "a|encoding-out=s"  => \$enc_o,
124
125     # Grep
126     "i|ignore-case!"    => \$opt_i,
127     "w|word!"           => \$opt_w,
128     "h|header:1"        => \$opt_h,
129     ) or usage 1, "GetOpt: $@";
130
131 unless ($is_grep) {
132 $opt_i && $opt_L and usage 1, "Options i and L are mutually exclusive";
133 $opt_i && $opt_s and usage 1, "Options i and s are mutually exclusive";
134 $opt_i && $opt_c and usage 1, "Options i and c are mutually exclusive";
135 $opt_i && $opt_u and usage 1, "Options i and u are mutually exclusive";
136 $opt_i && $opt_S and usage 1, "Options i and S are mutually exclusive";
137 $opt_i && $opt_R and usage 1, "Options i and R are mutually exclusive";
138 $opt_i && $opt_C and usage 1, "Options i and C are mutually exclusive";
139 $opt_i && $opt_F and usage 1, "Options i and F are mutually exclusive";
140 $opt_i && $opt_H and usage 1, "Options i and H are mutually exclusive";
141 }
142 $opt_c && $opt_s and usage 1, "Options c and s are mutually exclusive";
143 $opt_c && $opt_H and usage 1, "Options c and H are mutually exclusive";
144 $opt_s && $opt_H and usage 1, "Options s and H are mutually exclusive";
145
146 defined $opt_s or $opt_s = "|"; eval "\$opt_s = qq{$opt_s}";
147 defined $opt_S or $opt_S = $opt_i || $is_grep ? "all" : "1";
148 $opt_i && !$is_grep && $opt_v < 1 and $opt_v = 1;
149
150 if ($opt_c) {
151     $opt_L = 0; # Cannot align CSV
152     $opt_c =~ m/^1?$/ and $opt_c = ",";
153     $opt_c = Text::CSV_XS->new ({
154         binary   => 1,
155         sep_char => $opt_c,
156         eol      => "\r\n",
157         });
158     }
159
160 # Debugging. Prefer Data::Peek over Data::Dumper if available
161 {   use Data::Dumper;
162     my $dp = 0;
163     eval q{
164         use Data::Peek;
165         $dp = 1;
166         };
167     sub ddumper
168     {
169         $dp ? DDumper (@_)
170             : print STDERR Dumper (@_);
171         } # ddumper
172     }
173
174 my $pattern;
175 if ($is_grep) {
176     $pattern = shift or usage 1;
177     $opt_w and $pattern = "\\b$pattern\\b";
178     $opt_i and $pattern = "(?i:$pattern)";
179     $pattern = qr{$pattern};
180     $opt_v > 1 and warn "Matching on $pattern\n";
181     }
182
183 @ARGV or usage 1;
184 my $file = shift;
185 -f $file or usage 1, "the file argument is not a regular file";
186 -s $file or usage 1, "the file is empty";
187
188 use Encode qw( encode decode );
189 use Spreadsheet::Read;
190
191 if ($opt_c) {
192     Spreadsheet::Read::parses ("csv") or die "No CSV module found\n";
193     eval q{use Text::CSV_XS};
194     }
195 if ($opt_H) {
196     $enc_o = "utf-8";
197     $opt_H = sub { $_[0]; };
198     eval q{
199         use HTML::Entities;
200         $opt_H = sub {
201             encode_entities (decode ("utf-8", $_[0]));
202             };
203         };
204     }
205
206 my @RDarg = (debug => $opt_d, clip => $clip);
207 $opt_A         and push @RDarg, "attr"  => 1;
208 defined $sep   and push @RDarg, "sep"   => $sep, parser => "csv";
209 defined $dtfmt and push @RDarg, "dtfmt" => $dtfmt;
210 $opt_v > 4 and warn "ReadData ($file, @RDarg);\n";
211 my $xls = ReadData ($file, @RDarg) or die "cannot read $file\n";
212 $opt_v > 7 and ddumper ($xls);
213 my $sc  = $xls->[0]{sheets}     or die "No sheets in $file\n";
214 $opt_v > 1 and warn "Opened $file with $sc sheets\n";
215
216 $opt_S eq "all" and $opt_S = "1..$sc";  # all
217 $opt_S =~ s/-$/-$sc/;                   # 3,6-
218 $opt_S =~ s/-/../g;
219 my %print;
220 eval "%{\$print{sheet}} = map { \$_ => 1 } $opt_S";
221
222 my $v_fmt = $opt_C || $opt_R || $opt_F ? "" : "%6d x %6d%s";
223
224 # New style xterm (based on ANSI colors):
225 # 30 Black
226 # 31 Red
227 # 32 Green
228 # 33 Yellow
229 # 34 Blue
230 # 35 Magenta
231 # 36 Cyan
232 # 37 White
233 sub color_reduce
234 {
235     my ($rgb, $base) = @_;
236     defined $rgb or return "";
237     my ($r, $g, $b) = map { hex >> 7 }
238         ($rgb =~ m/^\s*#?([\da-f]{2})([\da-f]{2})([\da-f]{2})/);
239     $base + 4 * $b + 2 * $g + $r;
240     } # color_reduce
241
242 sub ansi_color
243 {
244     my ($fg, $bg, $bold, $ul) = @_;
245
246     # warn "$fg on $bg $bold $ul\n";
247     my $attr = join ";", 0, grep { /\S/ }
248         $bold ? 1 : "",
249         $ul   ? 4 : "",
250         color_reduce ($fg, 30),
251         color_reduce ($bg, 40);
252
253     "\e[${attr}m";
254     } # ansi_color
255
256 sub css_color
257 {
258     my ($fg, $bg, $bold, $ul, $ha) = @_;
259
260     my @css;
261     $bold and push @css, "font-weight: bold";
262     $ul   and push @css, "text-decoration: underline";
263     $fg   and push @css, "color: $fg";
264     $bg   and push @css, "background: $bg";
265     $ha   and push @css, "text-align: $ha";
266
267     local $" = "; ";
268     @css ? qq{ style="@css"} : "";
269     } # css_color
270
271             binmode STDERR, ":utf8";
272 $enc_o and  binmode STDOUT, ":encoding($enc_o)";
273
274 if ($opt_H) {
275     print <<EOH;
276 <?xml version="1.0" encoding="utf-8"?>
277 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
278 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
279 <head>
280   <title>$file</title>
281   <meta name="Author" content="xlscat $VERSION" />
282   <style type="text/css">
283     body, h2,
284     td, th { font-family:     "Nimbus Sans L", "DejaVu Sans",
285                               Helvetica, Arial, sans; }
286     table  { border-spacing:  2px;
287              border-collapse: collapse;               }
288     td, th { vertical-align:  top;
289              padding:         4px;                    }
290     table  > tbody > tr > th,
291     table  > tr > th {
292              background:      #e0e0e0;                }
293     table  > tbody > tr > td:not([class]),
294     table  > tr > td:not([class]) {
295              background:      #f0f0f0;                }
296     .odd   { background:      #e0e0e0;                }
297     </style>
298   </head>
299 <body>
300 EOH
301     }
302
303 my $name_len = 30;
304 if ($opt_i) {
305     my $nl = 0;
306     foreach my $sn (keys %{$xls->[0]{sheet}}) {
307         length ($sn) > $nl and $nl = length $sn;
308         }
309     $nl and $name_len = $nl;
310     }
311 my @opt_F = split m/[^A-Z\d]+/ => $opt_F;
312 foreach my $si (1 .. $sc) {
313     my @data;
314     exists $print{sheet}{$si} or next;
315     $opt_v > 1 and warn "Opening sheet $si ...\n";
316     my $s = $xls->[$si] or next;
317     $opt_v > 5 and ddumper ($s);
318     my @r = (1, $s->{maxrow});
319     my @c = (1, $s->{maxcol});
320     my ($sn, $nr, $nc) = ($s->{label}, $r[-1], $c[-1]);
321     $opt_v and printf STDERR "%s - %02d: [ %-*s ] %3d Cols, %5d Rows\n",
322         $file, $si, $name_len, $sn, $nc, $nr;
323     $opt_i && !$is_grep and next;
324
325     if (@opt_F) {
326         foreach my $fld (@opt_F) {
327             $is_grep && defined $s->{$fld} && $s->{$fld} !~ $pattern and next;
328             print "$fld:",$s->{$fld},"\n";
329             }
330         next;
331         }
332
333     if (my $rows = $opt_R) {
334         $rows eq "all" and $rows = "1..$nr";    # all
335         $rows =~ s/-$/-$nr/;                    # 3,6-
336         $rows =~ s/-/../g;
337         eval "%{\$print{row}} = map { \$_ => 1 } $rows";
338         }
339     if (my $cols = $opt_C) {
340         $cols eq "all" and $cols = "1..$nc";    # all
341         if ($cols =~ m/[A-Za-z]/) {             # -C B,D => -C 2,4
342             my %ct = map {
343                 my ($cc, $rr) = cell2cr (uc "$_".1);
344                 ($_ => $cc)
345                 } ($cols =~ m/([a-zA-Z]+)/g);
346             $cols =~ s/([A-Za-z]+)/$ct{$1}/g;
347             }
348         $cols =~ s/-$/-$nc/;                    # 3,6-
349         $cols =~ s/-/../g;
350         eval "\$print{col} = [ map { \$_ - 1  } $cols ]";
351         $nc = @{$print{col}};
352         }
353     $opt_v >= 8 and ddumper (\%print);
354
355     $opt_H and print qq{<h2>$sn</h2>\n\n<table border="1">\n};
356     my $undef = $opt_v > 2 ? "-- undef --" : "";
357     my ($h, @w) = (0, (0) x $nc); # data height, -width, and default column widths
358     my @align = ("") x $nc;
359     foreach my $r ($r[0] .. $r[1]) {
360         exists $print{row} && !exists $print{row}{$r} and next;
361         my @att;
362         my @row = map {
363             my $cell = cr2cell ($_, $r);
364             my ($uval, $fval) = map {
365                 defined $_ ? $enc_i ? decode ($enc_i, $_) : $_ : $undef
366                 } $s->{cell}[$_][$r], $s->{$cell};
367             $opt_v > 2 and warn "$_:$r '$uval' / '$fval'\n";
368             $opt_A and 
369                 push @att, [ @{$s->{attr}[$_][$r]}{qw( fgcolor bgcolor bold uline halign )} ];
370             defined $s->{cell}[$_][$r] ? $opt_u ? $uval : $fval : "";
371             } $c[0] .. $c[1];
372         exists $print{col} and @row = @row[@{$print{col}}];
373         $is_grep && $r > $opt_h &&
374             ! grep { defined $_ && $_ =~ $pattern } @row and next;
375         if ($opt_L) {
376             foreach my $c (0 .. $#row) {
377                 my $l = length $row[$c];
378                 $l > $w[$c] and $w[$c] = $l;
379                 $row[$c] =~ m/\D/ and $align[$c] = "-";
380                 }
381             }
382         if ($enc_o) { $_ = encode ($enc_o, $_) for @row; }
383         if ($opt_H) {   # HTML
384             print "  <tr>";
385             if (defined $opt_n) {
386                 my $x = $r - $opt_n;
387                 $x <= 0 and $x = "";
388                 my $c = $r % 2 ? qq{ class="odd"} : "";
389                 print qq{<td style="text-align: right" $c>$x</td>};
390                 }
391             foreach my $c (0 .. $#row) {
392                 my $css = css_color (@{$att[$c]});
393                 $r % 2 and $css .= qq{ class="odd"};
394                 my $td  = $opt_H->($row[$c]);
395                 print "<td$css>$td</td>";
396                 }
397             print "</tr>\n";
398             next;
399             }
400         if ($opt_c) {   # CSV
401             $opt_c->print (*STDOUT, \@row) or die $opt_c->error_diag;
402             next;
403             }
404         if (defined $opt_n) {
405             unshift @row, $r;
406             unshift @att, [ "#ffffff", "#000000", 0, 0 ];
407             }
408         if ($opt_L) {   # Autofit / Align
409             push @data, [ [ @row ], [ @att ] ];
410             next;
411             }
412         if ($opt_A) {
413             foreach my $c (0 .. $#row) {
414                 $row[$c] =
415                     ansi_color (@{$att[$c]}).
416                     $row[$c] .
417                     "\e[0m";
418                 }
419             }
420         print join ($opt_s => @row), "\n";
421         } continue {
422             ++$h % 100 == 0 && $opt_v and printf STDERR $v_fmt, $nc, $h, "\r";
423             }
424     $opt_H and print "  </table>\n\n";
425     printf STDERR $v_fmt, $nc, $h, "\n";
426     $opt_L or next;
427     if (defined $opt_n) {
428         unshift @w, length $data[-1][0][0];
429         unshift @align, "";
430         }
431     my $fmt = join ($opt_s =>
432         map { my $f = "%$align[$_]$w[$_]s";
433               $opt_A ? "%s$f%s" : $f } 0 .. $#w)."\n";
434     for (@data) {
435         my ($row, $att) = @$_;
436         my @row = $opt_A
437             ? map { (
438                 ansi_color (@{$att->[$_]}),
439                 $row->[$_],
440                 "\e[0m" ) } 0 .. $#$row
441             : @$row;
442         printf $fmt, @row;
443         }
444     }
445 $opt_H and print "</body>\n</html>\n";