local.*@ARGV results from the CPAN

local.*@ARGV

Getopt-Kingpin

view release on metacpan or search on metacpan

use strict;
use Test::More 0.98;
use Getopt::Kingpin;


subtest 'string normal' => sub {
    local @ARGV;
    push @ARGV, qw(--name kingpin);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->flag('name', 'set name')->string();
    $kingpin->parse;

    is $kingpin->flags->get('name'), 'kingpin';
};

subtest 'string normal 2 options' => sub {
    local @ARGV;
    push @ARGV, qw(--name kingpin --xyz abcde);

    my $k = Getopt::Kingpin->new;
    $k->flag('name', 'option 1')->string;
    $k->flag('xyz',  'option 2')->string;
    $k->parse;

    is $k->flags->get('name'), 'kingpin';
    is $k->flags->get('xyz'), 'abcde';

t/02_string_with_overload.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Getopt::Kingpin;


subtest 'string normal with overload' => sub {
    local @ARGV;
    push @ARGV, qw(--name kingpin);

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->flag('name', 'set name')->string();
    $kingpin->parse;

    is $name, 'kingpin';
};

t/03_int.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Test::Exception;
use Capture::Tiny ':all';
use Getopt::Kingpin;


subtest 'int normal with overload' => sub {
    local @ARGV;
    push @ARGV, qw(--x 0);

    my $kingpin = Getopt::Kingpin->new;
    my $x = $kingpin->flag('x', 'set x')->int();
    $kingpin->parse;

    is $x, 0;
    ok $x == 0;
};


subtest 'int error with overload' => sub {
    local @ARGV;
    push @ARGV, qw(--x ZERO);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    my $x = $kingpin->flag('x', 'set x')->int();
    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

    like $stderr, qr/int parse error/, 'int parse error';

t/04_required.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Capture::Tiny ':all';
use Getopt::Kingpin;


subtest 'required' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    $kingpin->flag('name', 'set name')->required->string();

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

    like $stderr, qr/error: required flag --name not provided, try --help/, 'required error';
    is $exit, 1;
};

subtest 'required and not required' => sub {
    local @ARGV;
    push @ARGV, qw(--name abc --x 3);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    my $name = $kingpin->flag('name', 'set name')->required->string();
    my $x = $kingpin->flag('x', 'set x')->int();

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

t/05_short_option.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Test::Exception;
use Capture::Tiny ':all';
use Getopt::Kingpin;


subtest 'short option' => sub {
    local @ARGV;
    push @ARGV, qw(-n kingpin);

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->flag('name', 'set name')->short('n')->required->string();

    $kingpin->parse;

    is $name, 'kingpin';
};

subtest 'short and long option' => sub {
    local @ARGV;
    push @ARGV, qw(-n kingpin --xxxx 3);

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->flag('name', 'set name')->short('n')->required->string();
    my $xxxx = $kingpin->flag('xxxx', 'set xxxx')->required->string();

    $kingpin->parse;

    is $name, 'kingpin';
    is $xxxx, 3;
};

subtest 'unknown short flag' => sub {
    local @ARGV;
    push @ARGV, qw(-h);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

    like $stderr, qr/error: unknown short flag '-h', try --help/;
    is $exit, 1;
};

subtest 'POSIX-style short flag combining 1' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new;
    my $x = $kingpin->flag("long_x", "")->short("x")->bool();
    my $y = $kingpin->flag("long_y", "")->short("y")->bool();

    $kingpin->parse;

    is $x, 0;
    is $y, 0;
};

subtest 'POSIX-style short flag combining 2' => sub {
    local @ARGV;
    push @ARGV, qw(-xy);

    my $kingpin = Getopt::Kingpin->new;
    my $x = $kingpin->flag("long_x", "")->short("x")->bool();
    my $y = $kingpin->flag("long_y", "")->short("y")->bool();

    $kingpin->parse;

    is $x, 1;
    is $y, 1;
};

subtest 'Short-flag+parameter combining 1' => sub {
    local @ARGV;
    push @ARGV, qw(-x 12);

    my $kingpin = Getopt::Kingpin->new;
    my $x = $kingpin->flag("long_x", "")->short("x")->int();

    $kingpin->parse;

    is $x, 12;
};

subtest 'Short-flag+parameter combining 2' => sub {
    local @ARGV;
    push @ARGV, qw(-x12);

    my $kingpin = Getopt::Kingpin->new;
    my $x = $kingpin->flag("long_x", "")->short("x")->int();

    $kingpin->parse;

    is $x, 12;
};

subtest 'Short-flag+parameter combining 3' => sub {
    local @ARGV;
    push @ARGV, qw(-yx12);

    my $kingpin = Getopt::Kingpin->new;
    my $x = $kingpin->flag("long_x", "")->short("x")->int();
    my $y = $kingpin->flag("long_y", "")->short("y")->bool();

    $kingpin->parse;

    is $x, 12;
    is $y, 1;
};

subtest 'Short-flag+parameter combining 4 error' => sub {
    local @ARGV;
    push @ARGV, qw(-x12y);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    my $x = $kingpin->flag("long_x", "")->short("x")->int();
    my $y = $kingpin->flag("long_y", "")->short("y")->bool();

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

t/06_default.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Test::Exception;
use Getopt::Kingpin;


subtest 'default' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->flag('name', 'set name')->default("default name")->string();
    my $xxxx = $kingpin->flag('xxxx', 'set xxxx')->string();

    $kingpin->parse;

    is $name, 'default name';
    is $xxxx, '';
};

subtest 'default (list)' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->flag('name', 'set name')->default(["default name", "default name 2"])->string_list();
    my $xxxx = $kingpin->flag('xxxx', 'set xxxx')->string_list();

    $kingpin->parse;

    is_deeply $name->value, ['default name', 'default name 2'];
    is_deeply $xxxx->value, [];
};

subtest 'default (hash)' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->flag('name', 'set name')->default({"foo"=>"a","bar"=>"b"})->string_hash();
    my $xxxx = $kingpin->flag('xxxx', 'set xxxx')->string_hash();

    $kingpin->parse;

    is_deeply $name->value, {"foo"=>"a","bar"=>"b"};
    is_deeply $xxxx->value, {};
};

subtest 'default arg' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->arg('name', 'set name')->default("default name")->string();
    my $xxxx = $kingpin->arg('xxxx', 'set xxxx')->string();

    $kingpin->parse;

    is $name, 'default name';
    is $xxxx, '';
};

subtest 'default arg (list)' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->arg('name', 'set name')->default(["default name", "default name 2"])->string_list();
    my $xxxx = $kingpin->arg('xxxx', 'set xxxx')->string_list();

    $kingpin->parse;

    is_deeply $name->value, ['default name', 'default name 2'];
    is_deeply $xxxx->value, [];
};

subtest 'default arg (hash)' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->arg('name', 'set name')->default({"foo"=>"a","bar"=>"b"})->string_hash();
    my $xxxx = $kingpin->arg('xxxx', 'set xxxx')->string_hash();

    $kingpin->parse;

    is_deeply $name->value, {"foo"=>"a","bar"=>"b"};
    is_deeply $xxxx->value, {};
};

subtest 'coderef default' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->flag('name', 'set name')->default(sub { "default name" })->string();
    my $xxxx = $kingpin->flag('xxxx', 'set xxxx')->string();

    $kingpin->parse;

    is $name, 'default name';
    is $xxxx, '';
};

subtest 'coderef default (list)' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->flag('name', 'set name')->default(sub { ["default name", "default name 2"] })->string_list();
    my $xxxx = $kingpin->flag('xxxx', 'set xxxx')->string_list();

    $kingpin->parse;

    is_deeply $name->value, ['default name', 'default name 2'];
    is_deeply $xxxx->value, [];
};

subtest 'coderef default (hash)' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->flag('name', 'set name')->default(sub {{"foo"=>"a","bar"=>"b"}})->string_hash();
    my $xxxx = $kingpin->flag('xxxx', 'set xxxx')->string_hash();

    $kingpin->parse;

    is_deeply $name->value, {"foo"=>"a","bar"=>"b"};
    is_deeply $xxxx->value, {};
};

subtest 'coderef default arg' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->arg('name', 'set name')->default(sub { "default name" })->string();
    my $xxxx = $kingpin->arg('xxxx', 'set xxxx')->string();

    $kingpin->parse;

    is $name, 'default name';
    is $xxxx, '';
};

subtest 'coderef default arg (list)' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->arg('name', 'set name')->default(sub { ["default name", "default name 2"] })->string_list();
    my $xxxx = $kingpin->arg('xxxx', 'set xxxx')->string_list();

    $kingpin->parse;

    is_deeply $name->value, ['default name', 'default name 2'];
    is_deeply $xxxx->value, [];
};

subtest 'coderef default arg (hash)' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->arg('name', 'set name')->default(sub {{"foo"=>"a","bar"=>"b"}})->string_hash();
    my $xxxx = $kingpin->arg('xxxx', 'set xxxx')->string_hash();

    $kingpin->parse;

    is_deeply $name->value, {"foo"=>"a","bar"=>"b"};
    is_deeply $xxxx->value, {};
};

# Package for overloaded defaults
sub ov (&) {
    package Local::Overloaded;
    use overload '&{}' => sub { $_[0][0] };
    bless [ @_ ];
}

subtest 'overloaded object default' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->flag('name', 'set name')->default(ov { "default name" })->string();
    my $xxxx = $kingpin->flag('xxxx', 'set xxxx')->string();

    $kingpin->parse;

    is $name, 'default name';
    is $xxxx, '';
};

subtest 'overloaded object default (list)' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->flag('name', 'set name')->default(ov { ["default name", "default name 2"] })->string_list();
    my $xxxx = $kingpin->flag('xxxx', 'set xxxx')->string_list();

    $kingpin->parse;

    is_deeply $name->value, ['default name', 'default name 2'];
    is_deeply $xxxx->value, [];
};

subtest 'overloaded object default (hash)' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->flag('name', 'set name')->default(ov {{"foo"=>"a","bar"=>"b"}})->string_hash();
    my $xxxx = $kingpin->flag('xxxx', 'set xxxx')->string_hash();

    $kingpin->parse;

    is_deeply $name->value, {"foo"=>"a","bar"=>"b"};
    is_deeply $xxxx->value, {};
};

subtest 'overloaded object default arg' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->arg('name', 'set name')->default(ov { "default name" })->string();
    my $xxxx = $kingpin->arg('xxxx', 'set xxxx')->string();

    $kingpin->parse;

    is $name, 'default name';
    is $xxxx, '';
};

subtest 'overloaded object default arg (list)' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->arg('name', 'set name')->default(ov { ["default name", "default name 2"] })->string_list();
    my $xxxx = $kingpin->arg('xxxx', 'set xxxx')->string_list();

    $kingpin->parse;

    is_deeply $name->value, ['default name', 'default name 2'];
    is_deeply $xxxx->value, [];
};

subtest 'overloaded object default arg (hash)' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->arg('name', 'set name')->default(ov {{"foo"=>"a","bar"=>"b"}})->string_hash();
    my $xxxx = $kingpin->arg('xxxx', 'set xxxx')->string_hash();

    $kingpin->parse;

    is_deeply $name->value, {"foo"=>"a","bar"=>"b"};
    is_deeply $xxxx->value, {};
};

subtest 'non-overloaded object default' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->arg('name', 'set name')->default(bless({'x'=>3}, 'Local::SomePackage'));
    my $xxxx = $kingpin->arg('xxxx', 'set xxxx');

    $kingpin->parse;

    is_deeply $name->value, bless({'x'=>3}, 'Local::SomePackage');
    is_deeply $xxxx->value, undef;

t/07_override_default_from_envvar.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Test::Exception;
use Capture::Tiny ':all';
use Getopt::Kingpin;


subtest 'default' => sub {
    local @ARGV;
    push @ARGV, qw();

    $ENV{KINGPIN_TEST_NAME} = "name from env var";

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->flag('name', 'set name')->default("default name")->override_default_from_envar("KINGPIN_TEST_NAME")->string();

    $kingpin->parse;

    is $name, 'name from env var';

    delete $ENV{KINGPIN_TEST_NAME};
};

subtest 'default arg' => sub {
    local @ARGV;
    push @ARGV, qw();

    $ENV{KINGPIN_TEST_NAME} = "name from env var";

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->arg('name', 'set name')->default("default name")->override_default_from_envar("KINGPIN_TEST_NAME")->string();

    $kingpin->parse;

    is $name, 'name from env var';

    delete $ENV{KINGPIN_TEST_NAME};
};

subtest 'default arg (no env var)' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->arg('name', 'set name')->default("default name")->override_default_from_envar("KINGPIN_TEST_NAME")->string();

    $kingpin->parse;

    is $name, 'default name';
};

subtest 'default with error' => sub {
    local @ARGV;
    push @ARGV, qw();

    $ENV{KINGPIN_TEST_ID} = "xxx";

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    my $name = $kingpin->flag('id', 'set id')->default("default id")->override_default_from_envar("KINGPIN_TEST_ID")->int();

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

    like $stderr, qr/int parse error/, 'int parse error';
    is $exit, 1;

    delete $ENV{KINGPIN_TEST_NAME};
};

subtest 'default with error (no env var)' => sub {
    local @ARGV;
    push @ARGV, qw();

    $ENV{KINGPIN_TEST_ID} = "xxx";

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    my $name = $kingpin->flag('id', 'set id')->default("default id")->int();

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

    like $stderr, qr/int parse error/, 'int parse error';
    is $exit, 1;

    delete $ENV{KINGPIN_TEST_NAME};
};

subtest 'default with error (no env var, list)' => sub {
    local @ARGV;
    push @ARGV, qw();

    $ENV{KINGPIN_TEST_ID} = "xxx";

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    my $name = $kingpin->flag('id', 'set id')->default(["default id"])->int_list();

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

    like $stderr, qr/int parse error/, 'int parse error';
    is $exit, 1;

    delete $ENV{KINGPIN_TEST_NAME};
};

subtest 'default arg with error' => sub {
    local @ARGV;
    push @ARGV, qw();

    $ENV{KINGPIN_TEST_ID} = "xxx";

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    my $name = $kingpin->arg('id', 'set id')->default("default id")->override_default_from_envar("KINGPIN_TEST_ID")->int();

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

    like $stderr, qr/int parse error/, 'int parse error';
    is $exit, 1;

    delete $ENV{KINGPIN_TEST_NAME};
};

subtest 'default arg with error (no env var)' => sub {
    local @ARGV;
    push @ARGV, qw();

    $ENV{KINGPIN_TEST_ID} = "xxx";

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    my $name = $kingpin->arg('id', 'set id')->default("default id")->int();

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

    like $stderr, qr/int parse error/, 'int parse error';
    is $exit, 1;

    delete $ENV{KINGPIN_TEST_NAME};
};

subtest 'default arg with error (no env var)' => sub {
    local @ARGV;
    push @ARGV, qw();

    $ENV{KINGPIN_TEST_ID} = "xxx";

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    my $name = $kingpin->arg('id', 'set id')->default(["default id"])->int_list();

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;

t/08_with_equal.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Test::Exception;
use Getopt::Kingpin;


subtest 'with equal' => sub {
    local @ARGV;
    push @ARGV, qw(--name=kingpin);

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->flag('name', 'set name')->string();

    $kingpin->parse;

    is $name, 'kingpin';
};

t/09_get.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Test::Exception;
use Getopt::Kingpin;


subtest 'get' => sub {
    local @ARGV;
    push @ARGV, qw(--name=kingpin);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->flag('name', 'set name')->string();

    $kingpin->parse;

    my $name = $kingpin->flags->get('name');
    is ref $name, 'Getopt::Kingpin::Flag';
    is $name, 'kingpin';
};

subtest 'args get' => sub {
    local @ARGV;
    push @ARGV, qw(kingpin);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->arg('name', 'set name')->string();

    $kingpin->parse;

    my $name = $kingpin->args->get_by_index(0);
    is ref $name, 'Getopt::Kingpin::Arg';
    is $name, 'kingpin';

t/10_bool.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Capture::Tiny ':all';
use Getopt::Kingpin;


subtest 'bool' => sub {
    local @ARGV;
    push @ARGV, qw(--verbose);

    my $kingpin = Getopt::Kingpin->new;
    my $x = $kingpin->flag('verbose', 'set verbose mode')->bool();
    $kingpin->parse;

    ok $x;
    is $x, 1;
};

subtest 'bool negative' => sub {
    local @ARGV;
    push @ARGV, qw(--no-verbose);

    my $kingpin = Getopt::Kingpin->new;
    my $x = $kingpin->flag('verbose', 'set verbose mode')->bool();
    $kingpin->parse;

    ok not $x;
    is $x, 0;
};

subtest 'bool default' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new;
    my $x = $kingpin->flag('verbose', 'set verbose mode')->default(1)->bool();
    $kingpin->parse;

    ok $x;
    is $x, 1;
};

subtest 'bool default 2' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new;
    my $x = $kingpin->flag('verbose', 'set verbose mode')->default(0)->bool();
    $kingpin->parse;

    ok not $x;
    is $x, 0;
};

subtest 'bool required' => sub {
    local @ARGV;
    push @ARGV, qw(--verbose);

    my $kingpin = Getopt::Kingpin->new;
    my $x = $kingpin->flag('verbose', 'set verbose mode')->required()->bool();
    $kingpin->parse;

    ok $x;
    is $x, 1;
};

subtest 'bool required 2' => sub {
    local @ARGV;
    push @ARGV, qw(--no-verbose);

    my $kingpin = Getopt::Kingpin->new;
    my $x = $kingpin->flag('verbose', 'set verbose mode')->required()->bool();
    $kingpin->parse;

    ok not $x;
    is $x, 0;
};

subtest 'bool required 3' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    my $x = $kingpin->flag('verbose', 'set verbose mode')->required()->bool();

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

t/11_invalid_flag.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Capture::Tiny ':all';
use Getopt::Kingpin;


subtest 'invalid flag' => sub {
    local @ARGV;
    push @ARGV, qw(--verbose);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

    like $stderr, qr/error: unknown long flag '--verbose', try --help/, 'invalid flag';
    is $exit, 1;
};

subtest 'invalid flag 2' => sub {
    local @ARGV;
    push @ARGV, qw(-v);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

    like $stderr, qr/error: unknown short flag '-v', try --help/, 'invalid flag';

t/12_arg.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Test::Exception;
use Capture::Tiny ':all';
use Getopt::Kingpin;


subtest 'arg' => sub {
    local @ARGV;
    push @ARGV, qw(--name=kingpin arg1 arg2);

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->flag('name', 'set name')->string();
    my $arg1 = $kingpin->arg('arg1', 'set arg1')->string();
    my $arg2 = $kingpin->arg('arg2', 'set arg2')->string();

    $kingpin->parse;

    is $name, 'kingpin';
    is $arg1, 'arg1';
    is $arg2, 'arg2';
};

subtest 'arg required' => sub {
    local @ARGV;
    push @ARGV, qw(--name=kingpin arg1);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    my $name = $kingpin->flag('name', 'set name')->string();
    my $arg1 = $kingpin->arg('arg1', 'set arg1')->string();
    my $arg2 = $kingpin->arg('arg2', 'set arg2')->required->string();

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

    like $stderr, qr/required arg 'arg2' not provided/, 'required error';
    is $exit, 1;
};

subtest 'arg required 2' => sub {
    local @ARGV;
    push @ARGV, qw(--name=kingpin);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    my $name = $kingpin->flag('name', 'set name')->string();
    my $arg1 = $kingpin->arg('arg1', 'set arg1')->string();
    my $arg2 = $kingpin->arg('arg2', 'set arg2')->required->string();

    # requiredãŒã¤ã„ã¦ã„ã‚‹æ‰‹å‰ã¯ã€å…¨ã¦requiredã®æ‰±ã„
    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    like $stderr, qr/required arg 'arg2' not provided/, 'required error';
    is $exit, 1;
};

subtest 'arg required 3' => sub {
    local @ARGV;
    push @ARGV, qw(--name=kingpin arg1 arg2);

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->flag('name', 'set name')->string();
    my $arg1 = $kingpin->arg('arg1', 'set arg1')->string();
    my $arg2 = $kingpin->arg('arg2', 'set arg2')->required->string();

    # requiredãŒã¤ã„ã¦ã„ã‚‹æ‰‹å‰ã¯ã€å…¨ã¦requiredã®æ‰±ã„
    lives_ok {
        $kingpin->parse;
    };

    is $arg1, 'arg1';
    is $arg2, 'arg2';
};

subtest 'arg num' => sub {
    local @ARGV;
    push @ARGV, qw(--name=kingpin arg1);

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->flag('name', 'set name')->string();
    my $arg1 = $kingpin->arg('arg1', 'set arg1')->string();

    $kingpin->parse;

    is $arg1, 'arg1';
};

subtest 'arg get' => sub {
    local @ARGV;
    push @ARGV, qw(arg1);

    my $kingpin = Getopt::Kingpin->new;
    my $arg1 = $kingpin->arg('arg1', 'set arg1')->string();

    $kingpin->parse;

    is $kingpin->args->get_by_index(0), 'arg1';
};

t/13_value.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Test::Exception;
use Capture::Tiny ':all';
use Getopt::Kingpin;


subtest 'default type' => sub {
    local @ARGV;
    push @ARGV, qw(--name=kingpin hello);

    my $kingpin = Getopt::Kingpin->new;
    my $name = $kingpin->flag('name', 'set name');
    my $word = $kingpin->arg('word', 'set word');

    $kingpin->parse;

    is $name, 'kingpin';
    is $word, 'hello';
};

subtest 'validate value' => sub {
    local @ARGV;
    push @ARGV, qw(--num 10);

    my $kingpin = Getopt::Kingpin->new;
    my $num = $kingpin->flag('num', 'set number')->int();

    $kingpin->parse;

    is $num, 10;
};

subtest 'validate value parse error' => sub {
    local @ARGV;
    push @ARGV, qw(--num ten);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    my $num = $kingpin->flag('num', 'set number')->int();

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

t/14_help.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Test::Exception;
use Capture::Tiny ':all';
use Getopt::Kingpin;
use File::Basename;


subtest 'help' => sub {
    local @ARGV;
    push @ARGV, qw(--help);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    my $verbose = $kingpin->flag('verbose', 'Verbose mode.')->short('v')->bool();
    my $name    = $kingpin->arg('name', 'Name of user.')->required()->string();

    my $expected = sprintf <<'...', basename($0);
usage: %s [<flags>] <name>

t/14_help.t view on Meta::CPAN


    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse
    };
    is $exit, 0;
    is $stdout, $expected;
};


subtest 'help short' => sub {
    local @ARGV;
    push @ARGV, qw(-h);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    $kingpin->flags->get("help")->short('h');
    my $verbose = $kingpin->flag('verbose', 'Verbose mode.')->short('v')->bool();
    my $name    = $kingpin->arg('name', 'Name of user.')->required()->string();

    my $expected = sprintf <<'...', basename($0);
usage: %s [<flags>] <name>

t/14_help.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'help max_length_of_flag' => sub {
    local @ARGV;
    push @ARGV, qw(-h);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    $kingpin->flags->get("help")->short('h');
    my $verbose = $kingpin->flag('verbose', 'Verbose mode.')->short('v')->bool();
    my $ip      = $kingpin->flag('ip', 'IP address.')->string();

    my $expected = sprintf <<'...', basename($0);
usage: %s [<flags>]

t/14_help.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'help max_length_of_flag 2' => sub {
    local @ARGV;
    push @ARGV, qw(-h);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    $kingpin->flags->get("help")->short('h');
    my $verbose = $kingpin->flag('verbose', 'Verbose mode.')->short('v')->bool();
    my $ip      = $kingpin->flag('ipaddress', 'IP address.')->string();

    my $expected = sprintf <<'...', basename($0);
usage: %s [<flags>]

t/14_help.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'help max_length_of_arg' => sub {
    local @ARGV;
    push @ARGV, qw(-h);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    $kingpin->flags->get("help")->short('h');
    my $verbose = $kingpin->flag('verbose', 'Verbose mode.')->short('v')->bool();
    my $ip      = $kingpin->flag('ip', 'IP address.')->bool();
    my $name    = $kingpin->arg('name', 'Name of user.')->required()->string();
    my $name    = $kingpin->arg('age', 'Age of user.')->required()->int();

t/14_help.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'help max_length_of_arg 2' => sub {
    local @ARGV;
    push @ARGV, qw(-h);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    $kingpin->flags->get("help")->short('h');
    my $verbose = $kingpin->flag('verbose', 'Verbose mode.')->short('v')->bool();
    my $ip      = $kingpin->flag('ip', 'IP address.')->string();
    my $name    = $kingpin->arg('age', 'Age of user.')->required()->int();
    my $name    = $kingpin->arg('name', 'Name of user.')->required()->string();

t/14_help.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'help required' => sub {
    local @ARGV;
    push @ARGV, qw(-h);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    $kingpin->flags->get("help")->short('h');
    my $verbose = $kingpin->flag('verbose', 'Verbose mode.')->short('v')->bool();
    my $ip      = $kingpin->flag('ip', 'IP address.')->string();
    my $name    = $kingpin->arg('age', 'Age of user.')->required()->int();
    my $name    = $kingpin->arg('name', 'Name of user.')->string();

t/14_help.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'app info' => sub {
    local @ARGV;
    push @ARGV, qw(--help);

    my $kingpin = Getopt::Kingpin->new("app_name", "app_description");
    $kingpin->terminate(sub {return @_});

    my $expected = sprintf <<'...';
usage: app_name [<flags>]

app_description

t/14_help.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'place holder' => sub {
    local @ARGV;
    push @ARGV, qw(--help);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    $kingpin->flag("name", "Set name.")->string();

    my $expected = sprintf <<'...', basename($0);
usage: %s [<flags>]

Flags:

t/14_help.t view on Meta::CPAN


...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $stdout, $expected;
};

subtest 'default' => sub {
    local @ARGV;
    push @ARGV, qw(--help);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    my $name = $kingpin->flag('name', 'Set name.')->default("default name")->string();

    my $expected = sprintf <<'...', basename($0);
usage: %s [<flags>]

Flags:

t/14_help.t view on Meta::CPAN


...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $stdout, $expected;
};

subtest 'default2' => sub {
    local @ARGV;
    push @ARGV, qw(--help);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    my $name = $kingpin->flag('name', 'Set name.')->default("")->string();
    my $id1 = $kingpin->flag('id1', 'Set id1.')->default(1)->int();
    my $id2 = $kingpin->flag('id2', 'Set id2.')->default(0)->int();

    my $expected = sprintf <<'...', basename($0);
usage: %s [<flags>]

t/14_help.t view on Meta::CPAN


...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $stdout, $expected;
};

subtest 'default3' => sub {
    local @ARGV;
    push @ARGV, qw(--help);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    my $name = $kingpin->flag('name', 'Set name.')->default(sub{ "default name" })->string();

    my $expected = sprintf <<'...', basename($0);
usage: %s [<flags>]

Flags:

t/14_help.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $stdout, $expected;
};

subtest 'default4' => sub {
    { package Local::Overloaded; use overload '&{}' => sub { $_[0][0] } };
    local @ARGV;
    push @ARGV, qw(--help);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    my $name = $kingpin->flag('name', 'Set name.')->default(bless [sub{ "default name" }], 'Local::Overloaded')->string();

    my $expected = sprintf <<'...', basename($0);
usage: %s [<flags>]

Flags:

t/14_help.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $stdout, $expected;
};

subtest 'default5' => sub {
    require Path::Tiny;
    local @ARGV;
    push @ARGV, qw(--help);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    my $name = $kingpin->flag('input', 'Set input.')->default(Path::Tiny::path('Build.PL'))->file();

    my $expected = sprintf <<'...', basename($0);
usage: %s [<flags>]

Flags:

t/14_help.t view on Meta::CPAN


...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $stdout, $expected;
};

subtest 'place holder' => sub {
    local @ARGV;
    push @ARGV, qw(--help);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    my $name = $kingpin->flag('name', 'Set name.')->placeholder("place_holder_name")->string();

    my $expected = sprintf <<'...', basename($0);
usage: %s [<flags>]

Flags:

t/14_help.t view on Meta::CPAN


...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $stdout, $expected;
};

subtest 'place holder' => sub {
    local @ARGV;
    push @ARGV, qw(--help);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    my $name = $kingpin->flag('name', 'Set name.')->placeholder("place_holder_name")->string();
    my $id1 = $kingpin->flag('id1', 'Set id1.')->placeholder("1")->int();
    my $id2 = $kingpin->flag('id2', 'Set id2.')->placeholder("0")->int();

    my $expected = sprintf <<'...', basename($0);
usage: %s [<flags>]

t/14_help.t view on Meta::CPAN


...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $stdout, $expected;
};

subtest 'place holder with default' => sub {
    local @ARGV;
    push @ARGV, qw(--help);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    my $name = $kingpin->flag('name', 'Set name.')->placeholder("place_holder_name")->default("default name")->string();

    my $expected = sprintf <<'...', basename($0);
usage: %s [<flags>]

Flags:

t/14_help.t view on Meta::CPAN


...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $stdout, $expected;
};

subtest 'flag with hidden flag' => sub {
    local @ARGV;
    push @ARGV, qw(--help);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});

    my $name = $kingpin->flag('name', 'Set name.')->hidden->string();

    my $expected = sprintf <<'...', basename($0);
usage: %s [<flags>]

t/15_flags.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Test::Exception;
use Capture::Tiny ':all';
use Getopt::Kingpin;
use File::Basename;


subtest 'flag error' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new();
    my $verbose = $kingpin->flag('verbose', 'Verbose mode.')->short('v')->bool();
    throws_ok {
        my $verbose = $kingpin->flag('verbose', 'Verbose mode.')->bool();
    } qr/flag verbose is already exists/;

};

subtest 'flags ordered help' => sub {
    local @ARGV;
    push @ARGV, qw(--help);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    my $verbose3 = $kingpin->flag('verbose3', 'Verbose mode.')->bool();
    my $verbose1 = $kingpin->flag('verbose1', 'Verbose mode.')->bool();
    my $verbose2 = $kingpin->flag('verbose2', 'Verbose mode.')->bool();

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;

t/16_type.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Test::Exception;
use Getopt::Kingpin;


subtest 'type error' => sub {
    local @ARGV;
    push @ARGV, qw(--verbose);

    my $kingpin = Getopt::Kingpin->new();
    my $verbose = $kingpin->flag('verbose', 'Verbose mode.')->short('v')->bool();
    $verbose->type("__type_error__");
    throws_ok {
        $kingpin->parse;
    } qr/type error '__type_error__'/;
};

subtest 'type error 2' => sub {
    local @ARGV;

    my $kingpin = Getopt::Kingpin->new();
    throws_ok {
        $kingpin->flag('verbose', 'Verbose mode.')->short('v')->type_error();
    } qr/type error 'TypeError'/;
};

done_testing;

t/17_version.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Capture::Tiny ':all';
use Getopt::Kingpin;
use File::Basename;


subtest 'version' => sub {
    local @ARGV;
    push @ARGV, qw(--version);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    $kingpin->version("v1.2.3");

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

    is $stderr, "v1.2.3\n";
    is $exit, 0;
};

subtest 'version help' => sub {
    local @ARGV;
    push @ARGV, qw(--help);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    $kingpin->version("v1.2.3");

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

t/18_file.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Test::Exception;
use Capture::Tiny ':all';
use Getopt::Kingpin;


subtest 'file' => sub {
    local @ARGV;
    push @ARGV, qw(kingpin Build.PL);

    my $kingpin = Getopt::Kingpin->new();
    my $name = $kingpin->arg("name", "")->string();
    my $path = $kingpin->arg("path", "")->file();

    $kingpin->parse;

    my $x = $name->value;

t/18_file.t view on Meta::CPAN

    my $y = $path->value;

    is $path, "Build.PL";
    is ref $path, "Getopt::Kingpin::Arg";

    is $y, "Build.PL";
    is ref $y, "Path::Tiny";
};

subtest 'existing_file' => sub {
    local @ARGV;
    push @ARGV, qw(kingpin Build.PL);

    my $kingpin = Getopt::Kingpin->new();
    my $name = $kingpin->arg("name", "")->string();
    my $path = $kingpin->arg("path", "")->existing_file();

    $kingpin->parse;

    my $x = $name->value;

t/18_file.t view on Meta::CPAN

    my $y = $path->value;

    is $path, "Build.PL";
    is ref $path, "Getopt::Kingpin::Arg";

    is $y, "Build.PL";
    is ref $y, "Path::Tiny";
};

subtest 'existing_file is dir' => sub {
    local @ARGV;
    push @ARGV, qw(lib);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    my $path = $kingpin->arg("path", "")->existing_file();

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

    like $stderr, qr/error: 'lib' is a directory, try --help/;
    is $exit, 1;
};

subtest 'existing_file error' => sub {
    local @ARGV;
    push @ARGV, qw(kingpin Build.PL NOT_FOUND_FILE);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    my $name = $kingpin->arg("name", "")->string();
    my $path = $kingpin->arg("path", "")->file();
    my $not_found = $kingpin->arg("not_found", "")->existing_file();

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

    like $stderr, qr/error: path 'NOT_FOUND_FILE' does not exist, try --help/;
    is $exit, 1;
};

subtest 'file with default' => sub {
    local @ARGV;

    my $kingpin = Getopt::Kingpin->new();
    my $path = $kingpin->flag("path", "")->default("Build.PL")->file();

    $kingpin->parse;

    is $path, "Build.PL";
    is ref $path->value, "Path::Tiny";
};

subtest 'file with blessed default' => sub {
    local @ARGV;
    require Path::Tiny;

    my $kingpin = Getopt::Kingpin->new();
    my $path = $kingpin->flag("path", "")->default(Path::Tiny::path("Build.PL"))->file();

    $kingpin->parse;

    is $path, "Build.PL";
    is ref $path->value, "Path::Tiny";
};

t/19_dash.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Getopt::Kingpin;


subtest 'double dash' => sub {
    local @ARGV;
    push @ARGV, qw(--name kingpin -- path);

    my $kingpin = Getopt::Kingpin->new();
    my $name = $kingpin->flag("name", "")->string();
    my $path = $kingpin->arg("path", "")->file();

    $kingpin->parse;

    my $x = $name->value;

    is $name, "kingpin";
    is $path, "path";
};

subtest 'double dash 2' => sub {
    local @ARGV;
    push @ARGV, qw(--name kingpin -- --path);

    my $kingpin = Getopt::Kingpin->new();
    my $name = $kingpin->flag("name", "")->string();
    my $path = $kingpin->arg("path", "")->file();

    $kingpin->parse;

    my $x = $name->value;

    is $name, "kingpin";
    is $path, "--path";
};

subtest 'double dash 3' => sub {
    local @ARGV;
    push @ARGV, qw(-n kingpin -- -v);

    my $kingpin = Getopt::Kingpin->new();
    my $name    = $kingpin->flag("name", "")->short("n")->string();
    my $verbose = $kingpin->flag("verbose", "")->short("v")->bool();
    my $path    = $kingpin->arg("path", "")->file();

    $kingpin->parse;

    my $x = $name->value;

t/20_flag_keys.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Getopt::Kingpin;


subtest 'double dash' => sub {
    local @ARGV;
    push @ARGV, qw(--name kingpin -- path);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->flag("bbb", "")->string();
    $kingpin->flag("ccc", "")->string();
    $kingpin->flag("aaa", "")->string();
    $kingpin->flag("eee", "")->string();
    $kingpin->flag("ddd", "")->string();

    my @keys = $kingpin->flags->keys;

t/21_dir.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Test::Exception;
use Capture::Tiny ':all';
use Getopt::Kingpin;


subtest 'existing_dir' => sub {
    local @ARGV;
    push @ARGV, qw(lib);

    my $kingpin = Getopt::Kingpin->new();
    my $path = $kingpin->arg("path", "")->existing_dir();

    $kingpin->parse;

    my $x = $path->value;

    is $path, "lib";
    is ref $path, "Getopt::Kingpin::Arg";

    is $x, "lib";
    is ref $x, "Path::Tiny";

    is $x->is_dir, 1;
};

subtest 'existing_dir is file' => sub {
    local @ARGV;
    push @ARGV, qw(Build.PL);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    my $path = $kingpin->arg("path", "")->existing_dir();

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

    like $stderr, qr/error: 'Build.PL' is a file, try --help/;
    is $exit, 1;
};

subtest 'existing_dir error' => sub {
    local @ARGV;
    push @ARGV, qw(NOT_FOUND_DIR);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    my $path = $kingpin->arg("path", "")->existing_dir();

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

    like $stderr, qr/error: path 'NOT_FOUND_DIR' does not exist, try --help/;
    is $exit, 1;
};

subtest 'existing_dir with default' => sub {
    local @ARGV;

    my $kingpin = Getopt::Kingpin->new();
    my $path = $kingpin->arg("path", "")->default("lib")->existing_dir();

    $kingpin->parse;

    is $path, "lib";
    is ref $path->value, "Path::Tiny";
    is $path->value->is_dir, 1;
};

subtest 'existing_dir with envar' => sub {
    local @ARGV;
    $ENV{KINGPIN_TEST_PATH} = "lib";

    my $kingpin = Getopt::Kingpin->new();
    my $path = $kingpin->arg("path", "")->override_default_from_envar("KINGPIN_TEST_PATH")->existing_dir();

    $kingpin->parse;

    is $path, "lib";
    is ref $path->value, "Path::Tiny";
    is $path->value->is_dir, 1;

t/22_file_or_dir.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Test::Exception;
use Capture::Tiny ':all';
use Getopt::Kingpin;


subtest 'existing_file_or_dir file' => sub {
    local @ARGV;
    push @ARGV, qw(Build.PL);

    my $kingpin = Getopt::Kingpin->new();
    my $path = $kingpin->arg("path", "")->existing_file_or_dir();

    $kingpin->parse;

    my $x = $path->value;

    is $path, "Build.PL";
    is ref $path, "Getopt::Kingpin::Arg";

    is $x, "Build.PL";
    is ref $x, "Path::Tiny";
    ok $x->is_file;
};

subtest 'existing_file_or_dir dir' => sub {
    local @ARGV;
    push @ARGV, qw(lib);

    my $kingpin = Getopt::Kingpin->new();
    my $path = $kingpin->arg("path", "")->existing_file_or_dir();

    $kingpin->parse;

    my $x = $path->value;

    is $path, "lib";
    is ref $path, "Getopt::Kingpin::Arg";

    is $x, "lib";
    is ref $x, "Path::Tiny";
    ok $x->is_dir;
};

subtest 'existing_file_or_dir not found' => sub {
    local @ARGV;
    push @ARGV, qw(NOT_FOUND);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    my $path = $kingpin->arg("path", "")->existing_file_or_dir();

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

t/23_command.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Test::Exception;
use Capture::Tiny ':all';
use Getopt::Kingpin;
use Getopt::Kingpin::Command;
use File::Basename;

subtest 'command (flag)' => sub {
    local @ARGV;
    push @ARGV, qw(post --server 127.0.0.1 --image=abc.jpg);

    my $kingpin = Getopt::Kingpin->new();
    my $post = $kingpin->command("post", "post image");
    my $server = $post->flag("server", "")->string();
    my $image = $post->flag("image", "")->file();

    my $cmd = $kingpin->parse;

    is $cmd, "post";

t/23_command.t view on Meta::CPAN


    is ref $post, "Getopt::Kingpin::Command";
    is ref $server, "Getopt::Kingpin::Flag";
    is ref $image, "Getopt::Kingpin::Flag";

    is $server, "127.0.0.1";
    is $image, "abc.jpg";
};

subtest 'command (arg)' => sub {
    local @ARGV;
    push @ARGV, qw(post 127.0.0.1 abc.jpg);

    my $kingpin = Getopt::Kingpin->new();
    my $post = $kingpin->command("post", "post image");
    my $server = $post->arg("server", "")->string();
    my $image = $post->arg("image", "")->file();

    my $cmd = $kingpin->parse;

    is $cmd, "post";

t/23_command.t view on Meta::CPAN


    is ref $post, "Getopt::Kingpin::Command";
    is ref $server, "Getopt::Kingpin::Arg";
    is ref $image, "Getopt::Kingpin::Arg";

    is $server, "127.0.0.1";
    is $image, "abc.jpg";
};

subtest 'command (flag and arg)' => sub {
    local @ARGV;
    push @ARGV, qw(post --server 127.0.0.1 abc.jpg);

    my $kingpin = Getopt::Kingpin->new();
    my $post = $kingpin->command("post", "post image");
    my $server = $post->flag("server", "")->string();
    my $image = $post->arg("image", "")->file();

    $kingpin->parse;

    is ref $post, "Getopt::Kingpin::Command";
    is ref $server, "Getopt::Kingpin::Flag";
    is ref $image, "Getopt::Kingpin::Arg";

    is $server, "127.0.0.1";
    is $image, "abc.jpg";
};

subtest 'command help' => sub {
    local @ARGV;
    push @ARGV, qw(--help);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    my $post = $kingpin->command("post", "post image");
    my $server = $post->flag("server", "")->string();
    my $image = $post->arg("image", "")->file();

    my $expected = sprintf <<'...', basename($0);
usage: %s [<flags>] <command> [<args> ...]

t/23_command.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'command help' => sub {
    local @ARGV;
    push @ARGV, qw(--help);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    my $post = $kingpin->command("post", "post image");
    my $server = $post->flag("server", "")->string();
    my $image = $post->arg("image", "")->file();
    my $get  = $kingpin->command("get", "get image");

    my $expected = sprintf <<'...', basename($0);

t/23_command.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'command help' => sub {
    local @ARGV;
    push @ARGV, qw(--help);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    my $post = $kingpin->command("post", "post image");
    my $server = $post->flag("server", "")->string();
    my $get  = $kingpin->command("get", "get image");

    my $expected = sprintf <<'...', basename($0);
usage: %s [<flags>] <command> [<args> ...]

t/23_command.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'command help 2' => sub {
    local @ARGV;
    push @ARGV, qw(help);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    my $post = $kingpin->command("post", "post image");
    my $server = $post->flag("server", "")->string();
    my $get  = $kingpin->command("get", "get image");

    my $expected = sprintf <<'...', basename($0);
usage: %s [<flags>] <command> [<args> ...]

t/23_command.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'command help 3' => sub {
    local @ARGV;
    push @ARGV, qw(--help post);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    my $post = $kingpin->command("post", "post image");
    my $server = $post->flag("server", "")->string();
    my $get  = $kingpin->command("get", "get image");

    my $expected = sprintf <<'...', basename($0);
usage: %s post [<flags>]

t/23_command.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'command help 3' => sub {
    local @ARGV;
    push @ARGV, qw(post --help);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    my $post = $kingpin->command("post", "post image");
    my $server = $post->flag("server", "")->string();
    my $get  = $kingpin->command("get", "get image");

    my $expected = sprintf <<'...', basename($0);
usage: %s post [<flags>]

t/23_command.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'command help 3' => sub {
    local @ARGV;
    push @ARGV, qw(help post);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    my $post = $kingpin->command("post", "post image");
    my $server = $post->flag("server", "")->string();
    my $get  = $kingpin->command("get", "get image");

    my $expected = sprintf <<'...', basename($0);
usage: %s post [<flags>]

t/23_command.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'command help 3' => sub {
    local @ARGV;
    push @ARGV, qw(help post --server=SERVER);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    my $post = $kingpin->command("post", "post image");
    my $server = $post->flag("server", "")->string();
    my $get  = $kingpin->command("get", "get image");

    my $expected = sprintf <<'...', basename($0);
usage: %s post [<flags>]

t/23_command.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'command help 3' => sub {
    local @ARGV;
    push @ARGV, qw(--help post);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    my $post = $kingpin->command("post", "post image");
    my $server = $post->flag("server", "")->string();
    my $get  = $kingpin->command("get", "get image");

    my $expected = sprintf <<'...', basename($0);
usage: %s post [<flags>]

t/23_command.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'command help 4' => sub {
    local @ARGV;
    push @ARGV, qw(help get);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    my $post = $kingpin->command("post", "post image");
    my $server = $post->flag("server", "")->string();
    my $get  = $kingpin->command("get", "get image");

    my $expected = sprintf <<'...', basename($0);
usage: %s get

t/23_command.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'command help 5' => sub {
    local @ARGV;
    push @ARGV, qw(--help post);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    my $post = $kingpin->command("post", "");
    my $server = $post->arg("server", "server address")->string();
    my $get  = $kingpin->command("get", "get image");

    my $expected = sprintf <<'...', basename($0);
usage: %s post [<server>]

t/23_command.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'command help 6' => sub {
    local @ARGV;
    push @ARGV, qw(--help);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    my $post = $kingpin->command("post", "post image");
    my $server = $post->flag("server", "server address")->string();
    my $get  = $kingpin->command("get", "get image");
    my $xyz  = $get->command("xyz", "set xyz");

    my $expected = sprintf <<'...', basename($0);

t/23_command.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'command help 6' => sub {
    local @ARGV;
    push @ARGV, qw(--help);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    my $post = $kingpin->command("post", "post image");
    my $server = $post->flag("server", "server address")->string();
    my $get  = $kingpin->command("get", "get image");
    my $xyz  = $get->command("xyz", "set xyz");
    my $abc  = $get->command("abc", "set abc");

t/23_command.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'command help 6' => sub {
    local @ARGV;
    push @ARGV, qw(--help get);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    my $post = $kingpin->command("post", "post image");
    my $server = $post->flag("server", "server address")->string();
    my $get  = $kingpin->command("get", "get image");
    my $xyz  = $get->command("xyz", "set xyz");

    my $expected = sprintf <<'...', basename($0);

t/23_command.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'command help 7' => sub {
    local @ARGV;
    push @ARGV, qw(--help register);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});

    my $register      = $kingpin->command('register', 'Register a new user.');
    my $register_nick = $register->arg('nick', 'Nickname for user.')->required->string;
    my $register_name = $register->arg('name', 'Name for user.')->required->string;

    my $post        = $kingpin->command('post', 'Post a message to a channel.');

t/23_command.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'command help 7-2' => sub {
    local @ARGV;
    push @ARGV, qw(register --help);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});

    my $register      = $kingpin->command('register', 'Register a new user.');
    my $register_nick = $register->arg('nick', 'Nickname for user.')->required->string;
    my $register_name = $register->arg('name', 'Name for user.')->required->string;

    my $post        = $kingpin->command('post', 'Post a message to a channel.');

t/23_command.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'command help 7-3' => sub {
    local @ARGV;
    push @ARGV, qw(help register);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});

    my $register      = $kingpin->command('register', 'Register a new user.');
    my $register_nick = $register->arg('nick', 'Nickname for user.')->required->string;
    my $register_name = $register->arg('name', 'Name for user.')->required->string;

    my $post        = $kingpin->command('post', 'Post a message to a channel.');

t/23_command.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'command help 8' => sub {
    local @ARGV;
    push @ARGV, qw(--help post);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});

    my $register      = $kingpin->command('register', 'Register a new user.');
    my $register_nick = $register->arg('nick', 'Nickname for user.')->required->string;
    my $register_name = $register->arg('name', 'Name for user.')->required->string;

    my $post        = $kingpin->command('post', 'Post a message to a channel.');

t/23_command.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'command help 8-2' => sub {
    local @ARGV;
    push @ARGV, qw(post --help);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});

    my $register      = $kingpin->command('register', 'Register a new user.');
    my $register_nick = $register->arg('nick', 'Nickname for user.')->required->string;
    my $register_name = $register->arg('name', 'Name for user.')->required->string;

    my $post        = $kingpin->command('post', 'Post a message to a channel.');

t/23_command.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'command help 8-3' => sub {
    local @ARGV;
    push @ARGV, qw(help post);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});

    my $register      = $kingpin->command('register', 'Register a new user.');
    my $register_nick = $register->arg('nick', 'Nickname for user.')->required->string;
    my $register_name = $register->arg('name', 'Name for user.')->required->string;

    my $post        = $kingpin->command('post', 'Post a message to a channel.');

t/23_command.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'command help 9-1' => sub {
    local @ARGV;
    push @ARGV, qw(--verbose register NICK NAME --age 100);

    my $kingpin = Getopt::Kingpin->new;
    my $verbose = $kingpin->flag("verbose", "set verbose mode")->bool;

    my $register      = $kingpin->command('register', 'Register a new user.');
    my $register_age  = $register->flag('age', 'Age for user.')->int;
    my $register_nick = $register->arg('nick', 'Nickname for user.')->required->string;
    my $register_name = $register->arg('name', 'Name for user.')->required->string;

    my $cmd = $kingpin->parse;

    is $cmd, "register";
    is $verbose, 1;
    is $register_age, 100;
    is $register_nick, "NICK";
    is $register_name, "NAME";
};

subtest 'command help 9-2' => sub {
    local @ARGV;
    push @ARGV, qw(register NICK NAME --age 100 --verbose);

    my $kingpin = Getopt::Kingpin->new;
    my $verbose = $kingpin->flag("verbose", "set verbose mode")->bool;

    my $register      = $kingpin->command('register', 'Register a new user.');
    my $register_age  = $register->flag('age', 'Age for user.')->int;
    my $register_nick = $register->arg('nick', 'Nickname for user.')->required->string;
    my $register_name = $register->arg('name', 'Name for user.')->required->string;

    my $cmd = $kingpin->parse;

    is $cmd, "register";
    is $verbose, 1;
    is $register_age, 100;
    is $register_nick, "NICK";
    is $register_name, "NAME";
};

subtest 'command help 9-3 help' => sub {
    local @ARGV;
    push @ARGV, qw(help register);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    my $verbose = $kingpin->flag("verbose", "set verbose mode")->bool;

    my $register      = $kingpin->command('register', 'Register a new user.');
    my $register_age  = $register->flag('age', 'Age for user.')->int;
    my $register_nick = $register->arg('nick', 'Nickname for user.')->required->string;
    my $register_name = $register->arg('name', 'Name for user.')->required->string;

t/23_command.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'command help 9-4 help' => sub {
    local @ARGV;
    push @ARGV, qw(--help register);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    my $verbose = $kingpin->flag("verbose", "set verbose mode")->bool;

    my $register      = $kingpin->command('register', 'Register a new user.');
    my $register_age  = $register->flag('age', 'Age for user.')->int;
    my $register_nick = $register->arg('nick', 'Nickname for user.')->required->string;
    my $register_name = $register->arg('name', 'Name for user.')->required->string;

t/23_command.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'command help 9-4 help' => sub {
    local @ARGV;
    push @ARGV, qw(register --help);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    my $verbose = $kingpin->flag("verbose", "set verbose mode")->bool;

    my $register      = $kingpin->command('register', 'Register a new user.');
    my $register_age  = $register->flag('age', 'Age for user.')->int;
    my $register_nick = $register->arg('nick', 'Nickname for user.')->required->string;
    my $register_name = $register->arg('name', 'Name for user.')->required->string;

t/23_command.t view on Meta::CPAN

...

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };
    is $exit, 0;
    is $stdout, $expected;
};

subtest 'command help hash' => sub {
    local @ARGV;
    push @ARGV, qw(register --help);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    my $verbose = $kingpin->flag("verbose", "set verbose mode")->bool;

    my $register = $kingpin->command('register', 'Register a new user.');
    $register->flag('test1', 'Test 1.')->string_hash;
    $register->flag('test2', 'Test 2.')->placeholder('VAL')->string_hash;
    $register->flag('test3', 'Test 3.')->placeholder('K=V')->string_hash;

t/24_user_type.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Test::Exception;
use Getopt::Kingpin;
use Getopt::Kingpin::Command;

subtest 'foo' => sub {
    local @ARGV;
    push @ARGV, qw(foo);

    my $kingpin = Getopt::Kingpin->new();
    my $foo = $kingpin->arg("foo", "set foo")->foo();

    $kingpin->parse;

    is ref $foo, "Getopt::Kingpin::Arg";
    is $foo, "foo";
    is $foo->value, "foo";
};

subtest 'digest_md5' => sub {
    local @ARGV;
    push @ARGV, qw(md5);

    my $kingpin = Getopt::Kingpin->new();
    my $md5 = $kingpin->arg("md5", "set keyword")->digest_md5();

    $kingpin->parse;

    is ref $md5, "Getopt::Kingpin::Arg";
    is $md5, "1bc29b36f623ba82aaf6724fd3b16718";
    is $md5->value, "1bc29b36f623ba82aaf6724fd3b16718";

t/25_parse.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Test::Exception;
use Getopt::Kingpin;
use Getopt::Kingpin::Command;

subtest 'parse() return' => sub {
    local @ARGV;
    push @ARGV, qw(post --server 127.0.0.1 --image=abc.jpg);

    my $kingpin = Getopt::Kingpin->new();
    my $post = $kingpin->command("post", "post image");
    my $server = $post->flag("server", "")->string();
    my $image = $post->flag("image", "")->file();

    my $cmd = $kingpin->parse;

    is ref $cmd, "Getopt::Kingpin::Command";

t/25_parse.t view on Meta::CPAN


    is ref $post, "Getopt::Kingpin::Command";
    is ref $server, "Getopt::Kingpin::Flag";
    is ref $image, "Getopt::Kingpin::Flag";

    is $server, "127.0.0.1";
    is $image, "abc.jpg";
};

subtest 'parse() with empty arrayref will ignore @ARGV' => sub {
    local @ARGV;
    push @ARGV, qw(post --server 127.0.0.1 --image=abc.jpg);

    my $kingpin = Getopt::Kingpin->new();

    my $cmd = $kingpin->parse([]);
    
    is ref $cmd, 'Getopt::Kingpin';
};

done_testing;

t/26_repeatable.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Test::Exception;
use Capture::Tiny ':all';
use Getopt::Kingpin;

subtest 'repeatable flag error' => sub {
    local @ARGV;
    push @ARGV, qw(--xxx a --xxx b --xxx c);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    my $args = $kingpin->flag("xxx", "xxx yyy")->string();

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

    like $stderr, qr/error: flag 'xxx' cannot be repeated, try --help/;
    is $exit, 1;
};

subtest 'repeatable flag (is_cumulative)' => sub {
    local @ARGV;
    push @ARGV, qw(--xxx a --xxx b --xxx c);

    my $kingpin = Getopt::Kingpin->new();
    my $args = $kingpin->flag("xxx", "xxx yyy")->string_list();
    #$args->is_cumulative(1);

    my $cmd = $kingpin->parse;

    is_deeply $args->value, ['a', 'b', 'c'];
};

subtest 'repeatable flag (is_cumulative no-flags)' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new();
    my $args = $kingpin->flag("xxx", "xxx yyy")->string_list();
    #$args->is_cumulative(1);

    my $cmd = $kingpin->parse;

    is_deeply $args->value, [];
};


subtest 'repeatable flag 2 (is_cumulative)' => sub {
    local @ARGV;
    push @ARGV, qw(--xxx a --xxx b --xxx c);

    my $kingpin = Getopt::Kingpin->new();
    my $args = $kingpin->flag("xxx", "xxx yyy")->file_list();
    #$args->is_cumulative(1);

    my $cmd = $kingpin->parse;

    is ref $args->value->[0], "Path::Tiny";
    is ref $args->value->[1], "Path::Tiny";
    is ref $args->value->[2], "Path::Tiny";
    is $args->value->[0], 'a';
    is $args->value->[1], 'b';
    is $args->value->[2], 'c';
};

subtest 'repeatable arg error' => sub {
    local @ARGV;
    push @ARGV, qw(a b c);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    my $args = $kingpin->arg("xxx", "xxx yyy")->string();

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

    like $stderr, qr/error: unexpected b, try --help/;
    is $exit, 1;
};

subtest 'repeatable arg (is_cumulative)' => sub {
    local @ARGV;
    push @ARGV, qw(a b c);

    my $kingpin = Getopt::Kingpin->new();
    my $args = $kingpin->arg("xxx", "xxx yyy")->string_list();

    my $cmd = $kingpin->parse;

    is_deeply $args->value, ['a', 'b', 'c'];
};

subtest 'repeatable arg (is_cumulative no-args)' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new();
    my $args = $kingpin->arg("xxx", "xxx yyy")->string_list();

    my $cmd = $kingpin->parse;

    is_deeply $args->value, [];
};

subtest 'repeatable arg 2 (is_cumulative)' => sub {
    local @ARGV;
    push @ARGV, qw(a b c);

    my $kingpin = Getopt::Kingpin->new();
    my $args = $kingpin->arg("xxx", "xxx yyy")->file_list();

    my $cmd = $kingpin->parse;

    is ref $args->value->[0], "Path::Tiny";
    is ref $args->value->[1], "Path::Tiny";
    is ref $args->value->[2], "Path::Tiny";
    is $args->value->[0], 'a';
    is $args->value->[1], 'b';
    is $args->value->[2], 'c';
};

subtest 'not repeatable and repeatable arg' => sub {
    local @ARGV;
    push @ARGV, qw(a b c);

    my $kingpin = Getopt::Kingpin->new();
    my $args1 = $kingpin->arg("xxx", "xxx yyy")->file();
    my $args2 = $kingpin->arg("yyy", "xxx yyy")->file_list();

    my $cmd = $kingpin->parse;

    is ref $args1->value, "Path::Tiny";
    is ref $args2->value->[0], "Path::Tiny";
    is ref $args2->value->[1], "Path::Tiny";
    is $args1->value, 'a';
    is $args2->value->[0], 'b';
    is $args2->value->[1], 'c';
};

subtest 'not repeatable and repeatable arg (required)' => sub {
    local @ARGV;
    push @ARGV, qw(a b c);

    my $kingpin = Getopt::Kingpin->new();
    my $args1 = $kingpin->arg("xxx", "xxx yyy")->required->file();
    my $args2 = $kingpin->arg("yyy", "xxx yyy")->file_list();

    my $cmd = $kingpin->parse;

    is ref $args1->value, "Path::Tiny";
    is ref $args2->value->[0], "Path::Tiny";
    is ref $args2->value->[1], "Path::Tiny";
    is $args1->value, 'a';
    is $args2->value->[0], 'b';
    is $args2->value->[1], 'c';
};

subtest 'not repeatable and repeatable arg 2 (required)' => sub {
    local @ARGV;
    push @ARGV, qw(a b c);

    my $kingpin = Getopt::Kingpin->new();
    my $args1 = $kingpin->arg("xxx", "xxx yyy")->required->file();
    my $args2 = $kingpin->arg("yyy", "xxx yyy")->required->file_list();

    my $cmd = $kingpin->parse;

    is ref $args1->value, "Path::Tiny";
    is ref $args2->value->[0], "Path::Tiny";

t/27_new.t view on Meta::CPAN

use strict;
use warnings;
use utf8;
use Test::More;
use Getopt::Kingpin;

subtest 'run' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new({
            name => 'run.pl',
        });

    is $kingpin->name, 'run.pl';
    is $kingpin->description, '';
};

subtest 'run' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new(
            name => 'run.pl',
            description => 'run.pl description',
        );

    is $kingpin->name, 'run.pl';
    is $kingpin->description, 'run.pl description';
};

t/28_num.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Test::Exception;
use Capture::Tiny ':all';
use Getopt::Kingpin;


subtest 'num normal' => sub {
    local @ARGV;
    push @ARGV, qw(--x 0);

    my $kingpin = Getopt::Kingpin->new;
    my $x = $kingpin->flag('x', 'set x')->num();
    $kingpin->parse;

    is $x->value, 0;
    ok $x == 0;
};

subtest 'num scientific notation 1' => sub {
    local @ARGV;
    push @ARGV, qw(--x 1e3);

    my $kingpin = Getopt::Kingpin->new;
    my $x = $kingpin->flag('x', 'set x')->num();
    $kingpin->parse;

    is $x->value + 0, 1000; # + 0 to force == instead of eq check
    ok $x == 1000;
};

subtest 'num scientific notation 2' => sub {
    local @ARGV;
    push @ARGV, qw(--x -1.5e6);

    my $kingpin = Getopt::Kingpin->new;
    my $x = $kingpin->flag('x', 'set x')->num();
    $kingpin->parse;

    is $x->value + 0, -1_500_000;
    ok $x == -1_500_000;
};

subtest 'num error' => sub {
    local @ARGV;
    push @ARGV, qw(--x ZERO);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    my $x = $kingpin->flag('x', 'set x')->num();
    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

    like $stderr, qr/num parse error/, 'num parse error';

t/29_hash.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Test::Exception;
use Capture::Tiny ':all';
use Getopt::Kingpin;

subtest 'repeatable flag error' => sub {
    local @ARGV;
    push @ARGV, qw(--xxx a --xxx b --xxx c);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    my $args = $kingpin->flag("xxx", "xxx yyy")->string();

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

    like $stderr, qr/error: flag 'xxx' cannot be repeated, try --help/;
    is $exit, 1;
};

subtest 'repeatable flag (is_hash)' => sub {
    local @ARGV;
    push @ARGV, qw(--xxx a=a --xxx b= --xxx c);

    my $kingpin = Getopt::Kingpin->new();
    my $args = $kingpin->flag("xxx", "xxx yyy")->string_hash();

    my $cmd = $kingpin->parse;

    is_deeply $args->value, { a=>'a', b=>'', c=>undef };
};

subtest 'repeatable flag 2 (is_hash)' => sub {
    local @ARGV;
    push @ARGV, qw(--xxx a=a --xxx b=b --xxx c=c);

    my $kingpin = Getopt::Kingpin->new();
    my $args = $kingpin->flag("xxx", "xxx yyy")->file_hash();

    my $cmd = $kingpin->parse;

    is ref $args->value->{'a'}, "Path::Tiny";
    is ref $args->value->{'b'}, "Path::Tiny";
    is ref $args->value->{'c'}, "Path::Tiny";
    is $args->value->{'a'}, 'a';
    is $args->value->{'b'}, 'b';
    is $args->value->{'c'}, 'c';
};

subtest 'repeatable flag 3 (is_hash)' => sub {
    local @ARGV;
    push @ARGV, qw(--xxx a=21 --xxx b=22 --xxx c=XYZ);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    my $args = $kingpin->flag("xxx", "xxx yyy")->int_hash();

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

    is ref($args->value), 'HASH';
    is $args->value->{'a'}, 21;
    is $args->value->{'b'}, 22;
    is $args->value->{'c'}, undef;

    like $stderr, qr/int parse error/;
    is $exit, 1;
};

subtest 'repeatable arg (is_hash)' => sub {
    local @ARGV;
    push @ARGV, qw(a=a b= c);

    my $kingpin = Getopt::Kingpin->new();
    my $args = $kingpin->arg("xxx", "xxx yyy")->string_hash();

    my $cmd = $kingpin->parse;

    is_deeply $args->value, { a=>'a', b=>'', c=>undef };
};

subtest 'repeatable arg 2 (is_hash)' => sub {
    local @ARGV;
    push @ARGV, qw(a=a b=b c=c);

    my $kingpin = Getopt::Kingpin->new();
    my $args = $kingpin->arg("xxx", "xxx yyy")->file_hash();

    my $cmd = $kingpin->parse;

    is ref $args->value->{'a'}, "Path::Tiny";
    is ref $args->value->{'b'}, "Path::Tiny";
    is ref $args->value->{'c'}, "Path::Tiny";
    is $args->value->{'a'}, 'a';
    is $args->value->{'b'}, 'b';
    is $args->value->{'c'}, 'c';
};

subtest 'repeatable flag (is_hash) with default' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new();
    my $args = $kingpin->flag("xxx", "xxx yyy")->default({a=>'a',b=>'',c=>undef})->string_hash();

    my $cmd = $kingpin->parse;

    is_deeply $args->value, { a=>'a', b=>'', c=>undef };
};

subtest 'repeatable flag (is_hash) with no default and no flag on command line' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new();
    my $args = $kingpin->flag("xxx", "xxx yyy")->string_hash();

    my $cmd = $kingpin->parse;

    is_deeply $args->value, {};
};

subtest 'repeatable flag (is_hash) with bad default' => sub {
    local @ARGV;
    push @ARGV, qw();

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->terminate(sub {return @_});
    my $args = $kingpin->flag("xxx", "xxx yyy")->default({'a'=>'xyz'})->int_hash();

    my ($stdout, $stderr, $ret, $exit) = capture {
        $kingpin->parse;
    };

t/30_hidden.t view on Meta::CPAN

use strict;
use Test::More 0.98;
use Getopt::Kingpin;
use Capture::Tiny ':all';
use File::Basename;


subtest 'hidden' => sub {
    # from : t/20_flag_keys.t
    local @ARGV;
    push @ARGV, qw(--name kingpin -- path);

    my $kingpin = Getopt::Kingpin->new();
    $kingpin->flag("hidden1", "")->hidden->string();
    $kingpin->flag("bbb", "")->string();
    $kingpin->flag("hidden2", "")->hidden->string();
    $kingpin->flag("ccc", "")->string();
    $kingpin->flag("hidden3", "")->hidden->string();
    $kingpin->flag("aaa", "")->string();
    $kingpin->flag("hidden4", "")->hidden->string();

t/30_hidden.t view on Meta::CPAN

    is $keys[1], "bbb";
    is $keys[2], "ccc";
    is $keys[3], "aaa";
    is $keys[4], "eee";
    is $keys[5], "ddd";

};

subtest 'hidden + command help 7-2' => sub {
    # from : t/23_command.t
    local @ARGV;
    push @ARGV, qw(register --help);

    my $kingpin = Getopt::Kingpin->new;
    $kingpin->terminate(sub {return @_});
    $kingpin->flag("hidden1", "")->hidden->string();

    my $register      = $kingpin->command('register', 'Register a new user.');
    my $register_nick = $register->arg('nick', 'Nickname for user.')->required->string;
    my $register_name = $register->arg('name', 'Name for user.')->required->string;

( run in 0.995 second using v1.01-cache-2.11-cpan-49f99fa48dc )