Mercurial > pub > Impl
view Lib/IMPL/Class/Meta.pm @ 149:b04e978d6d5a
minor changes
author | wizard |
---|---|
date | Wed, 18 Aug 2010 03:14:57 +0400 (2010-08-17) |
parents | 44977efed303 |
children | 3765adf1803f |
line wrap: on
line source
package IMPL::Class::Meta; use strict; use Storable qw(dclone); my %class_meta; my %class_data; sub set_meta { my ($class,$meta_data) = @_; $class = ref $class if ref $class; # ��� ������ ������������ ����������� ����������, ��������� ��� ���� ������������ # ����� IMPL::Object::Accessor, ������� ����������� �� �������� ������ die "The meta_data parameter should be an object" if not ref $meta_data; push @{$class_meta{$class}{ref $meta_data}},$meta_data; } sub get_meta { my ($class,$meta_class,$predicate,$deep) = @_; $class = ref $class if ref $class; no strict 'refs'; my @result; if ($deep) { @result = map { $_->can('get_meta') ? $_->get_meta($meta_class,$predicate,$deep) : () } @{$class.'::ISA'}; } if ($predicate) { push @result,grep( &$predicate($_), map( @{$class_meta{$class}{$_}}, grep( $_->isa($meta_class), keys %{$class_meta{$class} || {}} ) ) ); } else { push @result, map( @{$class_meta{$class}{$_} || []}, grep( $_->isa($meta_class), keys %{$class_meta{$class} || {}} ) ); } wantarray ? @result : \@result; } 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