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
my $CLASS = __PACKAGE__;
our @EXPORT = qw/lives_ok throws_ok lives_and/;
sub lives_ok(&;$) {
my ($code, $description) = @_;
my $tb = $CLASS->builder;
eval { $code->() };
$tb->ok(!$@, $description || "lives_ok");
}
sub throws_ok(&$;$) {
my ($code, $regexp, $description) = @_;
my $tb = $CLASS->builder;
eval { $code->() };
$tb->like($@, $regexp, $description || "throws_ok");
}
sub lives_and(&;$) {
my ($code, $description) = @_;
$CLASS->builder->subtest($description || 'lives_and', sub {
local $Test::Builder::Level = $Test::Builder::Level + 1;
eval {
$code->();
view release on metacpan or search on metacpan
lib/Sort/Hash/Values.pm view on Meta::CPAN
use warnings;
use Exporter 5.59 qw/import/;
our @EXPORT = our @EXPORT_OK = qw/sort_values/;
# Returns keys of sorted hash values
sub sort_values(&@) {
my ($code, %hash) = @_;
# Perl has special behavior when code prototype is $$ of uploading
# sorted values to @_. || "" is needed to avoid undef warning.
if ((prototype $code || "") eq '$$') {
view release on metacpan or search on metacpan
lib/Sort/MultipleFields.pm view on Meta::CPAN
mfsort sub { ... }, @list
=cut
sub mfsort(&@) {
my $spec = shift;
my @records = @_;
@records = @{$records[0]} if(reftype($records[0]) eq 'ARRAY');
(grep { reftype($_) ne 'HASH' } @records) &&
die(__PACKAGE__."::mfsort: Can only sort hash-refs\n");
view release on metacpan or search on metacpan
lib/Spreadsheet/Edit.pm view on Meta::CPAN
# sort_row_indicies {compare function}
# sort_row_indicies {compare function} $first_rx, $last_rx
#
# Returns [list of row indicies] but does not actually change anything.
# In list context, returns ( [list of row indicies], $first_rx, $last_rx )
sub sort_indicies(&;$$) {
my $self = &__selfmust;
my ($indicies, $first_rx, $last_rx) = $self->_internal_sort_indicies(@_);
if (wantarray) {
return( $indicies, $first_rx, $last_rx );
}
lib/Spreadsheet/Edit.pm view on Meta::CPAN
}
# sort_rows {compare function}
# sort_rows {compare function} $first_rx, $last_rx
sub sort_rows(&;$$) {
my $self = &__selfmust;
my ($indicies, $first_rx, $last_rx) = $self->_internal_sort_indicies(@_);
my ($rows, $linenums) = @$$self{qw/rows linenums/};
@$rows[$first_rx..$#$rows] = @$rows[@$indicies];
lib/Spreadsheet/Edit.pm view on Meta::CPAN
# obj->join_cols separator_or_coderef, colspecs...
# If coderef:
# $_ is bound to the first-named column, and is the destination
# @_ is bound to all named columns, in the order named.
sub join_cols(&@) {
my $self = &__selfmust;
my ($separator, @sources) = @_;
my $hash = $$self;
my ($num_cols, $rows) = @$hash{qw/num_cols rows/};
lib/Spreadsheet/Edit.pm view on Meta::CPAN
# apply {code}, colspec*
# @_ are bound to the columns in the order specified (if any)
# $_ is bound to the first such column
# Only visit rows bounded by first_data_rx and/or last_data_rx,
# starting with title_rx+1 if a title row is defined.
sub apply(&;@) {
my $self = &__selfmust;
my ($code, @cols) = @_;
my $hash = $$self;
my @cxs = map { scalar $self->_spec2cx($_) } @cols;
lib/Spreadsheet/Edit.pm view on Meta::CPAN
goto &_apply_to_rows
}
# apply_all {code}, colspec*
# Like apply, but ALL rows are visited, inluding the title row if any
sub apply_all(&;@) {
my $self = &__selfmust;
my ($code, @cols) = @_;
my $hash = $$self;
my @cxs = map { scalar $self->_spec2cx($_) } @cols;
log_methcall $self, [\"rx 0..",$#{$hash->{rows}},
lib/Spreadsheet/Edit.pm view on Meta::CPAN
# apply_torx {code} rx, colspec*
# apply_torx {code} [rx list], colspec*
# Only the specified row(s) are visited
# first/last_data_rx are ignored.
sub apply_torx(&$;@) {
my $self = &__selfmust;
my ($code, $rxlist_arg, @cols) = @_;
croak "Missing rx (or [list of rx]) argument\n" unless defined $rxlist_arg;
my $rxlist = __arrify_checknotempty($rxlist_arg);
my @cxs = map { scalar $self->_spec2cx($_) } @cols;
lib/Spreadsheet/Edit.pm view on Meta::CPAN
goto &_apply_to_rows
}
# apply_exceptrx {code} [rx list], colspec*
# All rows EXCEPT the specified rows are visited
sub apply_exceptrx(&$;@) {
my $self = &__selfmust;
my ($code, $exrxlist_arg, @cols) = @_;
croak "Missing rx (or [list of rx]) argument\n" unless defined $exrxlist_arg;
my $exrxlist = __arrify_checknotempty($exrxlist_arg);
my @cxs = map { scalar $self->_spec2cx($_) } @cols;
lib/Spreadsheet/Edit.pm view on Meta::CPAN
# split_col {code} oldcol, newcol_start_position, new titles...
# {code} is called for each row with $_ bound to <oldcol>
# and @_ bound to the new column(s).
# The old column is left as-is (not deleted).
sub split_col(&$$$@) {
my $self = &__selfmust;
my ($code, $oldcol_posn, $newcols_posn, @new_titles) = @_;
my $num_insert_cols = @new_titles;
my $old_cx = $self->_spec2cx($oldcol_posn);
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/Stable/Module.pm view on Meta::CPAN
}
return undef;
}
#---------------------------------------------------------------------
sub _first(&@) {
my $coderef = shift @_;
for (@_) {
if ($coderef->()) {
return $_;
}
view release on metacpan or search on metacpan
lib/Statocles/Util.pm view on Meta::CPAN
#pod Filter a list into its unique items based on the result of the passed-in block.
#pod This lets us get unique links from their C<href> attribute.
#pod
#pod =cut
sub uniq_by(&@) {
my ( $sub, @list ) = @_;
my ( %found, @out );
for my $i ( @list ) {
local $_ = $i;
push @out, $i if !$found{ $sub->() }++;
view release on metacpan or search on metacpan
t/GrianUtils.pm view on Meta::CPAN
our $msg;
@EXPORT_OK = qw(ref_mem_safe my_readdir my_readfile loose $msg total_sv);
*total_sv = \&Storable::AMF::Util::total_sv;
sub loose(&) {
my $sub = shift;
my $have = total_sv();
my $delta;
{
view release on metacpan or search on metacpan
t/lib/Test/Fatal/Assert.pm view on Meta::CPAN
$callback->($result);
}
}
}
sub and_fatal_is(&) {
my ($code) = @_;
return ( and_fatal_is => $code );
}
1;
view release on metacpan or search on metacpan
lib/Sub/AliasedUnderscore.pm view on Meta::CPAN
my $sub = transformed { do something to $_ }
$sub->($a); # $a is $_ in the above block
=cut
sub transformed(&) {
my $sub = shift;
return transform($sub);
}
=head1 BUGS
view release on metacpan or search on metacpan
lib/Sub/ArgShortcut.pm view on Meta::CPAN
package Sub::ArgShortcut;
our $VERSION = '1.022';
sub argshortcut(&) {
my ( $code ) = @_;
return sub {
my @byval;
my $nondestructive = defined wantarray;
$code->(
view release on metacpan or search on metacpan
lib/Sub/Become.pm view on Meta::CPAN
return (become { $thing })->();
}
=cut
sub become(&) {
croak "become needs a coderef"
unless @_ == 1 && 'CODE' eq ref $_[0];
no strict 'refs';
no warnings 'redefine';
return *{ ( caller 1 )[3] } = shift;
view release on metacpan or search on metacpan
t/03_zeftest.t view on Meta::CPAN
sub t3an { tail t3rn(@t3l) }
is_deeply t3as(), [3];
is_deeply t3aa(), [qw(x y z)];
is_deeply t3an(), [qw(x y z)];
sub t4r(&) { $_[0]->(123) }
sub t4a { tail t4r { [ "x", @_ ] } }
is_deeply t4a(), [ "x", 123 ];
sub t5r { [ "t5r", @_ ] }
sub t5a {
view release on metacpan or search on metacpan
lib/Sub/Go.pm view on Meta::CPAN
my $self = ${ $self_ref };
$self->{yielded} = 1;
$self->{rest}->{code}->( @_ );
}
sub go(&;@) {
my $code = shift;
my $rest = shift;
return bless { code => $code, rest => $rest }, __PACKAGE__;
}
sub by(&;@) {
my ( $code, $rest ) = @_;
return bless { code => $code, rest => $rest, by => 1 }, __PACKAGE__;
}
1;
view release on metacpan or search on metacpan
lib/Sub/Mage.pm view on Meta::CPAN
$Sub::Mage::Subs->{$sub} = \&{$sub};
_debug("$sub does not exist. Adding to Subs list\n");
}
}
sub constructor(&) {
my $sub = shift;
my $pkg = getscope();
*{"$pkg\::import"} = $sub;
}
sub destructor(&) {
my $sub = shift;
my $pkg = getscope();
*{"$pkg\::DESTROY"} = $sub;
}
view release on metacpan or search on metacpan
lib/Sub/Pipe.pm view on Meta::CPAN
use base 'Exporter';
our @EXPORT = qw/joint/;
use overload '|' => sub { $_[0]->( $_[1] ) };
sub joint(&) { bless $_[0], __PACKAGE__ };
if ( $0 eq __FILE__ ) {
local $\ = "\n";
my $uri = joint {
require URI::Escape;
view release on metacpan or search on metacpan
lib/Sub/ScopeFinalizer.pm view on Meta::CPAN
# -----------------------------------------------------------------------------
# scope_finalizer {CODE;...};
# scope_finalizer {CODE;...} { args=>[...] };
# shortcut of Sub::ScopeFinalizer->new(...);
#
sub scope_finalizer(&;@)
{
Sub::ScopeFinalizer->new(@_);
}
# -----------------------------------------------------------------------------
view release on metacpan or search on metacpan
{
my $index = $_[0]+1;
bless { arity=>0, impl=>sub{$_[$index]} };
}
sub hosub(&@)
{
# WRITE THIS
}
sub call
{
my ($self,@args) = @_;
return $self->{impl}->(0,@args);
}
sub meta_bop(&)
{
my ($op) = @_;
sub
{
my ($left, $right, $reversed) = @_;
}
};
};
}
sub meta_uop(&)
{
my ($op) = @_;
sub
{
my ($left) = @_;
view release on metacpan or search on metacpan
t/last_op_in_block.t view on Meta::CPAN
sub save_local_context {
$wantarray = wantarray;
}
sub test_void_context(&) {
my ($coderef) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
my $scalar = $coderef->();
is($wantarray, undef, "for scalar context it is undef");
view release on metacpan or search on metacpan
lib/Syntax/Keyword/Gather.pm view on Meta::CPAN
},
};
my %gatherers;
sub gather(&) {
croak "Useless use of 'gather' in void context" unless defined wantarray;
my ($code) = @_;
my $caller = caller;
local @_;
push @{$gatherers{$caller}}, bless \@_, 'Syntax::Keyword::Gather::MagicArrayRef';
view release on metacpan or search on metacpan
t/95benchmark.t view on Meta::CPAN
# This "test" never fails, but prints a benchmark comparison between this
# syntax and a simple if/elsif chain
use Time::HiRes qw( gettimeofday tv_interval );
sub measure(&)
{
my ( $code ) = @_;
my $start = [ gettimeofday ];
$code->();
return tv_interval $start;
view release on metacpan or search on metacpan
t/95benchmark.t view on Meta::CPAN
# This "test" never fails, but prints a benchmark comparison between these
# wrapper functions and the ones in Scalar::Util
use Time::HiRes qw( gettimeofday tv_interval );
sub measure(&)
{
my ( $code ) = @_;
my $start = [ gettimeofday ];
$code->();
return tv_interval $start;
view release on metacpan or search on metacpan
FreezeThaw.pm view on Meta::CPAN
}
\@procs
}
sub freezethaw(&) {
my ($code) = @_;
my $token = freeze;
eval {
view release on metacpan or search on metacpan
bin/pg_tapgen view on Meta::CPAN
print 'pg_prove ', main->VERSION, "\n";
exit;
}
# Function to write a test script.
sub script(&;$) {
my ($code, $fn) = @_;
my $file = File::Spec->catfile($opts->{directory}, $fn);
my $orig_fh = select;
my $output;
view release on metacpan or search on metacpan
inc/Scalar/Util.pm view on Meta::CPAN
@_;
}
# set_prototype has been moved to Sub::Util with a different interface
sub set_prototype(&$)
{
my ( $code, $proto ) = @_;
return Sub::Util::set_prototype( $proto, $code );
}
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);