### 00-test.t #################################################################

# TODO: rename this test file

### Includes ##################################################################

# Safe Perl
use warnings;
use strict;
use Carp;

use Test::More;
use Test::Exception;
use File::Path qw(make_path remove_tree);

### Prep  #####################################################################

my $logdir;
my %modkeys;

BEGIN {
    my @logdir = ( "scratch", $$ );
    for (@logdir) {
        $logdir .= '/' if $logdir;
        $logdir .= $_;
        make_path( $logdir );
    }
    print STDERR "Log for tests will be written in $logdir\n";
    %modkeys = ( NAME => 1, VERSION => 1, LOC => 1 );
}

### Tests #####################################################################

sub readlog {
    my $file = shift;
    open my $fh, '<', $file or die "Cannot open $file: $!";
    my @logs;
    my $log = {};
    while (my $line = <$fh>) {
        if ($line =~ /^########/) {
            $log = {};
            push @logs, $log;
            next;
        }
        next unless $line =~ /\S/;
        chomp $line;
        my @keys = split ': ', $line;
        s/^\s*// for @keys;
        s/\s*$// for @keys;
        die "Unexpected syntax in log line: $line\n" unless scalar(@keys) >= 2;
        my $val = pop @keys;
        my $key = shift @keys;
        if (scalar(@keys) == 0) {
            if ($key eq 'INC') {
                my $list = $log->{$key} ||= [];
                push @$list, $val;
            }
            else {
                die "repeated key: $key" if exists $log->{$key};
                $log->{$key} = $val;
            }
        }
        else {
            my $key2 = shift @keys;
            die "invalid nested key: {" . join( '}{', $key, $key2, @keys, $val ) . "}"
                if scalar(@keys);
            if ($key eq 'MODULE') {
                die "Unknown secondary MODULE key ($key2)" unless $modkeys{$key2};
                my $list = $log->{$key}{$key2} ||= [];
                push @$list, $val;
            }
            else {
                die "repeated key: $key $key2" if exists $log->{$key}{$key2};
                $log->{$key}{$key2} = $val;
            }
        }
    }
    return @logs;
}

sub setup_test {
    my ($dir, $scriptname, $script, @args) = @_;
    make_path($dir);
    open my $fhout, '>', "$dir/$scriptname";
    print $fhout $script;
    close $fhout;
    my $args = join( ' ', @args );
    is (system( "$^X $dir/script $args >>$dir/stdout 2>>$dir/stderr" ), 0, 'executing script should pass');
    opendir( my $dirhandle, $dir ) || die "cannot open dirhandle on ($dir): $!";
    my @logs =
        grep { -f $_ && $_ =~ /20\d{6}-script.programinfo$/ }
        map { "$dir/$_" }
        readdir $dirhandle;
    if (is( scalar(@logs), 1, 'find one log file')) {
        my $log = shift @logs;
        if (lives_ok { @logs = readlog( $log ); } "reading log file(s)") {
            return @logs;
        }
    }
    return undef;
}


# Verify that the module can be included. (BEGIN just makes this happen early)
BEGIN {use_ok('Log::ProgramInfo' => ( '-logdir' => $logdir ))};

subtest "basics" => sub {
    plan tests => 12;

    my $dir = "$logdir/basics";
    my @logs = setup_test( $dir, 'script', <<"SCRIPT" );

    use Log::ProgramInfo ( '-logdir', '$dir' );
    exit(0);
SCRIPT

    is( scalar(@logs), 1, 'find only one log in file');
    my $log = pop @logs; # check the latest in case there is more than one
    my $mod = $log->{MODULE}{NAME};
    # my $ver = $log->{MODULE}{VERSION};
    my $loc = $log->{MODULE}{LOC};
    my @index = grep { $mod->[$_] eq "Log::ProgramInfo" } 0..(scalar(@$mod)-1);
    is( scalar(@index), 1, 'found one index for module Log::ProgramInfo' );
    like( $loc->[$index[0]], qr(Log/ProgramInfo\.pm$), 'index for Log::ProgramInfo has a valid looking filename' );
    cmp_ok( $log->{Elapsed}, '>', 0, 'elapsed time is numeric and p9ositive' );
    cmp_ok( $log->{Elapsed}, '<', 1, 'elapsed time in less than one second' );
    cmp_ok( $log->{Args}, 'eq', '0', 'zero command line args passed' );
    ok( !exists $log->{arg}, 'no individual arg found' );
    if (length($log->{ProgDir}) == length($dir)) {
        is( $log->{ProgDir}, $dir, "program directory" );
    }
    else {
        like( $log->{ProgDir}, qr(/$dir$), "program directory" );
    }
    is( $log->{Program}, 'script', "program name" );
    done_testing;
};

subtest "args_and_time" => sub {
    plan tests => 10;

    my $dir = "$logdir/args_and_time";
    my @logs = setup_test( $dir, 'script', <<"SCRIPT", 'arg1', 'arg2' );

    use Log::ProgramInfo ( '-logdir', '$dir' );
    sleep(10);
    exit(0);
SCRIPT

    is( scalar(@logs), 1, 'find only one log in file');
    my $log = pop @logs; # check the latest in case there is more than one
    cmp_ok( $log->{Elapsed}, '>', 0, 'elapsed time is numeric and p9ositive' );
    cmp_ok( $log->{Elapsed}, '>=', 10, 'elapsed time at least ten seconds' );
    cmp_ok( $log->{Args}, 'eq', '2', 'two command line args passed' );
    ok( exists $log->{arg}, 'individual args found' );
    is( $log->{arg}{1}, 'arg1', 'arg 1 correct' );
    is( $log->{arg}{2}, 'arg2', 'arg 2 correct' );
    done_testing;
};


done_testing();

# This code gets run before the use_ok above - the first test - for some reason,
# so forget cleanup for now.
#
#     my $tb = Test::More->builder;
#     print STDERR "In END BLOCK\n";
#     if ($tb->is_passing) {
#         remove_tree( $logdir );
#     }

1;
