view release on metacpan or search on metacpan
t/parse_param.t view on Meta::CPAN
is(GM->getOpt('i'), 8, "i parsed ok");
is(GM->getOpt('f'), 3.145, "f parsed ok");
do {
local @ARGV = qw(
--stuff blah
);
dies_ok {GM->parseArgs()} 'parses errors';
my $e = Exception::Class->caught();
like($e, qr/no 'foo'/, 'Checking error');
};
GM->unacceptParam('stuff');
do {
local @ARGV = qw(
--stuff fooblah
);
dies_ok {GM->parseArgs()} 'rejects unaccepted parameter';
my $e = Exception::Class->caught();
like($e->message(), qr/Bad command-line/, 'Checking error') or diag explain $e;
view release on metacpan or search on metacpan
t/02.getopt.t view on Meta::CPAN
use parent 'Getopt::O2';
# Usage called?
{
local @ARGV = qw(-h);
local $override{exit} = 1;
my $cmdline = __PACKAGE__->new();
my $mock = Test::MockObject::Extends->new($cmdline);
t/02.getopt.t view on Meta::CPAN
pass('code.coverage.0');
no warnings 'once';
local $override{exit} = 1;
local @ARGV = qw(--garble);
eval {capture_stderr $usage, sub {
$cmdline->getopt({});
}};
t/02.getopt.t view on Meta::CPAN
}
# Test left-overs
{
my @args = qw(--flag --param value -- --param value --flag one two three);
local @ARGV = @args;
my $cmdline = __PACKAGE__->new();
my $mock = Test::MockObject::Extends->new($cmdline);
my (%options, @leftover);
$mock->mock(get_option_rules => sub {
t/02.getopt.t view on Meta::CPAN
}
# Unnamed parameters
{
my @args = (qw(foo bar), undef, '', '-', '--');
local @ARGV = @args;
my (@out, %options);
my $cmdline = __PACKAGE__->new();
$cmdline->getopt(\%options, \@out);
t/02.getopt.t view on Meta::CPAN
is($arg, 'snarf', 'param.invalid.long');
die $mock;
});
local @ARGV = qw(--snarf);
$mock->getopt(\%options);
};
die $@ unless blessed($@) && $mock == $@;
}
# Short options bundling and value
{
local @ARGV = qw(-affoobert -a -bbba);
my $cmdline = __PACKAGE__->new();
my $mock = Test::MockObject::Extends->new($cmdline);
my %options;
t/02.getopt.t view on Meta::CPAN
is('foobert', $options{file}, 'params.short.value');
}
# Short options value after "=" and value as separate argument
{
local @ARGV = qw(
--one=two
--three four
--list 1 --list 2 --list 3
--mode single
--enum a --enum c
t/02.getopt.t view on Meta::CPAN
$mock->mock(get_option_rules => sub {
return @{$set->{set} || []};
});
local @ARGV = @{$set->{ARGV}};
$mock->getopt(\%options);
unless (ref $set->{opt_expect}) {
is($options{$set->{opt_key}}, $set->{opt_expect}, $key);
} elsif ('ARRAY' eq ref $set->{opt_expect}) {
ok(@{$set->{opt_expect}} ~~ @{$options{$set->{opt_key}}}, $key);
t/02.getopt.t view on Meta::CPAN
is($arg, $set->{arg}, "$key.0");
is($fmt, $set->{fmt}, "$key.1") if exists $set->{fmt};
die $self;
});
local @ARGV = @{$set->{ARGV}};
eval {$mock->getopt(\%options);1} and next;
my $error = $@;
if (blessed($error) && $mock == $error) {
} elsif (!exists $set->{expect_error}) {
die $error;
view release on metacpan or search on metacpan
t/00.load.t view on Meta::CPAN
'quiet' => 1, # Gauranteed a 'Argument 6 did not match (?-xism:^--)'
});
my $inc;
{
local @ARGV = @cst;
$inc = Getopt::Param::Tiny->new({ 'quiet' => 1 });
}
my %val = (
'alone' => '--alone',
view release on metacpan or search on metacpan
t/01.methods.t view on Meta::CPAN
'quiet' => 1, # Gauranteed a 'Argument 6 did not match (?-xism:^--)'
});
my $inc;
{
local @ARGV = @cst;
$inc = Getopt::Param->new({ 'quiet' => 1 });
}
my %val = (
'alone' => '--alone',
view release on metacpan or search on metacpan
t/Getopt-Tree.t view on Meta::CPAN
}
sub test_parse_command_line {
my ( $params, $cli ) = @_;
local @ARGV = split( m/ +/, $cli );
local $SIG{__WARN__} = sub {};
my ( $op, $config ) = parse_command_line( $params );
ok( $op && $config, $cli );
return ( $op, $config );
}
view release on metacpan or search on metacpan
bin/example.pl view on Meta::CPAN
use lib 'lib';
use Getopt::Type::Tiny qw(get_opts Str Int);
use Data::Printer;
unless (@ARGV) {
local @ARGV = qw(--foo value_of_foo --bar 12 --verbose);
}
my %options = get_opts(
foo => { isa => Str },
bar => { isa => Int, default => 42 },
view release on metacpan or search on metacpan
use Test::More;
use Project::Libs;
use Getopt::TypeConstraint::Mouse;
subtest basic => sub {
local @ARGV = qw(--in=foo --out=bar);
{
package MyApp;
use Mouse;
with 'MouseX::Getopt';
has 'out' => ( is => 'ro', isa => 'Str', required => 1 );
view release on metacpan or search on metacpan
lib/Getopt/Usaginator.pm view on Meta::CPAN
usage 0 unless @arguments;
my ( $help );
{
local @ARGV = @arguments;
GetOptions(
'help|h|?' => \$help,
);
}
view release on metacpan or search on metacpan
$wrong_syntax = {-msg=>$default_msg,-verbose=>0} if ! defined $wrong_syntax;
$help_usage = { -verbose => 1 } if ! defined $help_usage;
my @args = @_ ? @_ : @ARGV;
local (@ARGV) = @args;
#
# Handle command line parameters
#
my @options = values %{ $this->{options} };
view release on metacpan or search on metacpan
lib/Giblog.pm view on Meta::CPAN
sub run_command {
my ($class, @argv) = @_;
# Command line option
local @ARGV = @argv;
my $getopt_option_save = Getopt::Long::Configure(qw(default no_auto_abbrev no_ignore_case pass_through));
GetOptions(
"h|help" => \my $help,
"H|C|home=s" => \my $home_dir,
);
view release on metacpan or search on metacpan
lib/Gimp/gppport.h view on Meta::CPAN
$rv;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
lib/Gimp/gppport.h view on Meta::CPAN
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
view release on metacpan or search on metacpan
lib/App/annex_to_annex.pm view on Meta::CPAN
CORE::exit main unless caller;
sub main {
shift if $_[0] and ref $_[0] eq ""; # in case main called as a class method
local @ARGV = @{ $_[0] } if $_[0] and ref $_[0] ne "";
# only support v7 because supporting v5 too would make things quite
# complex. require git-annex >=7.20191009 because it will refuse to
# work in v5 repos, and because it supports `git annex find --unlocked`
chomp(my %annex_version_fields = map { split ': ' } `git annex version`);
view release on metacpan or search on metacpan
t/20-init.t view on Meta::CPAN
# init using @ARGV
BEGIN { $tests += 5 }
$dir = tempdir( CLEANUP => 1 );
{
local @ARGV = $dir;
init();
}
check_repo( $dir, 1 );
# local::lib may have installed some files already
view release on metacpan or search on metacpan
t/lib/TestUtil.pm view on Meta::CPAN
sub objects_from {
my ($name) = @_;
my $perl = File::Spec->catfile( 't', 'bundles', "$name.perl" );
# slurp and eval the content of the file
my $objects = do { local @ARGV = ($perl); local $/; eval <> }
or die "Failed processing $perl";
# add extra information
for my $kind ( @kinds ) {
for my $object ( @{ $objects->{$kind} } ) {
view release on metacpan or search on metacpan
t/app-args.t view on Meta::CPAN
my ($env, $argv, $args, $exp) = @$test{qw(env argv args exp)};
$env->{"GIT_DV_\U$_"} = delete $env->{$_} for keys %$env;
local %ENV = (%ENV, %$env);
local @ARGV = @$argv;
is_deeply(Git::DescribeVersion::App::options(@$args), $exp, 'got expected options as function');
local @ARGV = @$argv;
is_deeply(Git::DescribeVersion::App->options(@$args), $exp, 'got expected options as class method');
}
view release on metacpan or search on metacpan
$rv;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
view release on metacpan or search on metacpan
t/001-options.t view on Meta::CPAN
my $params = {};
my @include_opts = ("--include", "t/001-load.t");
my @include_args = ("include", "t/001-load.t");
{
local @ARGV = (@include_opts);
$params = process_options();
for my $o ( qw|
dir
branch
prefix
t/001-options.t view on Meta::CPAN
my $suffix = '_smoke-me';
my $remote = 'upstream';
my $no_delete = 1;
my $no_push = 1;
my $test_extension = 'test';
local @ARGV = (
@include_opts,
'--branch' => $branch,
'--prefix' => $prefix,
'--remote' => $remote,
'--no_delete' => $no_delete,
t/001-options.t view on Meta::CPAN
{
my $no_delete = 1;
my $no_push = 1;
my $test_extension = 'test';
my $suffix = '_my_suffix';
local @ARGV = (
@include_opts,
'--no-delete' => $no_delete,
'--no-push' => $no_push,
'--test-extension' => $test_extension,
'--suffix' => $suffix,
t/001-options.t view on Meta::CPAN
ok(! $params->{prefix}, "Because 'suffix' is set, 'prefix' is not");
}
{
my $phony_dir = "/tmp/abcdefghijklmnop_foobar";
local @ARGV = ("--dir", $phony_dir, "verbose", @include_opts);
local $@;
eval { $params = process_options(); };
like($@, qr/Could not locate directory $phony_dir/,
"Die on non-existent directory $phony_dir provided on command-line");
}
t/001-options.t view on Meta::CPAN
}
{
my $cwd = cwd();
my $phony_dir = "/tmp/abcdefghijklmnop_foobar";
local @ARGV = ("--dir", $phony_dir, @include_opts);
$params = process_options("dir" => $cwd);
is($params->{dir}, $cwd,
"Argument provided directly to process_options supersedes command-line argument");
}
t/001-options.t view on Meta::CPAN
{
my $prefix = "my_prefix_";
my $suffix = "_my_suffix";
local $@;
local @ARGV = ('--prefix' => $prefix, '--suffix' => $suffix, @include_opts);
eval { $params = process_options(); };
like($@,
qr/Only one of '--prefix' or '--suffix' may be supplied/,
"Die on provision of both 'prefix' and 'suffix' options"
);
t/001-options.t view on Meta::CPAN
SKIP: {
my ($stdout);
eval { require IO::CaptureOutput; };
skip "IO::CaptureOutput not installed", 1 if $@;
local @ARGV = (@include_opts);
IO::CaptureOutput::capture(
sub { $params = process_options( "verbose" => 1 ); },
\$stdout,
);
like($stdout, qr/'verbose'\s*=>\s*1/s,
t/001-options.t view on Meta::CPAN
SKIP: {
my ($stdout);
eval { require IO::CaptureOutput; };
skip "IO::CaptureOutput not installed", 1 if $@;
local @ARGV = ("--verbose", @include_opts);
IO::CaptureOutput::capture(
sub { $params = process_options(); },
\$stdout,
);
like($stdout, qr/'verbose'\s*=>\s*1/s,
view release on metacpan or search on metacpan
eg/build-git view on Meta::CPAN
cmp_git( $version, '1.3.3' ) <= 0
&& cmp_git( '1.1.0', $version ) <= 0
&& do { no warnings; `git-describe`; $? != 0 }
)
{
local ( $^I, @ARGV ) = ( '', 'GIT-VERSION-GEN' );
s/git-describe/git describe/, print while <>;
}
# fix GIT_VERSION in the Makefile
if ( cmp_git( $version, '1.0.9' ) == 0 ) {
local ( $^I, @ARGV ) = ( '', 'Makefile' );
s/^GIT_VERSION = .*/GIT_VERSION = $version/, print while <>;
}
# add missing #include <sys/resource.h>
elsif ( cmp_git( $version, '1.7.5.rc0' ) <= 0
view release on metacpan or search on metacpan
my $pull_branch = "";
push @options, "DEBUG=$ENV{DEBUG}" if defined $ENV{DEBUG} and $xmod !~ /^DEBUG=/m;
if (eval { require Getopt::Long; 1; } and
Getopt::Long::GetOptions( "O=s" => \@options )) { # Strip stealth -O args from ARGV so the real git doesn't choke on it
if (my $rest_opt = ($op ne "clone" && "o|")."server-option|push-option=s") { # Ignore -o<origin> for "git clone"
local @ARGV = @ARGV; # Don't monkey anything. Just peek.
Getopt::Long::GetOptions( $rest_opt => \@options, "branch|b=s" => \$pull_branch ); # Handle "git clone -b <ref> <repo>"
}
}
$pull_branch = $1 if $op =~ /^(fetch|pull)$/ and $xmod !~ /^pull_branch=/m and git("branch") =~ m{^\* ([\w/\-.@]+)\s*$}m;
push @options, "pull_branch=$pull_branch" if $pull_branch;
}
# Special "config" handler to honor new --descent option
sub handle_config {
my @args = @_;
local @ARGV = @args;
# Don't try to handle the "--help"-first case.
return if join(" ", @ARGV) =~ /config --help\b/;
if (grep {$_ eq "config"} @ARGV and
# Smells like special "git config" command
eval { require Getopt::Long; 1; } and
view release on metacpan or search on metacpan
xs/ppport.h view on Meta::CPAN
$rv;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
xs/ppport.h view on Meta::CPAN
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
view release on metacpan or search on metacpan
eg/gitmeta-update view on Meta::CPAN
category => "main",
});
}
my($gmf_repo, $gmf_path,
$local_dir) = @ARGV;
if(!defined $local_dir) {
# alternative call: $0 $gmf $local_dir
undef $gmf_repo;
($gmf_path, $local_dir) = @ARGV;
}
GitMeta->health_check();
die "usage: $0 [gmf-repo] gmf-path local-dir"
view release on metacpan or search on metacpan
lib/Global/IPC/ppport.h view on Meta::CPAN
$rv;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
lib/Global/IPC/ppport.h view on Meta::CPAN
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
view release on metacpan or search on metacpan
lib/Global/ppport.h view on Meta::CPAN
$rv;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
lib/Global/ppport.h view on Meta::CPAN
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
view release on metacpan or search on metacpan
lib/Global/Rainbow/Map.pm view on Meta::CPAN
$rasterize->write(
type => 'png',
file_name => $temp_file->filename,
);
return do { local(@ARGV, $/) = $temp_file->filename; <> };
};
=encoding utf8
view release on metacpan or search on metacpan
print " --- hint for $func ---\n", $hint;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
view release on metacpan or search on metacpan
$rv;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
view release on metacpan or search on metacpan
src/ppport.h view on Meta::CPAN
$rv || 0;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
src/ppport.h view on Meta::CPAN
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
view release on metacpan or search on metacpan
$rv;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
exit(0);
sub slurp_file {
my $file = shift;
return( do { local (@ARGV, $/) = $file; <> } );
}
sub no_framebuffer {
my $fb_absent = TRUE;
my $os = `uname`;
view release on metacpan or search on metacpan
$rv;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {