use IPC::System::Simple qw(capture EXIT_ANY);
use FindBin qw($Bin);
use Test::Exception;
use Data::Printer;
use Test::More;
use IO::All;
use strict;
use warnings;
use feature 'say';
use lib '/home/raj/perl-lib';
use Local::WriteExcel;
# filenames for 2 xl files, xls & xlsx:
my $xlsx_file = $Bin .'/write-excel-test-1.xlsx'; # warn $xlsx_file;
my $xls_file = $Bin .'/write-excel-test-2.xls'; # warn $xlx_file;
{ # delete any existing xls[x] files:
my @files = grep { $_->ext =~ /xls/ } io($Bin)->all; # p $_->ext for @files;
io($_)->unlink for @files;
# check all deleted:
my @empty = grep { $_->ext =~ /xls/ } io($Bin)->all; # p @empty;
is(@empty, 0, 'OK: old files cleared');
}
my @headers = qw( name dob result );
my @data = (
[ qw/bob 1975-02-01 pass/ ],
[ qw/joe 1973-03-01 fail/ ],
[ qw/amy 1983-11-15 pass/ ],
);
{ # dies if empty args to object
throws_ok( sub { my $xlsx = Local::WriteExcel->new() },
qr/^require either filename or filetype in args to object/,
'OK: empty args to new object not allowed'
);
}
# new xlsx src file ============================================================
{
my $xlsx = Local::WriteExcel->new(filename => $xlsx_file); # p $xl;
$xlsx->worksheet_name('data');
$xlsx->write_bold_row(\@headers);
$xlsx->write_row($_) for @data;
$xlsx->save();
is(-e $xlsx_file, 1, 'OK: test file 1 exists');
test_content($xlsx_file);
}
# new xls src file =============================================================
{
my $xls = Local::WriteExcel->new(filename => $xls_file); # p $xl;
# can't use worksheet_name for xls file:
throws_ok( sub { $xls->worksheet_name('data') },
qr/^filetype must be xlsx to use worksheet_name/,
'OK: incorrect filetype for worksheet_name'
);
$xls->write_bold_row(\@headers);
$xls->write_row($_) for @data;
$xls->save();
is(-e $xls_file, 1, 'OK: test file 2 exists');
test_content($xls_file);
}
# test xls save() command with filename arg ====================================
{
my $xls = Local::WriteExcel->new(filetype => 'xls'); # p $xl;
$xls->write_bold_row(\@headers);
$xls->write_row($_) for @data;
throws_ok( sub { $xls->save() },
qr/^cannot call save\(\) without a filename arg/,
'OK: failed to save file without filename'
);
my $test_file_3 = $Bin .'/write-excel-test-3.xls';
$xls->save($test_file_3);
is(-e $test_file_3, 1, 'OK: test file 3 exists');
test_content($test_file_3);
}
# test xlsx save() command with filename arg ====================================
{
my $xlsx = Local::WriteExcel->new(filetype => 'xlsx'); # p $xl;
$xlsx->worksheet_name('data');
$xlsx->write_bold_row(\@headers);
$xlsx->write_row($_) for @data;
throws_ok( sub { $xlsx->save() },
qr/^cannot call save\(\) without a filename arg/,
'OK: failed to save file without filename'
);
my $test_file_4 = $Bin .'/write-excel-test-4.xlsx';
$xlsx->save($test_file_4);
is(-e $test_file_4, 1, 'OK: test file 4 exists');
test_content($test_file_4);
# new xlsx file in same scope as previous (tests for persistence of xlxs_data):
my $xlsx2 = Local::WriteExcel->new(filetype => 'xlsx'); # p $xl;
$xlsx2->worksheet_name('data');
$xlsx2->write_bold_row(\@headers);
$xlsx2->write_row($_) for @data;
my $test_file_5 = $Bin .'/write-excel-test-5.xlsx';
$xlsx2->save($test_file_5);
is(-e $test_file_5, 1, 'OK: test file 5 exists');
# file is unreadable if xlxs_data persists:
test_content($test_file_5);
}
# test default worksheet name set (by not setting an explicit worksheet name):
{
my $xlsx = Local::WriteExcel->new(filetype => 'xlsx'); # p $xl;
$xlsx->write_bold_row([ qw/foo bar/ ]); # p $xlsx;
my @worksheets = map $_->get_name(), $xlsx->get_sheets(); # p @worksheets;
# just check only have 1 worksheet called 'sheet1':
is(scalar @worksheets, 1, 'OK: have 1 worksheet');
is($worksheets[0], 'sheet1', 'OK: default worksheet name applied');
}
sub test_content {
my $filename = shift; # p $filename;
# Spreadsheet::Read doesn't support OO until >0.67 which won't intsall on Deb7 perl
# my $book = ReadData($xl_file); # Can't locate object method "new" via package "Spreadsheet::Read"
#my $book = Spreadsheet::Read->new($xl_file); # p $book;
# my @sheets = $book->sheets; p @sheets; # Can't call method "sheets" on unblessed reference
#my @rows = rows($book->[1]); # p @rows;
my $row_count = 1; # for xlscat -R<x>
{ # header row:
my $expected = join '|', @headers;
chomp( my $content = capture('xlscat', '-R'.$row_count++, $filename) );
is( $expected, $content, 'OK: row 1 headers');
}
for (0..2) { # @data rows:
my $expected = join '|', @{$data[$_]};
chomp( my $content = capture('xlscat', '-R'.$row_count++, $filename) );
is( $expected, $content, 'OK: row ' . ($_ + 2) . ' content');
}
}
done_testing(32);