view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
$VERSION = '1.06';
# Storage for the pseudo-singleton
$MAIN = undef;
*inc::Module::Install::VERSION = *VERSION;
@inc::Module::Install::ISA = __PACKAGE__;
}
inc/Module/Install.pm view on Meta::CPAN
defined $_[0]
and
! ref $_[0]
and
$_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
) ? $_[0] : undef;
}
1;
# Copyright 2008 - 2012 Adam Kennedy.
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
defined $_[0]
and
! ref $_[0]
and
$_[0] =~ m/^[^\W\d]\w*(?:::\w+)*$/s
) ? $_[0] : undef;
}
1;
# Copyright 2008 Adam Kennedy.
view release on metacpan or search on metacpan
t/00-report-prereqs.t view on Meta::CPAN
use ExtUtils::MakeMaker;
use File::Spec;
# from $version::LAX
my $lax_version_re =
qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )?
|
(?:\.[0-9]+) (?:_[0-9]+)?
) | (?:
v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )?
|
t/00-report-prereqs.t view on Meta::CPAN
$file =~ s{::}{/}g;
$file .= ".pm";
my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC;
my $want = $req_hash->{$phase}{$type}{$mod};
$want = "undef" unless defined $want;
$want = "any" if !$want && $want == 0;
my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required";
if ($prefix) {
my $have = MM->parse_version( File::Spec->catfile($prefix, $file) );
$have = "undef" unless defined $have;
push @reports, [$mod, $want, $have];
if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) {
if ( $have !~ /\A$lax_version_re\z/ ) {
push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)";
view release on metacpan or search on metacpan
t/pms/MockTime.pm view on Meta::CPAN
our %EXPORT_TAGS = (
'all' => \@EXPORT_OK,
);
our ($VERSION) = '0.12';
our ($offset) = 0;
our ($fixed) = undef;
BEGIN {
*CORE::GLOBAL::time = \&Test::MockTime::time;
*CORE::GLOBAL::localtime = \&Test::MockTime::localtime;
*CORE::GLOBAL::gmtime = \&Test::MockTime::gmtime;
t/pms/MockTime.pm view on Meta::CPAN
return CORE::gmtime($time);;
}
sub restore {
$offset = 0;
$fixed = undef;
}
*restore_time = \&restore;
view release on metacpan or search on metacpan
lib/Acme/RightSideOutObject.pm view on Meta::CPAN
One of the most serious flaws of Class::InsideOut is that it encapsulates data,
making it difficult to directly minipulate the object's internal state.
Attempting to inspect the reference to an inside out object with
L<Data::Dumper>, you'll find this:
$VAR1 = bless( do{\(my $o = undef)}, 'My::Class' );
Fear not! Acme::RightSideOutObject to the rescue!
Acme::RightSideOutObject work exactly like the inside out object it replaces
except that it is also a hashref full of the object's instance data.
view release on metacpan or search on metacpan
ord int localtime abs oct pack pop eq scalar print
telldir open unpack return and unlink write chroot
hex bless utime split chown split close rmdir join
exp fileno getc sleep redo glob mkdir stat ne pack
reverse getpwnam next lstat gethostent and getpgrp
eq log ord time xor chr undef and eval caller and
printf srand lstat chown chdir syscall open select
eq -w closedir sleep chr split and quotemeta reset
require ne closedir sleep chr undef or pack unpack
length splice shift umask readpipe pos xor defined
join system and die or do exit if defined require
hex defined undef or sprintf localtime cmp time or
abs time and undef and open exp getc fileno system
caller eof rewinddir readpipe splice shift defined
kill pop wantarray and readlink eof readpipe split
eval warn join study abs localtime oct log time or
reverse xor open 0; print chr ord while readline 0
,;print chr abs length time for cos length getppid
view release on metacpan or search on metacpan
lib/Acme/Schlong.pm view on Meta::CPAN
# has number_of_modules => ( is => 'ro', isa => Int, lazy_build => 1, documentation => q{} );
method _build_useraccounts { scalar grep { !/Shared/ } grep { -d $_ } glob ( dir( $self->home_directory => '..') . '/*'); } #TODO Make safer for WIN
method _build_username_length { length $self->username }
method _build_shell { $_ = $ENV{SHELL}; s/.*\/(.*?)$/$1/; $_ } # /r
method _build_harddrive_size { $_=`df -l | grep '\\/\$' | awk '{print \$2}'`; chomp; $_ } # -E 'use IPC::Run qw<run timeout>; my $out; my @cmd = (q<du>, q<-s>, q</>); run \@cmd, "", \undef, \$out, timeout( 100 ) echo `uptime|grep days|sed...
method _build_harddrive_used { $_=`df -l | grep '\\/\$' | awk '{print \$3}'`; chomp; $_ } # -E 'use IPC::Run qw<run timeout>; my $out; my @cmd = (q<du>, q<-s>, q</>); run \@cmd, "", \undef, \$out, timeout( 100 ) echo `uptime|grep days|sed...
method _build_uptime { 100 }
method _build_users { 5 }
method _build_cores { App::OS::Detect::MachineCores->new->cores }
method _build_using_multiplex { $self->using_byobu or $self->using_tmux or $self->using_screen ? true : false }
method _build_using_byobu { exists $ENV{BYOBU_BACKEND} ? 1 : 0 }
view release on metacpan or search on metacpan
lib/Acme/Selection/RarestFirst.pm view on Meta::CPAN
for ( my $i = 0; $i < $size; $i++ ) {
next if $my_bitfield->get($i);
next if defined $priorities && ( $priorities->[$i] // 1 ) <= 0;
push @candidates, $i;
}
return undef unless @candidates;
# Sort by:
# 1. User priority (higher first)
# 2. Availability (lowest first)
# 3. Random tie-break (achieved by shuffling before sort)
view release on metacpan or search on metacpan
lib/Acme/Shotgun.pm view on Meta::CPAN
my ($class, %args) = @_;
my $self = {
type => 'double',
load => 'bird',
shots => undef,
quiet => 0,
debug => 0,
verbose => 1,
num_rounds => 0,
%args,
lib/Acme/Shotgun.pm view on Meta::CPAN
reloaded on construction.
my $gun = Acme::Shotgun->new(
type => 'double', # 'double' (default) or 'pump'
load => 'bird', # 'bird' (default), 'buck', or 'slug'
shots => undef, # optional: cap the number of rounds loaded
quiet => 0, # suppress all output
debug => 0, # dry-run mode, no file modifications
verbose => 1, # verbose output (disabled automatically if quiet)
);
view release on metacpan or search on metacpan
inc/Module/AutoInstall.pm view on Meta::CPAN
$file =~ s|::|/|g;
$file .= '.pm';
local $@;
return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 );
}
# Load CPAN.pm and it's configuration
sub _load_cpan {
return if $CPAN::VERSION;
inc/Module/AutoInstall.pm view on Meta::CPAN
version->can('new')
) {
# use version.pm if it is installed.
return (
( version->new($cur) >= version->new($min) ) ? $cur : undef );
}
elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) )
{
# use Sort::Versions as the sorting algorithm for a.b.c versions
return ( ( Sort::Versions::versioncmp( $cur, $min ) != -1 )
? $cur
: undef );
}
warn "Cannot reliably compare non-decimal formatted versions.\n"
. "Please install version.pm or Sort::Versions.\n";
}
# plain comparison
local $^W = 0; # shuts off 'not numeric' bugs
return ( $cur >= $min ? $cur : undef );
}
# nothing; this usage is deprecated.
sub main::PREREQ_PM { return {}; }
view release on metacpan or search on metacpan
lib/Acme/Signature/Arity.pm view on Meta::CPAN
=item * number of required scalar parameters
=item * number of optional scalar parameters (probably because there are defaults)
=item * a character representing the slurping behaviour, might be '@' or '%', or nothing (undef?) if it's
just a fixed list of scalar parameters
=back
This can also throw exceptions. That should only happen if you give it something that isn't
lib/Acme/Signature/Arity.pm view on Meta::CPAN
return $next->aux_list($cv);
}
=head2 max_arity
Takes a coderef, returns a number or C<undef>.
If the code uses signatures, this tells you how many parameters you could
pass when calling before it complains - C<undef> means unlimited.
Should also work when there are no signatures, just gives C<undef> again.
=cut
sub max_arity ($code) {
my ($scalars, $optional, $slurp) = arity($code);
return undef if $slurp;
return $scalars
}
=head2 min_arity
Takes a coderef, returns a number or C<undef>.
If the code uses signatures, this tells you how many parameters you need to
pass when calling - 0 means that no parameters are required.
Should also work when there are no signatures, returning 0 in that case.
view release on metacpan or search on metacpan
$signame[$_[0]];
}
sub TIEARRAY {
my $cls = shift;
my $d = undef;
bless \$d => $cls;
}
sub FETCH {
my $i = pop;
sub FETCHSIZE {
scalar @signame;
}
sub STORESIZE { undef }
sub EXTEND { undef }
sub EXISTS {
my $i = pop;
my $name = _signame($i);
unless ($name) { return 0 }
return exists $SIG{$name};
}
sub PUSH { undef }
sub CLEAR { undef }
sub DELETE { undef }
1;
__END__
=head1 NAME
view release on metacpan or search on metacpan
sub famous { $_[0] =~ /[A-Za-z0-9 ]/ }
sub smear {
($celebrity) = @_;
open CLEAN, $celebrity or die "Could not smear the good name of $celebrity\n";
undef $/; $_ = <CLEAN>;
print "$celebrity already smeared\n" and exit unless famous $_;
@dirt = qw&@- /. ~~ ;# ;; ;. ,. ); () *+ __ -( /@ .% /| ;_&; s/(.)/$dirt[ord($1)>>4].$dirt[ord($1)&15]/egs;
open A, ">$celebrity" or print "Could not smear the good name of $celebrity\n\n" and exit;
print A q#$==$';$;||$.|$|;$_='*$(^@(%_+&# . $_ . '&$#%^';print A <<'FILTH' and exit;;
';$__='`'&'&';$___="````"|"$[`$["|'`%",';$~=("$___$__-$[``$__"|"$___"|("$___$__-$[.%")).("'`"|"'$["|"'#").'/.*?&([^&]*)&.*/$'.++$=.("/``"|"/$[`"|"/#'").(";`/[\\`\\`$__]//`;"|";$[/[\\$[\\`$__]//`;"|";#/[\\\$\\.$__]//'").'@:=("@-","/.","~~",";#",";;","...
view release on metacpan or search on metacpan
t/01_test.t view on Meta::CPAN
print "ok 4\n";
}
my $two;
tie $two, 'Acme::Snark';
$two = undef;
$two = undef;
if ($two) {
print "not ok 5\n";
}
else {
print "ok 5\n";
}
$two = undef;
if ($two) {
print "ok 6\n";
}
else {
print "not ok 6\n";
view release on metacpan or search on metacpan
inc/Test/More.pm view on Meta::CPAN
($vars[1] = $var) =~ s/\$FOO/\$expected/;
my $out = "Structures begin differing at:\n";
foreach my $idx (0..$#vals) {
my $val = $vals[$idx];
$vals[$idx] = !defined $val ? 'undef' :
$val eq $DNE ? "Does not exist" :
ref $val ? "$val" :
"'$val'";
}
inc/Test/More.pm view on Meta::CPAN
# the same referenced used twice (such as [\$a, \$a]) to be considered
# circular.
local %Refs_Seen = %Refs_Seen;
{
# Quiet uninitialized value warnings when comparing undefs.
local $^W = 0;
$tb->_unoverload_str(\$e1, \$e2);
# Either they're both references or both not.
view release on metacpan or search on metacpan
t/00-load.t view on Meta::CPAN
Acme::Sort::Bogosort::is_ordered( $compare, [ qw/ E D C B A / ] ),
1,
"is_ordered( \&compare, [ qw/ E D C B A / ] ) returns false."
);
undef $caught;
try {
Acme::Sort::Bogosort::is_ordered( [ qw/ A B C D E / ] );
} catch { $caught = $_ };
like(
$caught,
qr/expects a coderef/,
"is_ordered() throws exception when not handed a coderef as first param."
);
undef $caught;
try {
Acme::Sort::Bogosort::is_ordered( $compare, qw/ A B C D E / );
} catch { $caught = $_ };
like(
$caught,
view release on metacpan or search on metacpan
t/00-load.t view on Meta::CPAN
Acme::Sort::Bozo::is_ordered( $compare, [ qw/ E D C B A / ] ),
1,
"is_ordered( \&compare, [ qw/ E D C B A / ] ) returns false."
);
undef $caught;
try {
Acme::Sort::Bozo::is_ordered( [ qw/ A B C D E / ] );
} catch { $caught = $_ };
like(
$caught,
qr/expects a coderef/,
"is_ordered() throws exception when not handed a coderef as first param."
);
undef $caught;
try {
Acme::Sort::Bozo::is_ordered( $compare, qw/ A B C D E / );
} catch { $caught = $_ };
like(
$caught,
view release on metacpan or search on metacpan
local/lib/perl5/Future.pm view on Meta::CPAN
return if $GLOBAL_END;
return if $self->{ready} and ( $self->{reported} or !$self->{failure} );
my $lost_at = join " line ", (caller)[1,2];
# We can't actually know the real line where the last reference was lost;
# a variable set to 'undef' or close of scope, because caller can't see it;
# the current op has already been updated. The best we can do is indicate
# 'near'.
if( $self->{ready} and $self->{failure} ) {
warn "${\$self->__selfstr} was $self->{constructed_at} and was lost near $lost_at with an unreported failure of: " .
local/lib/perl5/Future.pm view on Meta::CPAN
$done ? $code->done( @result ) :
$fail ? $code->fail( @result ) :
$code->cancel;
}
elsif( $flags & (CB_SEQ_ONDONE|CB_SEQ_ONFAIL) ) {
my ( undef, undef, $fseq ) = @$cb;
if( !$fseq ) { # weaken()ed; it might be gone now
# This warning should always be printed, even not in DEBUG mode.
# It's always an indication of a bug
Carp::carp +(DEBUG ? "${\$self->__selfstr} ($self->{constructed_at})"
: "${\$self->__selfstr} $self" ) .
local/lib/perl5/Future.pm view on Meta::CPAN
$exception = $future->failure
$exception, @details = $future->failure
Returns the exception passed to the C<fail> method, C<undef> if the future
completed successfully via the C<done> method, or raises an exception if
called on a future that is not yet ready.
If called in list context, will additionally yield a list of the details
provided to the C<fail> method.
local/lib/perl5/Future.pm view on Meta::CPAN
sub then
{
my $self = shift;
my $done_code = shift;
my $fail_code = ( @_ % 2 ) ? pop : undef;
my @catch_list = @_;
if( $done_code and !@catch_list and !$fail_code ) {
return $self->_sequence( $done_code, CB_SEQ_ONDONE|CB_RESULT );
}
local/lib/perl5/Future.pm view on Meta::CPAN
=cut
sub catch
{
my $self = shift;
my $fail_code = ( @_ % 2 ) ? pop : undef;
my @catch_list = @_;
return $self->_sequence( $make_donecatchfail_sub->(
0, undef, $fail_code, @catch_list,
), CB_SEQ_ONDONE|CB_SEQ_ONFAIL|CB_SELF );
}
=head2 transform
local/lib/perl5/Future.pm view on Meta::CPAN
sub then_with_f
{
my $self = shift;
my $done_code = shift;
my $fail_code = ( @_ % 2 ) ? pop : undef;
my @catch_list = @_;
if( $done_code and !@catch_list and !$fail_code ) {
return $self->_sequence( $done_code, CB_SEQ_ONDONE|CB_SELF|CB_RESULT );
}
local/lib/perl5/Future.pm view on Meta::CPAN
=cut
sub catch_with_f
{
my $self = shift;
my $fail_code = ( @_ % 2 ) ? pop : undef;
my @catch_list = @_;
return $self->_sequence( $make_donecatchfail_sub->(
1, undef, $fail_code, @catch_list,
), CB_SEQ_ONDONE|CB_SEQ_ONFAIL|CB_SELF );
}
=head2 followed_by
local/lib/perl5/Future.pm view on Meta::CPAN
I<Since version 0.28.>
If both tracing timestamps are defined, returns the number of seconds of
elapsed time between them as a floating-point number. If not, returns
C<undef>.
=cut
sub elapsed
{
my $self = shift;
return undef unless defined $self->{btime} and defined $self->{rtime};
return $self->{elapsed} ||= tv_interval( $self->{btime}, $self->{rtime} );
}
=head2 wrap_cb
view release on metacpan or search on metacpan
# we need to expand this test to include other Damian modules.
if (victim($file)) {
carp "$file doesn't like spiders";
return 0;
}
return undef;
}
BEGIN { unshift @INC, \&bite }
=head1 AUTHORS
view release on metacpan or search on metacpan
lib/Acme/Spinodal/Utils.pm view on Meta::CPAN
=cut
sub _check_number {
if( !defined $_[0] ){
croak( "Argument was undefined!");
}
if( ref $_[0]){
croak( "Expected a scalar, but found ". ref $_[0] );
}
view release on metacpan or search on metacpan
my $ysize = $self->y;
for (my $y = $ysize; $y-- > 0; ) {
# New row
my $this_row = $next_row;
undef $next_row;
for (my $x = $xsize; $x-- > 0; ) {
my $offset = $y * $xsize + $x;
# I'm not sure if I've got the algorithm correct.
view release on metacpan or search on metacpan
t/000-report-versions-tiny.t view on Meta::CPAN
diag("${module}: $@");
$pmver = 'died during VERSION check.';
} elsif (defined $version) {
$pmver = "$version";
} else {
$pmver = '<undef>';
}
}
# So, we should be good, right?
return sprintf('%-45s => %-10s%-15s%s', $module, $pmver, $wanted, "\n");
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
defined $_[0]
and
! ref $_[0]
and
$_[0] =~ m/^[^\W\d]\w*(?:::\w+)*$/s
) ? $_[0] : undef;
}
1;
# Copyright 2008 Adam Kennedy.
view release on metacpan or search on metacpan
DateLocales.pm view on Meta::CPAN
POSIX::setlocale(&POSIX::LC_TIME, $locale);
}
my %locale_res;
{
my @l = (0,0,0,1,undef,2000-1900);
for my $mon (1..12) {
$l[4] = $mon-1;
push @{$locale_res{'%B'}}, strftime("%B", @l);
push @{$locale_res{'%b'}}, strftime("%b", @l);
push @{$locale_res{'%OB'}}, strftime("%OB", @l);
}
}
{
my @l = (0,0,0,1,1,1,undef);
foreach my $wkday (0..6) {
$l[6] = $wkday;
push @{$locale_res{'%A'}}, strftime("%A", @l);
push @{$locale_res{'%a'}}, strftime("%a", @l);
}
DateLocales.pm view on Meta::CPAN
return "$_\\$prog.cmd" if (-f "$_\\$prog.cmd" && -x "$_\\$prog.cmd");
} else {
return "$_/$prog" if (-x "$_/$prog" && !-d "$_/$prog");
}
}
undef;
}
# REPO END
1;
view release on metacpan or search on metacpan
examples/function_use_example.pl view on Meta::CPAN
#############################################
# function with two parameters
#
# 'thing' which is optional and defaults to "Something Blue" if not passed
# 'other_thing' which is required and cannot be the undef value
#
sub foo {
BindParms : (
my $thing : thing [optional, default="Something Red"];
my $other : other_thing [required, is_defined];
view release on metacpan or search on metacpan
lib/Acme/SubstituteSubs.pm view on Meta::CPAN
If the package doesn't already exist in the source file of the script, it'll be added to the end and
the new function placed after it.
If attempting to replace a function defined elsewhere than the top level C<.pl> file, such as in some module,
the module won't be changed, but the code will instead be replicated into the main script.
The result is undefined when run from C<perl -e>.
C<die>s if it fails to write and replace the original source file.
=head2 C<< Acme::SubstituteSubs->list() >>
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
$VERSION = '0.88';
# Storage for the pseudo-singleton
$MAIN = undef;
*inc::Module::Install::VERSION = *VERSION;
@inc::Module::Install::ISA = __PACKAGE__;
}
inc/Module/Install.pm view on Meta::CPAN
defined $_[0]
and
! ref $_[0]
and
$_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
) ? $_[0] : undef;
}
1;
# Copyright 2008 - 2009 Adam Kennedy.
view release on metacpan or search on metacpan
lib/Acme/TLDR.pm view on Meta::CPAN
unless (exists $collisions{$short}) {
++$collisions{$short};
$modules{$long} = $short;
_debug(q(%-64s => %s), $long, $short);
} else {
_debug(q(%-64s => *undef*), $long);
}
}
return \%modules;
}
view release on metacpan or search on metacpan
lib/Acme/Taboo.pm view on Meta::CPAN
bless [@list], $class;
}
sub censor {
my ($self, $str) = @_;
my $taboo = my $replace = undef;
for $taboo (@$self) {
$replace = $self->_get_replace;
$str =~ s{$taboo}{$replace}g;
}
return $str;
view release on metacpan or search on metacpan
);
# Check to see whether we have an odd or even number of arguments
my ($maybe_template, $args) = File::Temp::_parse_args(@_);
carp "options args->{DIR} $args->{DIR}" if tainted($args->{DIR});
my $template = @$maybe_template ? $maybe_template->[0] : undef;
# Read the options and merge with defaults
%options = (%options, %$args);
carp "options dir 1 $options{DIR}" if tainted($options{'DIR'});
carp "options dir 2 $options{DIR}" if tainted($options{'DIR'});
# Strip parent directory from the filename
#
# There is no filename at the end
my ($volume, $directories, undef) = File::Spec->splitpath( $template, 1);
# Last directory is then our template
$template = (File::Spec->splitdir($directories))[-1];
carp "tempdir after spltdir tainted template $template" if tainted($template);
my $tempdir;
my $suffixlen = 0;
my $errstr;
croak "Error in tempdir() using $template: $errstr"
unless ((undef, $tempdir) = File::Temp::_gettemp($template,
"open" => 0,
"mkdir"=> 1 ,
"suffixlen" => $suffixlen,
"ErrStr" => \$errstr,
) );
# Install exit handler; must be dynamic to get lexical
if ( $options{'CLEANUP'} && -d $tempdir) {
_deferred_unlink(undef, $tempdir, 1);
}
# Return the dir name
return $tempdir;