view release on metacpan or  search on metacpan

t/getopt.t  view on Meta::CPAN

my $ok_count = 1;
sub ok {
    shift or print "not ";
    print "ok $ok_count\n";
    ++$ok_count;
}

use AppConfig qw(:argcount);
$loaded = 1;
ok(1);


#------------------------------------------------------------------------
# create new AppConfig
#

my $default = "<default>";
my $anon    = "<anon>";
my $user    = "Fred Smith";
my $age     = 42;
my $notarg  = "This is not an arg";

my $config = AppConfig->new({
#	DEBUG    => 1,
	ERROR    => sub { 
		my $format = "ERR: " . shift() . "\n"; 
		printf STDERR $format, @_;
	    },
	GLOBAL => { 
	    DEFAULT  => $default,
	    ARGCOUNT => ARGCOUNT_ONE,
	} 
    },
    'verbose' => {
       	DEFAULT  => 0,
	ARGCOUNT => ARGCOUNT_NONE,
	ALIAS    => 'v',
    },
    'user' => {
	ALIAS    => 'u|name|uid',
	ARGS     => '=s',              # explicit Getopt::Long args
	DEFAULT  => $anon,
    },
    'age' => {
	ALIAS    => 'a',
	VALIDATE => '\d+',
	                               # NOTE: Getopt::Long args 
				       # constructed automatically
    });

#2: test the AppConfig got instantiated correctly
ok( defined $config );

my @args = ('-v', '-u', $user, '--age', $age, $notarg);

#3: process the args
# $config->_debug(1);
ok( $config->getopt(qw(default auto_abbrev), \@args) );
# $config->_debug(0);

#4 - #6: check variables got updated
ok( $config->verbose() == 1     );
ok( $config->user()    eq $user );
ok( $config->age()     eq $age  );

#7: next arg should be $notarg
ok( $args[0] = $notarg );

#8 - #10: check args defaults to using @ARGV
@ARGV = ('--age', $age * 2, $notarg);
ok( $config->getopt() );
ok( $config->age() == ($age * 2) );
ok( $ARGV[0] eq $notarg );