The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

use strict;
use Test::More tests => 34;
use File::Spec::Functions qw(:ALL);

##############################################################################
# Make sure that we can use the stuff that's in our local lib directory.
BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = ('../lib', 'lib');
    } else {
        unshift @INC, 't/lib', 'lib';
    }
}
chdir 't';
use TieOut;

##############################################################################
# Set up an App::Info subclass to ruin.
package App::Info::Category::FooApp;
use strict;
use App::Info;
use File::Spec::Functions qw(:ALL);
use vars qw(@ISA);
@ISA = qw(App::Info);
sub key_name { 'FooApp' }
my $tmpdir = tmpdir;

sub inc_dir {
    shift->unknown( key      => 'bin',
                    prompt   => 'Path to tmpdir',
                    callback => sub { -d $_[0] },
                    error    => 'Not a valid directory')
 }

sub lib_dir {
    shift->confirm( key      => 'bin',
                    prompt   => 'Path to tmpdir',
                    value    => $tmpdir,
                    callback => sub { -d $_[0] },
                    error    => 'Not a valid directory')
}

sub patch { shift->info("Info message" ) }
sub major { shift->error("Error message" ) }
sub minor { shift->unknown( key => 'minor version number') }

sub version {
    shift->unknown( key      => 'version number',
                    callback => sub { $_[0] =~ /^\d+$/ } )
}

sub so_lib_dir {
    shift->confirm( key   => 'shared object directory',
                    value => '/foo33')
}

sub name {
    shift->confirm( key      => 'name',
                    value    => 'ick',
                    callback => sub { $_[0] !~ /\d/ })
}

sub bin_dir { shift->confirm }
sub foo_dir { shift->unknown }

##############################################################################
# Set up the tests.
package main;

BEGIN { use_ok('App::Info::Handler::Prompt') }

# Tie off the file handles.
my $stdout = tie *STDOUT, 'TieOut' or die "Cannot tie STDOUT: $!\n";
my $stdin = tie *STDIN, 'TieOut' or die "Cannot tie STDIN: $!\n";
my $stderr = tie *STDERR, 'TieOut' or die "Cannot tie STDERR: $!\n";

ok( my $app = App::Info::Category::FooApp->new( on_unknown => 'prompt'),
    "Use keyword to set up for unknown" );
ok( my $p = App::Info::Handler::Prompt->new, "Create prompt" );
$p->{tty} = 1; # Cheat death.
ok( $app = App::Info::Category::FooApp->new( on_unknown => $p),
    "Set up for unknown" );
# Make sure there were no warnings.
is $stderr->read, '', "There should be no warnings";

##############################################################################
# Set up a couple of answers.
print STDIN 'foo3424324';
print STDIN $tmpdir;
# Trigger the unknown handler.
my $dir = $app->inc_dir;

# Check the result and the output.
is( $dir, $tmpdir, "Got tmpdir from inc_dir" );
my $expected = qq{Path to tmpdir Not a valid directory: 'foo3424324'
Path to tmpdir };
is ($stdout->read, $expected, "Check unknown prompt" );

##############################################################################
# Okay, now we'll test the confirm handler.
ok( $app = App::Info::Category::FooApp->new( on_confirm => $p),
    "Set up for first confirm" );

# Start with an affimative answer.
print STDIN "\n";
$dir = $app->lib_dir;
is($dir, $tmpdir, "Got tmpdir from lib_dir" );
$expected = qq{Path to tmpdir [$tmpdir] };
is( $stdout->read, $expected, "Check first confirm prompt" );

##############################################################################
# Now try an alternate answer.
ok( $app = App::Info::Category::FooApp->new( on_confirm => $p),
    "Set up for second confirm" );
# Set up the answers.
print STDIN "foo123123\n";
print STDIN "$tmpdir\n";
# Set it off.
$dir = $app->lib_dir;
# Check the answer.
is($dir, $tmpdir, "Got tmpdir from second confirm" );
# Check the output.
$expected = qq{Path to tmpdir [$tmpdir] Not a valid directory: 'foo123123'
Path to tmpdir [$tmpdir] };
is( $stdout->read, $expected, "Check second confirm prompt" );

##############################################################################
# Now just try the default answer.
ok( $app = App::Info::Category::FooApp->new( on_confirm => $p),
    "Set up for third confirm" );
# Set up the answers.
print STDIN "\n";
# Set it off.
$dir = $app->lib_dir;
# Check the answer.
is($dir, $tmpdir, "Got tmpdir from third confirm" );
# Check the output.
$expected = qq{Path to tmpdir [$tmpdir] };
is( $stdout->read, $expected, "Check third confirm prompt" );

##############################################################################
# Now test just a key argument to unknown
ok( $app = App::Info::Category::FooApp->new( on_unknown => $p),
    "Set up for key argument" );
# Set up the answer.
print STDIN "$tmpdir\n";
# Set it off.
$app->minor;
# Check the answer.
is($dir, $tmpdir, "Got tmpdir from key argument" );
# Check the output.
$expected = qq{Enter a valid FooApp minor version number };
is( $stdout->read, $expected, "Check key argument prompt" );

##############################################################################
# Now test key argument with callback to unknown.
ok( $app = App::Info::Category::FooApp->new( on_unknown => $p),
    "Set up for key with callback");
# Set up the answers.
print STDIN "foo\n";
print STDIN "22";
# Set it off.
my $ver = $app->version;
# Check the answer.
is($ver, 22, "Got 22 from version" );
# Check the output.
$expected = qq{Enter a valid FooApp version number Invalid value: 'foo'
Enter a valid FooApp version number };
is( $stdout->read, $expected, "Check key with callback prompt" );

##############################################################################
# Now test just a key argument to confirm
ok( $app = App::Info::Category::FooApp->new( on_confirm => $p),
    "Set up for key argument" );
# Set up the answer.
print STDIN "$tmpdir\n";
# Set it off.
$app->so_lib_dir;
# Check the answer.
is($dir, $tmpdir, "Got tmpdir from key argument" );
# Check the output.
$expected = qq{Enter a valid FooApp shared object directory [/foo33] };
is( $stdout->read, $expected, "Check confirm key argument prompt" );

##############################################################################
# Now test key argument with callback to confirm.
ok( $app = App::Info::Category::FooApp->new( on_confirm => $p),
    "Set up for key with callback");
# Set up the answers.
print STDIN "foo22\n";
print STDIN "foo";
# Set it off.
$ver = $app->name;
# Check the answer.
is($ver, 'foo', "Got 'foo' from name" );
# Check the output.
$expected = qq{Enter a valid FooApp name [ick] Invalid value: 'foo22'
Enter a valid FooApp name [ick] };
is( $stdout->read, $expected, "Check confirm key with callback prompt" );

##############################################################################
# Now check how it handles info and error. These should just print to the
# relevant file handle. Info prints to STDOUT.
ok( $app = App::Info::Category::FooApp->new( on_info => $p),
    "Set up for info" );
$app->patch;
is( $stdout->read, "Info message\n", "Check info message" );

# And error prints to STDERR.
ok( $app = App::Info::Category::FooApp->new( on_error => $p),
    "Set up for error" );
$app->major;
is( $stderr->read, "Error message\n", "Check error message" );

##############################################################################
# Clean up our mess.
undef $stdout;
undef $stdin;
undef $stderr;
untie *STDOUT;
untie *STDIN;
untie *STDERR;

##############################################################################
# Test for errors when no key argument is passed.
{
    my $msg;
    local $SIG{__DIE__} = sub { $msg = shift };
    eval { $app->bin_dir };
    like( $msg, qr/No key parameter passed to confirm/,
          "Check no key confirm" );
    eval { $app->foo_dir };
    like( $msg, qr/No key parameter passed to unknown/,
          "Check no key unknown" );
}

##############################################################################
# Interactive tests for maintainer.
if ($ENV{APP_INFO_MAINTAINER} && ! $ENV{HARNESS_ACTIVE}) {
    # Interactive tests for maintainer only.
    $app = App::Info::Category::FooApp->new( on_confirm => $p);
    $app->inc_dir;
    $app->lib_dir;
}

__END__