view release on metacpan or search on metacpan
inc/Perl/Tidy.pm view on Meta::CPAN
prefilter => undef,
postfilter => undef,
);
# don't overwrite callers ARGV
local @ARGV = @ARGV;
my %input_hash = @_;
if ( my @bad_keys = grep { !exists $defaults{$_} } keys %input_hash ) {
local $" = ')(';
inc/Perl/Tidy.pm view on Meta::CPAN
#---------------------------------------------------------------
# set the defaults by passing the above list through GetOptions
#---------------------------------------------------------------
my %Opts = ();
{
local @ARGV;
my $i;
# do not load the defaults if we are just dumping perltidyrc
unless ( $dump_options_type eq 'perltidyrc' ) {
for $i (@$rdefaults) { push @ARGV, "--" . $i }
inc/Perl/Tidy.pm view on Meta::CPAN
die $death_message if ($death_message);
# process any .perltidyrc parameters right now so we can
# localize errors
if (@$rconfig_list) {
local @ARGV = @$rconfig_list;
expand_command_abbreviations( $rexpansion, \@raw_options,
$config_file );
if ( !GetOptions( \%Opts, @$roption_string ) ) {
die
"Error in this config file: $config_file \nUse -npro to ignore this file, -h for help'\n";
}
# Anything left in this local @ARGV is an error and must be
# invalid bare words from the configuration file. We cannot
# check this earlier because bare words may have been valid
# values for parameters. We had to wait for GetOptions to have
# a look at @ARGV.
if (@ARGV) {
view release on metacpan or search on metacpan
lib/MooseX/Getopt/Defanged.pm view on Meta::CPAN
map { $_->get_full_specification($type_metadata) } @option_attributes;
my $parse_worked;
{
local @ARGV = @{$argv_ref};
open my $stderr_handle, '>', \$stderr;
$parse_worked = _getopt_invoke_getopt_long_while_handling_exceptions(
$parser, $stderr_handle, \%option_values, \@specification_strings,
);
view release on metacpan or search on metacpan
t/01_basic.t view on Meta::CPAN
throws_ok {
MyTestClass->new_with_options();
} qr/First parameter ins't Getopt::Kingpin instance/, 'kingpin instance';
{
local @ARGV = ();
my $kingpin = Getopt::Kingpin->new();
exits_nonzero {
MyTestClass->new_with_options($kingpin);
} 'missing required options';
}
{
local @ARGV = ($0);
my $kingpin = Getopt::Kingpin->new();
my $my = MyTestClass->new_with_options($kingpin);
is($my->input_file, $0, 'required input_file');
is($my->lines, 10, 'default lines');
}
{
local @ARGV = ($0, '--lines', 100);
my $kingpin = Getopt::Kingpin->new();
my $my = MyTestClass->new_with_options($kingpin);
view release on metacpan or search on metacpan
lib/MooseX/Getopt/Basic.pm view on Meta::CPAN
my $constructor_params = ( @params == 1 ? $params[0] : {@params} );
my $config_from_file;
if($class->meta->does_role('MooseX::ConfigFromFile')) {
local @ARGV = @ARGV;
# just get the configfile arg now out of @ARGV; the rest of the args
# will be fetched later
my $configfile;
my $opt_parser = Getopt::Long::Parser->new( config => [ qw( no_auto_help pass_through no_auto_version ) ] );
lib/MooseX/Getopt/Basic.pm view on Meta::CPAN
sub _getopt_spec { shift->_traditional_spec(@_); }
sub _parse_argv {
my ( $class, %params ) = @_;
local @ARGV = @{ $params{params}{argv} || \@ARGV };
my ( $opt_spec, $name_to_init_arg ) = $class->_getopt_spec(%params);
# Get a clean copy of the original @ARGV
my $argv_copy = [ @ARGV ];
view release on metacpan or search on metacpan
xt/cover.pl view on Meta::CPAN
chdir '..' or die "$!";
};
do "./Build.PL";
local @ARGV = (@ARGV, 'testcover');
do "./Build";
view release on metacpan or search on metacpan
lib/MooseX/Runnable/Invocation/Scheme/MooseX/Getopt.pm view on Meta::CPAN
};
around create_instance => sub {
my ($next, $self, $class, @args) = @_;
local @ARGV = @args; # ugly!
my $instance = $class->name->new_with_options();
my $more_args = $instance->extra_argv;
return ($instance, @$more_args);
view release on metacpan or search on metacpan
lib/MouseX/App/Cmd/Command.pm view on Meta::CPAN
isa => 'MouseX::App::Cmd',
);
override _process_args => sub {
my ( $class, $args ) = @_;
local @ARGV = @{$args};
my $config_from_file;
if ( $class->meta->does_role('MouseX::ConfigFromFile') ) {
local @ARGV = @ARGV;
my $configfile;
my $opt_parser;
{
## no critic (Modules::RequireExplicitInclusion)
view release on metacpan or search on metacpan
lib/MouseX/Getopt/Basic.pm view on Meta::CPAN
sub new_with_options {
my ($class, @params) = @_;
my $config_from_file;
if($class->meta->does_role('MouseX::ConfigFromFile')) {
local @ARGV = @ARGV;
# just get the configfile arg now; the rest of the args will be
# fetched later
my $configfile;
my $opt_parser = Getopt::Long::Parser->new( config => [ qw( no_auto_help pass_through ) ] );
lib/MouseX/Getopt/Basic.pm view on Meta::CPAN
sub _getopt_spec { shift->_traditional_spec(@_); }
sub _parse_argv {
my ( $class, %params ) = @_;
local @ARGV = @{ $params{params}{argv} || \@ARGV };
my ( $opt_spec, $name_to_init_arg ) = $class->_getopt_spec(%params);
# Get a clean copy of the original @ARGV
my $argv_copy = [ @ARGV ];
view release on metacpan or search on metacpan
t/02_getopt.t view on Meta::CPAN
isa_ok $obj->dir => 'Path::Class::Dir';
isa_ok $obj->file => 'Path::Class::File';
is $obj->dir => $dir;
is $obj->file => $file;
local @ARGV = qw(--dir /tmp --file /tmp/foo);
my $opt = $class->new_with_options;
isa_ok $opt => $class;
isa_ok $opt->dir => 'Path::Class::Dir';
isa_ok $opt->file => 'Path::Class::File';
is $opt->dir => $dir;
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
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
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
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
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
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
lib/MyCPAN/App/BackPAN/Indexer.pm view on Meta::CPAN
my( $application ) = @_;
my $run_dir = dirname( $0 );
( my $script = basename( $0 ) ) =~ s/\.\w+$//;
local @ARGV = @{ $application->{args} };
getopts( 'cl:f:', \ my %Options );
# other things might want to use things from @ARGV, and
# we just removed the bits that we wanted.
$application->{args} = [ @ARGV ]; # XXX: yuck
view release on metacpan or search on metacpan
lib/MySQL/ORM/Generate/Writer.pm view on Meta::CPAN
confess "$stdout\n$stderr";
}
return;
#local @ARGV = ('-b', "-bext='/'", $file_name);
#Perl::Tidy::Sweetened::perltidy();
}
#method _tidy (Str $file_name) {
#
view release on metacpan or search on metacpan
lib/MySQL/Warmer/CLI.pm view on Meta::CPAN
my ($class, @argv) = @_;
my $parser = Getopt::Long::Parser->new(
config => [qw/posix_default no_ignore_case bundling permute pass_through auto_help/],
);
local @ARGV = @argv;
$parser->getoptions(\my %opt, qw/
host|h=s
user|u=s
password|p:s
port|P=i
view release on metacpan or search on metacpan
lib/MySQL/Workbench/DBIC.pm view on Meta::CPAN
}
sub _custom_code {
my ($self, $path) = @_;
my $content = do { local (@ARGV, $/) = $path; <> };
my ($code) = $content =~ m{
^[#] \s+ --- \s*
^[#] \s+ Put \s+ your \s+ own \s+ code \s+ below \s+ this \s+ comment \s*
^[#] \s+ --- \s*
view release on metacpan or search on metacpan
t/commandline.t view on Meta::CPAN
use Test::Trap;
use Nagios::Plugin::OverHTTP;
SKIP: {
local @ARGV = '--help';
my $skip = 0;
# Create new plugin with no arguments which means it will read from
# command line
trap { Nagios::Plugin::OverHTTP->new_with_options; };
t/commandline.t view on Meta::CPAN
unlike($output, qr/\s+--useragent\s+/msx, 'useragent should not be in usage');
}
SKIP: {
my $url = 'http://example.net/nagios/check_service';
local @ARGV = "--url=$url";
# Create new plugin with no arguments which means it will read from
# command line
my $plugin = Nagios::Plugin::OverHTTP->new_with_options;
t/commandline.t view on Meta::CPAN
is($plugin->url, $url, 'Command line arguments override perl arguments');
}
SKIP: {
my $url = 'http://example.net/nagios/check_service';
local @ARGV = split /\s+/, '--hostname=example.net --path=/nagios/check_service';
# Create new plugin with no arguments which means it will read from
# command line
my $plugin = Nagios::Plugin::OverHTTP->new_with_options;
t/commandline.t view on Meta::CPAN
is($plugin->url, $url, 'Hostname + relative URL');
}
SKIP: {
my $url = 'http://example.net/nagios/check_service';
local @ARGV = split /\s+/, "--url=$url --critical time=4 --critical other=3.5"
." --warning time=10:3 --warning other=4:";
# Create new plugin with no arguments which means it will read from
# command line
my $plugin = Nagios::Plugin::OverHTTP->new_with_options;
view release on metacpan or search on metacpan
bin/narada-lock view on Meta::CPAN
use Narada;
use Narada::Lock qw( shared_lock child_inherit_lock );
Narada::detect();
local @ARGV = @ARGV ? @ARGV : ('env', 'PS1=[SHARED] \u@\h \w \$ ', 'bash', '--norc');
shared_lock();
child_inherit_lock(1);
exec @ARGV;
view release on metacpan or search on metacpan
include/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;
include/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
share/cgi-bin/obj/date_time.pl view on Meta::CPAN
use strict;
use POSIX qw(strftime);
my $nes = Nes::Singleton->new('./date_time.html');
my $q = $nes->{'query'}->{'q'};
my $local_gmt = $q->{'local_gmt'} || $q->{'date_time_param_1'} || shift @ARGV || 'local';
my $format = $q->{'format'} || $q->{'date_time_param_2'} || "@ARGV" || '%a %e %b %Y %H:%M:%S';
my $tags = {};
$tags->{'date_time'} = POSIX::strftime( "$format", localtime ); # default
$tags->{'date_time'} = POSIX::strftime( "$format", gmtime ) if $local_gmt =~ /gmt/i;
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 || 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
$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
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
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;
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
# perlcriticrc uses Config::Tiny, which does not support nesting
if (-f ".perlcriticrc" && -s "$ENV{HOME}/.perlcriticrc") {
open my $fh, ">", ".perlcriticrc";
print $fh do {
local (@ARGV, $/) = ("$ENV{HOME}/.perlcriticrc");
<> =~ s{^hard_max = \K\d+$}{150}rm };
print $fh join "\n" => "",
"[-Community::EmptyReturn]", #
"[-Community::Wantarray]", #
"";