--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/declare.pm	Thu Apr 19 02:10:02 2012 +0400
@@ -0,0 +1,146 @@
+package IMPL::declare;
+use strict;
+
+use Scalar::Util qw(set_prototype);
+
+sub import {
+	my ($self,$args) = @_;
+	
+	return unless $args;
+    
+    die "A hash reference is required" unless ref $args eq 'HASH';
+    
+    no strict 'refs';
+	
+	my $caller = caller;
+	
+	my $aliases = $args->{require} || {};
+	
+	while( my ($alias, $class) = each %$aliases ) {
+		_require($class);
+        
+        *{"${caller}::$alias"} = set_prototype(sub {
+            $class
+        }, '');
+    }
+    
+    my $base = $args->{base} || {};
+    
+    my %ctor;
+    my @isa;
+    
+    if (ref $base eq 'ARRAY') {
+    	@isa = map _require($_), @$base if @$base;
+    } elsif (ref $base eq 'HASH' ) {
+    	while ( my ($class,$mapper) = each %$base ) {
+    		$class = $aliases->{$class} || _require($class);
+    		
+    		push @isa,$class;
+    		$ctor{$class} = $mapper;
+    	}
+    }
+    
+    *{"${caller}::CTOR"} = \%ctor;
+    *{"${caller}::ISA"} = \@isa;
+}
+
+sub _require {
+	my ($class) = @_;
+	
+	if (not $class =~ s/^-//) {
+		(my $file = $class) =~ s/::|'/\//g;
+		require "$file.pm";
+	}
+	$class;
+}
+
+
+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
\ No newline at end of file