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;
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
$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
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
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
$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/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
$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/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
$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/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 ||= $_;
view release on metacpan or search on metacpan
lib/Catalyst/Helper/InitScript/FreeBSD.pm view on Meta::CPAN
# parse args
{
no warnings 'uninitialized';
my $opts = {};
local @ARGV = @args;
my $ret = GetOptions(
'help|?' => \$opts->{help},
'user=s' => \$opts->{user},
'group=s' => \$opts->{group},
'pidfile|p=s' => \$opts->{pidfile},
view release on metacpan or search on metacpan
t/auth-code-flow-IT.t view on Meta::CPAN
use FindBin qw($Bin);
use lib "$Bin/auth-code-flow-IT/MyCatalystApp/lib";
local $ENV{MOJO_LOG_LEVEL} = 'error';
local @ARGV = ('version');
my $provider_app = require "$Bin/auth-code-flow-IT/MyProviderApp/app.pl";
my $mock_oidc_client = Test::MockModule->new('OIDC::Client');
$mock_oidc_client->redefine('kid_keys' => sub { {} });
$mock_oidc_client->redefine('user_agent' => $provider_app->ua);
view release on metacpan or search on metacpan
t/aggregate/unit_core_script_cgi.t view on Meta::CPAN
use Test::More;
use Test::Fatal;
use Catalyst::Script::CGI;
local @ARGV;
is exception {
Catalyst::Script::CGI->new_with_options(application_name => 'TestAppToTestScripts')->run;
}, undef, "new_with_options";
shift @TestAppToTestScripts::RUN_ARGS;
my $server = pop @TestAppToTestScripts::RUN_ARGS;
view release on metacpan or search on metacpan
examples/TestApp/Controller/Root.pm view on Meta::CPAN
:MenuPath('/How it works/The template')
:MenuTitle('The template')
{
my ( $self, $c ) = @_;
my $text;
{ local (@ARGV, $/) = 'TestApp/root/src/index.tt2'; $text = <> }
$c->res->content_type('text/plain');
$c->res->body($text);
}
1;
view release on metacpan or search on metacpan
t/lib/MockHTTPClient.pm view on Meta::CPAN
use Moo;
sub get {
my ($self, $url) = @_;
$url =~ /query=([^&]+)/;
my $xml = do {local (@ARGV, $/) = "t/$1"; <>};
{success => 1, status => 200, reason => 'OK', content => $xml,};
}
1;
view release on metacpan or search on metacpan
t/lib/MockHTTPClient.pm view on Meta::CPAN
use Moo;
sub get {
my ($self, $url) = @_;
$url =~ /query=([^&]+)/;
my $xml = do {local (@ARGV, $/) = "t/files/$1"; <>};
{success => 1, status => 200, reason => 'OK', content => $xml,};
}
1;
view release on metacpan or search on metacpan
lib/Catmandu/Importer/RDF.pm view on Meta::CPAN
has sparql => (
is => 'ro',
lazy => 1,
trigger => sub {
my ($sparql, $ns) = ($_[1], $_[0]->ns);
$sparql = do { local (@ARGV,$/) = $sparql; <> } if $sparql =~ /^\S+$/ && -r $sparql;
my %prefix;
# guess requires prefixes (don't override existing). Don't mind false positives
$prefix{$_} = 1 for ($sparql =~ /\s([a-z][a-z0-0_-]*):/mig);
delete $prefix{$_} for ($sparql =~ /PREFIX\s+([^:]+):/mg);
$_[0]->{sparql} = join "\n", (map { $ns->SPARQL($_) } keys %prefix), $sparql;
view release on metacpan or search on metacpan
t/lib/MockHTTPClient.pm view on Meta::CPAN
use Moo;
sub get {
my ($self, $url) = @_;
$url =~ /query=([^&]+)/;
my $xml = do {local (@ARGV, $/) = "t/files/$1"; <>};
{success => 1, status => 200, reason => 'OK', content => $xml,};
}
1;
view release on metacpan or search on metacpan
t/exporter.t view on Meta::CPAN
{ _id => 'foo', _xml => [ foo => {} ] },
{ _id => 'bar.xml', _xml => [ bar => {} ] },
]);
ok(-e "$dir/foo.xml" and -e "$dir/bar.xml", 'export to directory');
$xml = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<foo/>\n";
$out = do { local (@ARGV, $/) = "$dir/foo.xml"; <> };
is $out, $xml, 'exported to multiple files';
done_testing;
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/Cinnamon/CLI.pm view on Meta::CPAN
}
sub run {
my ($self, @args) = @_;
local @ARGV = @args;
my $p = Getopt::Long::Parser->new(
config => ["no_ignore_case", "pass_through"],
);
$p->getoptions(
"h|help" => \$self->{help},
view release on metacpan or search on metacpan
lib/Class/AutoDB/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/Class/AutoDB/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
$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
my $main_module;
my $main_module_version;
{
local @INC = @INC;
local @ARGV = qw( NAME VERSION );
( $main_module, $main_module_version ) = @{ require './Makefile.PL' }; ## no critic ( RequireBarewordIncludes )
is $main_module, 'Class::Enumeration', 'Check main module'
}
require_ok $main_module or BAIL_OUT "Cannot load module '$main_module'";
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') {