Mercurial > pub > Impl
diff Lib/IMPL/Class/Meta.pm @ 209:a8db61d0ed33
IMPL::Class::Meta refactoring
author | cin |
---|---|
date | Mon, 28 May 2012 19:58:56 +0400 |
parents | 4d0e1962161c |
children | 47f77e6409f7 |
line wrap: on
line diff
--- a/Lib/IMPL/Class/Meta.pm Fri May 18 18:43:00 2012 +0400 +++ b/Lib/IMPL/Class/Meta.pm Mon May 28 19:58:56 2012 +0400 @@ -1,12 +1,13 @@ package IMPL::Class::Meta; use strict; +use Carp qw(carp); use IMPL::clone qw(clone); my %class_meta; my %class_data; -sub set_meta { +sub SetMeta { my ($class,$meta_data) = @_; $class = ref $class if ref $class; @@ -17,7 +18,11 @@ push @{$class_meta{$class}{ref $meta_data}},$meta_data; } -sub get_meta { +sub set_meta { + goto &SetMeta; +} + +sub GetMeta { my ($class,$meta_class,$predicate,$deep) = @_; $class = ref $class if ref $class; no strict 'refs'; @@ -35,10 +40,16 @@ wantarray ? @result : \@result; } +sub get_meta { + goto &GetMeta; +} + sub class_data { my $class = shift; $class = ref $class || $class; + carp 'The method is obsolete, use static_accessor($name,$value,\'clone\') instead'; + if (@_ > 1) { my ($name,$value) = @_; return $class_data{$class}{$name} = $value; @@ -58,23 +69,26 @@ } sub static_accessor { - my ($class,$name,$value) = @_; + my ($class,$name,$value,$clone) = @_; $class = ref $class || $class; no strict 'refs'; *{"${class}::${name}"} = sub { - if (@_ > 1) { - my $self = shift; - $self = ref $self || $self; + my $self = shift; + + if (@_ > 0) { + $self = ref $self || $self; if ($class ne $self) { - $self->static_accessor( $name => $_[0]); # define own class data + $self->static_accessor( $name => $_[0] ); # define own class data } else { $value = $_[0]; } } else { - $value; + ($clone and $class ne $self) + ? $self->static_accessor($name => clone($value),$clone) + : $value and $value ; } }; $value @@ -152,13 +166,11 @@ =head1 MEMBERS -=over - -=item C<set_meta($meta_data)> +=head2 C<set_meta($meta_data)> Добавляет метаданные C<$meta_data> к классу. -=item C<get_meta($meta_class,$predicate,$deep)> +=head2 C<get_meta($meta_class,$predicate,$deep)> Выбирает метаданные типа C<$meta_class> и его наследников, с возможностью фильтрации и получения метаданных базовых классов. @@ -201,50 +213,13 @@ =back -=item C<class_data($name,$new_value)> - -В отличии от метаданных, C<class_data> не накапливает информацию, -а хранит только один экземпляр для одного ключа C<$name>. - -Если новое значение не задано, то осуществляется выборка сохраненного, -если текущий класс не имеет сохраненного значения, то оно ищется в базовых -классах, затем копия найденного значения сохраняется в текущем классе и -возвращается наружу. Это позволяет базовым классам задавать значение по-умолчанию, -которые могут быть изменены или заменены субклассами. - -=begin code - -package Foo; -use parent 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 parent 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 - -=item C<static_accessor($name[,$value])> +=head2 C<static_accessor($name[,$value[,$clone]])> Создает статическое свойство с именем C<$name> и начальным значением C<$value>. -Использование данного свойство аналогично использованию C<class_data>, за исключением -того, что C<class_data> гарантирует, что наследник обладает собственной копией данных, -изменение которых не коснется ни базового класса, ни соседей. +Параметр C<$clone> контролирует то, как наследуются значения, если требуется каждому классу обеспечить +свое уникальное значение, то при первом обращении оно будет клонировано, по умолчанию клонирование не +происходит. =begin code @@ -260,8 +235,5 @@ __PACKAGE__->info({language => 'English'}); # will define own 'info' but will loose original data. =end code - - -=back =cut