view release on metacpan or  search on metacpan

lib/Aion/Enum.pm  view on Meta::CPAN

package Aion::Enum;
use 5.22.0;
no strict; no warnings; no diagnostics;
use common::sense;

our $VERSION = "0.0.3";

use constant;
use Aion -role;

# Импорт
sub import {
	my $pkg = caller;
	*{"${pkg}::issa"} = \&issa if $pkg->can('issa') != \&issa;
	*{"${pkg}::case"} = \&case if $pkg->can('case') != \&case;
	eval "package $pkg; use Aion -role; with 'Aion::Enum'; 1" or die
}

sub unimport {
	my $pkg = caller;
	undef &{"${pkg}::issa"};
	undef &{"${pkg}::case"};
	eval "package $pkg; no Aion; 1" or die
}

#@category Свойства
has name  => (is => 'ro');
has value => (is => 'ro');
has stash => (is => 'ro');
has alias => (is => 'ro', default => sub {
    my ($self) = @_;
    $self->_alias->{$self->{name}};
});

#@category Управленцы

# Создать перечисление
sub case(@) {
	my ($name, $value, $stash) = @_;
	
	die "The case name must by 1+ simbol!" unless length $name;
	
	my $pkg = caller;
	my $meta = $Aion::META{$pkg};
	my $issa = $meta->{issa};
	my $enum = $meta->{enum} //= [];
	
	$issa->{name}->validate($name, "$name name") if $issa->{name};
	$issa->{value}->validate($value, "$name value") if $issa->{value};
	$issa->{stash}->validate($stash, "$name stash") if $issa->{stash};
	$issa->{alias}->validate($pkg->_alias->{$name}, "$name alias") if $issa->{alias};
	
	my $case = bless {
        name => $name,
        defined($value)? (value => $value): (),
        defined($stash)? (stash => $stash): (),
    }, $pkg;

    push @$enum, $case;

    constant->import("${pkg}::$name", $case);

    return;
}

# Задаёт типы для value и stash
sub issa(@) {
	my $pkg = caller;
	my ($nameisa, $valueisa, $stashisa, $aliasisa) = map { ref $_ eq '' ? eval "package $pkg; $_" || die : $_ } @_;
	$Aion::META{$pkg}{issa} = {
		name => $nameisa,
		value => $valueisa,
		stash => $stashisa,
		alias => $aliasisa,
	};
	return;
}

#@category Перечисления

# Перечисления
sub cases {
	my ($cls) = @_;
	@{$Aion::META{ref $cls || $cls}{enum}}
}

# Имена
sub names {
	my ($cls) = @_;
	map $_->{name}, $cls->cases
}

# Значения
sub values {
	my ($cls) = @_;
	map $_->{value}, $cls->cases
}

# Дополнения
sub stashes {
	my ($cls) = @_;
	map $_->{stash}, $cls->cases
}

# Псевдонимы
sub aliases {
	my ($cls) = @_;
	map $_->alias, $cls->cases
}

my %ALIAS;
sub _alias {
	my ($cls) = @_;