view release on metacpan or search on metacpan
lib/Pod/Markdown/Passthrough.pm view on Meta::CPAN
# Read the contents of a file and stash in object.
sub parse_from_file {
my $self = shift;
my $file = shift;
$self->{_markdown} = do { local ( @ARGV, $/ ) = $file; <> };
}
# Return any stashed raw file content.
sub as_markdown {
view release on metacpan or search on metacpan
t/app-pod2pandoc-meta.t view on Meta::CPAN
unless $ENV{RELEASE_TESTING};
sub pod2meta {
my ( $fh, $file ) = tempfile;
pod2pandoc ['script/pod2pandoc'], {@_}, '-t' => 'json', '-o', $file;
my $json = do { local ( @ARGV, $/ ) = $file; <> };
pandoc_json($json)->metavalue;
}
my $expect = {
file => 'script/pod2pandoc',
view release on metacpan or search on metacpan
my $date = ''; # Footer date string
my $h_str = 'pod2pdf'; # Inside string for header
my $section = ''; # Section type: 'doc', 'cat', 'ind', etc.
sub pod2pdf {
local @ARGV = @_;
unless ( @ARGV && $ARGV[0] ) { die "no input, no output!\n" }
parse_command_line();
unless ($ARGV[0]) {
view release on metacpan or search on metacpan
inc/inc_Module-Build/Module/Build/Base.pm view on Meta::CPAN
return $package->resume;
}
sub current {
# hmm, wonder what the right thing to do here is
local @ARGV;
return shift()->resume;
}
sub _construct {
my ($package, %input) = @_;
inc/inc_Module-Build/Module/Build/Base.pm view on Meta::CPAN
push @specs, $k . (defined $v->{type} ? $v->{type} : '');
push @specs, $v->{store} if exists $v->{store};
$args->{$k} = $v->{default} if exists $v->{default};
}
local @ARGV = @argv; # No other way to dupe Getopt::Long
# Get the options values and return them.
# XXX Add option to allow users to set options?
if ( @specs ) {
Getopt::Long::Configure('pass_through');
view release on metacpan or search on metacpan
lib/Pod/Simple/HTMLLegacy.pm view on Meta::CPAN
{
my($help);
my($netscape); # dummy
local @ARGV = @args;
GetOptions(
"help" => \$help,
"verbose!" => \$verbose,
"infile=s" => \$infile,
"outfile=s" => \$outfile,
view release on metacpan or search on metacpan
man => undef,
help => undef,
);
DEFAULTS: {
local @ARGV = ('--doc-root', $doc_root, '--base-uri', $base_uri, $mod_root );
is_deeply $CLASS->_config, \%config, 'Should have default config';
}
ERRS: {
my $mock = Test::MockModule->new($CLASS);
my @args;
$mock->mock(_pod2usage => sub { @args = @_} );
local @ARGV = ($mod_root);
ok $CLASS->_config, 'configure with no options';
is_deeply \@args, [
$CLASS,
'-message', 'Missing required --doc-root and --base-uri options',
], 'Should have been helped';
'-message', 'Missing path to module root',
], 'Should have been helped again';
}
MULTIPLES: {
local @ARGV = (
'--doc-root' => $doc_root,
'--base-uri' => $base_uri,
'--base-uri' => '/whatever',
$mod_root, '/another/root'
);
HELP: {
my $mock = Test::MockModule->new($CLASS);
my @args;
$mock->mock(_pod2usage => sub { @args = @_} );
local @ARGV = ('--doc-root', $doc_root, '--base-uri', $base_uri, $mod_root, '--help' );
ok $CLASS->_config, 'Ask for help';
is_deeply \@args, [ $CLASS, '-exitval', 0 ], 'Should have been helped';
@ARGV = ('--doc-root', $doc_root, '--base-uri', $base_uri, $mod_root, '-h' );
ok $CLASS->_config, 'Ask for help short';
is_deeply \@args, [ $CLASS, '-exitval', 0 ], 'Should have been helped again';
is_deeply \@args, [ $CLASS, '-sections', '.+', '-exitval', 0 ],
'Should have been manned again';
}
LOTS: {
local @ARGV = (
'--doc-root' => $doc_root,
'--base-uri' => $base_uri,
'--favicon-uri' => 'my.icon',
'--sample-module' => 'lib/Hello.pm',
'--main-module' => 'lib/Bye.pm',
help => undef,
}, 'Lots of opts should work';
}
SHORT: {
local @ARGV = (
'-d' => $doc_root,
'-u' => $base_uri,
'-s' => 'lib/Hello.pm',
'-m' => 'lib/Bye.pm',
'-i' => 'default.htm',
}, 'Lots of short opts should work';
}
NEGATED: {
local @ARGV = (
'--doc-root' => $doc_root,
'--base-uri' => $base_uri,
'--no-versioned-title',
$mod_root,
);
view release on metacpan or search on metacpan
lib/Pod/Stupid.pm view on Meta::CPAN
=head1 SYNOPSIS
use Pod::Stupid;
my $file = shift; # '/some/file/with/pod.pl';
my $original_text = do { local( @ARGV, $/ ) = $file; <> }; # slurp
my $ps = Pod::Stupid->new();
# in scalar context returns an array of hashes.
my $pieces = $ps->parse_string( $original_text );
view release on metacpan or search on metacpan
bin/pod2thread view on Meta::CPAN
use Pod::Usage qw(pod2usage);
# Insert -- into @ARGV before any single dash argument to hide it from
# Getopt::Long; we want to interpret it as meaning stdin.
my $stdin;
local @ARGV = map { $_ eq q{-} && !$stdin++ ? (q{--}, $_) : $_ } @ARGV;
# Parse our options.
my @options = qw(contents|c help|h navbar|n style|s=s title|t=s);
my %options;
Getopt::Long::config('bundling');
view release on metacpan or search on metacpan
t/lib/TestPW.pm view on Meta::CPAN
is => 'rw',
lazy => 1,
builder => 'initDocPPI',
);
sub slurp_file { local ( @ARGV, $/ ) = @_; <> }
sub run_in_dir {
shift if $_[0]->isa(__PACKAGE__); # Take TestPW->run_in_dir into account.
my $dir = shift;
view release on metacpan or search on metacpan
t/lib/TestPW.pm view on Meta::CPAN
$zilla->set_always(stash_named => undef);
$zilla->mock(copyright_holder => sub { $_[0]->license->holder });
# proposed changes to Pod::Weaver::Section::Legal look for a license file. we can ignore that for these tests.
$zilla->set_always(files => []);
sub slurp_file { local (@ARGV, $/) = @_; <> }
sub test_basic {
my ($weaver, $input, $stopwords) = @_;
my $expected = $input->{expected};
view release on metacpan or search on metacpan
In cases where Prima argument parsing conflicts with application options, use
L<Prima::noARGV> to disable automatic parsing; also see L<parse_argv>.
Alternatively, the construct
BEGIN { local @ARGV; require Prima; }
will also do.
=head1 SEE ALSO
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
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
$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/004_runner.t view on Meta::CPAN
is $runner->{app}, 'TestPuncheur';
is $runner->{app_options}{port}, 9876;
};
subtest 'no parse_options with ARGV' => sub {
local @ARGV = qw/-p 6666 -s SSS/;
my $runner = Puncheur::Runner->new(TestPuncheur => {
port => 9876,
server => 'TTT',
});
t/004_runner.t view on Meta::CPAN
};
subtest 'parse_options with ARGV' => sub {
local @ARGV = qw/-p 6666 -s SSS/;
my $runner = Puncheur::Runner->new(TestPuncheur2 => {
port => 9876,
server => 'TTT',
});
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/QMake/Project.pm view on Meta::CPAN
};
Getopt::Long::Configure( 'permute', 'pass_through' );
{
local @ARGV = $self->_split_command_to_words( $command );
# The first element is the qmake binary itself
$qmake = shift @ARGV;
GetOptions(
view release on metacpan or search on metacpan
lib/Qgoda/Command.pm view on Meta::CPAN
$path = './' . $path if !File::Spec->file_name_is_absolute($path);
$^W = 1 if $ENV{'PERLDOCDEBUG'};
pop @INC if $INC[-1] eq '.';
require Pod::Perldoc;
local @ARGV = ($path);
exit(Pod::Perldoc->run());
}
1;
view release on metacpan or search on metacpan
qtcore/src/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
qtcore/src/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
$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/ldf-client.pl view on Meta::CPAN
print "]\n";
}
sub process_sparql {
my $sparql = shift;
$sparql = do { local (@ARGV,$/) = $sparql; <> } if -r $sparql;
my $store = RDF::Trine::Store->new_with_config({
storetype => 'LDF',
url => [split(/\s+/,$url)]
});
view release on metacpan or search on metacpan
# make sure, git repository is clean
my $dirty = `git status --porcelain`;
die "git repository is dirty\n" if $dirty;
# get current version distribution
my $dist = do { local ( @ARGV, $/ ) = 'lib/RDF/NS.pm'; <> };
my $cur_version = $1 if $dist =~ /^our \$VERSION\s*=\s*'([^']+)'/m;
$cur_version or die 'current version not found in lib/RDF/NS.pm';
# get current prefixes
my $cur = RDF::NS->LOAD( "share/prefix.cc", warn => 1 );
README.md
);
foreach my $file (@files) {
print "$cur_version => $new_version in $file\n";
local ( $^I, @ARGV ) = ( '.bak', $file );
while (<>) {
s/$cur_version/$new_version/ig;
print;
}
}
my $msg = `git log --pretty=format:" - %s" $cur_version..`;
do {
print "prepend modifications to Changes\n";
local ( $^I, @ARGV ) = ( '.bak', 'Changes' );
my $line = 0;
while (<>) {
if ( !$line++ ) { # prepend
print join '', map { "$_\n" } @log;
print "\n$msg" if $msg;
view release on metacpan or search on metacpan
examples/rdfa-distiller-psgi/app.psgi view on Meta::CPAN
sub show_form
{
state $form = do
{
(my $file = __FILE__) =~ s/psgi$/html/;
local(@ARGV, $/) = $file;
my $html = <>;
$html =~ s{ \$AUTHORITY }
{ RDF::RDFa::Parser->AUTHORITY }xeg;
$html =~ s{ \$VERSION }
view release on metacpan or search on metacpan
t/02parse_and_serialise.t view on Meta::CPAN
serialize => { -type => RDF::Trine::Serializer::NTriples::Canonical->new };
my %in;
($in{filename} = __FILE__) =~ s/t$/nt/;
open $in{filehandle}, '<', $in{filename} or die "Could not open $in{filename}: $!";
$in{data} = do { local (@ARGV, $/) = $in{filename}; <> };
open $in{datahandle}, '<', \($in{data});
foreach my $source (qw(data datahandle filename filehandle))
{
my $model = parse(
view release on metacpan or search on metacpan
t/aref-query.t view on Meta::CPAN
BEGIN {
eval { require JSON; 1; }
or plan skip_all => "test requires JSON";
}
my $rdf = JSON::from_json(do { local (@ARGV, $/) = "t/doi-example.json"; <> });
my $uri = "http://dx.doi.org/10.2474/trol.7.147";
my @res = aref_query($rdf, $uri, '.');
is reftype $res[0], 'HASH';
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;