Mercurial > pub > Impl
view Lib/IMPL/Class/Meta.pm @ 32:56cef8e3cda6
+1
author | Sergey |
---|---|
date | Mon, 09 Nov 2009 01:39:31 +0300 |
parents | 03e58a454b20 |
children | 16ada169ca75 |
line wrap: on
line source
package IMPL::Class::Meta; use strict; my %class_meta; 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; } =pod __PACKAGE_->set_meta($metaObject); __PACKAGE_->get_meta('MyMetaClass',sub { my ($item) = @_; $item->Name eq 'Something' ? 1 : 0 } ); =cut 1;