RSS Git Download  Clone
Raw Blame History
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);