view release on metacpan or  search on metacpan

lib/Algorithm/Loops.pm  view on Meta::CPAN

package Algorithm::Loops;
# The command "perldoc Algorithm::Loops" will show you the
# documentation for this module.  You can also seach for
# "=head" below to read the unformatted documentation.

use strict;
BEGIN {     # Some still don't have warnings.pm:
    if(  eval { require warnings }  ) {
        warnings->import();
        if(  eval { require warnings::register; }  ) {
            warnings::register->import();
        }
    } else {
        # $^W= 1;
    }
}

require Exporter;
use vars qw( $VERSION @EXPORT_OK );
BEGIN {
    $VERSION= 1.032_00;
    @EXPORT_OK= qw(
        Filter
        MapCar MapCarE MapCarU MapCarMin
        NestedLoops
        NextPermute NextPermuteNum
    );
    { my @nowarn= ( *import, *isa ) }
    *import= \&Exporter::import;
    *isa= \&UNIVERSAL::isa;
}


sub _Type
{
    my( $val )= @_;
    return  ! defined($val) ? "undef" : ref($val) || $val;
}


sub _Croak
{
    my $depth= 1;
    my $sub;
    do {
        ( $sub= (caller($depth++))[3] ) =~ s/.*:://;
    } while(  $sub =~ /^_/  );
    if(   eval { require Carp; 1; }
      &&  defined &Carp::croak  ) {
        unshift @_, "$sub: ";
        goto &Carp::croak;
    }
    die "$sub: ", @_, ".\n";
}


sub Filter(&@)
{
    my( $code, @vals )= @_;
    isa($code,"CODE")  or  _Croak(
        "No code reference given" );
    # local( $_ ); # Done by the loop.
    for(  @vals  ) {
        $code->();
    }
    wantarray ? @vals : join "", @vals;
}


sub MapCarE(&@)
{
    my $sub= shift(@_);
    isa($sub,"CODE")  or  _Croak(
        "No code reference given" );
    my $size= -1;
    for my $av (  @_  ) {
        isa( $av, "ARRAY" )  or  _Croak(
            "Not an array reference (", _Type($av), ")" );
        if(  $size < 0  ) {
            $size= @$av;
        } elsif(  $size != @$av  ) {
            _Croak( "Arrays with different sizes",
                " ($size and ", 0+@$av, ")" );
        }
    }
    my @ret;
    for(  my $i= 0;  $i < $size;  $i++  ) {
        push @ret, &$sub( map { $_->[$i] } @_ );
    }
    return wantarray ? @ret : \@ret;
}


sub MapCarMin(&@)
{
    my $sub= shift(@_);
    isa($sub,"CODE")  or  _Croak(
        "No code reference given" );
    my $min= -1;
    for my $av (  @_  ) {
        isa( $av, "ARRAY" )  or  _Croak(
            "Not an array reference (", _Type($av), ")" );
        $min= @$av   if  $min < 0  ||  @$av < $min;
    }
    my @ret;
    for(  my $i= 0;  $i < $min;  $i++  ) {