view release on metacpan or search on metacpan
exec/nexfix.pl view on Meta::CPAN
my $time = localtime time;
# print STDERR "$shortname run on $time\n";
# slurp in the entire NEXUS file
my $nexus_text = do {local(@ARGV, $/) = $path; <>};
# move the old file to filename.old unless the user has specified
# overwriting (-c) or keeping the original file intact (-k)
move($path, "$path.old") unless ($flags{c} || $flags{k});
view release on metacpan or search on metacpan
Bio/DB/GFF.pm view on Meta::CPAN
return $self->do_load_gff($file_or_directory) if ref($file_or_directory)
&& tied *$file_or_directory;
my $tied_stdin = tied(*STDIN);
open my $SAVEIN, "<&STDIN" unless $tied_stdin;
local @ARGV = $self->setup_argv($file_or_directory,'gff','gff3') or return; # to play tricks with reader
my $result = $self->do_load_gff('ARGV');
open STDIN, '<', $SAVEIN unless $tied_stdin; # restore STDIN
return $result;
}
Bio/DB/GFF.pm view on Meta::CPAN
return $self->load_sequence($file_or_directory) if ref($file_or_directory)
&& tied *$file_or_directory;
my $tied = tied(*STDIN);
open my $SAVEIN, "<&STDIN" unless $tied;
local @ARGV = $self->setup_argv($file_or_directory,'fa','dna','fasta') or return; # to play tricks with reader
my $result = $self->load_sequence('ARGV');
open STDIN, '<', $SAVEIN unless $tied; # restore STDIN
return $result;
}
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
$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
src/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;
src/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/tutorial-webhook view on Meta::CPAN
use warnings;
use Mojolicious::Lite;
my $token = $ENV{TOKEN};
my $bot_url = $ENV{BOT_URL};
my $certificate = do { local (@ARGV, $/) = 'server.crt'; <> };
plugin 'Bot::ChatBots::Telegram' => instances => [
[
'WebHook',
processor => \&process_record,
view release on metacpan or search on metacpan
t/02_logger/01_output_file.t view on Meta::CPAN
ok( $output->_write("This is a test string"), '_write()' );
ok( -e $test_log_path, 'Log file was created' );
my $contents = do { local (@ARGV, $/) = $test_log_path ; <> };
chomp $contents;
cmp_ok( $contents, 'eq', "This is a test string" );
## FIXME test mode / perms ?
view release on metacpan or search on metacpan
src/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;
src/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
Makefile.PL view on Meta::CPAN
}
sub get_modules {
my $file = 'module_list';
local $/ = "\n";
chomp( my @list = do { local(@ARGV)=$file; <> } );
return \@list;
}
sub get_modules_pod_list {
join "\n\n",
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
lib/ByteBeat.pm view on Meta::CPAN
}
}
sub get_options {
my ($self) = shift;
local @ARGV = @{$self->args};
GetOptions(
'file=s' => \$file,
'length=s' => \$length,
'debug' => \$debug,
'shell' => \$shell,
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
$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/CAD/Calc.pm view on Meta::CPAN
);
=cut
sub import {
## print "import called with @_\n";
local @ARGV = @_; # shame that Getopt::Long isn't structured better!
use Getopt::Long ();
Getopt::Long::GetOptions( '-',
'precision=f' => \$linear_precision,
'angular=f' => \$angular_precision,
) or croak("bad import arguments");
view release on metacpan or search on metacpan
bin/rewritepdf.pl view on Meta::CPAN
{
print "CAM::PDF v$CAM::PDF::VERSION\n";
exit 0;
}
local @ARGV = @{$opts{otherargs}};
if (@ARGV < 1)
{
pod2usage(1);
}
view release on metacpan or search on metacpan
lib/CASCM/CLI.pm view on Meta::CPAN
sub run {
my ( $self, @args ) = @_;
# Initialize
$self->_init();
local @ARGV = ();
# Parse main arguments
my $main_options = {};
GetOptionsFromArray( \@args, $main_options, $self->_main_opt_spec() )
or $self->_print_bad_opts();
view release on metacpan or search on metacpan
easyxs/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;
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/01.basic.t view on Meta::CPAN
my $compare_opts = {};
is_deeply( $opts, $compare_opts, 'Able to add options' );
}
{
local @ARGV;
@ARGV = ('-t');
my $opts = GetOptions('t|test');
my $compare_opts = { test => 1 };
is_deeply( $opts, $compare_opts, 'Pass in boolean option test' );
}
{
local @ARGV;
@ARGV = ( '-t', 'string' );
my $opts = GetOptions('t|test=s');
my $compare_opts = { test => 'string' };
is_deeply( $opts, $compare_opts, 'Pass in string option test' );
}
{
local @ARGV;
@ARGV = ( '-v', '-v' );
my $opts = GetOptions();
my $compare_opts = { verbose => 2 };
is_deeply( $opts, $compare_opts, 'Verify incrental verbose' );
}
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
local/lib/perl5/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) = @_;
local/lib/perl5/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/CGI/Application/Structured/Tools/Starter.pm view on Meta::CPAN
# This next part is for the static files dir t/www
my @dirparts = ( $self->{basedir}, 't', 'www' );
my $twdir = File::Spec->catdir(@dirparts);
if ( not -d $twdir ) {
local @ARGV = $twdir;
mkpath();
$self->progress("Created $twdir");
}
my $placeholder =
File::Spec->catfile( @dirparts, 'PUT.STATIC.CONTENT.HERE' );
lib/CGI/Application/Structured/Tools/Starter.pm view on Meta::CPAN
my $self = shift;
my @dirparts = ( $self->{basedir}, 't' );
my $tdir = File::Spec->catdir(@dirparts);
if ( not -d $tdir ) {
local @ARGV = $tdir;
mkpath();
$self->progress("Created $tdir");
}
my $fname = File::Spec->catfile( @dirparts, 'perlcriticrc' );
lib/CGI/Application/Structured/Tools/Starter.pm view on Meta::CPAN
my @dirparts = ( $self->{basedir}, "config" );
my $tdir = File::Spec->catdir(@dirparts);
if ( not -d $tdir ) {
local @ARGV = $tdir;
mkpath();
$self->progress("Created $tdir");
}
my $fname = File::Spec->catfile( $tdir, 'config.pl' );
lib/CGI/Application/Structured/Tools/Starter.pm view on Meta::CPAN
my @dirparts = ( $self->{basedir}, "script" );
my $tdir = File::Spec->catdir(@dirparts);
if ( not -d $tdir ) {
local @ARGV = $tdir;
mkpath();
$self->progress("Created $tdir");
}
# template needs template_path not just template dir
lib/CGI/Application/Structured/Tools/Starter.pm view on Meta::CPAN
my @distroparts = @{ $self->{distroparts} };
my @dirparts = ( $self->{basedir}, 'lib', @distroparts, "C" );
my $tdir = File::Spec->catdir(@dirparts);
if ( not -d $tdir ) {
local @ARGV = $tdir;
mkpath();
$self->progress("Created $tdir");
}
my $fname =
File::Spec->catfile( $self->{basedir}, 'lib', @distroparts, "C",
lib/CGI/Application/Structured/Tools/Starter.pm view on Meta::CPAN
my $distro_namepart = $distroparts[-1] . '.pm';
my @dirparts = ( $self->{basedir}, 'lib', @distro_dirparts);
my $tdir = File::Spec->catdir(@dirparts);
if ( not -d $tdir ) {
local @ARGV = $tdir;
mkpath();
$self->progress("Created $tdir");
}
lib/CGI/Application/Structured/Tools/Starter.pm view on Meta::CPAN
my @dirparts = ( $self->{basedir}, "script" );
my $tdir = File::Spec->catdir(@dirparts);
if ( not -d $tdir ) {
local @ARGV = $tdir;
mkpath();
$self->progress("Created $tdir");
}
# create the user script
lib/CGI/Application/Structured/Tools/Starter.pm view on Meta::CPAN
my @distroparts = split /::/, $self->{main_module};
my @dirparts = ( $self->{basedir}, 'lib', @distroparts );
my $tdir = File::Spec->catdir(@dirparts);
if ( not -d $tdir ) {
local @ARGV = $tdir;
mkpath();
$self->progress("Created $tdir");
}
my $fname =
File::Spec->catfile( $self->{basedir}, 'lib', @distroparts,
lib/CGI/Application/Structured/Tools/Starter.pm view on Meta::CPAN
"C", "Home"
);
my $tdir = File::Spec->catdir(@dirparts);
if ( not -d $tdir ) {
local @ARGV = $tdir;
mkpath();
$self->progress("Created $tdir");
}
#TODO We only need one file so remove loop
view release on metacpan or search on metacpan
lib/CGI/Compile.pm view on Meta::CPAN
'}',
# NOTE: this is a workaround to fix a problem in Perl 5.10
q(local @SIG{keys %SIG} = do { no warnings 'uninitialized'; @{[]} = values %SIG };),
"local \$^W = $warnings;",
'my $rv = eval {',
'local @ARGV = @{ $_[4] };', # args to @ARGV
'local @_ = @{ $_[4] };', # args to @_ as well
($path ? "\n#line 1 $path\n" : ''),
$code,
"\n};",
q{
lib/CGI/Compile.pm view on Meta::CPAN
Things like the query string and form data should generally be in the
appropriate environment variables that things like L<CGI> expect.
You can also pass arguments to the generated coderef, they will be
locally aliased to C<@_> and C<@ARGV>.
=head2 C<BEGIN> and C<END> blocks
C<BEGIN> blocks are called once when the script is compiled.
C<END> blocks are called when the Perl interpreter is unloaded.
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/p5httpd view on Meta::CPAN
chdir "$server_root$dir"
or return logerr 500, "Cannot chdir to $server_root$dir: $!";
$script_path =~ s/[A-Z]://;
# command line decoding, cf description at http://hoohoo.ncsa.uiuc.edu/cgi/cl.html:
local @ARGV;
unless ( $arglist =~ /=/ ) {
$arglist =~
s/%([\dA-Fa-f]{2})/chr(hex($1))/eg; # decode arglist, e.g. %20 -> space
@ARGV = split /\s+/, $arglist;
}
view release on metacpan or search on metacpan
is($info->status(), 413, 'Status set to 413 Payload Too Large');
};
subtest 'Command Line Parameters' => sub {
local @ARGV = ('--mobile', 'param1=value1', 'param2=value2');
$info = new_ok('CGI::Info');
my $params = $info->params();
is_deeply(
$params,