#!/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__