File Coverage

blib/lib/App/Tables/Excel.pm

Criterion	Covered	Total	%
statement	28	145	19.3
branch	1	66	1.5
condition	0	48	0.0
subroutine	10	21	47.6
pod	4	11	36.3
total	43	291	14.7

package App::Tables::Excel;
BEGIN { die "Your perl version is old, see README for instructions" if $] < 5.005; }

use strict;
use Data::Table;
use Spreadsheet::WriteExcel;
use Spreadsheet::ParseExcel;
use Spreadsheet::XLSX;
use Excel::Writer::XLSX;
use vars qw(@ISA @EXPORT @EXPORT_OK);
use Carp;

use Exporter 'import';

@ISA = qw(Exporter AutoLoader);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = ();
@EXPORT_OK = qw(
  tables2xls xls2tables tables2xlsx xlsx2tables
  tables_from_file
);

sub xls2tables {
  my ($fileName, $sheetNames, $sheetIndices) = @_;
  return excelFileToTable($fileName, $sheetNames, $sheetIndices, '2003');
}

sub xlsx2tables {
  my ($fileName, $sheetNames, $sheetIndices) = @_;
  return excelFileToTable($fileName, $sheetNames, $sheetIndices, '2007');
}

sub H_BUILT { 1 }
sub H_READ  { 2 }
sub H_GUESS { 3 }

sub excelFileToTable {
  my ($fileName, $sheetNames, $sheetIndices, $excelFormat, $headers_are ) = @_;
  for my $h ($headers_are) {
      $h =
      $h eq 'built'  ? H_BUILT :
      $h eq 'read'   ? H_READ  :
      $h eq 'guess'  ? H_GUESS :
      $h;
      ($h > 0) && ($h < 4) or die;
  }

  my %sheetsName = ();
  my %sheetsIndex = ();
  if (defined($sheetNames) && ref($sheetNames) eq 'ARRAY') {
    foreach my $name (@$sheetNames) {
      $sheetsName{$name} = 1;
    }
  } elsif (defined($sheetIndices) && ref($sheetIndices) eq 'ARRAY') {
    foreach my $idx (@$sheetIndices) {
      $sheetsIndex{$idx} = 1;
    }
  }
  my $excel = undef;
  if ($excelFormat eq '2003') {
    $excel = Spreadsheet::ParseExcel::Workbook->Parse($fileName);
  } elsif ($excelFormat eq '2007') {
    $excel = Spreadsheet::XLSX->new($fileName);
  } else {
    croak "Unrecognized Excel format, must be either 2003 or 2007!";
  }
  my @tables = ();
  my @sheets = ();
  my $num = 0;
  foreach my $sheet (@{$excel->{Worksheet}}) {
    $num++;
    next if ((scalar keys %sheetsName) && !defined($sheetsName{$sheet->{Name}}));
    next if ((scalar keys %sheetsIndex) && !defined($sheetsIndex{$num}));
    next unless defined($sheet->{MinRow}) && defined($sheet->{MaxRow}) && defined($sheet->{MinCol}) && defined($sheet->{MaxRow});
    push @sheets, $sheet->{Name};
    #printf("Sheet: %s\n", $sheet->{Name});
    $sheet->{MaxRow} ||= $sheet->{MinRow};
    $sheet->{MaxCol} ||= $sheet->{MinCol};
    my @header = ();
    foreach my $col ($sheet->{MinCol} ..  $sheet->{MaxCol}) {
      my $cel=$sheet->{Cells}[$sheet->{MinRow}][$col];
      push @header, defined($cel)?$cel->{Val}:undef;
    }

    my $t = do {
        my $h = $headers_are;
        $h == H_GUESS and $h = do {
            my $d =  $Data::Table::DEFAULTS{CSV_DELIMITER};
            my $s = join $d, map {Data::Table::csvEscape($_)} @header;
            (Data::Table::fromFileIsHeader $s, $d)
            ? H_READ : H_BUILT
        };
        if    ( $h == H_READ  ) { Data::Table->new( [], \@header, 0) }
        elsif ( $h == H_BUILT ) {
          Data::Table->new
          ( [\@header]
          , [ map "col$_", 1..($sheet->{MaxCol}-$sheet->{MinCol}+1) ]
          , 0 );
        }
        else { die }
    };

    foreach my $row (($sheet->{MinRow}+1) .. $sheet->{MaxRow}) {
      my @one = ();
      foreach my $col ($sheet->{MinCol} ..  $sheet->{MaxCol}) {
        my $cel=$sheet->{Cells}[$row][$col];
        push @one, defined($cel)?$cel->{Val}:undef;
      }
      $t->addRow(\@one);
    }
    push @tables, $t;
  }
  return (\@tables, \@sheets);
}

sub tables_from_file {
    my ( $file, %with ) = @_;
    $with{headers_are} ||= 'built';
    $with{format} ||= do {
        $file =~ /[.]((xls)x)$/;
        $1 ? 2007 :
        $2 ? 2003 : die "can't guess the excel version";
    };
    for (qw( names indices )) { $with{$_} ||= undef }
    excelFileToTable $file
    , @with{qw( names indices format headers_are )};
}

# color palette is defined in
# http://search.cpan.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.20/doc/palette.html
sub oneTable2Worksheet {
  my ($workbook, $t, $name, $colors, $portrait) = @_;
  # Add a worksheet
  my $worksheet = $workbook->add_worksheet($name);
  $portrait=1 unless defined($portrait);
  #my @BG_COLOR=(26,47,44);
  my @BG_COLOR=(44, 9, 30);
  @BG_COLOR=@$colors if ((ref($colors) eq "ARRAY") && (scalar @$colors==3));
  my $fmt_header= $workbook->add_format();
  $fmt_header->set_bg_color($BG_COLOR[2]);
  $fmt_header->set_bold();
  $fmt_header->set_color('white');
  my $fmt_odd= $workbook->add_format();
  $fmt_odd->set_bg_color($BG_COLOR[0]);
  my $fmt_even= $workbook->add_format();
  $fmt_even->set_bg_color($BG_COLOR[1]);
  my @FORMAT = ($fmt_odd, $fmt_even);

  my @header=$t->header;
  if ($portrait) {
    for (my $i=0; $i<@header; $i++) {
      $worksheet->write(0, $i, $header[$i], $fmt_header);
    }
    for (my $i=0; $i<$t->nofRow; $i++) {
      for (my $j=0; $j<$t->nofCol; $j++) {
        $worksheet->write($i+1, $j, $t->elm($i,$j), $FORMAT[$i%2]);
      }
    }
  } else {
    for (my $i=0; $i<@header; $i++) {
      $worksheet->write($i, 0, $header[$i], $fmt_header);
    }
    for (my $i=0; $i<$t->nofRow; $i++) {
      for (my $j=0; $j<$t->nofCol; $j++) {
        $worksheet->write($j, $i+1, $t->elm($i,$j), $FORMAT[$i%2]);
      }
    }
  }
}

sub tables2excelFile {
  my ($fileName, $tables, $names, $colors, $portrait, $excelFormat) = @_;
  confess("No table is specified!\n") unless (defined($tables)&&(scalar @$tables));
  $names =[] unless defined($names);
  $colors=[] unless defined($colors);
  $portrait=[] unless defined($portrait);
  my $workbook = undef;
  if ($excelFormat eq '2003') {
    $workbook = Spreadsheet::WriteExcel->new($fileName);
  } elsif ($excelFormat eq '2007') {
    $workbook = Excel::Writer::XLSX->new($fileName);
  } else {
    croak "Unrecognized Excel format, must be either 2003 or 2007!";
  }
  $portrait=[] unless defined($portrait);
  my ($prevColors, $prevPortrait) = (undef, undef);
  for (my $i=0; $i<@$tables; $i++) {
    my $myColor=$colors->[$i];
    $myColor=$prevColors if (!defined($myColor) && defined($prevColors));
    $prevColors=$myColor;
    my $myPortrait=$portrait->[$i];
    $myPortrait=$prevPortrait if (!defined($myPortrait) && defined($prevPortrait));
    $prevPortrait=$myPortrait;
	my $mySheet = $names->[$i] ? $names->[$i]:"Sheet".($i+1);
    oneTable2Worksheet($workbook, $tables->[$i], $mySheet, $myColor, $myPortrait);
  }
}

sub tables2xls {
  my ($fileName, $tables, $names, $colors, $portrait) = @_;
  tables2excelFile($fileName, $tables, $names, $colors, $portrait, '2003');
}

sub tables2xlsx {
  my ($fileName, $tables, $names, $colors, $portrait) = @_;
  tables2excelFile($fileName, $tables, $names, $colors, $portrait, '2007');
}

1;

__END__