Result:
found more than 1414 distributions - search limited to the first 2001 files matching your query
( run in 0.514 )
CGI-Deurl-XS
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;
CGI-ExtDirect
view release on metacpan or search on metacpan
examples/p5httpd view on Meta::CPAN
chdir "$server_root$dir"
or return logerr 500, "Cannot chdir to $server_root$dir: $!";
$script_path =~ s/[A-Z]://;
# command line decoding, cf description at http://hoohoo.ncsa.uiuc.edu/cgi/cl.html:
local @ARGV;
unless ( $arglist =~ /=/ ) {
$arglist =~
s/%([\dA-Fa-f]{2})/chr(hex($1))/eg; # decode arglist, e.g. %20 -> space
@ARGV = split /\s+/, $arglist;
}
CGI-Info
view release on metacpan or search on metacpan
t/40-more.t view on Meta::CPAN
# Test basic parameter parsing
subtest 'Basic parameter parsing' => sub {
my $info = new_ok('CGI::Info');
# Test command line mode
local @ARGV = ('name=John', 'age=30');
my $params = $info->params();
is($params->{name}, 'John', 'Command line parameter parsing');
is($params->{age}, '30', 'Multiple command line parameters');
};
t/40-more.t view on Meta::CPAN
my $info = CGI::Info->new();
delete $ENV{'GATEWAY_INTERFACE'};
delete $ENV{'REQUEST_METHOD'};
delete $ENV{'QUERY_STRING'};
local @ARGV = ('allowed=yes', 'forbidden=no');
my $params = $info->params(
allow => {
allowed => undef, # Any value allowed
# forbidden parameter not in allow list
t/40-more.t view on Meta::CPAN
# Test regex validation
subtest 'Regex validation' => sub {
my $info = CGI::Info->new();
local @ARGV = ('user_id=123', 'invalid_id=abc');
my $params = $info->params(
allow => {
user_id => qr/^\d+$/, # Numbers only
invalid_id => qr/^\d+$/, # Should fail
t/40-more.t view on Meta::CPAN
# Test exact match validation
subtest 'Exact match validation' => sub {
my $info = CGI::Info->new();
local @ARGV = ('action=login', 'action2=register');
my $params = $info->params(
allow => {
action => 'login', # Exact match required
action2 => 'login', # Should fail
t/40-more.t view on Meta::CPAN
# Test custom validation subroutines
subtest 'Custom validation subroutines' => sub {
my $info = CGI::Info->new();
local @ARGV = ('even=4', 'odd=3', 'negative=-5');
my $params = $info->params(
allow => {
even => sub {
my ($key, $value, $info_obj) = @_;
t/40-more.t view on Meta::CPAN
plan skip_all => 'Params::Validate::Strict not available'
unless eval { require Params::Validate::Strict; 1 };
my $info = CGI::Info->new();
local @ARGV = ('age=25', 'invalid_age=200');
my $params = $info->params(
allow => {
age => {
type => 'integer',
t/40-more.t view on Meta::CPAN
delete $ENV{'GATEWAY_INTERFACE'};
delete $ENV{'REQUEST_METHOD'};
delete $ENV{'QUERY_STRING'};
my $info = CGI::Info->new();
local @ARGV = ('cached=value');
my $params1 = $info->params();
my $params2 = $info->params();
is($params1, $params2, 'Parameters are cached on repeat calls');
t/40-more.t view on Meta::CPAN
# Test param() method
subtest 'param() method' => sub {
my $info = CGI::Info->new();
local @ARGV = ('name=John', 'age=30');
is($info->param('name'), 'John', 'Single parameter retrieval');
is($info->param('age'), '30', 'Numeric parameter as string');
is($info->param('missing'), undef, 'Missing parameter returns undef');
t/40-more.t view on Meta::CPAN
# Test param() with allow list
subtest 'param() with allow list' => sub {
my $info = CGI::Info->new(carp_on_warn => 1);
local @ARGV = ('allowed=yes', 'forbidden=no');
# Set up allow list
$info->params(allow => { allowed => undef });
is($info->param('allowed'), 'yes', 'Allowed parameter accessible via param()');
t/40-more.t view on Meta::CPAN
# Test edge cases and error conditions
subtest 'Edge cases and error conditions' => sub {
my $info = CGI::Info->new();
# Test empty parameters
local @ARGV = ();
my $params = $info->params();
ok(!defined($params), 'Empty parameters return undef');
# Test malformed key=value pairs
local @ARGV = ('=value', 'key=', 'malformed');
$params = $info->params();
ok(!exists($params->{''}), 'Empty key ignored');
is($params->{key}, undef, 'Empty value handled correctly');
ok(!exists($params->{malformed}), 'Malformed pair without = ignored');
t/40-more.t view on Meta::CPAN
# Test URL decoding
subtest 'URL decoding' => sub {
my $info = CGI::Info->new();
local @ARGV = ('name=John%20Doe', 'email=test%40example.com', 'plus=a+b');
my $params = $info->params();
is($params->{name}, 'John Doe', 'Space decoding from %20');
is($params->{email}, 'test@example.com', 'At symbol decoding from %40');
t/40-more.t view on Meta::CPAN
# Test duplicate parameter handling
subtest 'Duplicate parameter handling' => sub {
my $info = CGI::Info->new();
# Simulate duplicate parameters (normally from query string)
local @ARGV = ('tag=red', 'tag=blue', 'tag=green');
my $params = $info->params();
# Should combine with commas
is($params->{tag}, 'red,blue,green', 'Duplicate parameters combined with commas');
t/40-more.t view on Meta::CPAN
delete $ENV{'REQUEST_METHOD'};
delete $ENV{'QUERY_STRING'};
my $info = CGI::Info->new();
# Test robot flag
local @ARGV = ('--robot', 'param=value');
my $params = $info->params();
ok($info->{is_robot}, 'Robot flag sets is_robot');
is($params->{param}, 'value', 'Parameters parsed after flag');
# Test mobile flag
$info = CGI::Info->new();
local @ARGV = ('--mobile', 'device=phone');
$params = $info->params();
ok($info->{is_mobile}, 'Mobile flag sets is_mobile');
# Test search engine flag
$info = CGI::Info->new();
local @ARGV = ('--search-engine', 'bot=google');
$params = $info->params();
ok($info->{is_search_engine}, 'Search engine flag sets is_search_engine');
# Test tablet flag
$info = CGI::Info->new();
local @ARGV = ('--tablet', 'screen=large');
$params = $info->params();
ok($info->{is_tablet}, 'Tablet flag sets is_tablet');
};
t/40-more.t view on Meta::CPAN
my @large_argv;
for my $i (1..1000) {
push @large_argv, "param$i=value$i";
}
local @ARGV = @large_argv;
my $start_time = time;
my $params = $info->params();
my $end_time = time;
t/40-more.t view on Meta::CPAN
push @log_messages, @_;
};
my $info = CGI::Info->new();
local @ARGV = ('test=value');
my $params = $info->params(logger => $mock_logger);
# Should have debug messages about parameters
ok(@log_messages > 0, 'Logger received messages');
t/40-more.t view on Meta::CPAN
delete $ENV{'REQUEST_METHOD'};
delete $ENV{'QUERY_STRING'};
my $info = CGI::Info->new();
local @ARGV = ('param=value');
my $params = $info->params();
# Test that Return::Set constraints are applied
returns_is($params, { type => 'hashref', min => 1 }, 'Returns::Set returns what we expect');
CIAO-Lib-Param
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') {
CLI-Dispatch
view release on metacpan or search on metacpan
t/lib/CLIDTestClass/Basic/Basic.pm view on Meta::CPAN
}
sub dispatch {
my $class = shift;
local @ARGV = @_;
my $ret;
try { $ret = CLI::Dispatch->run('CLIDTest::Basic') }
catch { $ret = $_ || 'Obscure error' };
CLI-Osprey
view release on metacpan or search on metacpan
lib/CLI/Osprey/Role.pm view on Meta::CPAN
sub new_with_options {
my ($class, %params) = @_;
my %config = $class->_osprey_config;
local @ARGV = @ARGV if $config{protect_argv};
if (!defined $params{invoked_as}) {
$params{invoked_as} = Getopt::Long::Descriptive::prog_name();
}
lib/CLI/Osprey/Role.pm view on Meta::CPAN
my $usage;
if (@messages && blessed($messages[0]) && $messages[0]->isa('CLI::Osprey::Descriptive::Usage')) {
$usage = shift @messages;
} else {
local @ARGV = ();
(undef, $usage) = $class->parse_options(help => 1);
}
my $message;
$message = join("\n", @messages, '') if @messages;
lib/CLI/Osprey/Role.pm view on Meta::CPAN
sub osprey_help {
my ($class, $code, $usage) = @_;
unless (defined $usage && blessed($usage) && $usage->isa('CLI::Osprey::Descriptive::Usage')) {
local @ARGV = ();
(undef, $usage) = $class->parse_options(help => 1);
}
my $message = $usage->option_help . "\n";
lib/CLI/Osprey/Role.pm view on Meta::CPAN
sub osprey_man {
my ($class, $usage, $output) = @_;
unless (defined $usage && blessed($usage) && $usage->isa('CLI::Osprey::Descriptive::Usage')) {
local @ARGV = ();
(undef, $usage) = $class->parse_options(man => 1);
}
my $tmpdir = Path::Tiny->tempdir;
my $podfile = $tmpdir->child("help.pod");
CLI-Popt
view release on metacpan or search on metacpan
easyxs/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;
easyxs/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') {
CLI-Simple
view release on metacpan or search on metacpan
t/01-cli-simple.t view on Meta::CPAN
########################################################################
subtest 'happy path' => sub {
########################################################################
local @ARGV = qw(--foo --bar=buz foo);
my $app = CLI::Simple->new( commands => { foo => \&foo }, option_specs => \@options );
ok( $app->get_foo, 'foo set' );
ok( $app->get_bar eq 'buz', 'bar set' );
t/01-cli-simple.t view on Meta::CPAN
########################################################################
subtest 'bad option' => sub {
########################################################################
local @ARGV = '--bad-option foo';
exits_ok { CLI::Simple->new( commands => { foo => \&foo }, option_specs => \@options ), 1, 'called exit' };
};
########################################################################
subtest 'option alias' => sub {
########################################################################
local @ARGV = qw(--foo --bar=buz foo);
my $app = CLI::Simple->new(
commands => { foo => \&foo },
alias => { options => { biz => 'bar' } },
option_specs => \@options
t/01-cli-simple.t view on Meta::CPAN
ok( $app->get_foo, 'foo set' );
ok( $app->get_bar eq 'buz', 'bar set' );
ok( $app->get_biz eq 'buz', 'biz set' );
local @ARGV = qw(--foo --biz=buz foo);
$app = CLI::Simple->new(
commands => { foo => \&foo },
alias => { options => { biz => 'bar' } },
option_specs => \@options
t/01-cli-simple.t view on Meta::CPAN
};
########################################################################
subtest 'run' => sub {
########################################################################
local @ARGV = qw(--foo --bar=buz foo);
my $app = CLI::Simple->new(
commands => { foo => \&foo },
alias => { options => { biz => 'bar' } },
option_specs => \@options
t/01-cli-simple.t view on Meta::CPAN
};
########################################################################
subtest 'alias precedence and symmetry' => sub {
########################################################################
local @ARGV = qw(--bar=2 --biz=9 go); # biz is alias for bar
my $got;
my $app = CLI::Simple->new(
commands => { go => sub { $got = \%ENV } }, # or capture parsed opts via a hook
t/01-cli-simple.t view on Meta::CPAN
};
########################################################################
subtest 'command alias' => sub {
########################################################################
local @ARGV = qw(--foo --bar=buz fiz);
my $app = CLI::Simple->new(
commands => { foo => \&foo },
alias => { options => { biz => 'bar' }, commands => { fiz => 'foo' } },
option_specs => \@options
t/01-cli-simple.t view on Meta::CPAN
};
########################################################################
subtest 'command abbreviations' => sub {
########################################################################
local @ARGV = qw(--foo --bar=buz fuzz);
my $app = CLI::Simple->new(
commands => { fuzzball => \&foo },
alias => { options => { biz => 'bar' } },
option_specs => \@options,
abbreviations => 1,
);
stdout_is( sub { $app->run() }, 'Hello World!' );
local @ARGV = qw(--foo --bar=buz fuzz);
eval {
CLI::Simple->new(
commands => {
fuzzball => \&foo,
t/01-cli-simple.t view on Meta::CPAN
};
########################################################################
subtest 'ambiguous abbrev croaks' => sub {
########################################################################
local @ARGV = qw(run); # both runit and runner exist
eval {
CLI::Simple->new(
commands => { runit => sub { }, runner => sub { } },
abbreviations => 1,
CLI-Startup
view release on metacpan or search on metacpan
t/getopts.t view on Meta::CPAN
no warnings 'qw';
# Test list-y options
{
local @ARGV = qw/ --x=a,b --x=c --x="d,1" --x "e,2","f,3",g /;
my $options = startup({ 'x=s@' => 'listy x option' });
is_deeply $options->{x},
[qw/a b c d,1 e,2 f,3 g/],
"Listy options";
}
# Invalid list-y options should fail
{
local @ARGV = ( "--x=b,\0", "--x=a" );
trap { startup({ 'x=s@' => 'listy x option' }) };
like $trap->stderr, qr/FATAL.*Can't parse/, "Parse dies on invalid CSV";
ok $trap->stdout eq '', "Nothing printed to stdout";
ok $trap->exit == 1, "Correct exit status";
}
# Test hash-y options
{
local @ARGV = qw/ --x=a=1 --x b=2 --x c=3=2+1 /;
my $options = startup({ 'x=s%' => 'hashy x option' });
is_deeply $options->{x},
{ a => 1, b => 2, c => '3=2+1' },
"Hashy options";
}
# Do it again, grouping multiple hash elements together
{
local @ARGV = qw/ --x=a=1,b=2,c=3=2+1,"d=a,b" /;
my $options = startup({ 'x=s%' => 'hashy x option' });
is_deeply $options->{x},
{ a => 1, b => 2, c => '3=2+1', d => 'a,b' },
"Hashy options combined using commas";
}
# Test incremental options
{
local @ARGV = ('--x')x10;
my $options = startup({ 'x+' => 'incremental x option' });
ok $options->{x} == 10, "Incremental options";
}
# Negatable options
{
local @ARGV = ( '--no-x' );
my $options = startup({ 'x!' => 'negatable x option' });
ok $options->{x} == 0, "Negatable options";
}
# Option with an alias
{
local @ARGV = ( map { "--x$_" } 0..9 );
my $optspec = join("|", map {"x$_"} 0..9 ) . "+";
my $options = startup({ $optspec => 'Option with aliases' });
ok $options->{x0} == 10, "Option with aliases";
}
CMS-MediaWiki
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;
CORBA-omniORB
view release on metacpan or search on metacpan
omnithreads/ppport.h view on Meta::CPAN
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;
omnithreads/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') {
CPAN-Digger
view release on metacpan or search on metacpan
use CPAN::Digger::CLI;
subtest recent_in_memory => sub {
my ($out, $err, $exit) = capture {
local @ARGV = ('--recent', '2', '--report', '--log', 'OFF');
CPAN::Digger::CLI::run();
};
is $err, '', 'STDERR';
my $expected_out = path('t/files/recent_in_memory.out')->slurp;
CPAN-Flatten
view release on metacpan or search on metacpan
lib/CPAN/Flatten/CLI.pm view on Meta::CPAN
use Pod::Usage 'pod2usage';
use CPAN::Flatten;
sub run {
my $class = shift;
local @ARGV = @_;
GetOptions
"h|help" => sub { pod2usage(-verbose => 1) },
"version" => sub { print "CPAN::Flatten $CPAN::Flatten::VERSION\n"; exit },
"v|verbose" => \my $verbose,
"q|quiet" => \my $quiet,
CPAN-Meta
view release on metacpan or search on metacpan
t/load-bad.t view on Meta::CPAN
use CPAN::Meta;
use File::Spec;
use IO::Dir;
sub _slurp { do { local(@ARGV,$/)=shift(@_); <> } }
delete $ENV{PERL_YAML_BACKEND};
delete $ENV{PERL_JSON_BACKEND};
delete $ENV{CPAN_META_JSON_BACKEND};
delete $ENV{CPAN_META_JSON_DECODER};
CPAN-Mini-Inject-REST
view release on metacpan or search on metacpan
inc/Module/Install/Catalyst.pm view on Meta::CPAN
else {
my $p = Getopt::Long::Parser->new(config => ['no_ignore_case']);
my %o;
require Text::ParseWords;
{
local @ARGV = Text::ParseWords::shellwords($optstring);
$p->getoptions(\%o, PAR::Packer->options);
}
%PAROPTS = ( %PAROPTS, %o);
}
}
CPAN-Mini-ProjectDocs
view release on metacpan or search on metacpan
scripts/mcd view on Meta::CPAN
#~ I<Exceptions> - exits if an invalid option is passed
#~ =cut
my (@arguments) = @_ ;
local @ARGV = @arguments ;
my ($search, $browse, $html_index, $user_defined_browser, $cpan_mini_user_location) ;
unless
(
CPAN-Mini
view release on metacpan or search on metacpan
return $tempdir;
}
subtest "defaults" => sub {
local $ENV{HOME} = config_dir;
local @ARGV = @LR_ARGS;
my $minicpan = CPAN::Mini::App->initialize_minicpan;
isa_ok($minicpan, 'CPAN::Mini');
is($minicpan->log_level, 'info', "default log level is info");
};
subtest "--debug" => sub {
local $ENV{HOME} = config_dir;
local @ARGV = (qw(--debug), @LR_ARGS);
my $minicpan = CPAN::Mini::App->initialize_minicpan;
isa_ok($minicpan, 'CPAN::Mini');
is($minicpan->log_level, 'debug', "--debug to get log level debug");
};
subtest "config: log_level" => sub {
local $ENV{HOME} = config_dir({ log_level => 'debug' });
local @ARGV = @LR_ARGS;
my $minicpan = CPAN::Mini::App->initialize_minicpan;
isa_ok($minicpan, 'CPAN::Mini');
is($minicpan->log_level, 'debug', "debug from config file");
};
subtest "--debug overrides config" => sub {
local $ENV{HOME} = config_dir({ log_level => 'fatal' });
local @ARGV = (qw(--debug), @LR_ARGS);
my $minicpan = CPAN::Mini::App->initialize_minicpan;
isa_ok($minicpan, 'CPAN::Mini');
is($minicpan->log_level, 'debug', "--debug overrides config file");
};
subtest "--log-level" => sub {
local $ENV{HOME} = config_dir;
local @ARGV = (qw(--log-level debug), @LR_ARGS);
my $minicpan = CPAN::Mini::App->initialize_minicpan;
isa_ok($minicpan, 'CPAN::Mini');
is($minicpan->log_level, 'debug', "--debug to get log level debug");
for my $combo (
[ qw(--debug -q) ],
[ qw(--debug --log-level debug) ],
) {
local $ENV{HOME} = config_dir;
local @ARGV = (@$combo, @LR_ARGS);
my $minicpan = eval { CPAN::Mini::App->initialize_minicpan };
like($@, qr/can't mix/, "can't use @$combo together");
};
};
for my $switch (qw(-qq --qq)) {
subtest "extra quiet with $switch" => sub {
local $ENV{HOME} = config_dir;
local @ARGV = ($switch, @LR_ARGS);
my $minicpan = CPAN::Mini::App->initialize_minicpan;
isa_ok($minicpan, 'CPAN::Mini');
is($minicpan->log_level, 'fatal', "$switch gets us log level 'fatal'");
subtest "-perl switch" => sub {
local $ENV{HOME} = config_dir;
local @ARGV = @LR_ARGS;
my $minicpan = CPAN::Mini::App->initialize_minicpan;
isa_ok($minicpan, 'CPAN::Mini');
is($minicpan->{skip_perl}, 1, "'skip_perl' is true without -perl switch");
local @ARGV = ('-perl', @LR_ARGS);
$minicpan = CPAN::Mini::App->initialize_minicpan;
isa_ok($minicpan, 'CPAN::Mini');
is($minicpan->{skip_perl}, q{}, "'skip_perl' is false with -perl switch");
};
CPAN-Mirror-Tiny
view release on metacpan or search on metacpan
lib/CPAN/Mirror/Tiny/CLI.pm view on Meta::CPAN
}
sub parse_options {
my $self = shift;
local @ARGV = @_;
my $parser = Getopt::Long::Parser->new(
config => [qw(no_auto_abbrev no_ignore_case pass_through)],
);
$parser->getoptions(
"h|help" => sub { $self->cmd_help; exit },
CPAN-Reporter
view release on metacpan or search on metacpan
t/10_prereq_computed.t view on Meta::CPAN
print $tmpfh <<EOF;
Bogus::ComputedVersion 0 1.00
EOF
close $tmpfh or die $!;
local @ARGV = $tmpfile;
local @INC = (@INC, "$FindBin::RealBin/perl5lib");
## open stdout to a variable
open OLDOUT, ">&", \*STDOUT;
close STDOUT;
CPAN-Static
view release on metacpan or search on metacpan
my ($guts, $ec);
sub _mod2pm { (my $mod = shift) =~ s{::}{/}g; return "$mod.pm" }
sub _path2mod { (my $pm = shift) =~ s{/}{::}g; return substr $pm, 5, -3 }
sub _mod2dist { (my $mod = shift) =~ s{::}{-}g; return $mod; }
sub _slurp { do { local (@ARGV,$/)=$_[0]; <> } }
sub capture(&) {
my $callback = shift;
my $output;
open my $fh, '>', \$output;
CPAN-Testers-ParseReport
view release on metacpan or search on metacpan
lib/CPAN/Testers/ParseReport.pm view on Meta::CPAN
print STDERR $report, "\n================\n" unless $Opt{quiet};
}
if ($Opt{interactive}) {
eval { require IO::Prompt; 1; } or
die "Option '--interactive' requires IO::Prompt installed";
local @ARGV;
local $ARGV;
my $ans = IO::Prompt::prompt
(
-p => "View $id? [onechar: ynq] ",
-d => "y",
CPAN
view release on metacpan or search on metacpan
lib/App/Cpan.pm view on Meta::CPAN
my $logger;
sub run
{
my( $class, @args ) = @_;
local @ARGV = @args;
my $return_value = HEY_IT_WORKED; # assume that things will work
$logger = $class->_init_logger;
$logger->debug( "Using logger from @{[ref $logger]}" );
CSS-Croco
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') {
CSS-Sass
view release on metacpan or search on metacpan
bin/psass.pl view on Meta::CPAN
# get cmd arg encoding
use Encode::Locale qw();
# convert cmd args to utf8
use Encode qw(decode encode);
# now just decode every command arguments
@ARGV = map { decode(locale => $_, 1) } @ARGV;
####################################################################################################
# config variables
####################################################################################################
CXC-Form-Tiny-Plugin-OptArgs2
view release on metacpan or search on metacpan
t/required.t view on Meta::CPAN
my $form = My::Form->new;
subtest 'present' => sub {
local @ARGV = qw( --file foo );
my $optargs = $form->optargs;
is(
$optargs,
array {
Cache-Memcached-XS
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;
Cache-Swifty
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;
Cache-utLRU
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') {
Cairo
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') {
Canella
view release on metacpan or search on metacpan
lib/Canella/CLI.pm view on Meta::CPAN
use Guard;
sub parse_argv {
my ($self, $ctx, @argv) = @_;
local @ARGV = @argv;
my $p = Getopt::Long::Parser->new;
$p->configure(qw(
posix_default
no_ignore_case
auto_help
( run in 0.514 second using v1.01-cache-2.11-cpan-4face438c0f )