Aion

 view release on metacpan or  search on metacpan

lib/Aion.pm  view on Meta::CPAN

package Aion;

use common::sense;

our $VERSION = "2.3";

use Aion::Types qw//;
use Aion::Meta::RequiresAnyFunction;
use Aion::Meta::Feature;
use Aion::Meta::RequiresFeature;
use Aion::Meta::Subroutine;

# Когда осуществлять проверки:
#   ro - только при выдаче
#   wo - только при установке
#   rw - при выдаче и уcтановке
#   no - никогда не проверять
use Aion::Env AION_ISA => (default => 'rw');

sub export($@);

# Классы в которых подключён Aion с метаинформацией
our %META;

# Вызывается из другого пакета, для импорта данного
sub import {
	my (undef, $attr) = @_;
	my $pkg = caller;

	*{"$pkg\::DOES"} = \&does if \&does != $pkg->can('DOES');

	if($attr ne '-role') {  # Класс
		export $pkg, qw/extends/;
		*{"${pkg}::new"} = \&initialize;
	} else {	# Роль
		export $pkg, qw/requires req/;
	}

	export $pkg, qw/with has aspect does exactly/;

	# Метаинформация
	$META{$pkg} = {
		order => scalar keys %META,
		require => {},
		feature => {},
		subroutine => {},
		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;

lib/Aion.pm  view on Meta::CPAN

=head2 pleroma ()

Returns the locator.

	Aion->pleroma->isa('Aion::Pleroma')  # -> 1

=head1 SUBROUTINES IN CLASSES

=head2 extends (@superclasses)

Expands the class with another class/classes. It causes from each inherited class the method of C<import_extends>, if it is in it.

	package World { use Aion;
	
		our $extended_by_this = 0;
	
		sub import_extends {
			my ($class, $extends) = @_;
			$extended_by_this ++;
	
			$class   # => World
			$extends # => Hello
		}
	}
	
	package Hello { use Aion;
		extends q/World/;
	
		$World::extended_by_this # -> 1
	}
	
	Hello->isa("World")	 # -> 1

=head2 new (%param)

The constructor.

=over

=item * Installs C<%param> for features.

=item * Checks that the parameters correspond to the features.

=item * Sets default values.

=back

	package NewExample { use Aion;
		has x => (is => 'ro', isa => Num);
		has y => (is => 'ro+', isa => Num);
		has z => (is => 'ro-', isa => Num);
	}
	
	NewExample->new(f => 5) # @-> y required!
	NewExample->new(f => 5, y => 10) # @-> f is'nt feature!
	NewExample->new(f => 5, p => 6, y => 10) # @-> f, p is'nt features!
	NewExample->new(z => 10, y => 10) # @-> z excessive!
	
	my $ex = NewExample->new(y => 8);
	
	$ex->x # @-> Get feature x must have the type Num. The it is undef!
	
	$ex = NewExample->new(x => 10.1, y => 8);
	
	$ex->x # -> 10.1

=head1 SUBROUTINES IN ROLES

=head2 requires (@subroutine_names)

Checks that classes using this role have the specified routines or features.

	package Role::Alpha { use Aion -role;
	
		requires qw/abc/;
	}
	
	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

=head2 Role inherits role

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

lib/Aion.pm  view on Meta::CPAN

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.

=item * Objects with overloaded C<&{}> operator. If such an object also has a C<coerce> method, then it will participate in casts if C<< coerce =E<gt> 1 >> is specified.

=back

	package Externalis {
		use overload '&{}' => sub { sub { /^\d+$/ } };
		sub coerce { int $_ }
	}
	
	package ExIsa { use Aion;
		has x => (isa => Int);
		has y => (isa => sub { /^\d+$/ });
		has z => (isa => bless({}, 'Externalis'), coerce => 1);
	}
	
	ExIsa->new(x => 'str') # @-> Set feature x must have the type Int. The it is 'str'!
	ExIsa->new->x # @-> Get feature x must have the type Int. The it is undef!
	ExIsa->new(x => 10)->x			  # -> 10
	
	ExIsa->new(y => 'abc') # @-> Set feature y must have the type External[CODE
	ExIsa->new(z => ' 6 xyz')->z # -> 6

=head2 coerce => (1|0)

Includes type conversions.

	package ExCoerce { use Aion;
		has x => (is => 'ro', isa => Int, coerce => 1);
	}
	
	ExCoerce->new(x => 10.4)->x  # -> 10
	ExCoerce->new(x => 10.5)->x  # -> 11

=head2 default => $value

The default value is set in the designer if there is no parameter with the name of the feature.

	package ExDefault { use Aion;
		has x => (is => 'ro', default => 10);
	}
	
	ExDefault->new->x  # -> 10
	ExDefault->new(x => 20)->x  # -> 20

If C<$value> is a subroutine, then the subroutine is considered the feature's value constructor. Lazy evaluation is used if there is no C<lazy> attribute.

	my $count = 10;
	
	package ExLazy { use Aion;
		has x => (default => sub {
			my ($self) = @_;
			++$count
		});
	}
	
	my $ex = ExLazy->new;
	$count   # -> 10
	$ex->x   # -> 11
	$count   # -> 11
	$ex->x   # -> 11
	$count   # -> 11

=head2 lazy => (1|0)

The C<lazy> aspect enables or disables lazy evaluation of the default value (C<default>).

By default it is only enabled if the default is a subroutine.

	package ExLazy0 { use Aion;
		has x => (is => 'ro?', lazy => 0, default => sub { 5 });
	}
	
	my $ex0 = ExLazy0->new;
	$ex0->has_x # -> 1
	$ex0->x     # -> 5
	
	package ExLazy1 { use Aion;
		has x => (is => 'ro?', lazy => 1, default => 6);
	}
	
	my $ex1 = ExLazy1->new;
	$ex1->has_x # -> ""
	$ex1->x     # -> 6

=head2 eon => (1|2|$key)

The C<eon> aspect implements the B<Dependency Injection> pattern.

It associates a property with a service from the C<< Aion-E<gt>pleroma >> container.

The aspect value can be a service key, 1 or 2.

=over

=item * If 1 – then the key will be the package in C<< isa =E<gt> Object['Packet'] >>.

=item * If 2 – then the key will be “package#property”.

=back

File lib/CounterEon.pm:

	package CounterEon;
	#@eon ex.counter
	use Aion;
	
	has accomulator => (isa => 'AccomulatorEon', eon => 1);
	
	1;

File lib/AccomulatorEon.pm:

	package AccomulatorEon;
	#@eon
	use Aion;
	
	has power => (isa => 'PowerEon', eon => 2);
	
	1;

lib/PowerEon.pm file:

	package PowerEon;
	use Aion;
	
	has counter => (eon => 'ex.counter');
		
	#@eon
	sub power { shift->new }
	
	1;

We use pleroma locally:

	{
		use Aion::Pleroma;
		my $pleroma = Aion::Pleroma->new(ini => undef, pleroma => {
			'ex.counter' => 'CounterEon#new',
			AccomulatorEon => 'AccomulatorEon#new',
			'PowerEon#power' => 'PowerEon#power',
		});
	
		local *Aion::pleroma = sub { $pleroma };
		
		my $counter = Aion->pleroma->get('ex.counter');
	
		$counter->accomulator->power->counter # -> $counter
	}
	
	Aion->pleroma->get('ex.counter') # -> undef

See L<Aion::Pleroma>.

=head2 trigger => $sub

C<$sub> is called after setting the property in the constructor (C<new>) or via a setter.

The etymology of C<trigger> is to let in.

	package ExTrigger { use Aion;
		has x => (trigger => sub {
			my ($self, $old_value) = @_;
			$self->y($old_value + $self->x);
		});
	
		has y => ();
	}
	
	my $ex = ExTrigger->new(x => 10);
	$ex->y	  # -> 10
	$ex->x(20);
	$ex->y	  # -> 30

=head2 release => $sub

C<$sub> is called before returning a property from an object via a getter.

The etymology of C<release> is to release.

	package ExRelease { use Aion;
		has x => (release => sub {
			my ($self, $value) = @_;
			$_[1] = $value + 1;
		});
	}
	
	my $ex = ExRelease->new(x => 10);
	$ex->x	  # -> 11

=head2 init_arg => $name

Changes the property name in the constructor.

	package ExInitArg { use Aion;
		has x => (is => 'ro+', init_arg => 'init_x');
	
		ExInitArg->new(init_x => 10)->x # -> 10
	}

=head2 accessor => $name

Changes the accessor name.

	package ExAccessor { use Aion;
		has x => (is => 'rw', accessor => '_x');
	
		ExAccessor->new->_x(10)->_x # -> 10
	}

=head2 writer => $name

lib/Aion.pm  view on Meta::CPAN

		has x => (is => 'ro', writer => '_set_x');
	
		ExWriter->new->_set_x(10)->x # -> 10
	}

=head2 reader => $name

Creates a getter named C<$name> for a property.

	package ExReader { use Aion;
		has x => (is => 'wo', reader => '_get_x');
	
		ExReader->new(x => 10)->_get_x # -> 10
	}

=head2 predicate => $name

Creates a predicate named C<$name> for a property. You can also create a predicate with a standard name using C<< is =E<gt> '?' >>.

	package ExPredicate { use Aion;
		has x => (predicate => '_has_x');
		
		my $ex = ExPredicate->new;
		$ex->_has_x        # -> ""
		$ex->x(10)->_has_x # -> 1
	}

=head2 clearer => $name

Creates a cleaner named C<$name> for a property. You can also create a cleaner with a standard name using C<< is =E<gt> '!' >>.

	package ExClearer { use Aion;
		has x => (is => '?', clearer => 'clear_x_');
	}
	
	my $ex = ExClearer->new;
	$ex->has_x	  # -> ""
	$ex->clear_x_;
	$ex->has_x	  # -> ""
	$ex->x(10);
	$ex->has_x	  # -> 1
	$ex->clear_x_;
	$ex->has_x	  # -> ""

=head2 cleaner => $sub

C<$sub> is called when the destructor or C<< $object-E<gt>clear_feature >> is called, but only if the feature is present (see C<< $object-E<gt>has_feature >>).

This aspect forces the creation of a predicate and a clearer.

	package ExCleaner { use Aion;
	
		our $x;
	
		has x => (is => '!', cleaner => sub {
			my ($self) = @_;
			$x = $self->x
		});
	}
	
	$ExCleaner::x		  # -> undef
	ExCleaner->new(x => 10);
	$ExCleaner::x		  # -> 10
	
	my $ex = ExCleaner->new(x => 12);
	
	$ExCleaner::x	  # -> 10
	$ex->clear_x;
	$ExCleaner::x	  # -> 12
	
	undef $ex;
	
	$ExCleaner::x	  # -> 12

=head1 ATTRIBUTES

C<Aion> adds universal attributes to the package.

=head2 :Isa (@signature)

The attribute C<Isa> checks the signature of the function.

	package MaybeCat { use Aion;
	
		sub is_cat : Isa(Me => Str => Bool) {
			my ($self, $anim) = @_;
			$anim =~ /(cat)/
		}
	}
	
	my $anim = MaybeCat->new;
	$anim->is_cat('cat')	# -> 1
	$anim->is_cat('dog')	# -> ""
	
	MaybeCat->is_cat("cat") # @-> Arguments of method `is_cat` must have the type Tuple[Me, Str].
	my @items = $anim->is_cat("cat") # @-> Returns of method `is_cat` must have the type Tuple[Bool].

The Isa attribute allows you to declare the required functions:

	package Anim { use Aion -role;
	
		sub is_cat : Isa(Me => Bool);
	}
	
	package Cat { use Aion; with qw/Anim/;
	
		sub is_cat : Isa(Me => Bool) { 1 }
	}
	
	package Dog { use Aion; with qw/Anim/;
	
		sub is_cat : Isa(Me => Bool) { 0 }
	}
	
	package Mouse { use Aion; with qw/Anim/;
		
		sub is_cat : Isa(Me => Int) { 0 }
	}
	
	Cat->new->is_cat # -> 1
	Dog->new->is_cat # -> 0
	Mouse->new # @-> Signature mismatch: is_cat(Me => Bool) of Anim <=> is_cat(Me => Int) of Mouse

=head1 SEE ALSO

Aion Ecosystem:

=over

=item * L<Aion::Annotation>