view release on metacpan or  search on metacpan

lib/Aion.pm  view on Meta::CPAN

		aspect => {
			is        => \&is_aspect,
			isa       => \&isa_aspect,
			coerce    => \&coerce_aspect,
			lazy      => \&lazy_aspect,
			default   => \&default_aspect,
			trigger   => \&trigger_aspect,
			release   => \&release_aspect,
			init_arg  => \&init_arg_aspect,
			accessor  => \&accessor_aspect,
			writer    => \&writer_aspect,
			reader    => \&reader_aspect,
			predicate => \&predicate_aspect,
			clearer   => \&clearer_aspect,
			cleaner   => \&cleaner_aspect,
			eon       => \&eon_aspect,
		}
	};

	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 ISA =~ /ro|rw/;

	$construct->add_preset("${\$feature->meta}\{isa}->validate(\$val, 'Set feature $name');") if 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 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}";
		
	}

lib/Aion.pm  view on Meta::CPAN

	
	package Omega1 { use Aion; with Role::Alpha; }
	
	eval { Omega1->new }; $@ # ~> Requires abc of Role::Alpha
	
	package Omega { use Aion;
		with Role::Alpha;
	
		sub abc { "abc" }
	}
	
	Omega->new->abc  # => abc

=head2 req ($name => @aspects)

Checks that classes using this role have the specified features with the specified aspects.

	package Role::Beta { use Aion -role;
	
		req x => (is => 'rw', isa => Num);
	}
	
	package Omega2 { use Aion; with Role::Beta; }
	
	eval { Omega2->new }; $@ # ~> Requires req x => \(is => 'rw', isa => Num\) of Role::Beta
	
	package Omega3 { use Aion;
		with Role::Beta;
	
		has x => (is => 'rw', isa => Num, default => 12);
	}
	
	Omega3->new->x  # -> 12

=head1 ASPECTS

C<use Aion> includes the following aspects in the module for use in C<has>:

=head2 is => $permissions

=over

=item * C<ro> - create only a gutter.

=item * C<wo> - create only a setter.

=item * C<rw> - Create getter and setter.

=back

By default - C<rw>.

Additional permits:

=over

=item * C<+> – the feature is required in the constructor parameters. C<+> is not used with C<->.

=item * C<-> – the feature cannot be installed via the constructor. '-' is not used with C<+>.

=item * C<*> – do not increment the value's reference counter (apply C<weaken> to the value after installing it in the feature).

=item * C<?> – create a predicate.

=item * C<!> – create clearer.

=back

	package ExIs { use Aion;
		has rw => (is => 'rw?!');
		has ro => (is => 'ro+');
		has wo => (is => 'wo-?');
	}
	
	ExIs->new # @-> ro required!
	ExIs->new(ro => 10, wo => -10) # @-> wo excessive!
	
	ExIs->new(ro => 10)->has_rw # -> ""
	ExIs->new(ro => 10, rw => 20)->has_rw # -> 1
	ExIs->new(ro => 10, rw => 20)->clear_rw->has_rw # -> ""
	
	ExIs->new(ro => 10)->ro  # -> 10
	
	ExIs->new(ro => 10)->wo(30)->has_wo # -> 1
	ExIs->new(ro => 10)->wo # @-> Feature wo cannot be get!
	ExIs->new(ro => 10)->rw(30)->rw  # -> 30

The function with C<*> does not hold the meaning:

	package Node { use Aion;
		has parent => (is => "rw*", isa => Maybe[Object["Node"]]);
	}
	
	my $root = Node->new;
	my $node = Node->new(parent => $root);
	
	$node->parent->parent   # -> undef
	undef $root;
	$node->parent   # -> undef
	
	# And by setter:
	$node->parent($root = Node->new);
	
	$node->parent->parent   # -> undef
	undef $root;
	$node->parent   # -> undef

=head2 isa => $type

Indicates the type, or rather - a validator, feature.

Can take:

=over

=item * C<Aion::Type> – Aion immediately imports all types from L<Aion::Types> into the package.

=item * Strings are treated as packets and wrapped in C<Object>.

=item * Subroutines - the test value is passed to C<$_> and the subroutine returns a boolean value.