CLI-Startup

 view release on metacpan or  search on metacpan

t/getopts.t  view on Meta::CPAN

use Test::More;
use Test::Trap;

eval "use CLI::Startup 'startup'";
plan skip_all => "Can't load CLI::Startup" if $@;

no warnings 'qw';

# Test list-y options
{
    local @ARGV = qw/ --x=a,b --x=c --x="d,1" --x "e,2","f,3",g /;
    my $options = startup({ 'x=s@' => 'listy x option' });
    is_deeply $options->{x},
        [qw/a b c d,1 e,2 f,3 g/],
        "Listy options";
}

# Invalid list-y options should fail
{
    local @ARGV = ( "--x=b,\0", "--x=a" );
    trap { startup({ 'x=s@' => 'listy x option' }) };
    like $trap->stderr, qr/FATAL.*Can't parse/, "Parse dies on invalid CSV";
    ok $trap->stdout eq '', "Nothing printed to stdout";
    ok $trap->exit == 1, "Correct exit status";
}

# Test hash-y options
{
    local @ARGV = qw/ --x=a=1 --x b=2 --x c=3=2+1 /;
    my $options = startup({ 'x=s%' => 'hashy x option' });
    is_deeply $options->{x},
        { a => 1, b => 2, c => '3=2+1' },
        "Hashy options";
}

# Do it again, grouping multiple hash elements together
{
    local @ARGV = qw/ --x=a=1,b=2,c=3=2+1,"d=a,b" /;
    my $options = startup({ 'x=s%' => 'hashy x option' });
    is_deeply $options->{x},
        { a => 1, b => 2, c => '3=2+1', d => 'a,b' },
        "Hashy options combined using commas";
}

# Test incremental options
{
    local @ARGV = ('--x')x10;
    my $options = startup({ 'x+' => 'incremental x option' });
    ok $options->{x} == 10, "Incremental options";
}

# Negatable options
{
    local @ARGV = ( '--no-x' );
    my $options = startup({ 'x!' => 'negatable x option' });
    ok $options->{x} == 0, "Negatable options";
}

# Option with an alias
{
    local @ARGV = ( map { "--x$_" } 0..9 );
    my $optspec = join("|", map {"x$_"} 0..9 ) . "+";
    my $options = startup({ $optspec => 'Option with aliases' });
    ok $options->{x0} == 10, "Option with aliases";
}

done_testing();

t/help.t  view on Meta::CPAN

use English;
use Test::More;
use Test::Trap;

eval "use CLI::Startup 'startup'";
plan skip_all => "Can't load CLI::Startup" if $@;

# Simulate an invocation with --help
{
    local @ARGV = ('--help');

    # Pretend to invoke the script
    trap { startup({ x => 'dummy option' }) };

    # Confirm the basic behaviors of --help
    ok $trap->exit == 0, "Normal exit";
    ok $trap->stdout, "Error message printed";
    like $trap->stdout, qr/usage:/, "Usage message printed";
    like $trap->stderr, qr/^$/, "Nothing printed to stderr";

t/manpage.t  view on Meta::CPAN

# Test the print_manpage functionality

use Test::More;
use Test::Trap;

eval "use CLI::Startup 'startup'";
plan skip_all => "Can't load CLI::Startup" if $@;

# Simulate an invocation with --manpage
{
    local @ARGV = ('--manpage');

    trap { startup({ x => 'dummy option' }) };
    ok $trap->leaveby eq 'exit', "App exited";
    ok $trap->exit == 0, "Normal exit";
    ok $trap->stdout, "Stuff printed to stdout";
    ok $trap->stderr eq '', "Nothing printed to stderr";
    like $trap->stdout, qr/My::Module - An example module/, "POD contents printed";
}

done_testing();

t/nomanpage.t  view on Meta::CPAN

# Test the print_manpage functionality with no POD

use Test::More;
use Test::Trap;

eval "use CLI::Startup 'startup'";
plan skip_all => "Can't load CLI::Startup" if $@;

# Simulate an invocation with --manpage
{
    local @ARGV = ('--manpage');

    trap { startup({ x => 'dummy option' }) };
    ok $trap->exit == 0, "Normal exit";
    ok $trap->stdout, "Error message printed";
    like $trap->stdout, qr/usage:/, "Usage message printed";
    like $trap->stderr, qr/^$/, "Nothing printed to stderr";
}

done_testing();

t/perl-fourish.t  view on Meta::CPAN

plan skip_all => "Can't load CLI::Startup" if $@;

# Test that the sub was imported
ok defined(&startup), "startup() was exported";

# This isn't the version of anything; it's for testing
our $VERSION = 3.1415;

# Print the script version
{
    local @ARGV = ('--version');
    trap { startup({ x => 'dummy option' }) };
    ok $trap->leaveby eq 'exit', "App exits";
    ok $trap->exit == 0, "Exit status 0";
    like $trap->stderr, qr/3\.1415/, "Version was printed";
}

# Clear the version and try again
{
    $VERSION = 0;

    local @ARGV = ('--version');
    trap { startup({ x => 'dummy option' }) };
    ok $trap->leaveby eq 'exit', "App exits";
    ok $trap->exit == 0, "Exit status 0";
    like $trap->stderr, qr/UNKNOWN/, "Version was unknown";
}

# Trivial command-line flag
{
    local @ARGV = ('--dummy');
    my $options = startup({
        dummy => 'Do something, dummy',
    });
    ok $options->{dummy} || 0, "--dummy option read correctly";
}

# Bad options cause usage message
{
    my $options;

    local @ARGV = ('--foo');
    trap { startup({ bar => 'bar option' }) };

    ok $trap->exit == 1, "Error status on invalid option";
    like $trap->stderr, qr/usage:/, "Usage message printed";
}

# --help option automatically causes usage message
{
    local @ARGV = ('--help');
    trap { startup({ foo => 'foo option' }) };

    ok $trap->exit == 0, "Correct exit status on --help option";
    like $trap->stdout, qr/usage:/, "Regular usage message printed";
}

# --help option can't be turned off
{
    local @ARGV = ('--help');
    trap { startup({ 'help' => 0, foo => 'bar' })};

    like $trap->stdout, qr/usage:/, "Can't disable --help option";
    ok $trap->exit == 0, "...and the exit status is correct";
}

# --rcfile option with rcfile disabled
{
    local @ARGV = ('--rcfile=/foo');
    trap { startup({ rcfile => undef, foo => 'bar' })};

    ok $trap->exit == 1, "Error status with disabled --rcfile";
    like $trap->stderr, qr/usage:/, "Usage message printed";
}

# --write-rcfile option with rcfile diabled
{
    local @ARGV = ('--write-rcfile');
    trap { startup({ 'write-rcfile' => undef, foo => 'bar' }) };

    ok $trap->exit == 1, "Error status with disabled --write-rcfile";
    like $trap->stderr, qr/usage:/, "Usage message printed";
    like $trap->stderr, qr/rcfile/, "--rcfile shown in help";
    unlike $trap->stderr, qr/write-rcfile.*Write options/,
        "--write-rcfile not shown";
}

# --help option defined twice

t/perl-fourish.t  view on Meta::CPAN

    {
        trap { startup({ $spec => 'foo', bar => 'baz' }) };

        ok $trap->leaveby eq 'die', "Error exit with invalid spec: $spec";
        like $trap->die, qr/multiple definitions/i, "Error message printed";
    }
}

# --help text with boolean option
{
    local @ARGV = ('--help');
    trap { startup({ 'x!' => 'negatable option' }) };

    ok $trap->exit == 0, "Normal exit status";
    like $trap->stdout, qr/Negate this with --no-x/, "Help text";
}

# --help text with aliases
{
    local @ARGV = ('--help');
    trap { startup({ 'x|a|b|c' => 'aliased option' }) };

    ok $trap->exit == 0, "Exit status";
    like $trap->stdout, qr/Aliases: -a, -b, -c/, "Help text";
}

done_testing();

t/rcfile.t  view on Meta::CPAN

        rcfile  => "$dir/tmp/no_such_file",
        options => { foo => 'bar' },
    });
    lives_ok { $app3->init } "Init with nonexistent file";
    is_deeply $app3->get_config, { default => {} }, "Config is empty";
}

# Repeat the above, using a command-line argument instead of
# an option in the constructor.
{
    local @ARGV = ( "--rcfile=$dir/tmp/no_such_file" );
    my $app = CLI::Startup->new({ foo => 'bar' });
    lives_ok { $app->init } "Init with command-line rcfile";
    ok $app->get_rcfile eq "$dir/tmp/no_such_file", "rcfile set correctly";
    is_deeply $app->get_config, { default => {} }, "Config is empty";
}

# Specify a blank config-file name, then try to write it. That should
# fail with an error.
{
    my $app = CLI::Startup->new({
        rcfile  => '',
        options => { foo => 'bar' },
    });
    ok $app->get_rcfile eq '', "Set blank rcfile name";

    local @ARGV = ('--write-rcfile');
    trap { $app->init() };

    ok $trap->leaveby eq 'die', "App died trying to write file";
    like $trap->die, qr/no file specified/, "Correct error message";
}

# Specify a blank config file on the command line. That should also fail.
{
    my $app = CLI::Startup->new({ foo => 'bar' });

    local @ARGV = ('--rcfile', '', '--write-rcfile');
    trap { $app->init() };

    ok $trap->leaveby eq 'die', "Error exit trying to write file";
    like $trap->die, qr/no file specified/, "Correct error message";
}

# Don't specify any config file on the command line. That should also fail.
{
    my $app = CLI::Startup->new({ foo => 'bar' });

    local @ARGV = ('--rcfile=', '--write-rcfile');
    trap { $app->init() };

    ok $trap->leaveby eq 'die', "Error exit trying to write file";
    like $trap->die, qr/no file specified/, "Correct error message";
}

# Specify a config file in the constructor, then change it, and
# THEN specify a different config file on the command line. The
# one on the command line should win.
{
    # Create a CLI::Startup object and read the rc file
    my $app = CLI::Startup->new( {
            rcfile  => '/foo',
            options => { foo => 'bar' },
    } );
    ok $app->get_rcfile eq '/foo', "Set rcfile in constructor";

    $app->set_rcfile('/bar');
    ok $app->get_rcfile eq '/bar', "Changed rcfile in mutator";

    local @ARGV = ('--rcfile=/baz');
    $app->init();
    ok $app->get_rcfile eq '/baz', "Command line overrides rcfile";
}

# Write and read various different types of RC file
{
    local @ARGV = ();

    # All the config files should contain this data structure
    $config = {
        default => {
            foo     => 1,
            bar     => 'baz',
            baz     => 0,
            hash    => { a => 1, b => 2, c => 3 },
            list    => [ 1, 2, 3, 'purple' ],
        },

t/rcfile.t  view on Meta::CPAN

        is_deeply $app2->get_raw_options, {}, "...and an empty command line";
    }
}

# Call init() for a nonexistent rc file, then write back the
# config, and read in the config file in a second app object.
# The config data should match.
{
    my $file = "$dir/tmp/auto";

    local @ARGV = (
        "--rcfile=$file", qw/ --write-rcfile --rcfile-format=perl --foo --bar=baz /
    );
    my $app = CLI::Startup->new({
        options => {
            foo     => 'foo option',
            'bar=s' => 'bar option',
        },
    });

    trap { $app->init };

t/rcfile.t  view on Meta::CPAN

}

# Specify a custom rcfile writer
{
    my $app = CLI::Startup->new({
        write_rcfile => sub { print "writer called" },
        options      => { foo => 'bar' },
    });
    ok $app->get_write_rcfile, "Custom writer defined";

    local @ARGV = ('--write-rcfile');
    trap { $app->init() };

    ok $trap->leaveby eq 'exit', "Custom writer returned normally";
    like $trap->stdout, qr/writer called/, "Writer was indeed called";
}

# Disable rcfile writing
{
    my $app = CLI::Startup->new({
        write_rcfile => undef,
        options      => { foo => 'bar' },
    });
    ok !$app->get_write_rcfile, "--write-rcfile disabled";

    local @ARGV = ('--write-rcfile');

    # Command-line option will simply be unrecognized
    trap { $app->init() };
    ok $trap->exit == 1, "Error exit with disabled --write-rcfile";
    like $trap->stderr, qr/Unknown option/, "Unknown option error message";

    # Forcibly requesting a writeback from code should die
    trap { $app->init(); $app->write_rcfile };
    ok $trap->leaveby eq 'die', "Dies when forced to write rcfile";
    like $trap->die, qr/but called anyway/, "Correct error message";

t/rcfile.t  view on Meta::CPAN

            bar => 'qux',
        }
    }};
    close OUT;

    my $app = CLI::Startup->new({
        rcfile  => $rcfile,
        options => { 'foo=s' => 'foo', 'bar=s' => 'bar' },
    });

    local @ARGV = ('--foo=baz');
    $app->init;
    ok $app->get_options->{foo} eq 'baz', "Command line overrides config file";
    ok $app->get_options->{bar} eq 'qux', "Default value taken from rcfile";
    is_deeply $app->get_raw_options, { foo => 'baz' }, "Raw command-line options";
}


SKIP: {
    my $tests = 11;

t/write_rcfile.t  view on Meta::CPAN

{
    SKIP: {
        eval "use $libs->{$format}";
        skip( "Skipping $format format: $libs->{$format} is not installed", 1 ) if $@;

        # Restore from backup
        ok copy("$rcfile.orig", $rcfile), "Copied original perl-format RC file.";

        # Load the file
        eval {
            local @ARGV = ( '--rcfile', $rcfile, '--rcfile-format', $format, '--write-rcfile' );
            my $app1 = CLI::Startup->new($options);

            exits_zero { $app1->init } "Wrote ${format}-format rc file.";
            is_deeply $app1->get_config, $config, "Settings are correct.";
        };

        ok compare($rcfile, "$rcfile.orig") == 1, "File contents have changed."
            or system "cat $rcfile";

        # Load it a second time
        my $config2;
        {
            local @ARGV = ();
            my $app2 = CLI::Startup->new($options);

            lives_ok { $app2->init } "Read ${format}-format rc file.";
            $config2 = $app2->get_config;
        }

        # Ini files don't support deep structure, except for our enhancements
        # for array and hash command-line options. Cheat by forcing the "extras"
        # to match.
        if ( $format eq 'ini' )