view release on metacpan or search on metacpan
t/App/Foo.pm view on Meta::CPAN
no Getopt::EX::Hashed;
sub run {
my $app = shift;
local @ARGV = @_;
use Getopt::Long;
$app->getopt or die;
return @ARGV;
}
t/App/Foo.pm view on Meta::CPAN
no Getopt::EX::Hashed;
sub run {
my $app = shift;
local @ARGV = @_;
use Getopt::Long;
$app->getopt or die;
return @ARGV;
}
view release on metacpan or search on metacpan
t/extensions/list.t view on Meta::CPAN
imported_ok 'getopts';
subtest 'List option specified but not used' => sub {
plan tests => 3;
local @ARGV = qw( -a foo -b );
ok getopts( 'a:I,b', my %got_opts ), 'Succeeded';
is \%got_opts, { a => 'foo', b => 1 }, 'Options properly set';
is @ARGV, 0, '@ARGV is empty'
};
subtest 'List option repeated once' => sub {
plan tests => 3;
local @ARGV = qw( -I lib -a foo -c );
ok getopts( 'a:I,c', my %got_opts ), 'Succeeded';
is \%got_opts, { I => [ 'lib' ], a => 'foo', c => 1 }, 'Options properly set';
is @ARGV, 0, '@ARGV is empty'
};
subtest 'List option repeated 2 times' => sub {
plan tests => 3;
local @ARGV = qw( -b -I lib -a foo -I local/lib/perl5 );
ok getopts( 'I,a:b', my %got_opts ), 'Succeeded';
is \%got_opts, { I => [ 'lib', 'local/lib/perl5' ], a => 'foo', b => 1 }, 'Options properly set';
is @ARGV, 0, '@ARGV is empty'
};
subtest 'List option repeated 2 times; 2nd option-argument is undefined' => sub {
plan tests => 4;
local @ARGV = qw( -I lib -a foo -c -I );
my %got_opts;
like warning { ok !getopts( 'a:cI,', %got_opts ), 'Failed' }, qr/option requires an argument -- I/, 'Check warning';
is \%got_opts, {}, '%got_opts is empty';
is \@ARGV, [ qw( -I lib -a foo -c -I ) ], '@ARGV restored'
}
view release on metacpan or search on metacpan
lib/Getopt/Helpful.pm view on Meta::CPAN
} # end subroutine Get definition
########################################################################
=head2 Get_from
Equivalent to Get(@extra), but treats @args as a localized @ARGV.
$hopt->Get_from(\@args, @extra);
=cut
sub Get_from {
my $self = shift;
my ($args, @extra) = @_;
local @ARGV = @$args;
$self->Get(@extra);
@$args = @ARGV;
} # end subroutine Get_from definition
########################################################################
view release on metacpan or search on metacpan
t/01_string.t view on Meta::CPAN
use Test::More 0.98;
use Getopt::Kingpin;
subtest 'string normal' => sub {
local @ARGV;
push @ARGV, qw(--name kingpin);
my $kingpin = Getopt::Kingpin->new;
$kingpin->flag('name', 'set name')->string();
$kingpin->parse;
is $kingpin->flags->get('name'), 'kingpin';
};
subtest 'string normal 2 options' => sub {
local @ARGV;
push @ARGV, qw(--name kingpin --xyz abcde);
my $k = Getopt::Kingpin->new;
$k->flag('name', 'option 1')->string;
$k->flag('xyz', 'option 2')->string;
view release on metacpan or search on metacpan
t/01-basic.t view on Meta::CPAN
use Getopt::Long::Complete;
is($REQUIRE_ORDER, 0);
subtest GetOptions => sub {
local @ARGV = ("--foo", "--bar", "baz");
my %opts;
GetOptions(
'foo' => \$opts{foo},
'bar=s' => sub { $opts{bar} = $_[1] },
);
view release on metacpan or search on metacpan
t/descriptive.t view on Meta::CPAN
# precludes => [...]
# sugar for only_one_of and all_or_none
sub is_opt {
my ($argv, $specs, $expect, $desc) = @_;
local @ARGV = @$argv;
local $Test::Builder::Level = $Test::Builder::Level + 1;
my $ok = eval {
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ($opt, $usage) = describe_options(
"test %o",
t/descriptive.t view on Meta::CPAN
}
sub is_hidden {
my ($specs, $cmd, $text) = @_;
eval {
local @ARGV;
my ($opt, $usage) = describe_options(
"test %o",
@$specs,
);
like(
t/descriptive.t view on Meta::CPAN
{},
"an unrequired option"
);
{
local @ARGV;
my ($opt, $usage) = describe_options(
"%c %o",
[ foo => "a foo option" ],
[],
['bar options:'],
t/descriptive.t view on Meta::CPAN
"CODEISH: spacer and non-option description found",
);
}
{
local @ARGV;
my ($opt, $usage) = describe_options(
"%c %o",
[ foo => "a foo option" ],
[],
[\"bar options:\n -> they are cool"],
t/descriptive.t view on Meta::CPAN
"CODEISH: spacer and non-option description found",
);
}
{
local @ARGV;
my ($opt, $usage) = describe_options(
"%c %o",
[ 'foo' => "foo option" ],
[ 'bar|b' => "bar option" ],
[ 'string|s=s' => "string value" ],
t/descriptive.t view on Meta::CPAN
"short options",
);
}
{
local @ARGV;
my ($opt, $usage) = describe_options(
"%c %o",
[ 'string|s=s' => "string value" ],
[ 'ostring|S:s' => "optional string value" ],
[ 'list|l=s@' => "list of strings" ],
t/descriptive.t view on Meta::CPAN
"Spec ! gets a [no-] in usage output",
);
}
{
local @ARGV = qw(--foo FOO --baz BAZ);
my ($c_opt, $usage) = describe_options(
"%c %o",
[ "foo=s", '' ],
[ "bar=s", '', { default => 'BAR' } ],
[ "baz=s", '', { default => 'BAZ' } ],
t/descriptive.t view on Meta::CPAN
is($C_opt->baz, 'BAZ', 'C_opt->foo is BAZ');
is($s_opt->baz, 'BAZ', 's_opt->foo is BAZ');
}
{
local @ARGV = qw(--foo);
my ($opt, $usage) = describe_options(
"%c %o",
[ "foo", '' ],
[ "bar", '' ],
);
t/descriptive.t view on Meta::CPAN
is( $opt->{bar}, undef, "entry not given is undef (exists? no guarantee)" );
is( $opt->bar, undef, "entry not given is undef (as method)");
}
{
local @ARGV = qw(--get);
my ($opt, $usage) = describe_options(
"%c %o",
[ "mode" => hidden => { one_of => [
[ "get" => "get the value" ],
[ "set" => "set the value" ],
t/descriptive.t view on Meta::CPAN
is( $opt->{set}, undef, "one_of entry not given is undef (as hash key)" );
is( $opt->set, undef, "one_of entry not given is undef (as method)");
}
{
local @ARGV = qw(--foo-bar);
my ($opt) = describe_options(
"%c %o",
[ "foo:s", "foo option" ],
[ "foo-bar", "foo-bar option", { implies => 'foo' } ],
);
t/descriptive.t view on Meta::CPAN
is($opt->foo_bar, 1, 'given value (checked with method)');
is($opt->foo, 1, 'implied value (checked with method)');
}
{
local @ARGV;
local $Getopt::Long::Descriptive::TERM_WIDTH = 80;
my ($opt, $usage) = describe_options(
"test %o",
[ foo => "a foo option" ],
t/descriptive.t view on Meta::CPAN
is($usage->text, $expect, 'long option description is wrapped cleanly');
}
{
local @ARGV;
local $Getopt::Long::Descriptive::TERM_WIDTH = 80;
# We're testing, here, that if we "forget" the usual "%c %o" style format,
# its assumed.
my ($opt, $usage) = describe_options(
t/descriptive.t view on Meta::CPAN
[ 0, '--no-exit' ],
);
for my $test (@test) {
my $want = shift @$test;
local @ARGV = @$test;
my ($opt, $usage) = describe_options(@gld_args);
is(scalar $opt->exit, $want, "(@$test) for exit!");
}
}
{
local @ARGV;
my ($opt, $usage) = describe_options(
"%c %o",
[ foo => "x" x 80 ],
);
local $@;
view release on metacpan or search on metacpan
use Test::More;
use Getopt::Long::Modern;
# regular options
{
local @ARGV = qw(-f --bar baz -Z 1 --baz 2 abc);
GetOptions(
'f|foo' => \my $foo,
'b|bar=s' => \my $bar,
'Z|baz=s' => \my @baz,
);
is_deeply \@baz, [1,2], 'option is set';
}
# no_ignore_case, permute
{
local @ARGV = qw(--Foo abc --bar baz);
local $SIG{__WARN__} = sub {};
GetOptions(
'foo' => \my $foo,
'bar=s' => \my $bar,
);
is $bar, 'baz', 'option is set';
}
# bundling
{
local @ARGV = qw(-fb baz abc);
GetOptions(
'f|foo' => \my $foo,
'b|bar=s' => \my $bar,
);
is_deeply \@ARGV, ['abc'], 'argument left';
is $bar, 'baz', 'option is set';
}
# gnu_compat no_getopt_compat
{
local @ARGV = qw(+f --bar= abc);
GetOptions(
'f|foo' => \my $foo,
'b|bar=s' => \my $bar,
);
is_deeply \@ARGV, ['+f','abc'], 'argument left';
}
# extra options
Getopt::Long::Modern->import('pass_through');
{
local @ARGV = qw(-f --bar=baz --baz abc);
GetOptions(
'f|foo' => \my $foo,
'b|bar=s' => \my $bar,
);
is_deeply \@ARGV, ['--baz','abc'], 'arguments left';
view release on metacpan or search on metacpan
lib/Getopt/Long/Subcommand.pm view on Meta::CPAN
=head2 How to avoid modifying @ARGV? How to process from another array, like Getopt::Long's GetOptionsFromArray?
Instead of adding another function, you can use C<local>.
{
local @ARGV = ['--some', 'value'];
GetOptions(...);
}
# the original @ARGV is restored
=head1 HOMEPAGE
view release on metacpan or search on metacpan
t/parse_param.t view on Meta::CPAN
is(GM->getOpt('i'), 8, "i parsed ok");
is(GM->getOpt('f'), 3.145, "f parsed ok");
do {
local @ARGV = qw(
--stuff blah
);
dies_ok {GM->parseArgs()} 'parses errors';
my $e = Exception::Class->caught();
like($e, qr/no 'foo'/, 'Checking error');
};
GM->unacceptParam('stuff');
do {
local @ARGV = qw(
--stuff fooblah
);
dies_ok {GM->parseArgs()} 'rejects unaccepted parameter';
my $e = Exception::Class->caught();
like($e->message(), qr/Bad command-line/, 'Checking error') or diag explain $e;
view release on metacpan or search on metacpan
t/02.getopt.t view on Meta::CPAN
use parent 'Getopt::O2';
# Usage called?
{
local @ARGV = qw(-h);
local $override{exit} = 1;
my $cmdline = __PACKAGE__->new();
my $mock = Test::MockObject::Extends->new($cmdline);
t/02.getopt.t view on Meta::CPAN
pass('code.coverage.0');
no warnings 'once';
local $override{exit} = 1;
local @ARGV = qw(--garble);
eval {capture_stderr $usage, sub {
$cmdline->getopt({});
}};
t/02.getopt.t view on Meta::CPAN
}
# Test left-overs
{
my @args = qw(--flag --param value -- --param value --flag one two three);
local @ARGV = @args;
my $cmdline = __PACKAGE__->new();
my $mock = Test::MockObject::Extends->new($cmdline);
my (%options, @leftover);
$mock->mock(get_option_rules => sub {
t/02.getopt.t view on Meta::CPAN
}
# Unnamed parameters
{
my @args = (qw(foo bar), undef, '', '-', '--');
local @ARGV = @args;
my (@out, %options);
my $cmdline = __PACKAGE__->new();
$cmdline->getopt(\%options, \@out);
t/02.getopt.t view on Meta::CPAN
is($arg, 'snarf', 'param.invalid.long');
die $mock;
});
local @ARGV = qw(--snarf);
$mock->getopt(\%options);
};
die $@ unless blessed($@) && $mock == $@;
}
# Short options bundling and value
{
local @ARGV = qw(-affoobert -a -bbba);
my $cmdline = __PACKAGE__->new();
my $mock = Test::MockObject::Extends->new($cmdline);
my %options;
t/02.getopt.t view on Meta::CPAN
is('foobert', $options{file}, 'params.short.value');
}
# Short options value after "=" and value as separate argument
{
local @ARGV = qw(
--one=two
--three four
--list 1 --list 2 --list 3
--mode single
--enum a --enum c
t/02.getopt.t view on Meta::CPAN
$mock->mock(get_option_rules => sub {
return @{$set->{set} || []};
});
local @ARGV = @{$set->{ARGV}};
$mock->getopt(\%options);
unless (ref $set->{opt_expect}) {
is($options{$set->{opt_key}}, $set->{opt_expect}, $key);
} elsif ('ARRAY' eq ref $set->{opt_expect}) {
ok(@{$set->{opt_expect}} ~~ @{$options{$set->{opt_key}}}, $key);
t/02.getopt.t view on Meta::CPAN
is($arg, $set->{arg}, "$key.0");
is($fmt, $set->{fmt}, "$key.1") if exists $set->{fmt};
die $self;
});
local @ARGV = @{$set->{ARGV}};
eval {$mock->getopt(\%options);1} and next;
my $error = $@;
if (blessed($error) && $mock == $error) {
} elsif (!exists $set->{expect_error}) {
die $error;
view release on metacpan or search on metacpan
t/00.load.t view on Meta::CPAN
'quiet' => 1, # Gauranteed a 'Argument 6 did not match (?-xism:^--)'
});
my $inc;
{
local @ARGV = @cst;
$inc = Getopt::Param::Tiny->new({ 'quiet' => 1 });
}
my %val = (
'alone' => '--alone',
view release on metacpan or search on metacpan
t/01.methods.t view on Meta::CPAN
'quiet' => 1, # Gauranteed a 'Argument 6 did not match (?-xism:^--)'
});
my $inc;
{
local @ARGV = @cst;
$inc = Getopt::Param->new({ 'quiet' => 1 });
}
my %val = (
'alone' => '--alone',
view release on metacpan or search on metacpan
t/Getopt-Tree.t view on Meta::CPAN
}
sub test_parse_command_line {
my ( $params, $cli ) = @_;
local @ARGV = split( m/ +/, $cli );
local $SIG{__WARN__} = sub {};
my ( $op, $config ) = parse_command_line( $params );
ok( $op && $config, $cli );
return ( $op, $config );
}
view release on metacpan or search on metacpan
bin/example.pl view on Meta::CPAN
use lib 'lib';
use Getopt::Type::Tiny qw(get_opts Str Int);
use Data::Printer;
unless (@ARGV) {
local @ARGV = qw(--foo value_of_foo --bar 12 --verbose);
}
my %options = get_opts(
foo => { isa => Str },
bar => { isa => Int, default => 42 },
view release on metacpan or search on metacpan
use Test::More;
use Project::Libs;
use Getopt::TypeConstraint::Mouse;
subtest basic => sub {
local @ARGV = qw(--in=foo --out=bar);
{
package MyApp;
use Mouse;
with 'MouseX::Getopt';
has 'out' => ( is => 'ro', isa => 'Str', required => 1 );
view release on metacpan or search on metacpan
lib/Getopt/Usaginator.pm view on Meta::CPAN
usage 0 unless @arguments;
my ( $help );
{
local @ARGV = @arguments;
GetOptions(
'help|h|?' => \$help,
);
}
view release on metacpan or search on metacpan
$wrong_syntax = {-msg=>$default_msg,-verbose=>0} if ! defined $wrong_syntax;
$help_usage = { -verbose => 1 } if ! defined $help_usage;
my @args = @_ ? @_ : @ARGV;
local (@ARGV) = @args;
#
# Handle command line parameters
#
my @options = values %{ $this->{options} };
view release on metacpan or search on metacpan
lib/Giblog.pm view on Meta::CPAN
sub run_command {
my ($class, @argv) = @_;
# Command line option
local @ARGV = @argv;
my $getopt_option_save = Getopt::Long::Configure(qw(default no_auto_abbrev no_ignore_case pass_through));
GetOptions(
"h|help" => \my $help,
"H|C|home=s" => \my $home_dir,
);
view release on metacpan or search on metacpan
lib/Gimp/gppport.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;
lib/Gimp/gppport.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/App/annex_to_annex.pm view on Meta::CPAN
CORE::exit main unless caller;
sub main {
shift if $_[0] and ref $_[0] eq ""; # in case main called as a class method
local @ARGV = @{ $_[0] } if $_[0] and ref $_[0] ne "";
# only support v7 because supporting v5 too would make things quite
# complex. require git-annex >=7.20191009 because it will refuse to
# work in v5 repos, and because it supports `git annex find --unlocked`
chomp(my %annex_version_fields = map { split ': ' } `git annex version`);
view release on metacpan or search on metacpan
t/20-init.t view on Meta::CPAN
# init using @ARGV
BEGIN { $tests += 5 }
$dir = tempdir( CLEANUP => 1 );
{
local @ARGV = $dir;
init();
}
check_repo( $dir, 1 );
# local::lib may have installed some files already
view release on metacpan or search on metacpan
t/lib/TestUtil.pm view on Meta::CPAN
sub objects_from {
my ($name) = @_;
my $perl = File::Spec->catfile( 't', 'bundles', "$name.perl" );
# slurp and eval the content of the file
my $objects = do { local @ARGV = ($perl); local $/; eval <> }
or die "Failed processing $perl";
# add extra information
for my $kind ( @kinds ) {
for my $object ( @{ $objects->{$kind} } ) {
view release on metacpan or search on metacpan
t/app-args.t view on Meta::CPAN
my ($env, $argv, $args, $exp) = @$test{qw(env argv args exp)};
$env->{"GIT_DV_\U$_"} = delete $env->{$_} for keys %$env;
local %ENV = (%ENV, %$env);
local @ARGV = @$argv;
is_deeply(Git::DescribeVersion::App::options(@$args), $exp, 'got expected options as function');
local @ARGV = @$argv;
is_deeply(Git::DescribeVersion::App->options(@$args), $exp, 'got expected options as class method');
}
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
t/001-options.t view on Meta::CPAN
my $params = {};
my @include_opts = ("--include", "t/001-load.t");
my @include_args = ("include", "t/001-load.t");
{
local @ARGV = (@include_opts);
$params = process_options();
for my $o ( qw|
dir
branch
prefix
t/001-options.t view on Meta::CPAN
my $suffix = '_smoke-me';
my $remote = 'upstream';
my $no_delete = 1;
my $no_push = 1;
my $test_extension = 'test';
local @ARGV = (
@include_opts,
'--branch' => $branch,
'--prefix' => $prefix,
'--remote' => $remote,
'--no_delete' => $no_delete,
t/001-options.t view on Meta::CPAN
{
my $no_delete = 1;
my $no_push = 1;
my $test_extension = 'test';
my $suffix = '_my_suffix';
local @ARGV = (
@include_opts,
'--no-delete' => $no_delete,
'--no-push' => $no_push,
'--test-extension' => $test_extension,
'--suffix' => $suffix,
t/001-options.t view on Meta::CPAN
ok(! $params->{prefix}, "Because 'suffix' is set, 'prefix' is not");
}
{
my $phony_dir = "/tmp/abcdefghijklmnop_foobar";
local @ARGV = ("--dir", $phony_dir, "verbose", @include_opts);
local $@;
eval { $params = process_options(); };
like($@, qr/Could not locate directory $phony_dir/,
"Die on non-existent directory $phony_dir provided on command-line");
}
t/001-options.t view on Meta::CPAN
}
{
my $cwd = cwd();
my $phony_dir = "/tmp/abcdefghijklmnop_foobar";
local @ARGV = ("--dir", $phony_dir, @include_opts);
$params = process_options("dir" => $cwd);
is($params->{dir}, $cwd,
"Argument provided directly to process_options supersedes command-line argument");
}
t/001-options.t view on Meta::CPAN
{
my $prefix = "my_prefix_";
my $suffix = "_my_suffix";
local $@;
local @ARGV = ('--prefix' => $prefix, '--suffix' => $suffix, @include_opts);
eval { $params = process_options(); };
like($@,
qr/Only one of '--prefix' or '--suffix' may be supplied/,
"Die on provision of both 'prefix' and 'suffix' options"
);
t/001-options.t view on Meta::CPAN
SKIP: {
my ($stdout);
eval { require IO::CaptureOutput; };
skip "IO::CaptureOutput not installed", 1 if $@;
local @ARGV = (@include_opts);
IO::CaptureOutput::capture(
sub { $params = process_options( "verbose" => 1 ); },
\$stdout,
);
like($stdout, qr/'verbose'\s*=>\s*1/s,
t/001-options.t view on Meta::CPAN
SKIP: {
my ($stdout);
eval { require IO::CaptureOutput; };
skip "IO::CaptureOutput not installed", 1 if $@;
local @ARGV = ("--verbose", @include_opts);
IO::CaptureOutput::capture(
sub { $params = process_options(); },
\$stdout,
);
like($stdout, qr/'verbose'\s*=>\s*1/s,
view release on metacpan or search on metacpan
eg/build-git view on Meta::CPAN
cmp_git( $version, '1.3.3' ) <= 0
&& cmp_git( '1.1.0', $version ) <= 0
&& do { no warnings; `git-describe`; $? != 0 }
)
{
local ( $^I, @ARGV ) = ( '', 'GIT-VERSION-GEN' );
s/git-describe/git describe/, print while <>;
}
# fix GIT_VERSION in the Makefile
if ( cmp_git( $version, '1.0.9' ) == 0 ) {
local ( $^I, @ARGV ) = ( '', 'Makefile' );
s/^GIT_VERSION = .*/GIT_VERSION = $version/, print while <>;
}
# add missing #include <sys/resource.h>
elsif ( cmp_git( $version, '1.7.5.rc0' ) <= 0
view release on metacpan or search on metacpan
my $pull_branch = "";
push @options, "DEBUG=$ENV{DEBUG}" if defined $ENV{DEBUG} and $xmod !~ /^DEBUG=/m;
if (eval { require Getopt::Long; 1; } and
Getopt::Long::GetOptions( "O=s" => \@options )) { # Strip stealth -O args from ARGV so the real git doesn't choke on it
if (my $rest_opt = ($op ne "clone" && "o|")."server-option|push-option=s") { # Ignore -o<origin> for "git clone"
local @ARGV = @ARGV; # Don't monkey anything. Just peek.
Getopt::Long::GetOptions( $rest_opt => \@options, "branch|b=s" => \$pull_branch ); # Handle "git clone -b <ref> <repo>"
}
}
$pull_branch = $1 if $op =~ /^(fetch|pull)$/ and $xmod !~ /^pull_branch=/m and git("branch") =~ m{^\* ([\w/\-.@]+)\s*$}m;
push @options, "pull_branch=$pull_branch" if $pull_branch;
}
# Special "config" handler to honor new --descent option
sub handle_config {
my @args = @_;
local @ARGV = @args;
# Don't try to handle the "--help"-first case.
return if join(" ", @ARGV) =~ /config --help\b/;
if (grep {$_ eq "config"} @ARGV and
# Smells like special "git config" command
eval { require Getopt::Long; 1; } and
view release on metacpan or search on metacpan
xs/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;
xs/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
eg/gitmeta-update view on Meta::CPAN
category => "main",
});
}
my($gmf_repo, $gmf_path,
$local_dir) = @ARGV;
if(!defined $local_dir) {
# alternative call: $0 $gmf $local_dir
undef $gmf_repo;
($gmf_path, $local_dir) = @ARGV;
}
GitMeta->health_check();
die "usage: $0 [gmf-repo] gmf-path local-dir"
view release on metacpan or search on metacpan
lib/Global/IPC/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;
lib/Global/IPC/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') {