File Coverage

blib/lib/Class/Enumemon.pm

Criterion	Covered	Total	%
statement	83	83	100.0
branch	15	16	93.7
condition			n/a
subroutine	20	20	100.0
pod			n/a
total	118	119	99.1

package Class::Enumemon;
use 5.008001;
use strict;
use warnings;

our $VERSION = "0.01";

use Carp ();
use Guard ();

sub import {
    shift;
    my $pkg = caller;
    my $meta = {};
    my $defs = [];
    while (my $v = shift @_) {
        if (ref $v) {
            push @$defs, $v;
        } else {
            $meta->{$v} = shift @_;
        }
    }

    my $data = _generate_data($pkg, $meta, $defs);
    _mk_values($pkg, $data)         if $meta->{values};
    _mk_getter($pkg, $defs)         if $meta->{getter};
    _mk_indexer($pkg, $meta, $data) if $meta->{indexer};
    _mk_local($pkg, $meta, $data);
}

sub _generate_data {
    my ($pkg, $meta, $defs) = @_;
    my $data = {};

    # values
    $data->{values} = [ map { bless $_, $pkg } @$defs ];

    # indexer
    if ($meta->{indexer}) {
        $data->{indexer} = {};
        for my $indexer (keys %{$meta->{indexer}}) {
            my $field = $meta->{indexer}->{$indexer};
            $data->{indexer}->{$indexer} = +{
                map { ( $_->{$field} => $_ ) } @{$data->{values}}
            }
        }
    }

    return $data;
}

sub _mk_values {
    my ($pkg, $data) = @_;
    no strict 'refs';
    *{"$pkg\::values"} = sub {
        my $values = $data->{values};
        wantarray ? @$values : [ @$values ];
    };
}

sub _mk_indexer {
    my ($pkg, $meta, $data) = @_;
    for my $indexer (keys %{$meta->{indexer}}) {
        my $field = $meta->{indexer}->{$indexer};

        no strict 'refs';
        *{"$pkg\::$indexer"} = sub {
            my ($class, $field_val) = @_;
            return defined $field_val
                ? $data->{indexer}->{$indexer}->{$field_val}
                : undef;
        };
    }
}

sub _mk_getter {
    my ($pkg, $defs) = @_;
    my $all_keys = [ keys %{ +{ map { %$_ } @$defs } }];
    for my $field (@$all_keys) {
        no strict 'refs';
        *{"$pkg\::$field"} = sub { $_[0]->{$field} } ;
    }
}

sub _mk_local {
    my ($pkg, $meta, $data) = @_;
    no strict 'refs';
    *{"$pkg\::local"} = sub {
        my ($class, @defs) = @_;
        Carp::croak("Cannot use $class\::local in void context") unless defined wantarray;

        my %orig_data = %$data;
        my $local_data = _generate_data($pkg, $meta, \@defs);
        %$data = %$local_data;
        return Guard::guard { %$data = %orig_data };
    };
}

1;
__END__