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
t/Ambrosia/Options.t view on Meta::CPAN
{
my $options_spec = shift;
my $opt = shift;
my $param = shift;
my $val = shift;
local @ARGV = @$opt;
my $o = new Ambrosia::CommonGatewayInterface::Options(options_spec=>$options_spec);
$o->open();
ok($o->input_data($param) eq $val, "input_data: $param == $val");
}
view release on metacpan or search on metacpan
t/03_cli_opt.t view on Meta::CPAN
use Test::Output;
use Amon2::CLI 'MyApp';
{
local @ARGV = ('--option' => 'bar!');
Test::Output::stdout_is {
MyApp->bootstrap->run('Bar');
} 'bar!', 'cli options';
}
view release on metacpan or search on metacpan
lib/Anego/CLI.pm view on Meta::CPAN
use Anego::Logger;
sub run {
my ($self, @args) = @_;
local @ARGV = @args;
my $parser = Getopt::Long::Parser->new(
config => [ "no_ignore_case", "pass_through" ],
);
$parser->getoptions(
"config=s" => \$Anego::Config::CONFIG_PATH,
view release on metacpan or search on metacpan
src/ppport.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;
src/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
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
example/client_simple.pl view on Meta::CPAN
use AnyEvent;
use AnyEvent::Finger qw( finger_client );
my $done = AnyEvent->condvar;
finger_client 'localhost', shift @ARGV, sub {
my($lines) = @_;
print "[response]\n";
print join "\n", @$lines;
print "\n";
$done->send;
view release on metacpan or search on metacpan
examples/pktproxy.pl view on Meta::CPAN
Usage:
$0 local_port dst_host[:dst_port] [header_templ]
EOU
my ($local_port, $dst, $header_templ) = @ARGV;
my ($dst_host, $dst_port) = $dst =~ /^(.*?)(?::(\d+))?$/;
defined $dst_host or die "invalid destination host expecification\n";
$dst_port = $local_port unless defined $dst_port;
tcp_server undef, $local_port, sub { PacketProxy->new($_[0], $dst_host, $dst_port) };
view release on metacpan or search on metacpan
pbc/generate_doc.pl view on Meta::CPAN
use 5.012;
use strict;
use warnings;
use FindBin qw($Bin);
my @content = split(m|\n|, do{local(@ARGV,$/)="$Bin/riak.proto";(<>)});
my $pod = "package AnyEvent::Riak::Documentation;\n\n1;\n\n";
my $current_comment = '';
my $request_name = '';
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
$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
lib/Apache/TestRun.pm view on Meta::CPAN
# new paths, and force a complete cleanup. if we don't fixup the
# config files, the cleanup process won't be able to locate files
# to delete and re-configuration will fail
{
# in place editing
local @ARGV = $config_file;
local $^I = ".bak"; # Win32 needs a backup
while (<>) {
s{$cfg_top_dir}{$cur_top_dir}g;
print;
}
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
$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
$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
$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/Apache2/Translation.pm view on Meta::CPAN
die Apache2::Translation::Error->new( loc=>$loc, code=>$code||302 );
},
call=>sub {
my ($action, $what)=@_;
local @ARGV;
($what, @ARGV)=handle_eval( $what );
my @l=$cf->{provider}->fetch( $KEY, $what );
@l=$cf->{provider}->fetch( '*', $what ) unless( @l );
process( @l );
return 1;
view release on metacpan or search on metacpan
lib/App/AYCABTU.pm view on Meta::CPAN
}
}
sub get_options {
my $self = shift;
local @ARGV = @_;
GetOptions(
'file=s' => sub { $self->file($_[1]) },
'verbose' => sub { $self->verbose(1) },
'quiet' => sub { $self->quiet(1) },
'list' => sub { $self->action('list') },
view release on metacpan or search on metacpan
lib/App/Adenosine.pm view on Meta::CPAN
my $self = { %$args };
bless $self, $class;
local @ARGV = @{$self->argv};
my $action = shift @ARGV;
my $uri_base = $self->uri_base;
view release on metacpan or search on metacpan
lib/App/Aphra.pm view on Meta::CPAN
require App::HTTPThis;
if ($@) {
croak "App::HTTPThis must be installed for 'serve' command";
}
local @ARGV = $self->config->{target};
App::HTTPThis->new->run;
}
sub version {
my $me = path($0)->basename;
view release on metacpan or search on metacpan
lib/App/BCSSH/Options.pm view on Meta::CPAN
my %opts;
my @parse_args = map {
("$arguments{$_}" => \($opts{$_}))
} keys %arguments;
{
local @ARGV = @$args;
local $SIG{__WARN__} = $arg_error;
$parser->getoptions(@parse_args) or $error->();
@$args = @ARGV;
}
for my $k (keys %opts) {
view release on metacpan or search on metacpan
lib/App/BCVI/NotifyClient.pm view on Meta::CPAN
sub _notify_get_options {
my($self, @args) = @_;
local(@ARGV) = @args;
my %opt = ();
Getopt::Long::GetOptions(\%opt,
'--idle|i:i',
'--output|o:i',
'--tty|t=s',
view release on metacpan or search on metacpan
my($class, @args) = @_;
my $opt = $class->option_defaults();
my @cfg = $class->getopt_config();
local(@ARGV) = @args;
Getopt::Long::GetOptions($opt, @cfg) or $class->die_synopsis();
my $handler = $opt->{listener}
? $class->server_class
: $class->client_class;
view release on metacpan or search on metacpan
lib/App/Base/Script/Common.pm view on Meta::CPAN
sub _parse_arguments {
my $self = shift;
my $args = shift;
local @ARGV = (@$args);
# Build the hash of options to pass to Getopt::Long
my $options = $self->all_options;
my %options_hash = ();
my %getopt_args = ();
view release on metacpan or search on metacpan
lib/App/BashHistoryUtils.pm view on Meta::CPAN
undef $main::TS;
}
};
}
local @ARGV = ($histfile);
my $stdout = Capture::Tiny::capture_stdout(
sub {
Bash::History::Read::each_hist($code);
}
);
view release on metacpan or search on metacpan
scripts/lastaccess view on Meta::CPAN
my $elps = sprintf "%.6f" , tv_interval $start_time ;
say STDERR CYAN "Files processed : $num ; Shown above : $shown ; Elapsed seconds : $elps" ;
}
sub HELP_MESSAGE { # <-- - サブコマンドãŒå‘¼ã°ã‚Œã¦ã„ã‚‹ã¨ãã¯ãã®ãƒ˜ãƒ«ãƒ—ãŒå‘¼ã°ã‚Œã‚‹ã€‚
local @ARGV = do { my ($x,@y) = 0 ; 1 while ( @y = caller $x++ )[ 0 ] eq "Getopt::Std" ; $y[1] } ;
Pod::Perldoc -> run ;
}
sub VERSION_MESSAGE { $ Getopt::Std::STANDARD_HELP_VERSION = 1 } # <- here?
view release on metacpan or search on metacpan
script/block-web-flooders view on Meta::CPAN
}
sub action_unblock_all {
_init();
local @ARGV = keys %Blocked;
_block_or_unblock_ips("unblock");
_set_need_reload(1);
}
sub action_run {
view release on metacpan or search on metacpan
t/lib/TestAppBuild.pm view on Meta::CPAN
local $Test::Builder::Level = $Test::Builder::Level + 1;
eq_or_diff( $found, $fixed_tree );
}
sub touch_file {
local @ARGV = $_[0];
ExtUtils::Command::touch();
}
1;
view release on metacpan or search on metacpan
t/01-App-CPAN-Mini-Visit.t view on Meta::CPAN
} => \$stdout,
\$stderr;
};
catch my $err;
ok( -f $tempfile, "[$label] output file created" );
my @found = map { chomp; $_ } do { local @ARGV = ($tempfile); <> };
is( $stdout, '', "[$label] saw no output on terminal" );
is_deeply( \@found, \@files, "[$label] listing correct" );
}