--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/declare.pm	Fri Sep 04 19:40:23 2015 +0300
@@ -0,0 +1,216 @@
+package IMPL::declare;
+use strict;
+
+use Carp qw(carp);
+use IMPL::Class::PropertyInfo();
+use IMPL::Const qw(:access);
+use IMPL::require();
+
+BEGIN {
+	*_require = *IMPL::require::_require;
+	*_trace   = *IMPL::require::_trace;
+}
+
+sub import {
+	my ( $self, $args ) = @_;
+
+	return unless $args;
+
+	die "A hash reference is required" unless ref $args eq 'HASH';
+
+	no strict 'refs';
+	no warnings 'once';
+
+	my $caller = caller;
+
+	my $aliases = $args->{require} || {};
+
+	$IMPL::require::PENDING{$caller} = 1;
+	_trace("declare $caller");
+	$IMPL::require::level++;
+
+	*{"${caller}::SELF"} = sub () {
+		$caller;
+	};
+
+	while ( my ( $alias, $class ) = each %$aliases ) {
+		_trace("$alias => $class");
+		$IMPL::require::level++;
+		my $c = _require($class);
+
+		*{"${caller}::$alias"} = sub() {
+			$c;
+		};
+		$IMPL::require::level--;
+	}
+
+	my $base = $args->{base} || {};
+
+	my %ctor;
+	my @isa;
+
+	if ( ref $base eq 'ARRAY' ) {
+		carp "Odd elements number in require"
+		  unless scalar(@$base) % 2 == 0;
+		while ( my ( $class, $mapper ) = splice @$base, 0, 2 ) {
+			_trace("parent $class");
+			$IMPL::require::level++;
+			$class = $aliases->{$class} || _require($class);
+			$IMPL::require::level--;
+
+			push @isa, $class;
+			$ctor{$class} = $mapper;
+		}
+	}
+	elsif ( ref $base eq 'HASH' ) {
+		while ( my ( $class, $mapper ) = each %$base ) {
+			_trace("parent $class");
+			$IMPL::require::level++;
+			$class = $aliases->{$class} || _require($class);
+			$IMPL::require::level--;
+
+			push @isa, $class;
+			$ctor{$class} = $mapper;
+		}
+	}
+
+	%{"${caller}::CTOR"} = %ctor;
+	push @{"${caller}::ISA"}, @isa;
+
+	if ( ref( $args->{meta} ) eq 'ARRAY' ) {
+		$caller->SetMeta($_) foreach @{ $args->{meta} };
+	}
+
+	my $props = $args->{props} || [];
+
+	if ( $props eq 'HASH' ) {
+		$props = [%$props];
+	}
+
+	die "A hash or an array reference is required in the properties list"
+	  unless ref $props eq 'ARRAY';
+
+	carp "Odd elements number in properties declaration of $caller"
+	  unless scalar(@$props) % 2 == 0;
+
+	if (@$props) {
+		$self->_implementProps( $props, $caller );
+	}
+
+	if ( $args->{_implement} ) {
+		$self->_implementProps( $caller->abstractProps, $caller );
+		$caller->abstractProps( [] );
+	}
+
+	$IMPL::require::level--;
+	delete $IMPL::require::PENDING{$caller};
+}
+
+sub _implementProps {
+	my ( $self, $props, $caller ) = @_;
+
+	for ( my $i = 0 ; $i < @$props - 1 ; $i = $i + 2 ) {
+		my ( $prop, $spec ) = @{$props}[ $i, $i + 1 ];
+
+		$caller->ClassPropertyImplementor->Implement(
+			$spec,
+			{
+				name   => $prop,
+				class  => $caller,
+				access => $prop =~ /^_/
+				? ACCESS_PRIVATE
+				: ACCESS_PUBLIC
+			}
+		);
+	}
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+C<IMPL::declare> - описывает класс
+
+=head1 SYNOPSIS
+
+=begin code
+
+package My::Bar;
+
+use IMPL::declare {
+	require => {
+		TFoo => 'My::Foo',
+		TBox => 'My::Box'
+	},
+	base => {
+		TFoo => '@_',
+		'IMPL::Object' => undef,
+	}
+}
+
+sub CreateBox {
+	my ($this) = @_;
+	return TBox->new($this);
+}
+
+=end code
+
+Специальная ситрока C<@_> означает передачу параметров конструктора текущего класса конструктору
+базового класса без изменений.
+
+=head1 DESCRIPTION
+
+Описывает текущий пакет(модуль) как класс. В качестве параметра получает ссылку на хеш,
+в которой храняться метаданные для объявления класса.
+
+=head1 METADATA
+
+=head2 C<require>
+
+Содержит ссылку на хеш с синонимами модулей, которые будут доступны в текушем модуле,
+аналогично использованию C<IMPL::require>. Однако, если модуль не требует загрузки при
+помощи C<require> нужно использовать префикс C<'-'> в его имени
+
+=begin code
+
+{
+	require => {
+		TObject => 'IMPL::Object', # will be loaded with require
+		TFoo => '-My:App::Data::Foo' # will not use 'require' to load module
+	}
+}
+
+=end code
+
+=head2 C<base>
+
+Обисывает базове классы для текущего класса. Если данный параметр - ссылка массив, то
+этот массив будет превращен в массив C<@ISA>. Если данный параметр - ссылка на хеш, то
+его ключи опичавют список базовых классов, а значения - преобразование параметров для
+вызова базовых конструкторов.
+
+В качестве имен базовых классов могут быть как полные имена модулей, так и назначенные
+ранее псевдонимы. Использование префикса C<'-'> перед B<полным именем модуля> означает,
+что модуль не требуется загружать, в случае с псевдонимами, префикс C<'-'> уже был указан
+при их объявлении.
+
+=begin code
+
+{
+    require => {
+        TFoo => '-My:App::Data::Foo' # will not use 'require' to load module
+    },
+    base => {
+    	TFoo => '@_', # pass parameters unchanged
+    	'My::Base::Class' => sub { name => $_[0], data => $_[1] },  # remap parameters
+    	'-My::Extentions' => undef, # do not pass any parameters
+    }
+}
+
+=end code
+
+=cut