List-MoreUtils

 view release on metacpan or  search on metacpan

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

    my $f = shift;
    return if !@_;
    my $found = 0;
    foreach (@_)
    {
        $f->() and $found++ and return 0;
    }
    return $found;
}

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

    # Localise $a, $b
    my ($caller_a, $caller_b) = do
    {
        my $pkg = caller();
        ## no critic (TestingAndDebugging::ProhibitNoStrict, ValuesAndExpressions::ProhibitCommaSeparatedStatements)
        no strict 'refs';
        \*{$pkg . '::a'}, \*{$pkg . '::b'};

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

    *$caller_a = \();
    for (0 .. $#_)
    {
        *$caller_b = \$_[$_];
        *$caller_a = \($code->());
    }

    return ${*$caller_a};
}

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

    # Localise $a, $b
    my ($caller_a, $caller_b) = do
    {
        my $pkg = caller();
        ## no critic (TestingAndDebugging::ProhibitNoStrict, ValuesAndExpressions::ProhibitCommaSeparatedStatements)
        no strict 'refs';
        \*{$pkg . '::a'}, \*{$pkg . '::b'};

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

    *$caller_a = \0;
    for (0 .. $#_)
    {
        *$caller_b = \$_[$_];
        *$caller_a = \($code->());
    }

    return ${*$caller_a};
}

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

    # Localise $a, $b
    my ($caller_a, $caller_b) = do
    {
        my $pkg = caller();
        ## no critic (TestingAndDebugging::ProhibitNoStrict, ValuesAndExpressions::ProhibitCommaSeparatedStatements)
        no strict 'refs';
        \*{$pkg . '::a'}, \*{$pkg . '::b'};

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

}

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

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

    my $rc;
    my $i = 0;
    my $j = @_;
    ## no critic (ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions)
    do
    {
        my $k = int(($i + $j) / 2);

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

        }
        else
        {
            $j = $k - 1;
        }
    } until $i > $j;

    return;
}

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

    my $rc;
    my $i = 0;
    my $j = @_;
    ## no critic (ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions)
    do
    {
        my $k = int(($i + $j) / 2);

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

        }
        else
        {
            $j = $k - 1;
        }
    } until $i > $j;

    return -1;
}

sub lower_bound(&@)
{
    my $code  = shift;
    my $count = @_;
    my $first = 0;
    while ($count > 0)
    {
        my $step = $count >> 1;
        my $it   = $first + $step;
        local *_ = \$_[$it];
        if ($code->() < 0)

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

        }
        else
        {
            $count = $step;
        }
    }

    return $first;
}

sub upper_bound(&@)
{
    my $code  = shift;
    my $count = @_;
    my $first = 0;
    while ($count > 0)
    {
        my $step = $count >> 1;
        my $it   = $first + $step;
        local *_ = \$_[$it];
        if ($code->() <= 0)

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

        }
        else
        {
            $count = $step;
        }
    }

    return $first;
}

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

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

sub bremove (&\@)
{
    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)
    # Localise $a, $b
    my ($caller_a, $caller_b) = do
    {
        my $pkg = caller();
        no strict 'refs';

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

sub slideatatime ($$@)
{
    my ($m, $w, @list) = @_;
    my $n = $w - $m - 1;
    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;
}

## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
sub _XScompiled { return 0 }