Mercurial > pub > Impl
view Lib/IMPL/Class/Meta.pm @ 4:e59f44f75f20
DOM - в разработке
Testing - по мелочи
Property - изменен механизм выбора имплементора
author | Sergey |
---|---|
date | Wed, 12 Aug 2009 17:36:07 +0400 |
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;