File Coverage

blib/lib/List/GroupBy.pm

Criterion	Covered	Total	%
statement	38	38	100.0
branch	12	12	100.0
condition	16	19	84.2
subroutine	6	6	100.0
pod	1	1	100.0
total	73	76	96.0

package List::GroupBy;
use 5.010001;
use strict;
use warnings;

our $VERSION = "0.03";

use Exporter qw( import );

our @EXPORT_OK = qw( groupBy );

use Carp;

my $nop = sub { $_[0] };

sub groupBy {
    my ( $options, @list ) = @_;

    $options = ref $options eq "ARRAY" ? { keys => $options } : $options;

    croak "missing grouping keys" unless ref $options->{keys} eq "ARRAY";

    my @keys = @{ $options->{keys} };

    my $default = $options->{defaults} // {};

    croak "defaults should be a hashref" unless ref $default eq "HASH";

    $options->{operations} //= {};

    croak "operations should be a hashref" unless ref $options->{operations} eq "HASH";


    my %op = map {
        my $operation = $options->{operations}->{ $_ } // $nop;

        croak "operation defined should be an anonymous sub" unless ref $operation eq "CODE";

        $_ => $operation;
    } @keys;


    my $groupings = {};

    my $leaf = pop @keys;

    foreach my $item (@list) {
        my $current = $groupings;

        foreach my $key ( @keys ) {
            my $branch = $op{ $key }->( $item->{ $key } // $default->{ $key } // '' );

            $current = $current->{ $branch } //= {};
        }

        my $leafNode = $op{ $leaf }->( $item->{$leaf} // $default->{ $leaf } // '' );
        push @{ $current->{ $leafNode } }, $item;
    }

    return wantarray ? %$groupings : $groupings;
}


1;
__END__