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; require_ok( 'Spreadsheet::Read' ); # required for xlscat require_ok( 'Spreadsheet::XLSX' ); # supplies a parser for xlscat # 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'); } # using xlscat to extract file contents - default '|' separator no longer works # after Spreadsheet::Read v0.79 on Deb7, creates spaces between entries and fails # is() test, even when $expected adjusted for spaces; using '~' separator now 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|--rows=] { # header row: my $expected = join '~', @headers; # warn $expected; my @args = ( 'xlscat', '--sep=~', '--rows='.$row_count++, $filename ); chomp( my $content = capture(@args) ); # warn $content; is( $content, $expected, 'OK: row 1 headers'); } for (0..2) { # @data rows: my $expected = join '~', @{$data[$_]}; # warn $expected; my @args = ( 'xlscat', '--sep=~', '--rows='.$row_count++, $filename ); chomp( my $content = capture(@args) ); # warn $content; is( $content, $expected, 'OK: row ' . ($_ + 2) . ' content'); } } done_testing(34);