Mercurial > pub > Impl

comparison Lib/IMPL/Class/Meta.pm @ 0:03e58a454b20

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Создан репозитарий
author Sergey
date Tue, 14 Jul 2009 12:54:37 +0400
parents
children 16ada169ca75
comparison
equal deleted inserted replaced
-1:000000000000 0:03e58a454b20
1 package IMPL::Class::Meta;
2 use strict;
3
4 my %class_meta;
5
6 sub set_meta {
7 my ($class,$meta_data) = @_;
8 $class = ref $class if ref $class;
9
10 # òóò íåëüçÿ èñïîëüçîâàòü ñòàíäàðòíîå èñêëþ÷åíèå, ïîñêîëüêó äëÿ íåãî èñïîëüçóåòñÿ
11 # êëàññ IMPL::Object::Accessor, êîòîðûé íàñëåäóåòñÿ îò òåêóùåãî êëàññà
12 die "The meta_data parameter should be an object" if not ref $meta_data;
13
14 push @{$class_meta{$class}{ref $meta_data}},$meta_data;
15 }
16
17 sub get_meta {
18 my ($class,$meta_class,$predicate,$deep) = @_;
19 $class = ref $class if ref $class;
20 no strict 'refs';
21 my @result;
22
23 if ($deep) {
24 @result = map { $_->can('get_meta') ? $_->get_meta($meta_class,$predicate,$deep) : () } @{$class.'::ISA'};
25 }
26
27 if ($predicate) {
28 push @result,grep( &$predicate($_), map( @{$class_meta{$class}{$_}}, grep( $_->isa($meta_class), keys %{$class_meta{$class} || {}} ) ) );
29 } else {
30 push @result, map( @{$class_meta{$class}{$_} || []}, grep( $_->isa($meta_class), keys %{$class_meta{$class} || {}} ) );
31 }
32 wantarray ? @result : \@result;
33 }
34
35 =pod
36 __PACKAGE_->set_meta($metaObject);
37 __PACKAGE_->get_meta('MyMetaClass',sub {
38 my ($item) = @_;
39 $item->Name eq 'Something' ? 1 : 0
40 } );
41 =cut
42
43 1;