view release on metacpan or search on metacpan
t/25backcompat.t view on Meta::CPAN
sub _write_custom_content {
my ($schema, $class, $content) = @_;
my $pm = $schema->loader->get_dump_filename($class);
{
local ($^I, @ARGV) = ('.bak', $pm);
while (<>) {
if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
print;
print $content;
}
view release on metacpan or search on metacpan
maint/travis-ci_scripts/lib/TAP/Harness/IgnoreNonessentialDzilAutogeneratedTests.pm view on Meta::CPAN
my $fn = File::Spec::Unix->catpath( File::Spec->splitpath( $_ ) );
if (my $REs = $frivolous_test_map->{
(first { $fn =~ $_ } keys %$frivolous_test_map ) || ''
}) {
my $slurptest = do { local (@ARGV, $/) = $fn; <> };
$slurptest =~ $_ and push @$skip_tests, $fn and next TESTFILE for @$REs;
}
push @$run_tests, $fn;
}
view release on metacpan or search on metacpan
# fdbget: copies a file (or files) from the db
GetOptions("localname=s" => \$localname ) || die Usage();
$|++;
die "fdbget: pass files to copy from DB\n" unless @ARGV;
die "fdbget: can't use --local option with multiple files\n" if (@ARGV > 1 && $localname);
for my $filename (@ARGV) {
$filestore->read_from_db($localname || $filename, $filename);
}
}
view release on metacpan or search on metacpan
lib/DBIx/Migration/CLI.pm view on Meta::CPAN
use PerlX::Maybe qw( maybe );
use POSIX qw( EXIT_FAILURE EXIT_SUCCESS );
use Try::Tiny qw( catch try );
sub run {
local @ARGV = @_;
my $opts;
my $exitval;
{
local $SIG{ __WARN__ } = sub {
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
t/02-trigger.t view on Meta::CPAN
plan skip_all => "SQLite not installed";
}
plan tests => 2;
my $sql = do { local (@ARGV,$/) = 't/trigger.sql'; <> };
my @statements;
while( defined( my $frag = DBIx::RunSQL->split_sql( $sql ))) {
push @statements, $frag;
}
is \@statements, [
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
Makefile.PL view on Meta::CPAN
{
my $our_sub = shift;
my $warn_sub = shift;
local ($^I) = ".bak" ;
local (@ARGV) = shift;
while (<>)
{
print, last if /^__(END|DATA)__/ ;
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
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
lib/DSP/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/DSP/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
$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/02-full.t view on Meta::CPAN
route_exists [GET => $route];
response_content_is([GET => $route], 'whatever');
}
my $collector = do {
local (@ARGV, $/) = ($logfile);
<>;
};
# Verify log messages were all logged
for my $level (qw( debug core info warning error )) {
t/02-full.t view on Meta::CPAN
# Verify that core messages are filtered when Dancer's 'log' setting isn't 'core'
# setting log => 'debug';
# truncate($logfile,0);
# response_content_is([GET => "/core"], 'whatever');
# $collector = do {
# local (@ARGV, $/) = ($logfile);
# <>;
# };
# unlike($collector, qr{core-whatever}, 'log line is correct');
ok(unlink($logfile), 'unlinking log file');
view release on metacpan or search on metacpan
t/003-htmlsnippet.t view on Meta::CPAN
['t/htmlsnippet-ical.html',1],
) {
my($fn,$entries) = @$test;
diag $fn;
# Sluurp
my $html = do { local(@ARGV,$/) = ($fn); <> };
my @snippets = Dancer::SearchApp::HTMLSnippet->extract_highlights(
html => $html,
max_length => 150,
);
view release on metacpan or search on metacpan
lib/Data/Conveyor/Service/Interface/Shell.pm view on Meta::CPAN
# Don't call this run_service_method, or Term::Shell will think it's a
# command.
sub execute_service_method {
my $self = shift;
my $method = shift;
local @ARGV = @_;
my %opt;
GetOptions(\%opt, $self->getopt_spec_for_method($method))
or return $self->run_help($method);
if (@ARGV) {
print "extraneous arguments [@ARGV]\n\n";
view release on metacpan or search on metacpan
lib/Data/Dump/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/Data/Dump/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
use Data::Dumper::Compact;
my $can_j = eval { require JSON::Dumper::Compact; 1 };
DEEP: foreach my $example (glob('ex/deep*')) {
my $contents = do { local (@ARGV, $/) = $example; <> };
my $data = eval '+'.$contents;
is(Data::Dumper::Compact->dump($data), $contents);
if ($can_j) {
(my $jfile = $example) =~ s/deep/jdeep/;
next DEEP unless -e $jfile;
my $jcont = do { local (@ARGV, $/) = $jfile; <> };
is(my $res = JSON::Dumper::Compact->dump($data), $jcont);
is(
Data::Dumper::Compact->dump(JSON::Dumper::Compact->decode($res)),
$contents,
);
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 || 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;
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/Data/Generator/FromDDL/CLI.pm view on Meta::CPAN
my $out;
my $format = 'sql';
my $pretty;
my $bytes_per_sql = 1024 * 1024; # 1MB
local @ARGV = @args;
GetOptions(
"help|h" => \$help,
"num|n=s" => \$n,
"parser|p=s" => \$parser,
"include|i=s" => \$include,
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
examples/encode_v5.pl view on Meta::CPAN
sub uptime
{
return (
split /\s/,
do {local ( @ARGV, $/ ) = '/proc/uptime'; <>}
)[0];
}
view release on metacpan or search on metacpan
lib/Data/Object/Args.pm view on Meta::CPAN
package main;
use Data::Object::Args;
local @ARGV = qw(--help execute);
my $args = Data::Object::Args->new(
named => { flag => 0, command => 1 }
);
lib/Data/Object/Args.pm view on Meta::CPAN
package main;
use Data::Object::Args;
local @ARGV = qw(--help execute --format markdown);
my $args = Data::Object::Args->new(
named => { flag => 0, command => 1 }
);
lib/Data/Object/Args.pm view on Meta::CPAN
package main;
use Data::Object::Args;
local @ARGV = qw(execute phase-1 --format markdown);
my $args = Data::Object::Args->new(
named => { command => 1 }
);
view release on metacpan or search on metacpan
t/Data_Object_Cli.t view on Meta::CPAN
$result
});
$subs->example(-1, 'auto', 'method', fun($tryable) {
local @ARGV;
$ARGV[0] = 'init';
ok my $result = $tryable->result;
ok my $returned = $result->main;
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 || 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;
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/binary-load.t view on Meta::CPAN
ok( not($ret), "Invalid offset table address" );
like( "$@", qr/invalid offset table/i, "Threw an error" );
# Refsize is too small for NumObjects
my $string
= do { local @ARGV = "t/data/longfile-03.binary.plist"; local $/; <> };
ok( $string, "Read from file." );
use bytes;
substr( $string, -25, 1, "\x01" );
$ret = eval { $read->open_string($string) };
ok( not($ret), "Refsize is too small for NumObjects." );
t/binary-load.t view on Meta::CPAN
ok( $ret, "Opening from a fh worked" );
isa_ok( $ret, "Data::Plist" );
ok( $ret->raw_data, "Has data inside" );
# Load from string
my $str = do { local @ARGV = "t/data/basic.binary.plist"; local $/; <> };
ok( $str, "Read binary data in by hand" );
$ret = $read->open_string($str);
ok( $ret, "Opening from a string worked" );
isa_ok( $ret, "Data::Plist" );
ok( $ret->raw_data, "Has data inside" );