File Coverage

blib/lib/List/Breakdown.pm

Criterion	Covered	Total	%
statement	26	26	100.0
branch	6	6	100.0
condition			n/a
subroutine	7	7	100.0
pod	1	1	100.0
total	40	40	100.0

package List::Breakdown;

# Force me to write this properly
use strict;
use warnings;
use utf8;

# Target reasonably old Perls
use 5.006;

# Import required modules
use Carp;

# Handle exporting in a way Perl v5.6 should tolerate
use base qw(Exporter);    ## no critic (ProhibitUseBase)
our @EXPORT_OK = qw(breakdown);

# Specify package version
our $VERSION = '0.24';

# Dispatch table of functions to handle different ref types for the spec
# hashref's values
my %types = (

    # If it's a hash, apply breakdown() again as if it were another root-level
    # spec
    ref {} => sub {
        my $spec = shift;
        return { breakdown( $spec, @_ ) };
    },

    # If it's an array, we're doing numeric bounds checking [a,b)
    ref [] => sub {
        my $bounds = shift;
        @{$bounds} == 2
          or croak 'arrayref for bounds needs two items';
        return [
            grep {
                      ( not defined $bounds->[0] or $_ >= $bounds->[0] )
                  and ( not defined $bounds->[1] or $_ < $bounds->[1] )
            } @_,
        ];
    },

    # If it's a subroutine, return a arrayref of all elements for which it
    # returns true
    ref sub { } => sub {
        my $sub = shift;
        return [ grep { $sub->() } @_ ];
    },

    # If it's a regular expression, return an arrayref of all elements it
    # matches
    ref qr//msx => sub {
        my $re = shift;
        return [ grep { $_ =~ $re } @_ ];
    },
);

# Given a spec and a list of items, filter them into a hash of the same
# structure
sub breakdown {
    my ( $spec, @items ) = @_;

    # Check the spec is a hashref
    ref $spec eq ref {}
      or croak 'hashref expected for first argument';

    # Start building a results hash
    my %results;
    for my $key ( keys %{$spec} ) {

        # Check that the value for this key is a reference
        my $ref = ref $spec->{$key}
          or croak "Ref expected for '$key'";

        # Check it's a reference we understand
        exists $types{$ref}
          or croak "Unhandled ref type $ref for '$key'";

        # Apply the appropriate subroutine for this reference type to the list
        # of items
        $results{$key} = $types{$ref}->( $spec->{$key}, @items );
    }

    # Return the constructed result set
    return %results;
}

1;

__END__