view release on metacpan or  search on metacpan

lib/Aion.pm  view on Meta::CPAN

	};

	eval "package $pkg; use Aion::Types; 1" or die;
}

# Удаляет добавленные символы
sub unimport {
	my $pkg = caller;
	
	undef &{"${pkg}::$_"} for qw/extends with aspect requires req/;
	
	eval "package $pkg; no Aion::Types; 1" or die;
}

# Экспортирует функции в пакет, если их там ещё нет
sub export($@) {
	my $pkg = shift;
	for my $sub (@_) {
		my $can = $pkg->can($sub);
		die "$pkg can $sub!" if $can && $can != \&$sub;
		*{"${pkg}::$sub"} = \&$sub unless $can;
	}
}

# Проверяет, что этот пакет инициализирован Aion
sub is_aion($) {
	my $pkg = shift;
	die "$pkg is'nt class of Aion!" if !exists $META{$pkg};
}

#@category Aspects

# ro, rw, + и -, *
sub is_aspect {
	my ($is, $feature) = @_;
	die "Use is => '{ro|rw|wo|no} {+|-} {*} {?} {!}'" if $is !~ /^(?<access>ro|rw|wo|no)?(?<require>[+-])?(?<weak>\*)?(?<has>\??)(?<clear>!?)\z/;

	my ($construct, $name) = @$feature{qw/construct name/};

	$construct->getter("die 'Feature $name cannot be get!';") if $+{access} ~~ [qw/wo no/];

	$construct->setter("die 'Feature $name cannot be set!';") if $+{access} ~~ [qw/ro no/];

	$construct->add_trigger("%(weaken)s") if $+{weak};

	$feature->{required} = 1, $construct->not_specified(' else { die "%(init_arg)s required!" }') if $+{require} eq '+';
	
	$feature->{excessive} = 1, $construct->initer('die "%(init_arg)s excessive!"') if $+{require} eq '-';

	$feature->{make_predicate} = 1 if $+{has};
	$feature->{make_clearer} = 1 if $+{clear};
}

# isa => Type
sub isa_aspect {
	my ($isa, $feature) = @_;
	my ($construct, $name) = @$feature{qw/construct name/};

	$feature->{isa} = Aion::Types::External[$isa];

	$construct->add_release("${\$feature->meta}\{isa}->validate(\$val, 'Get feature $name');") if AION_ISA =~ /ro|rw/;

	$construct->add_preset("${\$feature->meta}\{isa}->validate(\$val, 'Set feature $name');") if AION_ISA =~ /wo|rw/;
}

# coerce => 1
sub coerce_aspect {
	my ($coerce, $feature) = @_;

	return unless $coerce;

	die "coerce: isa not present!" unless $feature->{isa};

	$feature->{construct}->add_preset("\$val = ${\$feature->meta}\{isa}->coerce(\$val);", 1) if AION_ISA =~ /wo|rw/;
}

my $pleroma;

sub pleroma {
	require Aion::Pleroma;
	$pleroma = Aion::Pleroma->new;
	*pleroma = sub { $pleroma };
	$pleroma
}

# eon => $key
sub eon_aspect {
	my ($key, $feature) = @_;

	die "eon is not compatible with default!" if $feature->{opt}{default};

	if($key eq 1) {
		my $isa = $feature->{isa};
		$key = $isa && $isa->{name} eq "Object" && $isa->{args}[0]
			or die "use: has $feature->{name} => (isa => Object[...], eon => 1)";
	}
	elsif($key eq 2) {
		my $isa = $feature->{isa};
		$key = ($isa && $isa->{name} eq "Object" && $isa->{args}[0]
			or die "use: has $feature->{name} => (isa => Object[...], eon => 2)")
		. "#$feature->{name}";
		
	}

	default_aspect(sub { Aion->pleroma->resolve($key) }, $feature);
}

# lazy => 1|0
sub lazy_aspect {
	my ($lazy, $feature) = @_;

	$feature->{lazy} = $lazy;
}

# default => value
sub default_aspect {
	my ($default, $feature) = @_;

	my $name = $feature->name;
	my $default_is_code = ref $default eq "CODE";

	if($default_is_code) {
		$feature->{builder} = $default;
	} else {
		$feature->{default} = $default;
		$feature->{isa}->validate($default, $name) if $feature->{isa};
	}

	if($feature->{opt}{lazy} // $default_is_code) {
		$feature->{lazy} = 1;

		if ($default_is_code) {
			$feature->construct->add_access("unless(%(has)s) {
				my \$val = ${\$feature->meta}\{builder}->(\$self);
				%(write)s
			}");
		} else {
			$feature->construct->add_access("unless(%(has)s) {
				my \$val = ${\$feature->meta}\{default};
				%(write)s
			}");
		}
	} else {
		if($default_is_code) {
			$feature->{construct}->not_specified(" else {
				my \$val = ${\$feature->meta}\{builder}->(\$self);
				%(write)s
			}");
		} else {
			$feature->{construct}->not_specified(" else {
				my \$val = ${\$feature->meta}\{default};
				%(write)s
			}");
		}
		
	}
}

# trigger => $sub
sub trigger_aspect {
	my ($trigger, $feature) = @_;

	$feature->{trigger} = $trigger;

	my $construct = $feature->{construct};

	$construct->add_preset("my \@old = %(has)s? %(get)s: ();");
	$construct->add_trigger("${\$feature->meta}\{trigger}->(\$self, \@old);");
}

# release => $sub
sub release_aspect {
	my ($release, $feature) = @_;

	$feature->{release} = $release;

	$feature->{construct}->add_release("${\$feature->meta}\{release}->(\$self, \$val);");
}

# init_arg => $name
sub init_arg_aspect {
	my ($init_arg, $feature) = @_;

	$feature->construct->init_arg($init_arg);
}