view release on metacpan or  search on metacpan

lib/Aion.pm  view on Meta::CPAN

		$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;

__END__

=encoding utf-8

=head1 NAME

Aion - a postmodern object system for Perl 5, such as “Mouse”, “Moose”, “Moo”, “Mo” and “M”, but with improvements

=head1 VERSION

1.9

=head1 SYNOPSIS

	package Calc {
	
		use Aion;

lib/Aion.pm  view on Meta::CPAN

In addition to standard aspects, roles can add their own aspects using the B<aspect> subprogram.

The signature of the methods can be checked using the attribute C<:Isa(...)>.

=head1 SUBROUTINES IN CLASSES AND ROLES

C<Use Aion> imports types from the moduleC<Aion::Types> and the following subprograms:

=head2 has ($name, %aspects)

Creates a method for obtaining/setting the function (properties) of the class.

lib/Animal.pm file:

	package Animal;
	use Aion;
	
	has type => (is => 'ro+', isa => Str);
	has name => (is => 'rw-', isa => Str, default => 'murka');
	
	1;



	use lib "lib";
	use Animal;
	
	my $cat = Animal->new(type => 'cat');
	
	$cat->type   # => cat
	$cat->name   # => murka
	
	$cat->name("murzik");
	$cat->name   # => murzik

=head2 with

Adds to the module of the role. For each role, the C<import_with> method is called.

File lib/Role/Keys/Stringify.pm:

	package Role::Keys::Stringify;
	
	use Aion -role;
	
	sub keysify {
		my ($self) = @_;
		join ", ", sort keys %$self;
	}
	
	1;

File lib/Role/Values/Stringify.pm:

	package Role::Values::Stringify;
	
	use Aion -role;
	
	sub valsify {
		my ($self) = @_;
		join ", ", map $self->{$_}, sort keys %$self;
	}
	
	1;

File lib/Class/All/Stringify.pm:

	package Class::All::Stringify;
	
	use Aion;
	
	with q/Role::Keys::Stringify/;
	with q/Role::Values::Stringify/;
	
	has [qw/key1 key2/] => (is => 'rw', isa => Str);
	
	1;



	use lib "lib";
	use Class::All::Stringify;
	
	my $s = Class::All::Stringify->new(key1=>"a", key2=>"b");
	
	$s->keysify	 # => key1, key2
	$s->valsify	 # => a, b

=head2 exactly ($package)

Checks that C<$package> is a super class for a given or this class itself.

Aion does not change the implementation of the C<isa> method and it finds both superclasses and roles (since both are added to the C<@ISA> package).

	package Ex::X { use Aion; }
	package Ex::A { use Aion; extends q/Ex::X/; }
	package Ex::B { use Aion; }
	package Ex::C { use Aion; extends qw/Ex::A Ex::B/ }
	
	Ex::C->exactly("Ex::A") # -> 1
	Ex::C->exactly("Ex::B") # -> 1
	Ex::C->exactly("Ex::X") # -> 1
	Ex::C->exactly("Ex::X1") # -> ""
	Ex::A->exactly("Ex::X") # -> 1
	Ex::A->exactly("Ex::A") # -> 1
	Ex::X->exactly("Ex::X") # -> 1

=head2 does ($package)

Checks that C<$package> is a role that is used in a class or another role.

	package Role::X { use Aion -role; }
	package Role::A { use Aion -role; with qw/Role::X/; }
	package Role::B { use Aion -role; }
	package Ex::Z { use Aion; with qw/Role::A Role::B/; }
	
	Ex::Z->does("Role::A") # -> 1
	Ex::Z->does("Role::B") # -> 1
	Ex::Z->does("Role::X") # -> 1
	Role::A->does("Role::X") # -> 1
	Role::A->does("Role::X1") # -> ""