view release on metacpan or  search on metacpan

lib/Ambrosia/Utils/Enumeration.pm  view on Meta::CPAN

package Ambrosia::Utils::Enumeration;
use strict;
no strict 'refs';
use warnings;
no warnings 'redefine';

use Ambrosia::Assert;

our $VERSION = 0.010;

sub import
{
    my $proto = shift;

    my $style = shift or return; #property or flag
    my $field_name = shift;
    my %states_name = @_;

    assert {$proto eq __PACKAGE__} "'$proto' cannot be inherited from sealed class '" . __PACKAGE__ . '\'.';
    #throw Ambrosia::error::Exception("'$proto' cannot be inherited from sealed class '" . __PACKAGE__ . '\'.') if $proto ne __PACKAGE__;

    my $INSTANCE_CLASS = caller(0);

    if ( $style eq 'property' )
    {
        foreach my $f ( keys %states_name )
        {
            *{"${INSTANCE_CLASS}::SET_$f"} = sub() {
                    local $::__AMBROSIA_ACCESS_ALLOW = 1;
                    $_[0]->{$field_name} = $states_name{$f};
                    return $_[0];
                };

            *{"${INSTANCE_CLASS}::OFF_$f"} = sub() {
                    local $::__AMBROSIA_ACCESS_ALLOW = 1;
                    $_[0]->{$field_name} = undef;
                    return $_[0];
                };

            *{"${INSTANCE_CLASS}::IS_$f"}  = sub() {
                    local $::__AMBROSIA_ACCESS_ALLOW = 1;
                    defined $_[0]->{$field_name} && $_[0]->{$field_name} == $states_name{$f};
                };
        }
    }
    else
    {
        foreach my $f ( keys %states_name )
        {
            my $val = 2 ** $states_name{$f};
            *{"${INSTANCE_CLASS}::ON_$f"} = sub() {
                    local $::__AMBROSIA_ACCESS_ALLOW = 1;
                    $_[0]->{$field_name} ||= 0;
                    $_[0]->{$field_name} |= $val;
                    return $_[0];
                };

            *{"${INSTANCE_CLASS}::OFF_$f"} = sub() {
                    local $::__AMBROSIA_ACCESS_ALLOW = 1;
                    $_[0]->{$field_name} ||= 0;
                    $_[0]->{$field_name} &= ~($val);
                    return $_[0];
                };

            *{"${INSTANCE_CLASS}::IS_$f"}  = sub() {
                    local $::__AMBROSIA_ACCESS_ALLOW = 1;
                    defined $_[0]->{$field_name} && $_[0]->{$field_name} & $val;
                };
        }
    }
}

1;

__END__

=head1 NAME

Ambrosia::Utils::Enumeration - creates enumerable fields in a class.