App-Framework

 view release on metacpan or  search on metacpan

t/01-Man.t  view on Meta::CPAN


use App::Framework ;

# VERSION
our $VERSION = '1.234' ;

my $DEBUG=0;
my $VERBOSE=0;

	my $stdout="" ;
	my $stderr="" ;

	diag( "Testing usage" );
	
	my @man = (
		'Must specify input file "source"',
		'-help|h               Print help',
		'-man                  Full documentation',
		'-name|n <arg>             Test name',
		'-nomacro              Do not create test macro calls',
		'-int <integer>        An integer',

t/01-Man.t  view on Meta::CPAN

           '-man',         
	) ;


	## start with a redirect check
	eval{
		local *STDOUT ;
		local *STDERR ;

		open(STDOUT, '>', \$stdout)  or die "Can't open STDOUT: $!" ;
		open(STDERR, '>', \$stderr) or die "Can't open STDERR: $!";

		print "I was hoping for more!\n" ;
	} ;
	if (!$stdout)
	{
		diag("Sorry, can't redirect stdout: $@") ;
		plan skip_all => 'Unable to redirect stdout (I need to redirect to check the man pages)';
		exit 0 ;
	}
	else

t/01-Man.t  view on Meta::CPAN

	#           -int <integer>        An integer
	#           -float <float>        An float
	#           -array <string>       An array           (option may be specified multiple times)
	#           -hash <key=value>     A hash             (option may be specified multiple times)	
	#
	eval{
		local *STDOUT ;
		local *STDERR ;

		open(STDOUT, '>', \$stdout)  or die "Can't open STDOUT: $!" ;
		open(STDERR, '>', \$stderr) or die "Can't open STDERR: $!";

		@ARGV = () ;	
		App::Framework->new('exit_type'=>'die')->go() ;
#		$app->go() ;
	} ;

print "App: $stdout\n\n" ;

	foreach my $test (@man)
	{

t/01-Mandev.t  view on Meta::CPAN


use App::Framework ;

# VERSION
our $VERSION = '1.234' ;

my $DEBUG=0;
my $VERBOSE=0;

	my $stdout="" ;
	my $stderr="" ;

	diag( "Testing usage" );
	
	my @sections = qw/NAME SYNOPSIS OPTIONS DESCRIPTION/ ;
	my @mandev = (
		'-pod                  Output full pod',
		'-dbg-data             Debug option: Show __DATA__',
		'-dbg-data-array       Debug option: Show all __DATA__ items',
		'-int=i                An integer',
		'-float=f              An float',

t/01-Mandev.t  view on Meta::CPAN

	#	            string that is the full 'path' of the test name.
	#	
	#	            The test path being the menu names, separated by '::' down to
	#	            the actual test name
	#	
	#	DESCRIPTION
	#	    01-Man reads the control file to pull together fragments of test script.
	#	    Creates a single test script file and a test menu.
	#	
	$stdout="" ;
	$stderr="" ;
	
	eval{
		local *STDOUT ;
		local *STDERR ;

		open(STDOUT, '>', \$stdout)  or die "Can't open STDOUT: $!" ;
		open(STDERR, '>', \$stderr) or die "Can't open STDERR: $!";
	
#		push @ARGV, '-man-dev' ;
		@ARGV = ('-man-dev') ;
		App::Framework->new('exit_type'=>'die')->go() ;
#		$app->go() ;
		pop @ARGV ;
	} ;
print "App -man-dev: $stdout\n\n" ;

	if (!$stdout)

t/02-Options-1.t  view on Meta::CPAN


use App::Framework ;

# VERSION
our $VERSION = '1.234' ;

my $DEBUG=0;
my $VERBOSE=0;

	my $stdout="" ;
	my $stderr="" ;

	diag( "Testing options" );

	## run time options
	my %expected_options = (
		'name=s'			=> 'a name',
		'default=s'			=> 'a default',
		'default2=s'		=> 'b default',
		'default3=s'		=> 'c default',
		'log=s'				=> 'new setting',

t/02-Options-2.t  view on Meta::CPAN


use App::Framework ;

# VERSION
our $VERSION = '1.234' ;

my $DEBUG=0;
my $VERBOSE=0;

	my $stdout="" ;
	my $stderr="" ;

	diag( "Testing options" );

	## run time options
	my %expected_options = (
		'name=s'			=> 'a default',
		'default=s'			=> 'a default',
		'default2=s'		=> 'a default a default',
		'default3=s'		=> 'a default a default another default',
		'log=s'				=> 'another default',

t/02-Options-3.t  view on Meta::CPAN


use App::Framework ;

# VERSION
our $VERSION = '1.234' ;

my $DEBUG=0;
my $VERBOSE=0;

	my $stdout="" ;
	my $stderr="" ;

	diag( "Testing options expanded variables" );

	## run time options
	my %expected_options = (
		'test_name=s'		=> 'this is different',
		'default=s'			=> 'this is different',
		'default2=s'		=> 'my def',
		'default3=s'		=> 'my def another default',
		'log=s'				=> 'another default',

t/02-Options-4.t  view on Meta::CPAN


use App::Framework ;

# VERSION
our $VERSION = '1.234' ;

my $DEBUG=0;
my $VERBOSE=0;

	my $stdout="" ;
	my $stderr="" ;

	diag( "Testing options and args expanded variables" );

	## run time options
	my %expected_options = (
		'test_name=s'		=> 'im the series name',
		'default=s'			=> 'im the series name',
		'default2=s'		=> 'im the series name im the series name',
		'default3=s'		=> 'im the series name im the series name another default',
		'log=s'				=> 'another default',

t/04-Args.t  view on Meta::CPAN


use App::Framework '+Args(open=none)' ;

# VERSION
our $VERSION = '2.01' ;

my $DEBUG=0;
my $VERBOSE=0;

	my $stdout="" ;
	my $stderr="" ;

	diag( "Testing args" );

	my $input_checks = 3 ;	
	my @args = (
		['src1',	't/args/file.txt'],
		['src2',	't/args/dir'],
		['src3',	't/args/exists.txt'],
		['out1',	't/args/outfile'],
		['out2',	't/args/outdir'],

t/04-Args.t  view on Meta::CPAN

			push @ARGV, $val ;
			
			++$arg ;
		}
		push @ARGV, @array ; # array
		eval {
			local *STDOUT ;
			local *STDERR ;
	
			open(STDOUT, '>', \$stdout)  or die "Can't open STDOUT: $!" ;
			open(STDERR, '>', \$stderr) or die "Can't open STDERR: $!";
			$app->go() ;
		};
		print "reply: $stdout" ;
		like($stdout, qr/Error: Must specify/i, "Input checking") ;
	}

	## Array input
	foreach my $arg_aref (@args)
	{
		my $val = $arg_aref->[1] ;
		push @ARGV, $val ;
	}
	eval {
		local *STDOUT ;
		local *STDERR ;

		open(STDOUT, '>', \$stdout)  or die "Can't open STDOUT: $!" ;
		open(STDERR, '>', \$stderr) or die "Can't open STDERR: $!";
		$app->go() ;
	};
	print "reply: $stdout" ;
	like($stdout, qr/Error: Must specify/i, "Input array checking") ;

	## These should now work	
	@ARGV = () ;
	foreach my $arg_aref (@args)
	{
		push @ARGV, $arg_aref->[1] ;

t/04-ArgsArray.t  view on Meta::CPAN

use App::Framework '+Args(open=none)' ;

# VERSION
our $VERSION = '2.01' ;

my $DEBUG=0;
my $VERBOSE=0;
my $SKIP=0;

	my $stdout="" ;
	my $stderr="" ;

	diag( "Testing args (array)" );

	my @array = (
		't/args/file.txt',
		't/args/exists.txt',
		't/args/array.txt',
	) ;
	plan tests => 1 + (1 + scalar(@array) );

t/04-ArgsArray.t  view on Meta::CPAN

			}
		},
	) ;

	@ARGV = () ;
	eval {
		local *STDOUT ;
		local *STDERR ;

		open(STDOUT, '>', \$stdout)  or die "Can't open STDOUT: $!" ;
		open(STDERR, '>', \$stderr) or die "Can't open STDERR: $!";
		$SKIP=1;
		$app->go() ;
	};
	print "reply: $stdout" ;
	like($stdout, qr/Error: Must specify/i, "Input array checking") ;

	## Array input
	foreach my $val (@array)
	{
		push @ARGV, $val ;

t/04-ArgsArray2.t  view on Meta::CPAN


use App::Framework '+Args(open=none)' ;

# VERSION
our $VERSION = '2.00' ;

my $DEBUG=0;
my $VERBOSE=0;

	my $stdout="" ;
	my $stderr="" ;

	diag( "Testing args (array no-check)" );

	plan tests => 1 ;

	## This should work	
	my $app = App::Framework->new('exit_type'=>'die',
		'feature_config' => {
			'Args'	=> {
				'debug'	=> 0,
			}
		},
	) ;

	@ARGV = () ;
	eval {
		local *STDOUT ;
		local *STDERR ;

		open(STDOUT, '>', \$stdout)  or die "Can't open STDOUT: $!" ;
		open(STDERR, '>', \$stderr) or die "Can't open STDERR: $!";
		$app->go() ;
	};
	print "reply: $stdout\n" ;
	unlike($stdout, qr/Error: Must specify/i, "Input array checking") ;

	$@ =~ s/Died.*//m if $@ ;
	print "$@" if $@ ;



t/04-ArgsDefault.t  view on Meta::CPAN


use App::Framework ;

# VERSION
our $VERSION = '2.01' ;

my $DEBUG=0;
my $VERBOSE=0;

	my $stdout="" ;
	my $stderr="" ;

	diag( "Testing args (open handles with defaults)" );

	# 0 = arg name
	# 1 = arg value (filename/dirname)
	# 2 = check for opened
	# 3 = check output file
	# 4 = output file append
	# 5 = input file
	my @args = (

t/04-ArgsOpen.t  view on Meta::CPAN


use App::Framework ;

# VERSION
our $VERSION = '2.01' ;

my $DEBUG=0;
my $VERBOSE=0;

	my $stdout="" ;
	my $stderr="" ;

	diag( "Testing args (open handles)" );

	# 0 = arg name
	# 1 = arg value (filename/dirname)
	# 2 = check for opened
	# 3 = check output file
	# 4 = output file append
	# 5 = input file
	my @args = (

t/04-ArgsWild.t  view on Meta::CPAN

use App::Framework '+Args(open=none)' ;

# VERSION
our $VERSION = '1.00' ;

my $DEBUG=0;
my $VERBOSE=0;
my $SKIP=0;

	my $stdout="" ;
	my $stderr="" ;

	diag( "Testing args (array)" );

	my @array = (
		't/args/array.txt',
		't/args/exists.txt',
		't/args/file.txt',

		't/args/file.txt',

t/05-Data.t  view on Meta::CPAN

use App::Framework ;
use App::Framework::Base ;

# VERSION
our $VERSION = '2.00' ;

my $DEBUG=0;
my $VERBOSE=0;

	my $stdout="" ;
	my $stderr="" ;

	diag( "Testing data" );

my $NAMED1 =<<'NAMED1';
=head2 Named Arguments

The [NAMEARGS] section is used to specify the expected command line arguments used with the application. These "named arguments" provide
a mechanism for the framework to determine if all required arguments have been specified (generating an error message if not), creates
the application documentation showing these required arguments, and allows for easier access to the arguments in the application itself.

t/100-Extension-Filter-std.t  view on Meta::CPAN

			"-skip_empty",
		],
		'input'		=> "$write_dir/$source",
		'output'	=> "$write_dir/terse.txt",
	},

) ;


	my $stdout="" ;
	my $stderr="" ;

	diag( "Testing filter extension - stdin/stdout" );

	plan tests => scalar(keys %expected) ;

	## clear out write path
	if (-d $write_dir)
	{
		foreach my $f (glob("$write_dir"))
		{

t/100-Extension-Filter.t  view on Meta::CPAN

			"-skip_empty",
		],
		'input'		=> "$write_dir/$source",
		'output'	=> "$write_dir/$source",
	},

) ;


	my $stdout="" ;
	my $stderr="" ;

	diag( "Testing filter extension" );

	plan tests => scalar(keys %expected) ;

	## clear out write path
	if (-d $write_dir)
	{
		foreach my $f (glob("$write_dir"))
		{

t/100-Extension-Filter.t  view on Meta::CPAN

#----------------------------------------------------------------------
sub do_go
{
	@ARGV = @_ ;

	eval {
		local *STDOUT ;
		local *STDERR ;

		open(STDOUT, '>', \$stdout)  or die "Can't open STDOUT: $!" ;
		open(STDERR, '>', \$stderr) or die "Can't open STDERR: $!";

		$app->go()
	} ;
#	$@ =~ s/Died.*//m if $@ ;
#	$@ =~ s/^\s+//gm if $@ ;
#	$@ =~ s/\s+$//gm if $@ ;

	print "$stdout" if $stdout ;
	print "$stderr" if $stderr ;
	print "$@" if $@ ;

}

#----------------------------------------------------------------------
sub getfh
{
	my ($fh) = @_ ;
	local $/ = undef ;
	my $data = <$fh> ;

t/100-Feature-Mail.t  view on Meta::CPAN

	eval {
		require Net::SMTP;
	} ;
	if ($@)
	{
	    plan skip_all => 'Unable to run tests since Net::SMTP not available';
		exit 0 ;
  	}

	my $stdout="" ;
	my $stderr="" ;


	## start with a redirect check
	eval{
		local *STDOUT ;
		local *STDERR ;

		open(STDOUT, '>', \$stdout)  or die "Can't open STDOUT: $!" ;
		open(STDERR, '>', \$stderr) or die "Can't open STDERR: $!";

		print "I was hoping for more!\n" ;
	} ;
	if (!$stdout)
	{
		diag("Sorry, can't redirect stdout: $@") ;
		$tests{'man'} = 0 ;
	}

	## Planned tests

t/100-Feature-Mail.t  view on Meta::CPAN

	plan tests => $test_count ;
	
	## MAN pages
	if ($tests{'man'})
	{
		eval{
			local *STDOUT ;
			local *STDERR ;
	
			open(STDOUT, '>', \$stdout)  or die "Can't open STDOUT: $!" ;
			open(STDERR, '>', \$stderr) or die "Can't open STDERR: $!";
	
			@ARGV = ('-help') ;	
			App::Framework->new('exit_type'=>'die')->go() ;
		} ;

		foreach my $test (keys %man)
		{
			like  ($stdout, qr/$test/im, "Man page entry existance: $test");
		}

t/20-Feature-Config.t  view on Meta::CPAN


use App::Framework '+Config' ;

# VERSION
our $VERSION = '1.00' ;

my $DEBUG=0;
my $VERBOSE=0;

	my $stdout="" ;
	my $stderr="" ;
	
	if (@ARGV)
	{
		$DEBUG = $ARGV[0] ;
		$VERBOSE = $ARGV[0] ;
		@ARGV = () ;
	}

	diag( "Testing config" );



( run in 2.293 seconds using v1.01-cache-2.11-cpan-a9ef4e587e4 )