view release on metacpan or search on metacpan
use FindBin;
use base qw(Exporter);
our @EXPORT = qw(test_redis);
sub test_redis(&;$) {
my $cb = shift;
my $args = shift;
chomp(my $redis_server = `which redis-server`);
unless ($redis_server && -e $redis_server && -x _) {
view release on metacpan or search on metacpan
lib/Time/Activated.pm view on Meta::CPAN
execute_logic { print "This is a verbose way of saying that this will be executed!" };
=cut
sub execute_logic(&) {
my ($code) = @_;
return $code;
}
=head2 PRIVATES
view release on metacpan or search on metacpan
lib/Time/Decimal.pm view on Meta::CPAN
cs => .01,
ms => .001,
'µs' => .000_001,
us => .000_001,
"\xb5s" => .000_001); # Latin-[13579] µ
sub loop(&) {
my $callback = $_[0];
require Time::HiRes;
my $last = '';
while( 1 ) {
my( $usec, $sec, $min, $h ) = Time::HiRes::time();
view release on metacpan or search on metacpan
lib/Time/UTC.pm view on Meta::CPAN
To do this for only one segment, see the C<when_complete> method on
C<Time::UTC::Segment>.
=cut
sub foreach_utc_segment_when_complete(&) {
my($what) = @_;
my $setup_for_segment;
$setup_for_segment = sub($) {
my($seg) = @_;
$seg->when_complete(sub() {
view release on metacpan or search on metacpan
lib/Trace/Mask/Carp.pm view on Meta::CPAN
*Carp::confess = \&confess;
*Carp::longmess = \&longmess;
*Carp::cluck = \&cluck;
}
sub mask(&) {
my ($code) = @_;
my $sigwarn = $SIG{__WARN__};
my $sigdie = $SIG{__DIE__};
local $SIG{__WARN__};
view release on metacpan or search on metacpan
t/23-rekey.t view on Meta::CPAN
use lib "$FindBin::RealBin/lib";
use Test2WithExplain;
use Tree::RB::XS qw( KEY_TYPE_INT KEY_TYPE_FLOAT );
use Time::HiRes 'time';
sub err(&) { my $code= shift; local $@; eval { $code->() }; my $err= "$@"; return $err; }
subtest error_unless_int_or_float => sub {
my $tree= Tree::RB::XS->new(key_type => KEY_TYPE_INT, kv => [ 1,1 ]);
is( err { $tree->rekey(offset => 1) }, '', 'int' );
view release on metacpan or search on metacpan
lib/Tree/SizeBalanced.pm view on Meta::CPAN
=cut
use Tree::SizeBalanced::any_void;
sub sbtree_any_void(&) {
unshift @_, 'Tree::SizeBalanced::any_void';
goto \&Tree::SizeBalanced::any_void::new;
}
sub sbtreea(&) {
unshift @_, 'Tree::SizeBalanced::any_void';
goto \&Tree::SizeBalanced::any_void::new;
}
push @EXPORT_OK, qw(sbtree_any_void sbtreea);
lib/Tree/SizeBalanced.pm view on Meta::CPAN
=cut
use Tree::SizeBalanced::any_int;
sub sbtree_any_int(&) {
unshift @_, 'Tree::SizeBalanced::any_int';
goto \&Tree::SizeBalanced::any_int::new;
}
sub sbtreeai(&) {
unshift @_, 'Tree::SizeBalanced::any_int';
goto \&Tree::SizeBalanced::any_int::new;
}
push @EXPORT_OK, qw(sbtree_any_int sbtreeai);
lib/Tree/SizeBalanced.pm view on Meta::CPAN
=cut
use Tree::SizeBalanced::any_num;
sub sbtree_any_num(&) {
unshift @_, 'Tree::SizeBalanced::any_num';
goto \&Tree::SizeBalanced::any_num::new;
}
sub sbtreean(&) {
unshift @_, 'Tree::SizeBalanced::any_num';
goto \&Tree::SizeBalanced::any_num::new;
}
push @EXPORT_OK, qw(sbtree_any_num sbtreean);
lib/Tree/SizeBalanced.pm view on Meta::CPAN
=cut
use Tree::SizeBalanced::any_any;
sub sbtree_any_any(&) {
unshift @_, 'Tree::SizeBalanced::any_any';
goto \&Tree::SizeBalanced::any_any::new;
}
sub sbtreeaa(&) {
unshift @_, 'Tree::SizeBalanced::any_any';
goto \&Tree::SizeBalanced::any_any::new;
}
push @EXPORT_OK, qw(sbtree_any_any sbtreeaa);
view release on metacpan or search on metacpan
lib/Tree/Transform/XSLTish.pm view on Meta::CPAN
);
return;
}
sub engine_factory(&) {
my ($new_factory)=@_;
Tree::Transform::XSLTish::Utils::_set_engine_factory(
scalar caller,
$new_factory,
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
ok $actual eq $expected,
$name . "\n" . Text::Diff::diff(\$expected, \$actual);
}
}
sub run(&;$) {
(my ($self), @_) = find_my_self(@_);
my $callback = shift;
for my $block (@{$self->block_list}) {
$block->run_filters unless $block->is_filtered;
&{$callback}($block);
view release on metacpan or search on metacpan
t/filter_chain.t view on Meta::CPAN
close($stdout_r);
return $pid;
}
}
sub run_cgi(&;$)
{
my $code = shift;
my $param = shift || {};
my $pid = my_fork(my $stdout);
view release on metacpan or search on metacpan
lib/Try/ALRM.pm view on Meta::CPAN
#NOTE: C<try_once> a case of C<retry>, where C<< tries => 1 >>.
sub try_once (&;@) {
&retry( @_, tries => 1 ); #&retry, bypasses prototype
}
sub retry(&;@) {
unshift @_, q{retry}; # adding marker, will be key for this &
my %TODO = @_;
my $TODO = \%TODO;
my $RETRY = $TODO->{retry} // sub { }; # defaults to no-op
view release on metacpan or search on metacpan
lib/Try/Catch.pm view on Meta::CPAN
sub _default_catch {
croak $_[0];
}
sub try(&;@) {
my $wantarray = wantarray;
my $try = shift;
my $caller = pop;
my $finally = pop;
my $catch = pop;
lib/Try/Catch.pm view on Meta::CPAN
$@ = $prev_error;
return $wantarray ? @ret : $ret[0];
}
sub catch(&;@) {
croak 'Useless bare catch()' unless wantarray;
if (@_ > 1){
croak "syntax error after catch block - maybe a missing semicolon"
if !$_[2] || $_[2] ne __PACKAGE__;
} else {
return ( shift, undef, __PACKAGE__);
}
return (@_);
}
sub finally(&;@) {
croak 'Useless bare finally()' unless wantarray;
if (@_ > 1) {
croak "syntax error after finally block - maybe a missing semicolon";
}
return ( shift, __PACKAGE__ );
view release on metacpan or search on metacpan
lib/Try/Tiny/Retry.pm view on Meta::CPAN
eval "use Sub::Name; 1" or *{subname} = sub { 1 }
}
our $_DEFAULT_DELAY = 1e5; # to override for testing
sub delay(&;@) { ## no critic
my ( $block, @rest ) = @_;
return ( bless( \$block, 'Try::Tiny::Retry::Delay' ), @rest, );
}
sub on_retry(&;@) { ## no critic
my ( $block, @rest ) = @_;
return ( bless( \$block, 'Try::Tiny::Retry::OnRetry' ), @rest, );
}
sub retry_if(&;@) { ## no critic
my ( $block, @rest ) = @_;
return ( bless( \$block, 'Try::Tiny::Retry::RetryIf' ), @rest, );
}
sub delay_exp(&;@) { ## no critic
my ( $params, @rest ) = @_;
my ( $n, $scale ) = $params->();
require Time::HiRes;
lib/Try/Tiny/Retry.pm view on Meta::CPAN
return if $_[0] >= $n;
Time::HiRes::usleep( int rand( $scale * ( 1 << ( $_[0] - 1 ) ) ) );
}, @rest;
}
sub retry(&;@) { ## no critic
my ( $try, @code_refs ) = @_;
# name the block if we have Sub::Name
my $caller = caller;
subname( "${caller}::retry {...} " => $try );
view release on metacpan or search on metacpan
lib/Try/Tiny/Warnings.pm view on Meta::CPAN
our %EXPORT_TAGS = (
'all' => [ @EXPORT, @EXPORT_OK ],
);
sub try_fatal_warnings(&;@) {
my $sub = shift;
local $SIG{__WARN__} = sub { die @_ };
try { $sub->() } @_;
};
sub try_warnings(&;@) {
my $sub = shift;
my @warnings;
local $SIG{__WARN__} = sub { push @warnings, @_ };
lib/Try/Tiny/Warnings.pm view on Meta::CPAN
: $_
} @_;
};
sub catch_warnings(&;@) {
my $sub = shift;
return bless( $sub, 'Try::Tiny::Warnings::Catch' ), @_
};
1;
view release on metacpan or search on metacpan
{
package t::TiedScalar::CountFetch;
sub TIESCALAR { bless({ value => $_[1] }, $_[0]) }
sub FETCH { $fetched++; $_[0]->{value} }
}
sub tm1(&$;$) {
untie $magic;
$magic = $_[2];
tie $magic, "t::TiedScalar::CountFetch", $_[1];
$fetched = 0;
$_[0]->();
view release on metacpan or search on metacpan
lib/UR/Context/Transaction.pm view on Meta::CPAN
}
}
# eval function takes a block (&) sort of like CORE::eval
# eval will rollback on a caught die
sub eval(&) {
my $is_failure = sub {
my ($result, $eval_error) = @_;
return $eval_error;
};
return eval_or_do($is_failure, @_);
}
# do function takes a block (&) sort of like CORE::do
# do will rollback on a false result as well as before re-throwing a caught die
sub do(&) {
my $is_failure = sub {
my ($result, $eval_error) = @_;
return !$result || $eval_error;
};
my ($result, $eval_error) = eval_or_do($is_failure, @_);
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
ok $actual eq $expected,
$name . "\n" . Text::Diff::diff(\$expected, \$actual);
}
}
sub run(&;$) {
(my ($self), @_) = find_my_self(@_);
my $callback = shift;
for my $block (@{$self->block_list}) {
$block->run_filters unless $block->is_filtered;
&{$callback}($block);
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
ok $actual eq $expected,
$name . "\n" . Text::Diff::diff(\$expected, \$actual);
}
}
sub run(&;$) {
(my ($self), @_) = find_my_self(@_);
my $callback = shift;
for my $block (@{$self->block_list}) {
$block->run_filters unless $block->is_filtered;
&{$callback}($block);
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
ok $actual eq $expected,
$name . "\n" . Text::Diff::diff(\$expected, \$actual);
}
}
sub run(&;$) {
(my ($self), @_) = find_my_self(@_);
my $callback = shift;
for my $block (@{$self->block_list}) {
$block->run_filters unless $block->is_filtered;
&{$callback}($block);
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
ok $actual eq $expected,
$name . "\n" . Text::Diff::diff(\$expected, \$actual);
}
}
sub run(&;$) {
(my ($self), @_) = find_my_self(@_);
my $callback = shift;
for my $block (@{$self->block_list}) {
$block->run_filters unless $block->is_filtered;
&{$callback}($block);
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
ok $actual eq $expected,
$name . "\n" . Text::Diff::diff(\$expected, \$actual);
}
}
sub run(&;$) {
(my ($self), @_) = find_my_self(@_);
my $callback = shift;
for my $block (@{$self->block_list}) {
$block->run_filters unless $block->is_filtered;
&{$callback}($block);
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
ok $actual eq $expected,
$name . "\n" . Text::Diff::diff(\$expected, \$actual);
}
}
sub run(&;$) {
(my ($self), @_) = find_my_self(@_);
my $callback = shift;
for my $block (@{$self->block_list}) {
$block->run_filters unless $block->is_filtered;
&{$callback}($block);
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
ok $actual eq $expected,
$name . "\n" . Text::Diff::diff(\$expected, \$actual);
}
}
sub run(&;$) {
(my ($self), @_) = find_my_self(@_);
my $callback = shift;
for my $block (@{$self->block_list}) {
$block->run_filters unless $block->is_filtered;
&{$callback}($block);
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
ok $actual eq $expected,
$name . "\n" . Text::Diff::diff(\$expected, \$actual);
}
}
sub run(&;$) {
(my ($self), @_) = find_my_self(@_);
my $callback = shift;
for my $block (@{$self->block_list}) {
$block->run_filters unless $block->is_filtered;
&{$callback}($block);
view release on metacpan or search on metacpan
URPM/Resolve.pm view on Meta::CPAN
=cut
#- a few functions from MDK::Common copied here:
sub any(&@) {
my $f = shift;
$f->($_) and return 1 foreach @_;
0;
}
sub uniq {
my (@l) = @_;
my %l;
$l{$_} = 1 foreach @l;
grep { delete $l{$_} } @l;
}
sub find(&@) {
my $f = shift;
$f->($_) and return $_ foreach @_;
undef;
}
view release on metacpan or search on metacpan
script/uniquote view on Meta::CPAN
use File::Basename;
#################################################################
sub main;
sub atexit(&);
sub convert_to_U_numbers(_);
sub convert_to_backslashes(_);
sub convert_to_bytes(_);
sub convert_to_hex(_);
sub convert_to_html4(_);
script/uniquote view on Meta::CPAN
sub panic($) {
confess "$0: [INTERNAL ERROR] @_";
}
sub atexit(&) {
my $coderef = shift();
eval q{ END { &$coderef } };
die if $@;
}
view release on metacpan or search on metacpan
lib/Unix/Sudo.pm view on Meta::CPAN
This module is also free-as-in-mason software.
=cut
sub sudo(&) {
my $context = peek_my(1);
my $code = "use warnings;use strict;\n";
my $deparse = B::Deparse->new();
view release on metacpan or search on metacpan
$ENV{CCM_DATETIME_FMT} = "%Y-%m-%d %H:%M:%S";
}
# all_ok BLOCK AREF [, TEST_NAME]
# check if predicate BLOCK holds for all elements in list
sub all_ok(&$;$)
{
my ($block, $aref, $test_name) = @_;
local $Test::Builder::Level = 2; # report failure for caller of all_ok
view release on metacpan or search on metacpan
lib/VS/RuleEngine/Declare.pm view on Meta::CPAN
with_defaults
);
our $current_engine;
sub engine(&) {
my ($sub, $name) = @_;
my $engine = VS::RuleEngine::Engine->new();
local $current_engine = $engine;
lib/VS/RuleEngine/Declare.pm view on Meta::CPAN
sub as($) {
return $_[0];
}
sub does(&) {
my $cv = shift;
my $does = bless [$cv], "_Does";
return $does;
}
view release on metacpan or search on metacpan
where => $args{where} || sub { 1 },
message => $args{message} || sub { "Must be a valid '$name'" },
);
}# end subtype()
sub as { as => shift, @_ }
sub where(&) { where => $_[0] }
sub message(&) { message => $_[0] }
sub coerce($;@)
{
my ($to, %args) = @_;
confess "Coercion from '$args{from}' to '$to' is already defined in $filename line $line"
if defined($_coercions->{$to}->{$args{from}});
$_coercions->{$to}->{$args{from}} = $args{via};
}# end coerce()
sub from { from => shift, @_ }
sub via(&) { via => $_[0] }
sub enum($$)
{
my ($name, $vals) = @_;