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 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}";
		
	}

lib/Aion.pm  view on Meta::CPAN

A role can inherit another role via C<with>. This way you can refine the interface: the types of required features (C<req>) and methods (C<:Isa>) either remain the same or are lowered - they become narrower subtypes. Demotion is checked by the less-t...

The role C<Role::Animal> requires a property C<legs> of the wide type C<Num | Object> and the C<sound> method with signature C<< (Me =E<gt> Str) >>.

	package Role::Animal { use Aion -role;
	
		req legs => (isa => Num | Object);
		sub sound : Isa(Me => Str);
	}

The C<Role::Bird> role inherits C<Role::Animal>, but lowers the C<legs> type to C<Num>, and leaves the C<sound> method signature the same.

	package Role::Bird { use Aion -role;
	
		with qw/Role::Animal/;
		req legs => (isa => Num);
		sub sound : Isa(Me => Str);
	}

The C<Ex::Sparrow> class uses the C<Role::Bird> role and implements all its requirements.

	package Ex::Sparrow { use Aion;
		with qw/Role::Bird/;
	
		has legs => (is => 'ro', isa => Num, default => 2);
		sub sound : Isa(Me => Str) { 'chirp' }
	
		Num < (Num | Object)  # -> 1
	}
	
	my $sparrow = Ex::Sparrow->new;
	$sparrow->legs  # => 2
	$sparrow->sound # => chirp

=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.