Spreadsheet-Read

 view release on metacpan or  search on metacpan

Read.pm  view on Meta::CPAN

    wrap    => 0,
    merged  => 0,
    hidden  => 0,
    locked  => 0,
    enc     => "utf-8", # $ENV{LC_ALL} // $ENV{LANG} // ...
    formula => undef,
    );

# Helper functions

sub _dump {
    my ($label, $ref) = @_;
    if ($can{dmp}) {
	print STDERR Data::Peek::DDumper ({ $label => $ref });
	}
    else {
	print STDERR Data::Dumper->Dump ([$ref], [$label]);
	}
    my @c = caller (1);
    print STDERR "<<- $c[1]:$c[2]|$c[3]\n";
    } # _dump

sub _parser {
    my $type = shift		or  return "";
    if ($type =~ m/::/ and my @p = grep { $_->[1] eq $type } @parsers) {
	my $format = $p[0][0];
	$ENV{"SPREADSHEET_READ_\U$format"} = $type;
	eval "local \$_; require $type";
	$@ and croak ("Forced backend $type for $format fails to load:\n$@");
	$can{$format} = $type;
	$type = $format;
	}
    $type = lc $type;
    my $ods = $can{ods} ? "ods" : "sxc";
    # Aliases and fullnames
    $type eq "excel"		and return "xls";
    $type eq "excel2007"	and return "xlsx";
    $type eq "xlsm"		and return "xlsx";
    $type eq "oo"		and return $ods;
#   $type eq "sxc"		and return $ods;
    $type eq "openoffice"	and return $ods;
    $type eq "libreoffice"	and return $ods;
    $type eq "perl"		and return "prl";
    $type eq "scalc"		and return "sc";
    $type eq "squirrelcalc"	and return "sc";
    return exists $can{$type} ? $type : "";
    } # _parser

sub new {
    my $class = shift;
    my $r = ReadData (@_);
    unless ($r) {
	@_ and return;	# new with arguments failed to open resource
	$r = [{
	    parsers	=> [],
	    error	=> undef,
	    sheets	=> 0,
	    sheet	=> { },
	    }];
	}
    bless $r => $class;
    } # new

sub parsers {
    ref $_[0] eq __PACKAGE__ and shift;
    my @c;
    for (sort { $a->[0] cmp $b->[0] || $a->[1] cmp $b->[1] }
         grep { $_->[0] !~ m{^(?:dmp|ios|!.*)$} }
         @parsers) {
	my ($typ, $mod, $min) = @$_;
	eval "local \$_; require $mod";
	my $vsn = $@ ? "-" : eval { $mod->VERSION };
	push @c => {
	    ext => $typ,
	    mod => $mod,
	    min => $min,
	    vsn => $vsn,
	    def => $can{$typ} eq $mod ? "*" : "",
	    };
	}
    @c;
    } # parsers

# Spreadsheet::Read::parses ("csv") or die "Cannot parse CSV"
sub parses {
    ref $_[0] eq __PACKAGE__ and shift;

    my $type = shift or
	return sort grep { !m/^(?:dmp|ios)/ && $can{$_} !~ m{^!} }
	    keys %can;

    $type = _parser ($type) or return 0;
    if ($can{$type} =~ m/^!\s*(.*)/) {
	$@ = $1;
	return 0;
	}
    return $can{$type} || 0;
    } # parses

sub sheets {
    my $ctrl = shift->[0];
    wantarray or return $ctrl->{sheets};

    my $s = $ctrl->{sheet} or return (); # No labels defined
    sort { $s->{$a} <=> $s->{$b} } keys %$s;
    } # sheets

# col2label (4) => "D"
sub col2label {
    ref $_[0] eq __PACKAGE__ and shift;
    my $c = shift;
    defined $c && $c > 0 or return "";
    my $cell = "";
    while ($c) {
	use integer;

	substr $cell, 0, 0, chr (--$c % 26 + ord "A");
	$c /= 26;
	}
    $cell;
    } # col2label

Read.pm  view on Meta::CPAN

sub cr2cell {
    ref $_[0] eq __PACKAGE__ and shift;
    my ($c, $r) = @_;
    defined $c && defined $r && $c > 0 && $r > 0 or return "";
    col2label ($c) . $r;
    } # cr2cell

# cell2cr ("D18") => (4, 18)
sub cell2cr {
    ref $_[0] eq __PACKAGE__ and shift;
    my ($cc, $r) = (uc ($_[0]||"") =~ m/^([A-Z]+)([0-9]+)$/) or return (0, 0);
    my $c = 0;
    while ($cc =~ s/^([A-Z])//) {
	$c = 26 * $c + 1 + ord ($1) - ord ("A");
	}
    ($c, $r);
    } # cell2cr

# my @row = cellrow ($book->[1], 1);
# my @row = $book->cellrow (1, 1);
sub cellrow {
    my $sheet = ref $_[0] eq __PACKAGE__ ? (shift)->[shift] : shift or return;
    ref     $sheet eq "HASH" && exists  $sheet->{cell}   or return;
    exists  $sheet->{maxcol} && exists  $sheet->{maxrow} or return;
    my $row   = shift or return;
    $row > 0 && $row <= $sheet->{maxrow} or return;
    my $s = $sheet->{cell};
    map { $s->[$_][$row] } 1..$sheet->{maxcol};
    } # cellrow

# my @row = row ($book->[1], 1);
# my @row = $book->row (1, 1);
sub row {
    my $sheet = ref $_[0] eq __PACKAGE__ ? (shift)->[shift] : shift or return;
    ref     $sheet eq "HASH" && exists  $sheet->{cell}   or return;
    exists  $sheet->{maxcol} && exists  $sheet->{maxrow} or return;
    my $row   = shift or return;
    $row > 0 && $row <= $sheet->{maxrow} or return;
    map { $sheet->{cr2cell ($_, $row)} } 1..$sheet->{maxcol};
    } # row

# Convert {cell}'s [column][row] to a [row][column] list
# my @rows = rows ($book->[1]);
sub rows {
    my $sheet = ref $_[0] eq __PACKAGE__ ? (shift)->[shift] : shift or return;
    ref    $sheet eq "HASH" && exists $sheet->{cell}   or return;
    exists $sheet->{maxcol} && exists $sheet->{maxrow} or return;
    my $s = $sheet->{cell};

    map {
	my $r = $_;
	[ map { $s->[$_][$r] } 1..$sheet->{maxcol} ];
	} 1..$sheet->{maxrow};
    } # rows

sub sheet {
    my ($book, $sheet) = @_;
    $book && $sheet or return;
    my $class = "Spreadsheet::Read::Sheet";
    $sheet =~ m/^[0-9]+$/ && $sheet >= 1 && $sheet <= $book->[0]{sheets} and
	return bless $book->[$sheet]			=> $class;
    exists $book->[0]{sheet}{$sheet} and
	return bless $book->[$book->[0]{sheet}{$sheet}]	=> $class;
    foreach my $idx (1 .. $book->[0]{sheets}) {
	$book->[$idx]{label} eq $sheet and
	    return bless $book->[$idx]			=> $class;
	}
    return;
    } # sheet

# If option "clip" is set, remove the trailing rows and
# columns in each sheet that contain no visible data
sub _clipsheets {
    my ($opt, $ref) = @_;

    unless ($ref->[0]{sheets}) {
	$ref->{sheet} ||= {};
	return $ref;
	}

    my ($rc, $cl)      = ($opt->{rc},   $opt->{cells});
    my ($oc, $os, $oa) = ($opt->{clip}, $opt->{strip}, $opt->{attr});

    # Strip leading/trailing spaces
    if ($os || $oc) {
	foreach my $sheet (1 .. $ref->[0]{sheets}) {
	    $ref->[$sheet]{indx} = $sheet;
	    my $ss = $ref->[$sheet];
	    $ss->{maxrow} && $ss->{maxcol} or next;
	    my ($mc, $mr) = (0, 0);
	    foreach my $row (1 .. $ss->{maxrow}) {
		foreach my $col (1 .. $ss->{maxcol}) {
		    if ($rc) {
			defined $ss->{cell}[$col][$row] or next;
			$os & 2 and $ss->{cell}[$col][$row] =~ s/\s+$//;
			$os & 1 and $ss->{cell}[$col][$row] =~ s/^\s+//;
			if (length $ss->{cell}[$col][$row]) {
			    $col > $mc and $mc = $col;
			    $row > $mr and $mr = $row;
			    }
			}
		    if ($cl) {
			my $cell = cr2cell ($col, $row);
			defined $ss->{$cell} or next;
			$os & 2 and $ss->{$cell} =~ s/\s+$//;
			$os & 1 and $ss->{$cell} =~ s/^\s+//;
			if (length $ss->{$cell}) {
			    $col > $mc and $mc = $col;
			    $row > $mr and $mr = $row;
			    }
			}
		    }
		}

	    $oc && ($mc < $ss->{maxcol} || $mr < $ss->{maxrow}) or next;

	    # Remove trailing empty columns
	    foreach my $col (($mc + 1) .. $ss->{maxcol}) {
		$rc and undef $ss->{cell}[$col];
		$oa and undef $ss->{attr}[$col];
		$cl or next;
		my $c = col2label ($col);
		delete $ss->{"$c$_"} for 1 .. $ss->{maxrow};
		}

	    # Remove trailing empty rows

Read.pm  view on Meta::CPAN

	      ref $book eq __PACKAGE__) && $book->[0]{sheets} or return $r;

    my $c1 = $book->[0];
    my $c2 = $r->[0];

    unless ($c1->{parsers}) {
	$c1->{parsers}[0]{$_} = $c1->{$_} for qw( type parser version );
	$book->[$_]{parser} = 0 for 1 .. $c1->{sheets};
	}
    my ($pidx) = (grep { my $p = $c1->{parsers}[$_];
	$p->{type}    eq $c2->{type}   &&
	$p->{parser}  eq $c2->{parser} &&
	$p->{version} eq $c2->{version} } 0 .. $#{$c1->{parsers}});
    unless (defined $pidx) {
	$pidx = scalar @{$c1->{parsers}};
	$c1->{parsers}[$pidx]{$_} = $c2->{$_} for qw( type parser version );
	}

    foreach my $sn (sort { $c2->{sheet}{$a} <=> $c2->{sheet}{$b} } keys %{$c2->{sheet}}) {
	my $s = $sn;
	my $v = 2;
	while (exists $c1->{sheet}{$s}) {
	    $s = $sn."[".$v++."]";
	    }
	$c1->{sheet}{$s} = $c1->{sheets} + $c2->{sheet}{$sn};
	$r->[$c2->{sheet}{$sn}]{parser} = $pidx;
	push @$book, $r->[$c2->{sheet}{$sn}];
	}
    $c1->{sheets} += $c2->{sheets};

    return $book;
    } # add

package Spreadsheet::Read::Attribute;

use Carp;
use vars qw( $AUTOLOAD );

sub AUTOLOAD {
    my $self = shift;
    (my $attr = $AUTOLOAD) =~ s/.*:://;
    $self->{$attr};
    } # AUTOLOAD

package Spreadsheet::Read::Sheet;

use List::Util qw( min max );

sub cell {
    my ($sheet, @id) = @_;
    @id == 2 && $id[0] =~ m/^[0-9]+$/ && $id[1] =~ m/^[0-9]+$/ and
	return $sheet->{cell}[$id[0]][$id[1]];
    @id && $id[0] && exists $sheet->{$id[0]} and
	return $sheet->{$id[0]};
    } # cell

sub attr {
    my ($sheet, @id) = @_;
    my $class = "Spreadsheet::Read::Attribute";
    @id == 2 && $id[0] =~ m/^[0-9]+$/ && $id[1] =~ m/^[0-9]+$/ and
	return bless $sheet->{attr}[$id[0]][$id[1]] => $class;
    if (@id && $id[0] && exists $sheet->{$id[0]}) {
	my ($c, $r) = $sheet->cell2cr ($id[0]);
	return bless $sheet->{attr}[$c][$r] => $class;
	}
    undef;
    } # attr

sub maxrow {
    my $sheet = shift;
    return $sheet->{maxrow};
    } # maxrow

sub maxcol {
    my $sheet = shift;
    return $sheet->{maxcol};
    } # maxrow

sub col2label {
    $_[0] =~ m/::/ and shift; # class unused
    return Spreadsheet::Read::col2label (@_);
    } # col2label

sub cr2cell {
    $_[0] =~ m/::/ and shift; # class unused
    return Spreadsheet::Read::cr2cell (@_);
    } # cr2cell

sub cell2cr {
    $_[0] =~ m/::/ and shift; # class unused
    return Spreadsheet::Read::cell2cr (@_);
    } # cell2cr

sub label {
    my ($sheet, $label) = @_;
    defined $label and $sheet->{label} = $label;
    return $sheet->{label};
    } # label

sub active {
    my $sheet = shift;
    return $sheet->{active};
    } # label

sub hidden {
    my $sheet = shift;
    return $sheet->{hidden};
    } # label

# my @row = $sheet->cellrow (1);
sub cellrow {
    my ($sheet, $row) = @_;
    defined $row && $row > 0 && $row <= $sheet->{maxrow} or return;
    my $s = $sheet->{cell};
    map { $s->[$_][$row] } 1..$sheet->{maxcol};
    } # cellrow

# my @row = $sheet->row (1);
sub row {
    my ($sheet, $row) = @_;
    defined $row && $row > 0 && $row <= $sheet->{maxrow} or return;
    map { $sheet->{$sheet->cr2cell ($_, $row)} } 1..$sheet->{maxcol};
    } # row