File Coverage

blib/lib/List/Flat.pm

Criterion	Covered	Total	%
statement	45	47	95.7
branch	13	16	81.2
condition	4	6	66.6
subroutine	10	10	100.0
pod	3	3	100.0
total	75	82	91.4

package List::Flat;
use 5.008001;
use strict;
use warnings;

our $VERSION = "0.003";
$VERSION = eval $VERSION;

use Exporter 5.57 'import';
our @EXPORT_OK = qw/flat flat_r flat_f/;

# if PERL_LIST_FLAT_NO_REF_UTIL environment variable is set to a true
# value, or $List::Flat::NO_REF_UTIL is set to a true value,
# uses the pure-perl version of is_plain_arrayref.
# Otherwise, uses Ref::Util if it can be successfully loaded.

BEGIN {
    my $impl = $ENV{PERL_LIST_FLAT_NO_REF_UTIL}
      || our $NO_REF_UTIL;

    if ( !$impl && eval { require Ref::Util; 1 } ) {
        Ref::Util->import('is_plain_arrayref');
    }
    else {
        *is_plain_arrayref = sub { ref( $_[0] ) eq 'ARRAY' };
    }
}

{
    my $croak;

    sub flat {
        $croak = 1;
        goto &_flat;
        # call _flat with current @_
    }

    sub flat_r {
        undef $croak;
        goto &_flat;
        # call _flat with current @_
    }

    sub _flat {

        my @results;
        my @seens;

        # this uses @_ as the queue of items to process.
        # An item is plucked off the queue. If it's not an array ref,
        # put it in @results.

        # If it is an array ref, check to see if it's the same as any
        # of the arrayrefs we are currently in the middle of processing.
        # If it is, either croak if called as flat, or if called as
        # flat_r, don't do anything -- skip to the next one.
        # If it hasn't been seen before, put all the items it
        # contains back on the @_ queue.
        # Also, for each of the items, push a reference into @seens
        # that contains references to all the arrayrefs we are currently
        # in the middle of processing, plus this arrayref.
        # Note that @seens will be empty at the top level, so we must
        # handle both when it is empty and when it is not.

        while (@_) {

            if ( is_plain_arrayref( my $element = shift @_ ) ) {
                if ( !defined( my $seen_r = shift @seens ) ) {
                    unshift @_, @{$element};
                    unshift @seens, ( ( [$element] ) x scalar @{$element} );
                }
                ## no critic (ProhibitBooleanGrep)
                elsif ( !grep { $element == $_ } @$seen_r ) {
                    ## use critic
                   # until the recursion gets very deep, the overhead in calling
                   # List::Util::none seems to be taking more time than the
                   # additional comparisons required by grep
                    unshift @_, @{$element};
                    unshift @seens,
                      ( ( [ @$seen_r, $element ] ) x scalar @{$element} );
                }
                elsif ($croak) {
                    require Carp;
                    Carp::croak( 'Circular reference passed to '
                          . __PACKAGE__
                          . '::flat' );
                }
                     # else do nothing
            } ## tidy end: if ( is_plain_arrayref...)

            else {    # not arrayref
                shift @seens;
                push @results, $element;
            }

        } ## tidy end: while (@_)

        return wantarray ? @results : \@results;

    } ## tidy end: sub _flat

}

sub flat_f {

    # this uses @_ as the queue of items to process.
    # An item is plucked off the queue. If it's not an array ref,
    # put it in @results.
    # If it is an array ref, put its contents back in the queue.

    # Mark Jason Dominus calls this the "agenda method" of turning
    # a recursive function into an iterative one.

    my @results;

    while (@_) {

        if ( is_plain_arrayref( my $element = shift @_ ) ) {
            unshift @_, @{$element};
        }
        else {
            push @results, $element;
        }

    }

    return wantarray ? @results : \@results;

} ## tidy end: sub flat_f

1;

__END__