File Coverage

blib/lib/List/Part.pm

Criterion	Covered	Total	%
statement	32	38	84.2
branch	11	26	42.3
condition			n/a
subroutine	9	9	100.0
pod	2	2	100.0
total	54	75	72.0

package List::Part;

#Prototypes
BEGIN { require 5.002 }

use Carp qw(croak);

use Exporter;
@ISA = qw(Exporter);

@EXPORT_OK = qw( parta );
@EXPORT = qw( part );

$VERSION = '0.03';

use strict;
use warnings;

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

    for(@_) {
        my $i=$code->($_);
        next unless defined $i;
        push @{$ret[$i]}, $_;
    }

    return @ret;
}

sub parta($@) {
    my $ary=shift;

    unshift @_, sub {
        for my $i(0..$#$ary) {
            return $i if _matches($ary->[$i], $_);
        }
        return undef;
    };

    goto ∂
}

sub _matches {
    my($thing, $value)=@_;

    if(ref $thing) {
        if(ref $thing eq 'ARRAY') {
            for(@$thing) {
                return 1 if _matches($_, $value);
            }
        }
        elsif(ref $thing eq 'HASH') {
            return 1 if $thing->{$value};
        }
        elsif(ref $thing eq 'CODE') {
            return 1 if $thing->($value);
        }
        elsif(ref $thing eq 'Regexp') {
            return 1 if $value =~ $thing;
        }
        else {
            return 1 if $thing eq $value;
        }
    }
    else {
        return 1 if $thing eq $value;
    }

    return 0;
}

1;

__END__