--- a/Lib/IMPL/Class/Meta.pm	Wed Apr 21 17:39:45 2010 +0400
+++ b/Lib/IMPL/Class/Meta.pm	Mon Apr 26 03:10:03 2010 +0400
@@ -1,7 +1,11 @@
 package IMPL::Class::Meta;
 use strict;
 
+use Class::Data::Inheritable;
+use Storable qw(dclone);
+
 my %class_meta;
+my %class_data;
 
 sub set_meta {
     my ($class,$meta_data) = @_;
@@ -32,12 +36,186 @@
     wantarray ? @result : \@result;
 }
 
-=pod
-__PACKAGE_->set_meta($metaObject);
-__PACKAGE_->get_meta('MyMetaClass',sub {
-    my ($item) = @_;
-    $item->Name eq 'Something' ? 1 : 0
-} );
-=cut
+sub class_data {
+	my $class = shift;
+	$class = ref $class || $class;
+	
+	if (@_ > 1) {
+		my ($name,$value) = @_;
+		return $class_data{$class}{$name} = $value;
+	} else {
+		my ($name) = @_;
+		
+		if( exists $class_data{$class}{$name} ) {
+			$class_data{$class}{$name};
+		} else {
+			if ( my $value = $class->_find_class_data($name) ) {
+				$class_data{$class}{$name} = dclone($value);
+			} else {
+				undef;
+			}
+		}
+	}
+}
+
+sub _find_class_data {
+	my ($class,$name) = @_;
+	
+	no strict 'refs';
+	
+	exists $class_data{$_}{$name} and return $class_data{$_}{$name}	foreach @{"${class}::ISA"};
+		
+	my $val;
+	$val = $_->_find_class_data($name) and return $val foreach @{"${class}::ISA"}; 
+}
 
 1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+C<IMPL::Class::Meta> - информация хранимая на уровне класса.
+
+=head1 SYNOPSIS
+
+=begin code
+
+package InfoMeta;
+
+use base qw(IMPL::Object IMPL::Object::Autofill);
+use IMPL::Class::Property;
+
+__PACKAGE__->PassThroughArgs;
+
+BEGIN {
+	public property name => prop_get | owner_set;
+}
+
+package InfoExMeta;
+use base qw(InfoMeta);
+
+__PACKAGE__->PassThroughArgs;
+
+BEGIN {
+	public property description => prop_all;
+}
+
+package Foo;
+
+__PACKAGE__->set_meta(new InfoMeta(name => 'info'));
+__PACKAGE__->set_meta(new InfoExMeta(name => 'infoEx', description => 'extended info' ));
+
+package main;
+
+# get all InfoMeta, InfoExMeta will be included, becouse it's derived from InfoMeta
+my @info = Foo->get_meta('InfoMeta'); # will get two objects, 'info' and 'infoEx';
+
+# get all InfoExMeta meta
+@info = Foo->get_meta('InfoExMeta'); # will get only 'infoEx'
+
+# get filtered meta
+@info = Foo->get_meta('InfoMeta', sub { $_->name eq 'info'} ); # will get only 'info' 
+
+=end code
+
+=head1 DESCRIPTION
+
+Позвоялет расширять информацию о типах (класса) при помощи метаданных, метаданными являются любые объекты,
+притом выборка метаданных приоизводится по их типу (классу), что позволяет выбрать все однотипные метаданные.
+
+Существует возможность выборки метаданных с учетом унаследованных от базовых классов
+
+=head1 MEMBERS
+
+=over
+
+=item C<set_meta($meta_data)>
+
+Добавляет метаданные C<$meta_data> к классу.
+
+=item C<get_meta($meta_class,$predicate,$deep)>
+
+Выбирает метаданные типа C<$meta_class> и его наследников, с возможностью фильтрации и получения
+метаданных базовых классов.
+
+=over
+
+=item C<$meta_class>
+
+Тип метаданных
+
+=item C<$predicate>
+
+Подпрограмма, которая будет вызываться для каждых найденных метаданных и на основе результата
+ее выполнения метаданные будут включены в результат или нет. Получеат в качестве параметра
+объект с метаданными, возвращает C<true> - включить метаданные в результа, C<false> - пропустить
+метаданные как не подходящие. Также переменная C<$_> ссылается на текущий объект с метаданными.
+
+=begin code
+
+my @info = Foo->get_meta(
+	'InfoMeta',
+	sub { ref $_ eq 'InfoMeta'}, # exclude subclasses ('InfoExMeta')
+	1 # deep search
+);
+
+my @info = Foo->get_meta(
+	'InfoMeta',
+	sub {
+		my $item = shift;
+		ref $item eq 'InfoMeta' # exclude subclasses ('InfoExMeta')
+	}, 
+	1 # deep search
+);
+
+=end code 
+ 
+=item C<$deep>
+
+Осуществлять поиск по базовым классам.
+
+=back  
+
+=item C<class_data($name,$new_value)>
+
+В отличии от метаданных, C<class_data> не накапливает информацию,
+а хранит только один экземпляр для одного ключа C<$name>.
+
+Если новое значение не задано, то осуществляется выборка сохраненного,
+если текущий класс не имеет сохраненного значения, то оно ищется в базовых
+классах, затем копия найденного значения сохраняется в текущем классе и
+возвращается наружу. Это позволяет базовым классам задавать значение по-умолчанию,
+которые могут быть изменены или заменены субклассами.
+
+=begin code
+
+package Foo;
+use base qw(IMPL::Class::Meta);
+
+__PACKAGE__->class_data( info => { version => 1 } ); # will be default for all subclasses
+
+sub say_version {
+	my ($self) = @_;
+	
+	print $self->class_data(info)->{version};
+}
+
+package Bar;
+use base qw(Foo);
+
+__PACKAGE__->class_data('info')->{ language } = 'English';
+
+package main;
+
+Foo->class_data('info')->{version} = 2;
+Bar->say_version; # will print '1';
+Foo->say_version; # will print '2';
+
+=end code   
+
+=back
+
+=cut