view release on metacpan or search on metacpan
lib/App/Gitc/Reversible.pm view on Meta::CPAN
push our(@undo_stack), $code;
return;
}
sub reversibly(&) {
my ($code) = @_;
local $SIG{INT} = sub { die "SIGINT\n" };
local $SIG{TERM} = sub { die "SIGTERM\n" };
local our(@undo_stack); # to allow nested, reversible computations
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
use Test2::Bundle::Extended;
use App::Inspect;
sub capture(&) {
my $code = shift;
my $out = "";
my ($ok, $e);
view release on metacpan or search on metacpan
t/lib/TestUtils.pm view on Meta::CPAN
$_[0] = decode($enc, $_[0], Encode::DIE_ON_ERR|Encode::LEAVE_SRC);
$res;
}
# TODO: call only as assert_raises_exception sub {}, $e - don't omit sub!
sub assert_raises_exception(&@)
{
my ($cb, $exception) = @_;
ok !defined eval { $cb->(); 1 };
my $err = $@;
cmp_deeply $err, superhashof($exception);
t/lib/TestUtils.pm view on Meta::CPAN
} else {
ok (1, $message);
}
}
sub with_fork(&&)
{
my ($parent_cb, $child_cb) = @_;
my $ppid = $$;
my $fromchild = new IO::Pipe;
my $tochild = new IO::Pipe;
view release on metacpan or search on metacpan
bin/atonal-util view on Meta::CPAN
#
# SUBROUTINES
# TODO move back to List::MoreUtils if that module is fixed up or some
# replacement with fewer open critical bugs is written.
sub all(&@) {
my $test = shift;
for (@_) {
return 0 unless &$test;
}
return 1;
view release on metacpan or search on metacpan
local/lib/perl5/Test/Spec.pm view on Meta::CPAN
label => $name,
});
}
# around CODE
sub around(&) {
my $package = caller;
my $code = pop;
if (ref($code) ne 'CODE') {
Carp::croak "expected subroutine reference as last argument";
}
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
maint/mk_fatlib.pl view on Meta::CPAN
}
my ($last) =
[ sort { $b->stat->mtime <=> $a->stat->mtime } @buildcandidates ]->[0];
print "Making fatlib using $last\n";
sub withlib(&) {
my ($code) = @_;
my $oldopts = $ENV{PERL5OPT} || '';
my @oldlib = split /:/, $ENV{PERL5LIB} || '';
# local $ENV{PERL5OPT} = "$oldopts -I${last}/lib";
maint/mk_fatlib.pl view on Meta::CPAN
#STDERR->print("\e[31mPERL5OPT=$ENV{PERL5OPT}\e[0m\n");
return $code->();
}
sub inbuild(&) {
my ($code) = @_;
chdir $last;
$code->();
chdir $cwd;
}
view release on metacpan or search on metacpan
t/t_TestCommon.pm view on Meta::CPAN
open($orig_stdERR, ">&", \*STDERR) or die "dup STDERR: $!";
close STDERR;
open(STDERR, ">", \$inmem_stdERR) or die "redir STDERR: $!";
binmode(STDERR); binmode(STDERR, ":utf8");
}
sub silent(&) {
my $wantarray = wantarray;
my $code = shift;
_start_silent();
my @result = do{
if (defined $wantarray) {
t/t_TestCommon.pm view on Meta::CPAN
my ($fn, $lno) = (caller(0))[1,2];
#use Data::Dumper::Interp; say dvis '###insert_loc_in_evalstr $fn $lno';
"# line $lno \"$fn\"\n".$orig
}
sub timed_run(&$@) {
my ($code, $maxcpusecs, @codeargs) = @_;
my $getcpu = eval {do{
require Time::HiRes;
() = (&Time::HiRes::clock());
t/t_TestCommon.pm view on Meta::CPAN
# to the cwd!
$str =~ s/The media is write protected\S*\R//gs;
$str
}
sub my_capture(&) {
my ($out, $err, @results) = &capture($_[0]);
return( clean_capture_output($out), clean_capture_output($err), @results );
}
sub my_capture_merged(&) {
my ($merged, @results) = &capture_merged($_[0]);
return( clean_capture_output($merged), @results );
}
sub my_tee_merged(&) {
my ($merged, @results) = &tee_merged($_[0]);
return( clean_capture_output($merged), @results );
}
1;
view release on metacpan or search on metacpan
lib/App/gh/Git.pm view on Meta::CPAN
Note that this is the only auto-exported function.
=cut
sub git_cmd_try(&$) {
my ($code, $errmsg) = @_;
my @result;
my $err;
my $array = wantarray;
try {
view release on metacpan or search on metacpan
lib/App/olson.pm view on Meta::CPAN
#
# list utilities
#
sub _all(&@) {
my $match = shift(@_);
foreach(@_) {
return 0 unless $match->($_);
}
return 1;
view release on metacpan or search on metacpan
local $_ = shift;
&pl;
}
# run pl, expect $_ altered by shift->()
sub pl_a(&@) {
at;
local $_ = $_;
shift->();
&pl;
}
view release on metacpan or search on metacpan
local $_ = shift;
&pltest;
}
# run pltest, expect $_ altered by shift->()
sub pl_a(&@) {
local $_ = $_;
shift->();
&pltest;
}
view release on metacpan or search on metacpan
sub init {
$FindBin::Bin .= "/.." if $FindBin::Bin !~ m!/\.\.!;
$t::Plugin::Dummy::RUN_COUNTER = 0;
}
sub capture(&) {
my $code = shift;
$ERR = undef;
$OUT = undef;
view release on metacpan or search on metacpan
t/01-colors.t view on Meta::CPAN
use Test::More tests => 5;
use Archlinux::Term qw(:all);
my %CODE_OF = ( 'red' => 31, 'green' => 32, 'yellow' => 33, 'blue' => 34, );
sub output_of(&)
{
my ($code_ref) = @_;
open my $old_stdout, '>&STDOUT' or die "open: $!";
my $out_buffer;
view release on metacpan or search on metacpan
lib/Array/AllUtils.pm view on Meta::CPAN
goto &Exporter::import;
}
# BEGIN_BLOCK: first
sub first(&$) {
my $code = shift;
for (@{$_[0]}) {
return $_ if $code->($_);
}
undef;
}
# END_BLOCK: first
# BEGIN_BLOCK: firstidx
sub firstidx(&$) {
my $code = shift;
my $i = 0;
for (@{$_[0]}) {
return $i if $code->($_);
$i++;
view release on metacpan or search on metacpan
lib/Array/Extract.pm view on Meta::CPAN
the array is a tied object with a class such as
Tie::File)
=cut
sub extract(&\@) {
my $block = shift;
my $array = shift;
# loop invariants. The element we're currently on
# and the length of the array
view release on metacpan or search on metacpan
lib/Assert/Conditional.pm view on Meta::CPAN
$joy ? "happy" : "unhappy",
subname_or_code($code),
$joy ? "false" : "true";
}
sub assert_happy_code(&)
:Assert( qw[boolean code] )
{
my($cref) = @_;
_run_code_test($cref => 1);
}
sub assert_unhappy_code(&)
:Assert( qw[boolean code] )
{
my($cref) = @_;
_run_code_test($cref => 0);
}
view release on metacpan or search on metacpan
lib/Assert/Refute.pm view on Meta::CPAN
It will stay available (with a warning) until as least 0.15.
=cut
sub try_refute(&;@) { ## no critic # need prototype
my ( $block, @arg ) = @_;
# Should a missing config even happen? Ok, play defensively...
my $conf = $CALLER_CONF{+caller};
if( !$conf ) {
view release on metacpan or search on metacpan
lib/Async/ContextSwitcher.pm view on Meta::CPAN
Make sure that all callbacks in your code are created with this function
or you can loose track of your context.
=cut
sub cb_w_context(&) {
my $cb = $_[0];
my $ctx = $CTX;
return sub {
$CTX = $ctx;
goto &$cb;
view release on metacpan or search on metacpan
lib/Attribute/Default.pm view on Meta::CPAN
## One specifies an expanding subroutine for Default by saying 'exsub
## { YOUR CODE HERE }'. It's run and used as a default at runtime.
##
## Exsubs are marked by being blessed into EXSUB_CLASS.
##
sub exsub(&) {
my ($sub) = @_;
ref $sub eq 'CODE' or die "Sub '$sub' can't be blessed: must be CODE ref";
bless $sub, EXSUB_CLASS;
}
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
lib/Attribute/Types.pm view on Meta::CPAN
$attr{$_}++;
}
}
sub verify(&) {
use warnings 'all';
local $^W = 1;
my $fail = 0;
local $SIG{__WARN__} = sub { $fail=1 };
return eval { $_[0]->() && !$fail };
view release on metacpan or search on metacpan
lib/Audit/Log.pm view on Meta::CPAN
}
close($fh);
return $ret;
}
sub file_changes(&@) {
my ( $block, @dirs ) = @_;
my %rules;
# Instruct auditctl to add UUID based rules
foreach my $dir (@dirs) {
view release on metacpan or search on metacpan
lib/B/Tools.pm view on Meta::CPAN
use parent qw(Exporter);
our @EXPORT = qw(op_grep op_walk op_descendants);
sub op_walk(&$) {
my ($code, $op) = @_;
local *B::OP::walkoptree_simple = sub {
local $_ = $_[0];
$code->();
};
B::walkoptree($op, 'walkoptree_simple');
}
sub op_grep(&$) {
my ($code, $op) = @_;
my @ret;
op_walk {
if ($code->()) {
view release on metacpan or search on metacpan
}
return $data;
}
sub bgs_call(&$) {
my ($sub, $callback) = @_;
my $data = _bgs_call($sub, $callback);
return $$data{vpid};
}
sub bgs_back(&) { shift }
sub bgs_wait(;$) {
my ($waited) = @_;
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
lib/Bash/History/Read.pm view on Meta::CPAN
undef $ts;
}
}
}
sub each_hist(&) {
my $code = shift;
_doit('each_hist', $code);
}
sub parse_bash_history_file {
view release on metacpan or search on metacpan
lib/Bolts.pm view on Meta::CPAN
},
)
);
}
sub contains(&;$) {
my ($parent_meta, $code, $such_that_each) = @_;
my $meta = _bag_meta($parent_meta);
return sub {
lib/Bolts.pm view on Meta::CPAN
my ($meta, $params) = @_;
return $params;
}
sub builder(&) {
my ($meta, $code) = @_;
$meta = _bag_meta($meta);
return {
blueprint => $meta->acquire('blueprint', 'built_injector', {
view release on metacpan or search on metacpan
lib/Bot/Backbone/DispatchSugar.pm view on Meta::CPAN
)
);
}
our $WITH_ARGS;
sub given_parameters(&$) {
my ($meta, $arg_code, $predicate) = @_;
my $dispatcher = $meta->building_dispatcher;
my @args;
{
lib/Bot/Backbone/DispatchSugar.pm view on Meta::CPAN
sub parameter($@) {
my ($name, %config) = @_;
push @$WITH_ARGS, [ $name, \%config ];
}
sub as(&) {
my $code = shift;
return $code;
}
sub _respond {
lib/Bot/Backbone/DispatchSugar.pm view on Meta::CPAN
the_code => $code,
)
);
}
sub respond(&) {
my ($meta, $code, $dispatcher_type) = @_;
_respond($meta, $code, $dispatcher_type);
}
sub _run_this {
lib/Bot/Backbone/DispatchSugar.pm view on Meta::CPAN
the_code => $code,
)
);
}
sub run_this(&) {
my ($meta, $code, $dispatcher_type) = @_;
_run_this($meta, $code, $dispatcher_type);
}
sub _by_method {