view release on metacpan or search on metacpan
lib/App/CPANGhq.pm view on Meta::CPAN
my $parser = Getopt::Long::Parser->new(
config => [qw/posix_default no_ignore_case bundling pass_through auto_help/],
);
local @ARGV = @argv;
$parser->getoptions(\my %opt) or Pod::Usage::pod2usage(1);
@argv = @ARGV;
(\%opt, \@argv);
}
view release on metacpan or search on metacpan
lib/App/CPANRepo.pm view on Meta::CPAN
my $parser = Getopt::Long::Parser->new(
config => [qw/posix_default no_ignore_case bundling pass_through auto_help/],
);
local @ARGV = @argv;
$parser->getoptions(\my %opt) or Pod::Usage::pod2usage(1);
@argv = @ARGV;
Pod::Usage::pod2usage(1) unless @argv;
(\%opt, \@argv);
view release on metacpan or search on metacpan
t/01-help.t view on Meta::CPAN
use App::CSE;
my $cse = App::CSE->new();
{
local @ARGV = ( 'help' , '--verbose' );
ok( $cse->version() , "Ok got a version");
ok( $cse->command()->isa('App::CSE::Command::Help') , "Ok good command instance");
ok( $cse->main() , "Ok can execute the magic command");
ok( $cse->options()->{verbose} , "Ok verbose is set");
}
view release on metacpan or search on metacpan
t/02-basic.t view on Meta::CPAN
111,222,333
.
sub setup {
my $input = shift;
local @ARGV = @_;
my $output_fh = IO::String->new;
my $ac = App::CSV->new_with_options(
_input_fh => IO::String->new($input),
_output_fh => $output_fh);
return($ac, $output_fh->string_ref);
view release on metacpan or search on metacpan
$obj->run;
ok -f $latex;
my $content = do { local (@ARGV, $/) = $latex; <> };
like_string $content, qr/begin\{table\}/;
like_string $content, qr/Name & Age & City \\\\/;
}
done_testing();
view release on metacpan or search on metacpan
inc/My/Module/Build.pm view on Meta::CPAN
*read_file = \&My::Module::Build::read_file; }
use Test::More;
use Fatal qw(mkdir chdir);
local @ARGV = qw(--noinstall-everything);
my $define_options =
My::Tests::Below->pod_code_snippet("option-graph");
$define_options =~ s/\.\.\.//g;
my $builder = eval $define_options; die $@ if $@;
view release on metacpan or search on metacpan
lib/App/Chained.pm view on Meta::CPAN
my @command_line_arguments = @{$self->{command_line_arguments}} ;
if(@command_line_arguments)
{
local @ARGV = @command_line_arguments ;
my @option_definitions = $self->get_options_definitions() ;
GetOptions(@option_definitions);
my @arguments_left_on_command_line = @ARGV ;
view release on metacpan or search on metacpan
t/05getopts.t view on Meta::CPAN
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
is( $getopts->option, undef, 'Expecting no die message' );
local @ARGV = '--option1';
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
trap {
$getopts->add_option( spec => 'option1' );
};
is( $trap->leaveby, 'return', 'adding an empty option failed' );
t/05getopts.t view on Meta::CPAN
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
is( $getopts->option1, 1, 'Expecting no die message' );
local @ARGV = ''; # @ARGV is never undef, but an empty string
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
trap {
$getopts->add_option( spec => 'option1', default => 5 );
};
is( $trap->leaveby, 'return', 'adding an empty option with a default value' );
t/05getopts.t view on Meta::CPAN
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
is( $getopts->option1, 5, 'correct default value' );
local @ARGV = ( '--option1', '8' );
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
trap {
$getopts->add_option( spec => 'option1=i', default => 5, );
};
is( $trap->leaveby, 'return', 'adding an empty option failed' );
view release on metacpan or search on metacpan
lib/Module/Starter/Plugin/App/Cmd.pm view on Meta::CPAN
sub create_script {
my $self = shift;
my $script_dir = File::Spec->catdir($self->{basedir}, 'script');
unless (-d $script_dir) {
local @ARGV = $script_dir;
mkpath @ARGV;
$self->progress("Created $script_dir");
}
my $script_file = File::Spec->catfile($script_dir, $self->{script});
view release on metacpan or search on metacpan
lib/App/Cmd/ArgProcessor.pm view on Meta::CPAN
# ABSTRACT: App::Cmd-specific wrapper for Getopt::Long::Descriptive
sub _process_args {
my ($class, $args, @params) = @_;
local @ARGV = @$args;
require Getopt::Long::Descriptive;
Getopt::Long::Descriptive->VERSION(0.116);
my ($opt, $usage) = Getopt::Long::Descriptive::describe_options(@params);
view release on metacpan or search on metacpan
expected_config => { 'bar' => '1' },
},
);
for my $test_name (keys %tests) {
local @ARGV = @{$tests{$test_name}->{ARGV}};
my $program = App::Commando::program('test');
$program->option('foo', '-f', '--foo', 'Enables foo');
$program->option('bar', '-b', '--bar', 'Enables bar');
$program->action(sub {
view release on metacpan or search on metacpan
lib/App/DBI/Loader.pm view on Meta::CPAN
use String::Unescape;
sub run
{
shift if @_ && eval { $_[0]->isa(__PACKAGE__) };
local (@ARGV) = @_;
my %opts;
getopts(Getopt::Config::FromPod->string, \%opts);
pod2usage(-verbose => 2) if exists $opts{h};
pod2usage(-msg => 'At least 2 arguments MUST be specified', -verbose => 0, -exitval => 1) if @ARGV < 2;
view release on metacpan or search on metacpan
t/cli/errors.t view on Meta::CPAN
# Test various errors.
eval { $docknot->run('foo') };
is_error($@, 'unknown command foo', 'Unknown command');
eval { $docknot->run('--bogus', 'generate') };
is_error($@, 'unknown option: bogus', 'Unknown top-level option');
local @ARGV = ();
eval { $docknot->run() };
is_error($@, 'no subcommand given', 'No subcommand');
eval { $docknot->run('generate', '-f', 'readme') };
is_error($@, 'generate: unknown option: f', 'Unknown option');
eval { $docknot->run('generate') };
view release on metacpan or search on metacpan
lib/App/EPAN.pm view on Meta::CPAN
my $action =
(scalar(@_) && length($_[0]) && (substr($_[0], 0, 1) ne '-'))
? shift(@_)
: 'list-actions';
$action =~ s{-}{_}gmxs;
local @ARGV = @_;
$self->action($action);
my %config = ();
GetOptions(
\%config,
qw(
view release on metacpan or search on metacpan
lib/App/FTPThis.pm view on Meta::CPAN
);
say "Starting FTP server on port $self->{port} ...";
chdir $self->{root} or die "Can't chdir to $self->{root}: $!";
local @ARGV = (
"-C=$dir/conf",
"-p", $self->{port},
"-s", # daemon mode (not background, which is -S)
);
my $ftpd = Net::FTPServer::RO_FTPThis::Server->run;
view release on metacpan or search on metacpan
lib/App/FatPacker.pm view on Meta::CPAN
return [ @ARGV ];
}
sub lines_of {
map +(chomp,$_)[1], do { local @ARGV = ($_[0]); <> };
}
sub stripspace {
my ($text) = @_;
$text =~ /^(\s+)/ && $text =~ s/^$1//mg;
lib/App/FatPacker.pm view on Meta::CPAN
# This method can be overload in sub classes
# For example to skip POD
sub load_file {
my ($self, $file) = @_;
my $content = do {
local (@ARGV, $/) = ($file);
<>
};
close ARGV;
return $content;
}
view release on metacpan or search on metacpan
t/bin-fetchware-run.t view on Meta::CPAN
my $test_dist_md5 = md5sum_file($test_dist_path);
verbose_on();
{
local @ARGV = ('install', $test_dist_path);
fork_ok(sub { run() },
'Checked run() test-dist install success');
}
ok(-e catfile(fetchware_database_path(), 'test-dist-1.00.fpkg'),
t/bin-fetchware-run.t view on Meta::CPAN
verbose_on();
{
# Run with --keep-temp option.
local @ARGV = ('--keep-temp', 'install', $test_dist_path);
fork_ok(sub { print "TMP[$ENV{TMPDIR}]"; run() },
'Checked run() test-dist install success');
}
ok(-e catfile(fetchware_database_path(), 'test-dist-1.00.fpkg'),
t/bin-fetchware-run.t view on Meta::CPAN
# Clear internal %CONFIG variable, because I have to parse a Fetchwarefile
# twice, and it's only supported once.
__clear_CONFIG();
{
local @ARGV = ('uninstall', 'test-dist-1.00');
fork_ok(sub { run() },
'Checked run() uninstall test-dist success.');
}
ok(unlink($test_dist_path, $test_dist_md5),
t/bin-fetchware-run.t view on Meta::CPAN
ver_num => '1.01', destination_directory => $upgrade_temp_dir);
my $new_test_dist_path_md5 = md5sum_file($new_test_dist_path);
{
local @ARGV = ('upgrade', 'test-dist');
fork_ok(sub { run() },
'Checked run() @ARGV upgrade success');
}
print_ok(sub {cmd_list()},
t/bin-fetchware-run.t view on Meta::CPAN
# installed.
# Clear internal %CONFIG variable, because I have to pare a Fetchwarefile
# twice, and it's only supported once.
__clear_CONFIG();
{
local @ARGV = ('upgrade', 'test-dist');
fork_ok(sub { run() },
'Checked run() @ARGV upgrade version already installed');
}
# Clean up upgrade path.
t/bin-fetchware-run.t view on Meta::CPAN
my $new_another_dist_path_md5 = md5sum_file($new_another_dist_path);
# Upgrade all installed fetchware packages.
{
local @ARGV = ('upgrade-all');
fork_ok(sub { run() },
'Checked run() @ARGV upgrade-all success. ');
}
print_ok(sub {cmd_list()},
t/bin-fetchware-run.t view on Meta::CPAN
ok(cmd_install($test_dist_path),
'checked cmd_list() by installing a test-dist to list');
{
local @ARGV = ('list');
fork_ok(sub {
print_ok(sub {run()}, qr/test-dist-1\.00/,
'checked cmd_list() success.');
},
'Checked run() @ARGV list success');
t/bin-fetchware-run.t view on Meta::CPAN
my $test_dist_path = make_test_dist(file_name => 'test-dist',
ver_num => '1.00');
my $test_dist_md5 = md5sum_file($test_dist_path);
{
local @ARGV = ('look', $test_dist_path);
fork_ok(sub {run()},
'checked run() look success.');
}
# Cleanup the test-dist crap.
t/bin-fetchware-run.t view on Meta::CPAN
ok(-e $fetchware_tempdir, 'checked creating fetchware temporary directory.');
ok(-e $fetchwarefile_tempdir, 'checked creating Fetchwarefile temporary directory.');
# Delete newly created tempfiles.
{
local @ARGV = ('clean', $testing_tempdir);
fork_ok(sub {run()},
'checked run() clean success.');
}
ok(! -e $fetchware_tempdir,
t/bin-fetchware-run.t view on Meta::CPAN
# Tests run() when @ARGV's first value is *not* one of fetchware's allowable
# commands.
subtest 'test run() default' => sub {
{
local @ARGV = ();
fork_ok(sub {
print_ok(sub {run()},
qr/fetchware is a package manager for source code distributions. It gives you the/,
'Checked run() @ARGV = help with print_ok().');
},
t/bin-fetchware-run.t view on Meta::CPAN
# Now test that the same else is hit if an unrecognized command is
# specified.
{
local @ARGV = ('unrecognized');
fork_ok(sub {
print_ok(sub {run()},
qr/fetchware is a package manager for source code distributions. It gives you the/,
'Checked run() @ARGV = help with print_ok().');
},
t/bin-fetchware-run.t view on Meta::CPAN
# Tests run() when @ARGV's first value is *not* one of fetchware's allowable
# commands.
subtest 'test run() help' => sub {
{
local @ARGV = ('help');
fork_ok(sub {
print_ok(sub {run()},
qr/fetchware is a package manager for source code distributions. It gives you the/,
'Checked run() @ARGV = help with print_ok().');
},
t/bin-fetchware-run.t view on Meta::CPAN
};
subtest 'test run() command line options' => sub {
{
local @ARGV = '-h';
fork_ok(sub {
print_ok(sub {run()},
qr/fetchware is a package manager for source code distributions. It gives you the/,
'Checked run() @ARGV = -h with print_ok().');
},
'checked run() -h success.');
}
{
local @ARGV = '-?';
fork_ok(sub {
print_ok(sub {run()},
qr/fetchware is a package manager for source code distributions. It gives you the/,
'Checked run() @ARGV = -? with print_ok().');
},
'checked run() -? success.');
}
{
local @ARGV = '--help';
fork_ok(sub {
print_ok(sub {run()},
qr/fetchware is a package manager for source code distributions. It gives you the/,
'Checked run() @ARGV = --help with print_ok().');
},
'checked run() --help success.');
}
{
local @ARGV = '-V';
fork_ok(sub {
print_ok(sub {run()},
qr/Fetchware version \d.\d\d\d/,
'checked run() -V option success with print_ok().');
},
'Checked run() -V option success.');
}
{
local @ARGV = '--version';
fork_ok(sub {
print_ok(sub {run()},
qr/Fetchware version \d.\d\d\d/,
'checked run() --version option success with print_ok().');
},
view release on metacpan or search on metacpan
return $revision;
}
sub autofixup {
my $self = shift;
local @ARGV = @_;
print "# git-autofixup ", join(' ', @ARGV), "\n";
return Autofixup::main();
}
sub switch_to_downstream_branch {
view release on metacpan or search on metacpan
lib/Test/Git/Workflow/Command.pm view on Meta::CPAN
${"${module}::workflow"} = $workflow->new(git => $git);
if ($data->{workflow}) {
${"${module}::workflow"}->{$_} = $data->{workflow}{$_} for keys %{ $data->{workflow} };
}
local @ARGV = @{ $data->{ARGV} };
local %ENV = %ENV;
if ($data->{ENV}) {
$ENV{$_} = $data->{ENV}{$_} for keys %{ $data->{ENV} };
}
my $stdin;
view release on metacpan or search on metacpan
lib/App/GitHub/create.pm view on Meta::CPAN
my ( $name, $homepage, $description, $private, $public, $dry_run );
usage 0 unless @arguments;
{
local @ARGV = @arguments;
GetOptions(
'help|h|?' => \$help,
'login=s' => \$login,
'token=s' => \$token,
view release on metacpan or search on metacpan
lib/App/GitHub/update.pm view on Meta::CPAN
# Oh god this is hacky
package App::GitHub::update::Sandbox;
BEGIN {
$App::GitHub::update::Sandbox::VERSION = '0.0011';
}
local @ARGV;
do './dzpl';
my $dzpl = $Dzpl::dzpl;
$dzpl = $Dzpl::dzpl;
$dzpl->zilla->_setup_default_plugins;
$_->gather_files for ( @{ $dzpl->zilla->plugins_with(-FileGatherer) } );
lib/App/GitHub/update.pm view on Meta::CPAN
usage 0 unless @arguments;
my ( $login, $token, $repository, $dzpl, $help );
my ( $homepage, $description );
{
local @ARGV = @arguments;
GetOptions(
'help|h|?' => \$help,
'login=s' => \$login,
'token=s' => \$token,
view release on metacpan or search on metacpan
lib/App/Greple/Filter.pm view on Meta::CPAN
$debug{F} and warn "Push output Filter: \"$filter\"\n";
my $pid = open($fh, '|-') // die "$filter: $!\n";
if ($pid == 0) {
if ($filter =~ /^&/ and
my $f = parse_func({ PACKAGE => $pkg }, $filter)) {
local @ARGV;
open STDIN, '<&', 0 if eof STDIN;
$f->call;
} else {
do { exec $filter } ;
warn $@ if $@;
view release on metacpan or search on metacpan
lib/App/HTTP_Proxy_IMP.pm view on Meta::CPAN
}
}
sub getoptions {
my $self = shift;
local @ARGV = @_;
GetOptions(
'h|help' => sub { usage() },
'P|pcapdir=s' => \$self->{pcapdir},
'mitm-ca=s' => \$self->{mitm_ca},
'capath=s' => \$self->{capath},
view release on metacpan or search on metacpan
lib/App/Ikaros/Helper.pm view on Meta::CPAN
uniq
/;
sub option_parser {
my ($options) = @_;
local @ARGV = @ARGV;
my $parser = Getopt::Long::Parser->new(
config => ["no_ignore_case", "pass_through"],
);
my %results;
my @opt_list;
view release on metacpan or search on metacpan
lib/App/Iops.pm view on Meta::CPAN
}
sub _read_arguments {
my $self = shift;
local @ARGV = @_;
Getopt::Long::GetOptions(
$self,
'help',
'pid=i',
)
view release on metacpan or search on metacpan
kritika.fatpack view on Meta::CPAN
| (.)
)/xg){if (defined $1){$is_utf8=1 if (!defined$is_utf8)}else {$is_utf8=0 if (!defined$is_utf8);if ($is_utf8){return}}}return$is_utf8}1;
JSON_BACKPORTPP_COMPAT5006
$fatpacked{"Module/Build/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_TINY';
package Module::Build::Tiny;$Module::Build::Tiny::VERSION='0.05';use strict;use warnings;use Exporter 5.57 'import';our@EXPORT=qw/Build Build_PL/;use CPAN::Meta;use ExtUtils::Config 0.003;use ExtUtils::Helpers 0.020 qw/make_executable split_like_sh...
MODULE_BUILD_TINY
$fatpacked{"Test/Deep.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEST_DEEP';
use strict;use warnings;package Test::Deep;use Carp qw(confess);use Test::Deep::Cache;use Test::Deep::Stack;use Test::Deep::RegexpVersion;require overload;use Scalar::Util;my$Test;unless (defined$Test::Deep::NoTest::NoTest){require Test::Builder;$T...
$message
view release on metacpan or search on metacpan
lib/App/MPDSync.pm view on Meta::CPAN
}
sub parse_options {
my ($self, @args) = @_;
local @ARGV = @args;
Getopt::Long::Configure('bundling');
Getopt::Long::GetOptions(
'D|daemon!' => \$self->{daemon},
'V|version' => \&show_version,
view release on metacpan or search on metacpan
lib/App/MechaCPAN.pm view on Meta::CPAN
# Cleanup any files opened already. They arn't useful after we exec
File::Temp::cleanup();
info "Restarting to local perl\n";
info( join( " ", $local_perl, map( {"-I$_"} @inc_add ), $real0, @ARGV ) );
exec( $local_perl, map( {"-I$_"} @inc_add ), $real0, @ARGV );
}
}
1;
__END__
view release on metacpan or search on metacpan
t/main/parse_args.t view on Meta::CPAN
my @patterns = (
[qw/127.0.0.1:11211/],
[qw/www.google.com:443/],
);
for my $ptn (@patterns) {
local @ARGV = @$ptn;
my $parsed = $Class->parse_args;
is($parsed->{addr}, $ptn->[0], 'addr='.$ptn->[0]);
}
};
t/main/parse_args.t view on Meta::CPAN
my @patterns = (
[qw/192.168.0.1/],
[qw/www.google.com/],
);
for my $ptn (@patterns) {
local @ARGV = @$ptn;
my $parsed = $Class->parse_args;
is(
$parsed->{addr},
$ptn->[0].':'.DEFAULT_PORT(),
'addr='.$ptn->[0].':(default-port)',
t/main/parse_args.t view on Meta::CPAN
my @patterns = (
[qw/-a 192.168.0.1/],
[qw/--addr www.google.com:1986/],
);
for my $ptn (@patterns) {
local @ARGV = @$ptn;
my $parsed = $Class->parse_args;
my $addr_to_be = create_addr($ptn->[1]);
is($parsed->{addr}, $addr_to_be, '--addr='.$addr_to_be);
}
};
view release on metacpan or search on metacpan
t/cli/parse_args.t view on Meta::CPAN
my $Class = 'App::Memcached::Tool::CLI';
subtest 'With no argument' => sub {
my $default = 'display';
local @ARGV = ();
my $parsed = $Class->parse_args;
is($parsed->{mode}, $default, "default $default");
};
subtest 'With normal single mode' => sub {
my @pattern = qw/dump/;
local @ARGV = @pattern;
my $parsed = $Class->parse_args;
is($parsed->{mode}, $pattern[0], 'mode='.$pattern[0]);
is($parsed->{addr}, DEFAULT_ADDR(), 'addr=(default)');
};
t/cli/parse_args.t view on Meta::CPAN
my @patterns = (
[qw/127.0.0.1:11211 display/],
[qw/www.google.com:443 stats/],
);
for my $ptn (@patterns) {
local @ARGV = @$ptn;
my $parsed = $Class->parse_args;
is($parsed->{mode}, $ptn->[1], 'mode='.$ptn->[1]);
is($parsed->{addr}, $ptn->[0], 'addr='.$ptn->[0]);
}
};
t/cli/parse_args.t view on Meta::CPAN
my @patterns = (
[qw/192.168.0.1 display/],
[qw/www.google.com stats/],
);
for my $ptn (@patterns) {
local @ARGV = @$ptn;
my $parsed = $Class->parse_args;
is($parsed->{mode}, $ptn->[1], 'mode='.$ptn->[1]);
is(
$parsed->{addr},
$ptn->[0].':'.DEFAULT_PORT(),
t/cli/parse_args.t view on Meta::CPAN
my @patterns = (
[qw/-a 192.168.0.1 -m stats/],
[qw/--addr www.google.com:1986 --mode settings/],
);
for my $ptn (@patterns) {
local @ARGV = @$ptn;
my $parsed = $Class->parse_args;
is($parsed->{mode}, $ptn->[3], '--mode='.$ptn->[3]);
my $addr_to_be = create_addr($ptn->[1]);
is($parsed->{addr}, $addr_to_be, '--addr='.$addr_to_be);
}
};
subtest 'With help/-h/--help' => sub {
my @patterns = ([qw/help/], [qw/-h/], [qw/--help/]);
for my $ptn (@patterns) {
local @ARGV = @$ptn;
my $parsed = $Class->parse_args;
is($parsed->{mode}, 'help', $ptn->[0]);
}
};
subtest 'With man/--man' => sub {
my @patterns = ([qw/man/], [qw/--man/]);
for my $ptn (@patterns) {
local @ARGV = @$ptn;
my $parsed = $Class->parse_args;
is($parsed->{mode}, 'man', $ptn->[0]);
}
};
subtest '--help/--man overwrites other modes' => sub {
my @patterns = ([qw/display --help help/], [qw/stats --man man/]);
for my $ptn (@patterns) {
local @ARGV = @$ptn[0,1];
my $parsed = $Class->parse_args;
is($parsed->{mode}, $ptn->[2], "$ptn->[0] is overwritten by $ptn->[1]");
}
};