File Coverage

blib/lib/List/Categorize/Multi.pm

Criterion	Covered	Total	%
statement	29	29	100.0
branch	7	8	87.5
condition	4	4	100.0
subroutine	5	5	100.0
pod	1	1	100.0
total	46	47	97.8

package List::Categorize::Multi;
use strict;
use warnings;

use Exporter qw/import/;
use Carp qw/croak/;

our $VERSION = '0.02';
our @EXPORT  = qw(categorize);

sub categorize (&@) {
  my $coderef = shift; # the rest of @_ is the list of elements to categorize

  my %tree = ();

  for my $element (@_) {
    # localize $_ and call the coderef
    local $_       = $element;
    my @categories = $coderef->(); # expected: list of categorizing scalars

    # loop over categories, using them to walk through/create the tree
    my $node = \%tree;
  CATEGORY:
    while (@categories) {
      my $categ = shift @categories;

      # if an undef is encountered, this element will be ignored
      defined $categ or last;

      if (@categories) {
        # create or retrieve an intermediate node
        $node = $node->{$categ} ||= {};
        ref $node ne 'ARRAY'
          or croak "inconsistent use of category '$categ'";
      }
      else {
        # add the element to a leaf
        my $ref = ref $node->{$categ} || '';
        $ref ne 'HASH'
          or croak "inconsistent use of category '$categ'";
        push @{$node->{$categ}}, $_;
      }
    }
  }

  return %tree;
}

1;

__END__