view release on metacpan or  search on metacpan

lib/Aion.pm  view on Meta::CPAN

	my $property = shift;

	my $pkg = caller;
	is_aion $pkg;

	my %opt = @_;
	my $meta = $Aion::META{$pkg};

	# создаём фичи
	for my $name (ref $property? @$property: $property) {

		die "has: the method $name is already in the package $pkg"
			if $pkg->can($name) && !exists $meta->{feature}{$name};

		my $feature = Aion::Meta::Feature->new($pkg, $name, @_);

		my $require = delete $meta->{require}{$name};
		$require->compare($feature) if $require;

		my $overload = $meta->{feature}{$name};
		$overload->compare($feature) if $overload;
		
		$feature->mk_property;
		$meta->{feature}{$name} = $feature;
	}
	return;
}

# Инициализатор: закрывает класс и заменяется на конструктор
sub initialize {
	my ($cls) = @_;

	$cls = ref $cls || $cls;
	is_aion $cls;

	my $REQUIRE = $Aion::META{$cls}{require};
	my $FEATURE = $Aion::META{$cls}{feature};
	my $SUBROUTINE = $Aion::META{$cls}{subroutine};
	for my $key (keys %$REQUIRE) {
		my $require = $REQUIRE->{$key};
		
		if ($require->isa('Aion::Meta::RequiresAnyFunction')) {
			$require->compare($cls->can($key));
		} elsif ($require->isa('Aion::Meta::RequiresFeature')) {
			$require->compare($FEATURE->{$require->name});
		} else {
			$require->compare($SUBROUTINE->{$require->subname});
		}
	}

	%$REQUIRE = ();

	# TODO: очищать класс от вспомогательных функций
	#eval "package $cls; Aion->unimport; 1" or die;

	my $new = << 'END';
package %(cls)s {
	sub new {
		my ($cls, %value) = @_;
		$cls = ref $cls || $cls;
		my $self = bless {}, $cls;
		
%(initializers)s
		
		if(scalar keys %value) {
			my @fakekeys = sort keys %value;
			die "@fakekeys is'nt feature!" if @fakekeys == 1;
			local $" = ", ";
			die "@fakekeys is'nt features!"
		}

		return $self;
	}
}
END

    my @destroyers;
	my $initializers = join "", map {
		push @destroyers, $_->{construct}->destroyer if $_->{cleaner};
		$_->{construct}->initializer
	} sort { $a->{order} <=> $b->{order} } values %$FEATURE;
	
	my %var = (
		cls => $cls,
		initializers => $initializers,
	);
	
	$new =~ s/%\((\w+)\)s/$var{$1}/ge;

	eval $new;
	die if $@;

	if (@destroyers) {
		my $destroyer = << 'END';
package %(cls)s {
	sub DESTROY {
		my ($self) = @_;

		warn "${\ref $self}#${\Scalar::Util::id $self} destroy in global phase!" if ${^GLOBAL_PHASE} eq 'DESTRUCT';

%(destroyers)s
	}
}
END

		my %var = (
			cls => $cls,
			destroyers => join "", @destroyers,
		);
	
		$destroyer =~ s/%\((\w+)\)s/$var{$1}/ge;

		eval $destroyer;
		die $@ if $@;
	}
	
	goto &{"${cls}::new"};
}

1;

lib/Aion.pm  view on Meta::CPAN

	
	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;