view release on metacpan or search on metacpan
lib/Geo/TCX.pm view on Meta::CPAN
my ($fh, $tmp_fname) = tempfile();
_convert_fit_to_tcx( $fname, $tmp_fname );
$file_to_read = $tmp_fname;
$fname =~ s/(?i:.fit)$/.tcx/
}
$txt = do { local(@ARGV, $/) = $file_to_read; <> };
$o->set_filename($fname)
}
$txt =~ s,\r,,g; # if it's a windows file
$txt =~ s,>\s+<,><,g;
view release on metacpan or search on metacpan
# test that ssl_verify_mode 0x02 is indeed enforced. disabled for now.
# my $res = get('/test', 0);
my $got_cert = get('/test', 1);
my $expected_cert = do { local(@ARGV, $/) = $cert_file; <> };
is(parsed($got_cert), parsed($expected_cert));
} else {
my $daemon;
my $app = sub {
view release on metacpan or search on metacpan
lib/Getopt/Alt.pm view on Meta::CPAN
default =>
{ %{ $self->opt }, %{ $options->{default} || {} } },
},
$opt_args
);
local @ARGV = ();
if ( $self->opt->auto_complete ) {
push @args, '--auto-complete', $self->opt->auto_complete,
'--';
}
$sub_obj->process(@args);
view release on metacpan or search on metacpan
t/v005-10-usage.t view on Meta::CPAN
},
},
},
);
local @ARGV = qw/--apple mango/;
undef @path;
$options = Getopt::Chain->process(%process);
cmp_deeply($options, { qw/apple 1/ });
cmp_deeply(\@path, [ undef, qw/mango/ ]);
local @ARGV = qw/grape --banana ripe/;
undef @path;
$options = Getopt::Chain->process(%process);
cmp_deeply($options, { qw/banana ripe/ });
cmp_deeply(\@path, [ undef, qw/grape/ ]);
local @ARGV = qw/--apple grape --banana ripe/;
undef @path;
$options = Getopt::Chain->process(%process);
cmp_deeply($options, { qw/apple 1 banana ripe/ });
cmp_deeply(\@path, [ undef, qw/grape/ ]);
view release on metacpan or search on metacpan
t/001_basic.t view on Meta::CPAN
# my $options = $opt->options;
# $opt->message( $opt->dumper( $params ) ); exit;
isa_ok( $opt, 'Getopt::Class' );
{
local @ARGV = qw( --debug 3 --dry-run --name Bob --created 2020-04-12T07:30:10 --langs en ja --with-zlib --disable-compress --enable-logging );
my $opts = $opt->exec || diag( "Error: " . $opt->error );
ok( defined( $opts ), 'No Getopt::Long error' );
is( Scalar::Util::reftype( $opts ), 'HASH', 'Expecting a hash reference' );
is( $opts->{dry_run}, 1, 'Boolean option enabled' );
is( $opts->{debug}, 3, 'Scalar reference of integer set' );
view release on metacpan or search on metacpan
t/private/parse_argv.t view on Meta::CPAN
my ($input, $expects, $sub_command, $desc) =
@specs{qw/input expects sub_command desc/};
subtest $desc => sub {
local @ARGV = @$input;
$go->{_struct} = $sub_command || {};
my @opts = $go->_parse_argv;
is_deeply \@opts, $expects, 'parse argv';
view release on metacpan or search on metacpan
lib/Getopt/Complete/Args.pm view on Meta::CPAN
my $self = shift;
# as long as the first word is a valid sub-command, drill down to the subordinate options list,
# and also shift the args into a special buffer
# (if you have sub-commands AND bare arguments, and the arg is a valid sub-command ...don't do that
local @ARGV = @{ $self->{argv} };
my @sub_command_path;
while (@ARGV and my $delegate = $self->options->completion_handler('>' . $ARGV[0])) {
push @sub_command_path, shift @ARGV;
$self->{options} = $delegate;
}
view release on metacpan or search on metacpan
t/App/Foo.pm view on Meta::CPAN
no Getopt::EX::Hashed;
sub run {
my $app = shift;
local @ARGV = @_;
use Getopt::Long;
$app->getopt or die;
return @ARGV;
}
t/App/Foo.pm view on Meta::CPAN
no Getopt::EX::Hashed;
sub run {
my $app = shift;
local @ARGV = @_;
use Getopt::Long;
$app->getopt or die;
return @ARGV;
}
view release on metacpan or search on metacpan
lib/Getopt/EX/Module.pm view on Meta::CPAN
sub run_inits {
my $obj = shift;
my $argv = shift;
my $module = $obj->module;
local @ARGV = ();
call_if_defined $module, "initialize" => ($obj, $argv);
for my $call ($obj->call) {
my $func = $call->can('call') ? $call : parse_func($call);
view release on metacpan or search on metacpan
lib/Getopt/Helpful.pm view on Meta::CPAN
} # end subroutine Get definition
########################################################################
=head2 Get_from
Equivalent to Get(@extra), but treats @args as a localized @ARGV.
$hopt->Get_from(\@args, @extra);
=cut
sub Get_from {
my $self = shift;
my ($args, @extra) = @_;
local @ARGV = @$args;
$self->Get(@extra);
@$args = @ARGV;
} # end subroutine Get_from definition
########################################################################
view release on metacpan or search on metacpan
t/01_string.t view on Meta::CPAN
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;
view release on metacpan or search on metacpan
t/01-basic.t view on Meta::CPAN
use Getopt::Long::Complete;
is($REQUIRE_ORDER, 0);
subtest GetOptions => sub {
local @ARGV = ("--foo", "--bar", "baz");
my %opts;
GetOptions(
'foo' => \$opts{foo},
'bar=s' => sub { $opts{bar} = $_[1] },
);
view release on metacpan or search on metacpan
t/descriptive.t view on Meta::CPAN
# precludes => [...]
# sugar for only_one_of and all_or_none
sub is_opt {
my ($argv, $specs, $expect, $desc) = @_;
local @ARGV = @$argv;
local $Test::Builder::Level = $Test::Builder::Level + 1;
my $ok = eval {
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ($opt, $usage) = describe_options(
"test %o",
t/descriptive.t view on Meta::CPAN
}
sub is_hidden {
my ($specs, $cmd, $text) = @_;
eval {
local @ARGV;
my ($opt, $usage) = describe_options(
"test %o",
@$specs,
);
like(
t/descriptive.t view on Meta::CPAN
{},
"an unrequired option"
);
{
local @ARGV;
my ($opt, $usage) = describe_options(
"%c %o",
[ foo => "a foo option" ],
[],
['bar options:'],
t/descriptive.t view on Meta::CPAN
"CODEISH: spacer and non-option description found",
);
}
{
local @ARGV;
my ($opt, $usage) = describe_options(
"%c %o",
[ foo => "a foo option" ],
[],
[\"bar options:\n -> they are cool"],
t/descriptive.t view on Meta::CPAN
"CODEISH: spacer and non-option description found",
);
}
{
local @ARGV;
my ($opt, $usage) = describe_options(
"%c %o",
[ 'foo' => "foo option" ],
[ 'bar|b' => "bar option" ],
[ 'string|s=s' => "string value" ],
t/descriptive.t view on Meta::CPAN
"short options",
);
}
{
local @ARGV;
my ($opt, $usage) = describe_options(
"%c %o",
[ 'string|s=s' => "string value" ],
[ 'ostring|S:s' => "optional string value" ],
[ 'list|l=s@' => "list of strings" ],
t/descriptive.t view on Meta::CPAN
"Spec ! gets a [no-] in usage output",
);
}
{
local @ARGV = qw(--foo FOO --baz BAZ);
my ($c_opt, $usage) = describe_options(
"%c %o",
[ "foo=s", '' ],
[ "bar=s", '', { default => 'BAR' } ],
[ "baz=s", '', { default => 'BAZ' } ],
t/descriptive.t view on Meta::CPAN
is($C_opt->baz, 'BAZ', 'C_opt->foo is BAZ');
is($s_opt->baz, 'BAZ', 's_opt->foo is BAZ');
}
{
local @ARGV = qw(--foo);
my ($opt, $usage) = describe_options(
"%c %o",
[ "foo", '' ],
[ "bar", '' ],
);
t/descriptive.t view on Meta::CPAN
is( $opt->{bar}, undef, "entry not given is undef (exists? no guarantee)" );
is( $opt->bar, undef, "entry not given is undef (as method)");
}
{
local @ARGV = qw(--get);
my ($opt, $usage) = describe_options(
"%c %o",
[ "mode" => hidden => { one_of => [
[ "get" => "get the value" ],
[ "set" => "set the value" ],
t/descriptive.t view on Meta::CPAN
is( $opt->{set}, undef, "one_of entry not given is undef (as hash key)" );
is( $opt->set, undef, "one_of entry not given is undef (as method)");
}
{
local @ARGV = qw(--foo-bar);
my ($opt) = describe_options(
"%c %o",
[ "foo:s", "foo option" ],
[ "foo-bar", "foo-bar option", { implies => 'foo' } ],
);
t/descriptive.t view on Meta::CPAN
is($opt->foo_bar, 1, 'given value (checked with method)');
is($opt->foo, 1, 'implied value (checked with method)');
}
{
local @ARGV;
local $Getopt::Long::Descriptive::TERM_WIDTH = 80;
my ($opt, $usage) = describe_options(
"test %o",
[ foo => "a foo option" ],
t/descriptive.t view on Meta::CPAN
is($usage->text, $expect, 'long option description is wrapped cleanly');
}
{
local @ARGV;
local $Getopt::Long::Descriptive::TERM_WIDTH = 80;
# We're testing, here, that if we "forget" the usual "%c %o" style format,
# its assumed.
my ($opt, $usage) = describe_options(
t/descriptive.t view on Meta::CPAN
[ 0, '--no-exit' ],
);
for my $test (@test) {
my $want = shift @$test;
local @ARGV = @$test;
my ($opt, $usage) = describe_options(@gld_args);
is(scalar $opt->exit, $want, "(@$test) for exit!");
}
}
{
local @ARGV;
my ($opt, $usage) = describe_options(
"%c %o",
[ foo => "x" x 80 ],
);
local $@;
view release on metacpan or search on metacpan
use Test::More;
use Getopt::Long::Modern;
# regular options
{
local @ARGV = qw(-f --bar baz -Z 1 --baz 2 abc);
GetOptions(
'f|foo' => \my $foo,
'b|bar=s' => \my $bar,
'Z|baz=s' => \my @baz,
);
is_deeply \@baz, [1,2], 'option is set';
}
# no_ignore_case, permute
{
local @ARGV = qw(--Foo abc --bar baz);
local $SIG{__WARN__} = sub {};
GetOptions(
'foo' => \my $foo,
'bar=s' => \my $bar,
);
is $bar, 'baz', 'option is set';
}
# bundling
{
local @ARGV = qw(-fb baz abc);
GetOptions(
'f|foo' => \my $foo,
'b|bar=s' => \my $bar,
);
is_deeply \@ARGV, ['abc'], 'argument left';
is $bar, 'baz', 'option is set';
}
# gnu_compat no_getopt_compat
{
local @ARGV = qw(+f --bar= abc);
GetOptions(
'f|foo' => \my $foo,
'b|bar=s' => \my $bar,
);
is_deeply \@ARGV, ['+f','abc'], 'argument left';
}
# extra options
Getopt::Long::Modern->import('pass_through');
{
local @ARGV = qw(-f --bar=baz --baz abc);
GetOptions(
'f|foo' => \my $foo,
'b|bar=s' => \my $bar,
);
is_deeply \@ARGV, ['--baz','abc'], 'arguments left';
view release on metacpan or search on metacpan
lib/Getopt/Long/Subcommand.pm view on Meta::CPAN
=head2 How to avoid modifying @ARGV? How to process from another array, like Getopt::Long's GetOptionsFromArray?
Instead of adding another function, you can use C<local>.
{
local @ARGV = ['--some', 'value'];
GetOptions(...);
}
# the original @ARGV is restored
=head1 HOMEPAGE
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
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') {