^sub \w+\(& results from the 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 all matches for this distribution

Lingua-JA-Halfwidth

1 match

        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 all matches for this distribution

Lingua-JA-Hepburn-Passport

1 match

        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 all matches for this distribution

Lingua-JA-OkapiBM25

1 match

        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 all matches for this distribution

Lingua-JA-Yomi

1 match

        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 all matches for this distribution

List-Comprehensions

1 match

lib/List/Comprehensions.pm view on Meta::CPAN

    comp1 sub { }, arg, [arg]
    arg: array ref | guard subs

=cut

sub comp1(&@) {
	local $code = shift;
	local @guards;
	local @sets;
	local @args;

lib/List/Comprehensions.pm view on Meta::CPAN

    comp2 sub { }, arg, [arg]
    arg: [name => ] array ref | guard subs

=cut

sub comp2(&@) {
	local $code = shift;
	local @guards;
	local @sets;
	local @args;

view all matches for this distribution

List-Enumerator

1 match

        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 all matches for this distribution

List-EvenMore

1 match

lib/List/EvenMoreUtils.pm view on Meta::CPAN

	repeatable_list_shuffler
);

our $VERSION = 0.11;

sub do_sublist(&&@)
{
	my $selector = shift;
	my $actor = shift;

	my @order;

view all matches for this distribution

List-Intersperse

1 match

Intersperse.pm view on Meta::CPAN

C<intersperseq> works like C<intersperse> but it applies BLOCK to the elements
of LIST to determine the equivalance key.

=cut

sub intersperseq(&@) {
  # wrapper with a prototype, allows calling like map
  _intersperse( @_ )
}

sub intersperse(@) { # no key func

view all matches for this distribution

List-Keywords

1 match

t/95benchmark.t view on Meta::CPAN


# This "test" never fails, but prints a benchmark comparison between these
# util functions and the ones provided by List::Util

use Time::HiRes qw( gettimeofday tv_interval );
sub measure(&)
{
   my ( $code ) = @_;
   my $start = [ gettimeofday ];
   $code->();
   return tv_interval $start;

view all matches for this distribution

List-MoreUtils

1 match

        $f->() and $found++ and return 0;
    }
    return $found;
}

sub reduce_u(&@)
{
    my $code = shift;

    # Localise $a, $b
    my ($caller_a, $caller_b) = do

    }

    return ${*$caller_a};
}

sub reduce_0(&@)
{
    my $code = shift;

    # Localise $a, $b
    my ($caller_a, $caller_b) = do

    }

    return ${*$caller_a};
}

sub reduce_1(&@)
{
    my $code = shift;

    # Localise $a, $b
    my ($caller_a, $caller_b) = do

    my @parts;
    push @{$parts[$code->($_)]}, $_ foreach @list;
    return @parts;
}

sub bsearch(&@)
{
    my $code = shift;

    my $rc;
    my $i = 0;

    } until $i > $j;

    return;
}

sub bsearchidx(&@)
{
    my $code = shift;

    my $rc;
    my $i = 0;

    } until $i > $j;

    return -1;
}

sub lower_bound(&@)
{
    my $code  = shift;
    my $count = @_;
    my $first = 0;
    while ($count > 0)

    }

    return $first;
}

sub upper_bound(&@)
{
    my $code  = shift;
    my $count = @_;
    my $first = 0;
    while ($count > 0)

    }

    return $first;
}

sub equal_range(&@)
{
    my $lb = &lower_bound(@_);
    my $ub = &upper_bound(@_);
    return ($lb, $ub);
}

{
    my $lb = &lower_bound($_[0], @{$_[1]});
    return splice @{$_[1]}, $lb, 1;
}

sub qsort(&\@)
{
    require Carp;
    Carp::croak("It's insane to use a pure-perl qsort");
}

sub slide(&@)
{
    my $op = shift;
    my @l  = @_;

    ## no critic (TestingAndDebugging::ProhibitNoStrict, ValuesAndExpressions::ProhibitCommaSeparatedStatements)

    return $n >= 0
      ? sub { my @r = splice @list, 0, $m; $#list < $n and $n = $#list; @r and push @r, (@list ? @list[0 .. $n] : ()); return @r; }
      : sub { return splice @list, 0, $m; };
}

sub sort_by(&@)
{
    my ($code, @list) = @_;
    return map { $_->[0] }
      sort     { $a->[1] cmp $b->[1] }
      map      { [$_, scalar($code->())] } @list;
}

sub nsort_by(&@)
{
    my ($code, @list) = @_;
    return map { $_->[0] }
      sort     { $a->[1] <=> $b->[1] }
      map      { [$_, scalar($code->())] } @list;

view all matches for this distribution

List-OrderBy

1 match

lib/List/OrderBy.pm view on Meta::CPAN

  @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
  @EXPORT = @EXPORT_OK;
  $VERSION = '0.2';
};

sub order_by(&;@) {
  List::OrderBy::Container->new(sub { $_[0] <=> $_[1] }, @_)->get();
}

sub order_by_desc(&;@) {
  List::OrderBy::Container->new(sub { $_[1] <=> $_[0] }, @_)->get();
}

sub order_cmp_by_desc(&;@) {
  List::OrderBy::Container->new(sub { $_[1] cmp $_[0] }, @_)->get();
}

sub order_cmp_by(&;@) {
  List::OrderBy::Container->new(sub { $_[0] cmp $_[1] }, @_)->get();
}

sub then_by(&;@) {
  List::OrderBy::Container->new(sub { $_[0] <=> $_[1] }, @_)
}

sub then_by_desc(&;@) {
  List::OrderBy::Container->new(sub { $_[1] <=> $_[0] }, @_)
}

sub then_cmp_by(&;@) {
  List::OrderBy::Container->new(sub { $_[0] cmp $_[1] }, @_)
}

sub then_cmp_by_desc(&;@) {
  List::OrderBy::Container->new(sub { $_[1] cmp $_[0] }, @_)
}

package List::OrderBy::Container;
use strict;

view all matches for this distribution

List-Part

1 match

Part.pm view on Meta::CPAN

$VERSION = '0.03';

use strict;
use warnings;

sub part(&@) {
    my $code=shift;
    my @ret;
    
    for(@_) {
        my $i=$code->($_);

view all matches for this distribution

List-Rank

1 match

lib/List/Rank.pm view on Meta::CPAN

        }
    }
    map { $_->[2] } sort { $a->[1] <=> $b->[1] } @ary;
}

sub rankby(&;@) { ## no critic: Subroutines::ProhibitSubroutinePrototypes
    no strict 'refs'; ## no critic: TestingAndDebugging::ProhibitNoStrict

    my $cmp = shift;

    my $caller = caller();

lib/List/Rank.pm view on Meta::CPAN

        }
    }
    map { ($_->[0], $_->[2]) } @ary;
}

sub sortrankby(&;@) { ## no critic: Subroutines::ProhibitSubroutinePrototypes
    no strict 'refs'; ## no critic: TestingAndDebugging::ProhibitNoStrict

    my $cmp = shift;

    my $caller = caller();

view all matches for this distribution

List-Rubyish

1 match

        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 all matches for this distribution

List-SomeUtils

1 match

lib/List/SomeUtils/PP.pm view on Meta::CPAN

    my @parts;
    push @{ $parts[ $code->($_) ] }, $_ foreach @list;
    return @parts;
}

sub bsearch(&@) {
    my $code = shift;

    my $rc;
    my $i = 0;
    my $j = @_;

lib/List/SomeUtils/PP.pm view on Meta::CPAN

    } until $i > $j;

    return;
}

sub bsearchidx(&@) {
    my $code = shift;

    my $rc;
    my $i = 0;
    my $j = @_;

lib/List/SomeUtils/PP.pm view on Meta::CPAN

    } until $i > $j;

    return -1;
}

sub sort_by(&@) {
    my ( $code, @list ) = @_;
    return map { $_->[0] }
        sort   { $a->[1] cmp $b->[1] }
        map    { [ $_, scalar( $code->() ) ] } @list;
}

sub nsort_by(&@) {
    my ( $code, @list ) = @_;
    return map { $_->[0] }
        sort   { $a->[1] <=> $b->[1] }
        map    { [ $_, scalar( $code->() ) ] } @list;
}

view all matches for this distribution

List-StackBy

1 match

lib/List/StackBy.pm view on Meta::CPAN


our @EXPORT = qw(
  stack_by
);

sub stack_by(&@) {
  my $code = shift;
  my @result;
  my $prev_key;

  for (@_) {

view all matches for this distribution

List-Util-groupby

1 match

lib/List/Util/groupby.pm view on Meta::CPAN

our @EXPORT_OK = qw(
                       groupby
                       hgroupby
               );

sub groupby(&;@) { ## no critic: Subroutines::ProhibitSubroutinePrototypes
    my $code = shift;

    my @result;
    my $index = -1;
    for my $item (@_) {

lib/List/Util/groupby.pm view on Meta::CPAN

        }
    }
    @result;
}

sub hgroupby(&;@) { ## no critic: Subroutines::ProhibitSubroutinePrototypes
    my $code = shift;

    my %result;
    my $index = -1;
    for my $item (@_) {

view all matches for this distribution

List-Util-mapsplice

1 match

lib/List/Util/mapsplice.pm view on Meta::CPAN


our @EXPORT_OK = qw(
                       mapsplice
               );

sub mapsplice(&\@;$$) { ## no critic: Subroutines::ProhibitSubroutinePrototypes
    my ($code, $array, $offset, $length) = @_;

    $offset = 0 unless defined $offset;
    $offset = @$array+$offset if $offset < 0;
    die "OutOfBoundError" if $offset < 0 || $offset >= @$array;

view all matches for this distribution

List-Util-sglice

1 match

lib/List/Util/sglice.pm view on Meta::CPAN

our @EXPORT_OK = qw(
                       sglice
                       msplice
               );

sub sglice(&\@;$) { ## no critic: Subroutines::ProhibitSubroutinePrototypes
    my ($code, $array, $num_remove) = @_;

    $num_remove = @$array unless defined $num_remove;

    my @indices;

view all matches for this distribution

List-UtilsBy

2 results

to some level (9 digits in this case), helping to ensure the lexical sort puts
them in the correct order.

=cut

sub sort_by(&@)
{
   my $keygen = shift;

   my @keys = map { local $_ = $_; scalar $keygen->( $_ ) } @_;
   return @_[ sort { $keys[$a] cmp $keys[$b] } 0 .. $#_ ];


Similar to L</sort_by> but compares its key values numerically.

=cut

sub nsort_by(&@)
{
   my $keygen = shift;

   my @keys = map { local $_ = $_; scalar $keygen->( $_ ) } @_;
   return @_[ sort { $keys[$a] <=> $keys[$b] } 0 .. $#_ ];

except that these functions are slightly more efficient because they avoid
the final C<reverse> operation.

=cut

sub rev_sort_by(&@)
{
   my $keygen = shift;

   my @keys = map { local $_ = $_; scalar $keygen->( $_ ) } @_;
   return @_[ sort { $keys[$b] cmp $keys[$a] } 0 .. $#_ ];
}

sub rev_nsort_by(&@)
{
   my $keygen = shift;

   my @keys = map { local $_ = $_; scalar $keygen->( $_ ) } @_;
   return @_[ sort { $keys[$b] <=> $keys[$a] } 0 .. $#_ ];

For symmetry with the L</nsort_by> function, this is also provided under the
name C<nmax_by> since it behaves numerically.

=cut

sub max_by(&@)
{
   my $code = shift;

   return unless @_;

Similar to L</max_by> but returns values which give the numerically smallest
result from the key function. Also provided as C<nmin_by>

=cut

sub min_by(&@)
{
   my $code = shift;

   return unless @_;

ties, only the first optimal element found in each case is returned. Also
provided as C<nminmax_by>.

=cut

sub minmax_by(&@)
{
   my $code = shift;

   return unless @_;

numbers, or object references which overload stringification in a suitable
manner).

=cut

sub uniq_by(&@)
{
   my $code = shift;

   my %present;
   return grep {

numbers, or object references which overload stringification in a suitable
manner).

=cut

sub partition_by(&@)
{
   my $code = shift;

   my %parts;
   push @{ $parts{ $code->( local $_ = $_ ) } }, $_ for @_;

numbers, or object references which overload stringification in a suitable
manner).

=cut

sub count_by(&@)
{
   my $code = shift;

   my %counts;
   $counts{ $code->( local $_ = $_ ) }++ for @_;

(A function having this behaviour is sometimes called C<zipWith>, e.g. in
Haskell, but that name would not fit the naming scheme used by this module).

=cut

sub zip_by(&@)
{
   my $code = shift;

   @_ or return;

This function is an inverse of L</zip_by>, if given a corresponding inverse
function.

=cut

sub unzip_by(&@)
{
   my $code = shift;

   my @ret;
   foreach my $idx ( 0 .. $#_ ) {


will strengthen them all again.

=cut

sub extract_by(&\@)
{
   my $code = shift;
   my ( $arrref ) = @_;

   my @ret;

list in list context. This allows a caller to distinguish the case between
no matching element, and the first matching element being C<undef>.

=cut

sub extract_first_by(&\@)
{
   my $code = shift;
   my ( $arrref ) = @_;

   foreach my $idx ( 0 .. $#$arrref ) {

probability of each item being returned first will be distributed with the
distribution of the weights, and so on recursively for the remaining items.

=cut

sub weighted_shuffle_by(&@)
{
   my $code = shift;
   my @vals = @_;

   my @weights = map { $code->( local $_ = $_ ) } @vals;

If given a list of values whose length does not evenly divide by C<$number>,
the final call will be passed fewer elements than the others.

=cut

sub bundle_by(&@)
{
   my $code = shift;
   my $n = shift;

   my @ret;

view all matches for this distribution

Liveman

1 match

lib/Liveman/Project.pm view on Meta::CPAN

    my $self = bless {@_}, $cls;
    $self->{license} //= 'perl_5';
    $self
}

sub _replace(&$) {
    my ($sub, $file) = @_;
    local $_ = read_text $file;
    $sub->();
    write_text $file, $_;
}

view all matches for this distribution

Log-Any-Adapter-TAP

1 match

t/lib/TestLogging.pm view on Meta::CPAN

use Try::Tiny;
use Exporter 'import';
our @EXPORT= qw( capture_output test_log_method );

# my ($stdout, $stderr)= capture_output( \&coderef )
sub capture_output(&) {
	my $code= shift;
	my ($stdout, $stderr)= ('', '');
	my $tb= Test::Builder->new if Test::Builder->can('new');
	my ($out, $fout);
	try {

view all matches for this distribution

Log-Contextual-LogDispatchouli

1 match

maint-travis-ci/lib/tools.pm view on Meta::CPAN

package tools;

use Cwd qw(cwd);
use Config;

sub capture_stdout(&) {
  require Capture::Tiny;
  goto &Capture::Tiny::capture_stdout;
}

sub diag {

view all matches for this distribution

Log-Dispatch-Colorful

1 match

        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 all matches for this distribution

Log-Dispatch-Screen-Color

1 match

        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 all matches for this distribution

Log-Log4Cli

2 results

lib/Log/Log4Cli.pm view on Meta::CPAN


sub die_fatal(;$;$) { _die $_[1] || 127, $LEVEL > -2, _pfx('FATAL'), $_[0] }
sub die_alert(;$;$) { _die $_[1] || 0,   $LEVEL > -1, _pfx('ALERT'), $_[0] }
sub die_info(;$;$)  { _die $_[1] || 0,   $LEVEL >  1, _pfx('INFO'),  $_[0] }

sub log_fatal(&) { print $FD _pfx('FATAL') . $_[0]->($_) . "\n" if $LEVEL > -2 }
sub log_error(&) { print $FD _pfx('ERROR') . $_[0]->($_) . "\n" if $LEVEL > -1 }
sub log_alert(&) { print $FD _pfx('ALERT') . $_[0]->($_) . "\n" if $LEVEL > -1 }
sub log_warn(&)  { print $FD _pfx('WARN')  . $_[0]->($_) . "\n" if $LEVEL >  0 }
sub log_info(&)  { print $FD _pfx('INFO')  . $_[0]->($_) . "\n" if $LEVEL >  1 }
sub log_debug(&) { print $FD _pfx('DEBUG') . $_[0]->($_) . "\n" if $LEVEL >  2 }
sub log_trace(&) { print $FD _pfx('TRACE') . $_[0]->($_) . "\n" if $LEVEL >  3 }

sub log_fd(;$) {
    if (@_) {
        $FD = shift;
        $COLOR = -t $FD;

view all matches for this distribution

Log-Report-Optional

1 match

lib/Log/Report/Minimal.pm view on Meta::CPAN



sub dispatcher($@) { panic "no dispatchers available in ".__PACKAGE__ }


sub try(&@)
{   my $code = shift;

    @_ % 2 and report {}, PANIC =>
        __x"odd length parameter list for try(): forgot the terminating ';'?";

view all matches for this distribution

Log-Report

1 match

lib/Log/Report.pm view on Meta::CPAN

	}
	$reporter->{needs} = \%needs;
}


sub try(&@)
{	my $code = shift;

	@_ % 2
	  and report {location => [caller 0]}, PANIC =>
		  __x"odd length parameter list for try(): forgot the terminating ';'?";

view all matches for this distribution

Log-Syslog-Fast

1 match