view release on metacpan or search on metacpan
lib/App/Rad/Plugin/ReadLine.pm view on Meta::CPAN
my $welcome = \&_welcome;
$c->$welcome();
while($still_going) {
(my $cmd, local @ARGV) = split ' ',
_terminal->get_reply(
prompt => _shell_prompt(),
default => $DefaultCommand,
);
if (defined $cmd and $cmd ne '') {
view release on metacpan or search on metacpan
lib/App/RecordStream/DBHandle.pm view on Meta::CPAN
my $options = shift;
my $mode = shift;
my $args = shift || \@ARGV;
my $spec = get_option_spec($mode, $options);
local @ARGV = @$args;
my $saved_settings = Getopt::Long::Configure();
Getopt::Long::Configure("pass_through");
GetOptions( %$spec );
Getopt::Long::Configure($saved_settings);
view release on metacpan or search on metacpan
xt/arguments.t view on Meta::CPAN
require_ok('bin/report-prereqs') or BAIL_OUT();
note('invalid parameter');
{
local @ARGV = ('--no-such-option');
my ( $stdout, $stderr, @result ) = capture { App::ReportPrereqs::_main() };
is( $result[0], 2, '_main() returns 2' );
ok( scalar @result == 1, '... and nothing else' );
is( $stdout, q{}, '... prints nothing to STDOUT' );
like( $stderr, qr{\Qusage: arguments.t\E}, '... prints usage to STDERR' );
}
note('to many arguments');
{
local @ARGV = qw(hello world);
my ( $stdout, $stderr, @result ) = capture { App::ReportPrereqs::_main() };
is( $result[0], 2, '_main() returns 2' );
ok( scalar @result == 1, '... and nothing else' );
is( $stdout, q{}, '... prints nothing to STDOUT' );
like( $stderr, qr{\Qusage: arguments.t\E}, '... prints usage to STDERR' );
}
note('--meta and --cpanfile');
{
local @ARGV = qw(--meta META.json --cpanfile cpanfile);
my ( $stdout, $stderr, @result ) = capture { App::ReportPrereqs::_main() };
is( $result[0], 2, '_main() returns 2' );
ok( scalar @result == 1, '... and nothing else' );
is( $stdout, q{}, '... prints nothing to STDOUT' );
like( $stderr, qr{\Qusage: arguments.t\E}, '... prints usage to STDERR' );
}
note('--meta and url');
{
local @ARGV = qw(--meta META.json http://example.com);
my ( $stdout, $stderr, @result ) = capture { App::ReportPrereqs::_main() };
is( $result[0], 2, '_main() returns 2' );
ok( scalar @result == 1, '... and nothing else' );
is( $stdout, q{}, '... prints nothing to STDOUT' );
like( $stderr, qr{\Qusage: arguments.t\E}, '... prints usage to STDERR' );
}
note('--cpanfile and url');
{
local @ARGV = qw(--cpanfile cpanfile http://example.com);
my ( $stdout, $stderr, @result ) = capture { App::ReportPrereqs::_main() };
is( $result[0], 2, '_main() returns 2' );
ok( scalar @result == 1, '... and nothing else' );
is( $stdout, q{}, '... prints nothing to STDOUT' );
view release on metacpan or search on metacpan
lib/App/RunCron/CLI.pm view on Meta::CPAN
use App::RunCron;
sub new {
my ($class, @argv) = @_;
local @ARGV = @argv;
my $p = Getopt::Long::Parser->new(
config => [qw/posix_default no_ignore_case bundling auto_help/],
);
$p->getoptions(\my %opt, qw/
logfile=s
view release on metacpan or search on metacpan
t/configure_shell.t view on Meta::CPAN
return @getpwuid_ref;
};
{
local $ENV{SHELL} = '/bin/dummy';
local @ARGV = ("$tmpdir/does_not_exist");
my ( $stdout, $stderr, @result ) = capture { App::SSH::SwitchShell::configure_shell() };
is( $result[0], $shell_from_getpwuid, "'$tmpdir/does_not_exist' returns shell from getpwuid()" );
is( $ENV{SHELL}, $shell_from_getpwuid, '... SHELL env variable is set correctly' );
is( $stdout, q{}, '... prints nothing to STDOUT' );
is( $stderr, "Shell '$tmpdir/does_not_exist' does not exist\n", '... prints that non existing shell does not exist to STDERR' );
t/configure_shell.t view on Meta::CPAN
close $fh;
chmod 0644, $shell_1;
{
local $ENV{SHELL} = '/bin/dummy';
local @ARGV = ($shell_1);
my ( $stdout, $stderr, @result ) = capture { App::SSH::SwitchShell::configure_shell() };
is( $result[0], $shell_from_getpwuid, "'$shell_1' (not executable) returns shell from getpwuid()" );
is( $ENV{SHELL}, $shell_from_getpwuid, '... SHELL env variable is set correctly' );
is( $stdout, q{}, '... prints nothing to STDOUT' );
is( $stderr, "Shell '$shell_1' is not executable\n", '... prints that shell is not executable to STDERR' );
t/configure_shell.t view on Meta::CPAN
chmod 0755, $shell_1;
SKIP: {
skip "File '$shell_1' is not executable - this OS seems to require more then chmod 0755" if !-x $shell_1;
local $ENV{SHELL} = '/bin/dummy';
local @ARGV = ($shell_1);
my ( $stdout, $stderr, @result ) = capture { App::SSH::SwitchShell::configure_shell() };
is( $result[0], $shell_1, "'$shell_1' (executable) returns '$shell_1'" );
is( $ENV{SHELL}, $shell_1, '... SHELL env variable is set correctly' );
is( $stdout, q{}, '... prints nothing to STDOUT' );
is( $stderr, q{}, '... prints nothing to STDERR' );
t/configure_shell.t view on Meta::CPAN
{
my $cwd = cwd();
chdir $tmpdir;
local $ENV{SHELL} = '/bin/dummy';
local @ARGV = ('testshell');
my ( $stdout, $stderr, @result ) = capture { App::SSH::SwitchShell::configure_shell() };
is( $result[0], $shell_from_getpwuid, q{'testshell' returns shell from getpwuid()} );
is( $ENV{SHELL}, $shell_from_getpwuid, '... SHELL env variable is set correctly' );
is( $stdout, q{}, '... prints nothing to STDOUT' );
is( $stderr, "Shell 'testshell' is not an absolute path\n", '... prints that shell is not absolute path to STDERR' );
t/configure_shell.t view on Meta::CPAN
}
chmod 0644, $shell_from_getpwuid;
{
local $ENV{SHELL} = '/bin/dummy';
local @ARGV = ();
my ( $stdout, $stderr, @result ) = capture { App::SSH::SwitchShell::configure_shell() };
is( $result[0], $shell_from_getpwuid, "no shell specified as argument returns '$shell_from_getpwuid' (not executable) from getpwuid()" );
is( $ENV{SHELL}, $shell_from_getpwuid, '... SHELL env variable is set correctly' );
is( $stdout, q{}, '... prints nothing to STDOUT' );
is( $stderr, q{}, '... prints nothing to STDERR' );
}
chmod 0644, $shell_1;
{
local $ENV{SHELL} = '/bin/dummy';
local @ARGV = ($shell_1);
my ( $stdout, $stderr, @result ) = capture { App::SSH::SwitchShell::configure_shell() };
is( $result[0], $shell_from_getpwuid, "'$shell_1' (not executbale) returns '$shell_from_getpwuid' (not executable) from getpwuid()" );
is( $ENV{SHELL}, $shell_from_getpwuid, '... SHELL env variable is set correctly' );
is( $stdout, q{}, '... prints nothing to STDOUT' );
is( $stderr, "Shell '$shell_1' is not executable\n", "... prints that '$shell_1' is not executable to STDERR" );
t/configure_shell.t view on Meta::CPAN
{
my $cwd = cwd();
chdir $tmpdir;
local $ENV{SHELL} = '/bin/dummy';
local @ARGV = ('testshell');
my ( $stdout, $stderr, @result ) = capture { App::SSH::SwitchShell::configure_shell() };
is( $result[0], $shell_from_getpwuid, "'testshell' returns '$shell_from_getpwuid' (not executable) from getpwuid()" );
is( $ENV{SHELL}, $shell_from_getpwuid, '... SHELL env variable is set correctly' );
is( $stdout, q{}, '... prints nothing to STDOUT' );
is( $stderr, "Shell 'testshell' is not an absolute path\n", '... prints not absolute path error message to STDERR' );
view release on metacpan or search on metacpan
$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;
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
devdata/Menlo-CLI-Compat.v1.9022.pm.txt view on Meta::CPAN
}
sub parse_options {
my $self = shift;
local @ARGV = @{$self->{argv}};
push @ARGV, grep length, split /\s+/, $self->env('OPT');
push @ARGV, @_;
Getopt::Long::Configure("bundling");
Getopt::Long::GetOptions(
view release on metacpan or search on metacpan
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
return $package->resume;
}
sub current {
# hmm, wonder what the right thing to do here is
local @ARGV;
return shift()->resume;
}
sub _construct {
my ($package, %input) = @_;
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
push @specs, $k . (defined $v->{type} ? $v->{type} : '');
push @specs, $v->{store} if exists $v->{store};
$args->{$k} = $v->{default} if exists $v->{default};
}
local @ARGV = @argv; # No other way to dupe Getopt::Long
# Get the options values and return them.
# XXX Add option to allow users to set options?
if ( @specs ) {
Getopt::Long::Configure('pass_through');
view release on metacpan or search on metacpan
t/03cmdline.t view on Meta::CPAN
);
foreach my $argset (@cmds) {
my ($arglist, $resultset) = @$argset;
my %results = %$resultset;
local @ARGV = @$arglist;
my $app = new App::SimpleScan;
for my $method (qw(run generate warn)) {
is ${$app->$method}, $results{$method}, "$method (@{$arglist})";
}
undef $app;
view release on metacpan or search on metacpan
lib/App/Skeletor.pm view on Meta::CPAN
print "Found user options at: $saved_options_path\n";
my $json_opts = decode_json($saved_options_path->slurp);
@args = (@args, %$json_opts);
}
local @ARGV = @args;
my ($desc ,@spec) = getopt_spec;
my ($opt, $usage) = describe_options($desc, @spec, {getopt_conf=>['pass_through']});
my ($path_to_share, $tmp) = path_to_share($opt->template);
## Templates can add or override options
if($opt->template->can('extra_getopt_spec')) {
my @new_spec = (@spec, $opt->template->extra_getopt_spec);
local @ARGV = @args;
($opt, $usage) = describe_options($desc, @new_spec);
}
my %template_var_names = (
(map { $_->{name} => $opt->${\$_->{name}} } @{$usage->{options}}),
view release on metacpan or search on metacpan
t/02-config.t view on Meta::CPAN
is($sr->username, 'keep_me');
is($sr->password, 'omfg');
$ENV{APP_SMOLDER_REPORT_CONF} = 'empty.conf';
$sr = App::Smolder::Report->new;
local @ARGV = (
"--username=userc",
"--password=passc",
"--server=serverc",
"--project-id=25",
"--delete",
t/02-config.t view on Meta::CPAN
ok($sr->delete);
ok(!$sr->dry_run);
ok(!$sr->quiet);
$sr = App::Smolder::Report->new;
local @ARGV = (
'--delete',
'--password=pass',
'--quiet',
'--dry-run'
);
view release on metacpan or search on metacpan
use warnings;
use Test::More 0.88;
use App::Software::License;
local @ARGV = ('--holder=FooBar');
my $app = App::Software::License->new_with_options;
like $app->notice, qr/^\QThis software is Copyright (c)\E/i,
'Copyright notice generated';
view release on metacpan or search on metacpan
t/11.appspecrun.t view on Meta::CPAN
my $name = "$app args: (@$args)";
$name .= ", $_=$env->{$_}" for sort keys %$env;
subtest $name => sub {
{
local @ARGV = @$args;
local %ENV = %ENV;
if ($env) {
@ENV{ keys %$env } = values %$env;
}
$runner->process;
view release on metacpan or search on metacpan
inc/Module/Build/Sqitch.pm view on Meta::CPAN
}
sub _set_findbin {
my ($self, $file) = @_;
local $^I = '';
local @ARGV = ($file);
while (<>) {
s{^use App::Sqitch}{use FindBin;\nuse lib "\$FindBin::RealBin/../lib/perl5";\nuse App::Sqitch};
print;
}
}
view release on metacpan or search on metacpan
lib/App/Stacktrace.pm view on Meta::CPAN
return;
}
sub _read_arguments {
my $self = shift;
local @ARGV = @_;
my %args;
Getopt::Long::GetOptions(
\ %args,
'help',
'm',
view release on metacpan or search on metacpan
# '--no-recursive',
'--style' => 'Test',
# '-vvvvv',
);
{
local @ARGV;
push @ARGV, @default_ARGV;
push @ARGV, 'build';
push @ARGV, $work_dir;
my $app = App::StaticImageGallery->new_with_options();
$app->run();
}
}
}
{
local @ARGV;
push @ARGV, @default_ARGV;
push @ARGV, '--no-recursive';
push @ARGV, 'clean';
push @ARGV, $work_dir;
my $app = App::StaticImageGallery->new_with_options();
}
}
}
{
local @ARGV;
push @ARGV, @default_ARGV;
push @ARGV, 'clean';
push @ARGV, $work_dir;
my $app = App::StaticImageGallery->new_with_options();
$app->run();
}
# Check rebuild
# {
# # Build
# local @ARGV;
# push @ARGV, 'build';
# push @ARGV, $work_dir;
# my $app = App::StaticImageGallery->new_with_options();
# $app->run();
# isa_ok($app, 'App::StaticImageGallery');
view release on metacpan or search on metacpan
bin/staticperl view on Meta::CPAN
sub cmd_file {
open my $fh, "<", $_[0]
or die "$_[0]: $!\n";
local @ARGV;
while (<$fh>) {
chomp;
next unless /\S/;
next if /^\s*#/;
view release on metacpan or search on metacpan
t/app-table2yaml.t view on Meta::CPAN
my ( %yml, @test );
foreach my $file ( keys %test_file ) {
my ( $name, $dir, $suffix ) = fileparse( $file, qr{\.[^.]*$} );
if ( $suffix eq q(.yml) ) {
my $yml = do { local ( @ARGV, $/ ) = $file; <> };
$yml{$name} = [ split m{\n}msx, $yml ];
next;
}
my $type = basename($dir);
view release on metacpan or search on metacpan
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
return $package->resume;
}
sub current {
# hmm, wonder what the right thing to do here is
local @ARGV;
return shift()->resume;
}
sub _construct {
my ($package, %input) = @_;
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
push @specs, $k . (defined $v->{type} ? $v->{type} : '');
push @specs, $v->{store} if exists $v->{store};
$args->{$k} = $v->{default} if exists $v->{default};
}
local @ARGV = @argv; # No other way to dupe Getopt::Long
# Get the options values and return them.
# XXX Add option to allow users to set options?
if ( @specs ) {
Getopt::Long::Configure('pass_through');
view release on metacpan or search on metacpan
lib/App/TemplateCMD.pm view on Meta::CPAN
'path|p=s',
$module->args($self),
);
{
local @ARGV = @argv;
Getopt::Long::Configure('bundling');
GetOptions( \%default, @args ) or $module = 'App::TemplateCMD::Command::Help';
$default{files} = [ @ARGV ];
}
view release on metacpan or search on metacpan
lib/App/Term/Jump.pm view on Meta::CPAN
I<Exceptions> - invalid options
=cut
local @ARGV = @_ ;
my %options = (ignore_path => []) ;
$options{db_location} = defined $ENV{APP_TERM_JUMP_DB} ? $ENV{APP_TERM_JUMP_DB} : home() . '/.jump_db' ;
$options{config_location} = defined $ENV{APP_TERM_JUMP_CONFIG} ? $ENV{APP_TERM_JUMP_CONFIG} : home() . '/.jump_config' ;
view release on metacpan or search on metacpan
lib/App/Timestamper/Format.pm view on Meta::CPAN
sub run
{
my ($self) = @_;
local @ARGV = @{ $self->{_argv} };
STDOUT->autoflush(1);
App::Timestamper::Format::Filter::TS->new->fh_filter( \*ARGV,
sub { print $_[0]; } );
view release on metacpan or search on metacpan
lib/App/Timestamper.pm view on Meta::CPAN
sub run
{
my ($self) = @_;
local @ARGV = @{ $self->{_argv} };
STDOUT->autoflush(1);
App::Timestamper::Filter::TS->new->fh_filter( \*ARGV,
sub { print $_[0]; } );
view release on metacpan or search on metacpan
lib/App/Uni.pm view on Meta::CPAN
my ($class, @argv) = @_;
my %opt;
{
my $exit;
local @ARGV = @argv;
GetOptions(
"c" => \$opt{explode},
"u" => \$opt{u_numbers},
"n" => \$opt{names},
"s" => \$opt{single},
view release on metacpan or search on metacpan
sub continuity_server {
my ($app) = @_;
chdir($app->{dir});
my $harness = "$app->{dir}/vw_harness.pl";
if (-e $harness) {
local @ARGV = %$app;
eval { do $harness; };
# ...and never return.
# But if it fails for some reason...
my $error = $@ || "$harness could not be started.";
syslog(LOG_ERR, "$app->{app}: $error");
view release on metacpan or search on metacpan
lib/Wallflower/Util.pm view on Meta::CPAN
)
}x;
sub _links_from_css {
my ( $file, $url ) = @_;
my $content = do { local ( *ARGV, $/ ); @ARGV = ("$file"); <> };
return map URI->new_abs( $_, $url ), grep defined,
$content =~ /$css_regexp/gc;
}
1;
view release on metacpan or search on metacpan
lib/App/Wx/PodEditor/Actions/File.pm view on Meta::CPAN
sub file_OpenFile {
my ($self,$event) = @_;
my $file = Wx::FileSelector( 'Open a Pod file', '', '', 'Pod file (*.pod) | *.pod' );
if( $file ){
my $content = do{ local (@ARGV,$/) = $file; <> };
$self->_editor->set_pod( $content );
}
}
sub file_SaveFile {
view release on metacpan or search on metacpan
t/unit/Script.t view on Meta::CPAN
@INC = @orig_inc;
};
subtest 'parse_new_dev_libs' => sub {
# No -D args, should return 0
local @ARGV = ('test', '--verbose');
is(App::Yath::Script::parse_new_dev_libs(), 0, 'returns 0 with no -D args');
# Stops at --
local @ARGV = ('--', '-D');
is(App::Yath::Script::parse_new_dev_libs(), 0, 'stops at --');
# Stops at ::
local @ARGV = ('::', '-D');
is(App::Yath::Script::parse_new_dev_libs(), 0, 'stops at ::');
};
subtest '_collect_dev_libs' => sub {
is([App::Yath::Script::_collect_dev_libs()], [], 'empty input -> empty list');
view release on metacpan or search on metacpan
lib/App/palien.pm view on Meta::CPAN
scalar $alien->libs;
}
sub main
{
local(undef, @ARGV) = @_;
my $bin_dir;
my $dir_sep = ' ';
my $cflags;
my $libs;
view release on metacpan or search on metacpan
lib/App/ansicolumn.pm view on Meta::CPAN
}
}
sub perform {
my $obj = shift;
local @ARGV = decode_argv(@_);
$obj->getopt || pod2usage(2);
$obj->setup_options;
warn Dumper $obj if $obj->debug;