Spreadsheet-Read
view release on metacpan or search on metacpan
scripts/xlscat view on Meta::CPAN
my @css;
$bold and push @css, "font-weight: bold";
$ul and push @css, "text-decoration: underline";
$fg and push @css, "color: $fg";
$bg and push @css, "background: $bg";
$ha and push @css, "text-align: $ha";
local $" = "; ";
@css ? qq{ style="@css"} : "";
} # css_color
binmode STDERR, ":encoding(utf-8)";
$enc_o and binmode STDOUT, ":encoding($enc_o)";
if ($opt_H) {
print <<"EOH";
<?xml version="1.0" encoding="utf-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
<title>$file</title>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<meta name="Author" content="xlscat $VERSION" />
<style type="text/css">
body, h2,
td, th { font-family: "Nimbus Sans L", "DejaVu Sans",
Helvetica, Arial, sans; }
table { border-spacing: 2px;
border-collapse: collapse; }
td, th { vertical-align: top;
padding: 4px; }
table > tbody > tr > th,
table > tr > th {
background: #e0e0e0; }
table > tbody > tr > td:not([class]),
table > tr > td:not([class]) {
background: #f0f0f0; }
.odd { background: #e0e0e0; }
</style>
</head>
<body>
EOH
}
my %first;
if ($opt_first) {
$opt_first =~ m/^([a-zA-Z]+)[0-9]*$/ and
$opt_first = (cell2cr (uc $1 . "1"))[0];
$opt_first =~ m/^[0-9]+$/ && $opt_first > 0 or
die "--first=C requires a numeric column index or a column index letter\n";
}
my $name_len = 30;
if ($opt_i) {
my $nl = 0;
foreach my $sn (keys %{$xls->[0]{sheet}}) {
length ($sn) > $nl and $nl = length $sn;
}
$nl and $name_len = $nl;
}
my @opt_F = split m/[^A-Z\d]+/ => $opt_F;
foreach my $si (1 .. $sc) {
my @data;
exists $print{sheet}{$si} or next;
$opt_v > 1 and warn "Opening sheet $si ...\n";
my $s = $xls->[$si] or next;
$opt_v > 5 and ddumper ($s);
my @r = (1, $s->{maxrow});
my @c = (1, $s->{maxcol});
my ($sn, $nr, $nc) = ($s->{label}, $r[-1], $c[-1]);
defined $nr or next;
defined $nc or next;
defined $sn or $sn = "";
my $active = $s->{active} ? " (Active)" : "";
my $hidden = $s->{hidden} ? " (Hidden)" : "";
my $eolt = $s->{eolt} ? ", EOL = $s->{eolt}" : "";
$eolt =~ s/\n/\\n/g; $eolt =~ s/\r/\\r/g; $eolt =~ s/\t/\\t/g;
$eolt =~ s/([\x00-\x1f])/sprintf "\\x{%02x}", ord $1/ge;
$opt_v and printf STDERR "%s - %02d: [ %-*s ] %3d Cols, %5d Rows%s%s%s\n",
$file, $si, $name_len, $sn, $nc, $nr, $active, $hidden, $eolt;
$opt_i && !$is_grep and next;
if (@opt_F) {
foreach my $fld (@opt_F) {
$is_grep && defined $s->{$fld} && $s->{$fld} !~ $pattern and next;
print "$fld:",$s->{$fld},"\n";
}
next;
}
if (my $rows = $opt_R) {
$rows eq "all" and $rows = "1..$nr"; # all
$rows =~ s/--(\d+)/-($nr+1-$1)/ge; # 3--2
$rows =~ s/-(\d+)(?=-)/($nr+1-$1)/ge; # -3-
$rows =~ s/-$/-$nr/; # 3,6-
$rows =~ s/-/../g;
eval "%{\$print{row}} = map { \$_ => 1 } $rows";
}
if (my $cols = $opt_C) {
$cols eq "all" and $cols = "1..$nc"; # all
if ($cols =~ m/[A-Za-z]/) { # -C B,D => -C 2,4
my %ct = map {
my ($cc, $rr) = cell2cr (uc "$_".1);
($_ => $cc)
} ($cols =~ m/([a-zA-Z]+)/g);
$cols =~ s/([A-Za-z]+)/$ct{$1}/g;
}
$cols =~ s/-$/-$nc/; # 3,6-
$cols =~ s/-/../g;
eval "\$print{col} = [ map { \$_ - 1 } $cols ]";
$nc = @{$print{col}};
}
$opt_v >= 8 and ddumper (\%print);
$opt_H and print qq{<h2>$sn</h2>\n\n<table border="1">\n};
my $undef = $opt_v > 2 ? "-- undef --" : "";
my ($h, @w) = (0, (0) x $nc); # data height, -width, and default column widths
my @align = ("") x $nc;
foreach my $r ($r[0] .. $r[1]) {
exists $print{row} && !exists $print{row}{$r} and next;
scripts/xlscat view on Meta::CPAN
$is_grep && $r > $opt_h &&
! first { defined $_ && $_ =~ $pattern } @row and next;
$skip_empty && ! first { length } @row and next;
if ($opt_first) {
@row >= $opt_first && $first{$row[$opt_first - 1]}++ and next;
}
if ($opt_D) {
ddumper ($opt_D == 1 ? \@row :
{ map { $s->{cell}[$_ + 1][1] => $row[$_] } 0 .. $#row });
next;
}
if ($opt_H) { # HTML
print " <tr>";
if (defined $opt_n) {
my $x = $r - $opt_n;
$x <= 0 and $x = "";
my $c = $r % 2 ? qq{ class="odd"} : "";
print qq{<td style="text-align: right" $c>$x</td>};
}
foreach my $c (0 .. $#row) {
my $css = css_color (@{$att[$c]});
$r % 2 and $css .= qq{ class="odd"};
my $td = $opt_H->($row[$c]);
print "<td$css>$td</td>";
}
print "</tr>\n";
next;
}
if (defined $opt_n) {
unshift @row, $r;
unshift @att, [ "#ffffff", "#000000", 0, 0 ];
}
if ($opt_L || $sort_order) { # Autofit / Align / order
push @data, [ [ @row ], [ @att ] ];
next;
}
if ($opt_c) { # CSV
$opt_c->print (*STDOUT, \@row) or die $opt_c->error_diag;
next;
}
if ($opt_A) {
foreach my $c (0 .. $#row) {
$row[$c] =
ansi_color (@{$att[$c]}).
$row[$c] .
"\e[0m";
}
}
line (0, $opt_s => @row);
} continue {
++$h % 100 == 0 && $opt_v && $v_fmt and printf STDERR $v_fmt, $nc, $h, "\r";
}
$opt_H and print " </table>\n\n";
$v_fmt && $v_fmt and printf STDERR $v_fmt, $nc, $h, "\n";
if ($sort_order) {
my @o;
my @h;
$sort_order =~ s/\+([0-9]+)\b// and @h = splice @data, 0, $1;
for ($sort_order =~ m/([0-9]+[rn]*)/g) {
m/^([0-9]+)(.*)/;
push @o, { col => $1 - 1, map { $_ => 1 } split m// => $2 };
}
my $sort = sub {
my $d = 0;
foreach my $o (@o) {
my ($A, $B) = map { $_->[0][$o->{col}] || 0 } $a, $b;
$d = $o->{n}
? $o->{r} ? $B <=> $A : $A <=> $B
: $o->{r} ? $B cmp $A : $A cmp $B
and return $d;
}
return $d;
};
@data = (@h, sort $sort @data);
}
if ($opt_c && @data) { # CSV
$opt_c->print (*STDOUT, $_->[0]) for @data;
next;
}
$opt_L || $sort_order or next;
if (defined $opt_n) {
unshift @w, length $data[-1][0][0];
unshift @align, "";
}
$opt_n = 0;
if ($opt_L) {
foreach my $r (0 .. $#data) {
my $R = $data[$r][0];
foreach my $c (0 .. $#$R) {
my $d = $R->[$c];
my $l = length $d;
$l > $w[$c] and $w[$c] = $l;
# Number alignment won't be effective if first row is empty and
# second row has column headers
$r && $d =~ m/\S/ or next;
$d =~ m/^(?:-|\s*(?:-\s*)?[0-9][0-9 .,]*)$/ or $align[$c] = "-";
}
}
if ($skip_empty) { # Skip empty columns. Rows have already been skipped
foreach my $i ( reverse 0 .. $#w) {
$w[$i] and next;
splice @w, $i, 1;
splice @align, $i, 1;
splice @$_, $i, 1 for grep { $#$_ >= $i } map { @{$_} } @data;
}
}
}
$opt_B and line (1, $opt_s => map { "-" x $w[$_] } 0..$#{$data[0][0]});
for (@data) {
my ($row, $att) = @$_;
my @row = @$row;
for (0 .. $#row) {
my $l = length $row[$_];
my $w = $l < $w[$_] ? " " x ($w[$_] - $l) : "";
if ($align[$_]) {
$_ < $#row || $opt_B and $row[$_] .= $w;
}
else {
substr $row[$_], 0, 0, $w;
( run in 0.738 second using v1.01-cache-2.11-cpan-5511b514fd6 )