view release on metacpan or  search on metacpan

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;

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

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' };

 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");

 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') {

 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";
}

 view release on metacpan or  search on metacpan

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;

 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') {

 view release on metacpan or  search on metacpan

t/01-cli.t  view on Meta::CPAN

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;

 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,

 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};

 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);
    }
}

 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
	(

 view release on metacpan or  search on metacpan

t/app.t  view on Meta::CPAN

  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");

t/app.t  view on Meta::CPAN

  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'");

t/app.t  view on Meta::CPAN

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");
};

 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 },

 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;

 view release on metacpan or  search on metacpan

t/simple.t  view on Meta::CPAN

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;

 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",

 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]}" );

 view release on metacpan or  search on metacpan

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;

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

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
####################################################################################################

 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 {

 view release on metacpan or  search on metacpan

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;

 view release on metacpan or  search on metacpan

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;

 view release on metacpan or  search on metacpan

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;

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

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;

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

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

 view release on metacpan or  search on metacpan

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;

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

t/18-custom-capture.t  view on Meta::CPAN

} stdout => $out_fh, stderr => $err_fh;

$out_fh->close;
$err_fh->close;

is( scalar do {local (@ARGV,$/) = $temp_out; <>} , "foo\n",
  "captured STDOUT to custom handle (IO::File)"
);
is( scalar do {local (@ARGV,$/) = $temp_err; <>} , "bar\n",
  "captured STDERR to custom handle (IO::File)"
);

unlink $_ for $temp_out, $temp_err;

t/18-custom-capture.t  view on Meta::CPAN

} stdout => $out_fh, stderr => $err_fh;

$out_fh->close;
$err_fh->close;

is( scalar do {local (@ARGV,$/) = $temp_out; <>} , "foo\n",
  "captured STDOUT to custom handle (GLOB)"
);
is( scalar do {local (@ARGV,$/) = $temp_err; <>} , "bar\n",
  "captured STDERR to custom handle (GLOB)"
);

unlink $_ for $temp_out, $temp_err;

 view release on metacpan or  search on metacpan

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;

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

lib/Catalyst/Helper/FastCGI/ExternalServer.pm  view on Meta::CPAN

}

sub _parse_args {
    my ( $self, $config, @args ) = @_;

    local @ARGV = ();

    foreach (@args) {
        my ( $key, $value ) = split /=/;
        $key ||= $_;