view release on metacpan or search on metacpan
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',
'-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
# -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" );