annotate 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
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
1 package IMPL::Class::Meta;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
2 use strict;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
3
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
4 my %class_meta;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
5
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
6 sub set_meta {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
7 my ($class,$meta_data) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
8 $class = ref $class if ref $class;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
9
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
10 # òóò íåëüçÿ èñïîëüçîâàòü ñòàíäàðòíîå èñêëþ÷åíèå, ïîñêîëüêó äëÿ íåãî èñïîëüçóåòñÿ
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
11 # êëàññ IMPL::Object::Accessor, êîòîðûé íàñëåäóåòñÿ îò òåêóùåãî êëàññà
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
12 die "The meta_data parameter should be an object" if not ref $meta_data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
13
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
14 push @{$class_meta{$class}{ref $meta_data}},$meta_data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
15 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
16
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
17 sub get_meta {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
18 my ($class,$meta_class,$predicate,$deep) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
19 $class = ref $class if ref $class;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
20 no strict 'refs';
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
21 my @result;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
22
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
23 if ($deep) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
24 @result = map { $_->can('get_meta') ? $_->get_meta($meta_class,$predicate,$deep) : () } @{$class.'::ISA'};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
25 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
26
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
27 if ($predicate) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
28 push @result,grep( &$predicate($_), map( @{$class_meta{$class}{$_}}, grep( $_->isa($meta_class), keys %{$class_meta{$class} || {}} ) ) );
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
29 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
30 push @result, map( @{$class_meta{$class}{$_} || []}, grep( $_->isa($meta_class), keys %{$class_meta{$class} || {}} ) );
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
31 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
32 wantarray ? @result : \@result;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
33 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
34
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
35 =pod
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
36 __PACKAGE_->set_meta($metaObject);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
37 __PACKAGE_->get_meta('MyMetaClass',sub {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
38 my ($item) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
39 $item->Name eq 'Something' ? 1 : 0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
40 } );
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
41 =cut
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
42
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
43 1;