Mercurial > pub > Impl

annotate Lib/IMPL/TypeKeyedCollection.pm @ 390:de1f875e8875

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
added reverse matching lookup to TypeKeyedCollection (find closest descendant)
author cin
date Wed, 12 Feb 2014 18:02:03 +0400
parents 96a522aeb359
children 69a1f1508696
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
316
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
1 package IMPL::TypeKeyedCollection;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
2 use strict;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
3
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
4 use IMPL::Const qw(:prop);
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
5 use IMPL::declare {
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
6 require => {
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
7 ArgException => '-IMPL::InvalidArgumentException'
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
8 },
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
9 base => [
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
10 'IMPL::Object' => undef
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
11 ],
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
12 props => [
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
13 _items => PROP_RW | PROP_DIRECT,
390
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
14 _cache => PROP_RW | PROP_DIRECT,
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
15 _reverse => PROP_RW | PROP_DIRECT
316
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
16 ]
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
17 };
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
18
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
19 sub CTOR {
390
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
20 my ($this,$items,$reverse) = @_;
316
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
21
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
22 $items = {}
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
23 unless ref($items) eq 'HASH';
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
24
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
25 $this->{$_items} = $items;
390
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
26 $this->{$_reverse} = $reverse;
316
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
27 }
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
28
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
29 sub Get {
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
30 my ($this,$type) = @_;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
31
317
96a522aeb359 small fixes
cin
parents: 316
diff changeset
32 die ArgException->new(type => 'Invalid type', $type)
96a522aeb359 small fixes
cin
parents: 316
diff changeset
33 if not $type or ref($type);
316
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
34
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
35 if(my $val = $this->{$_cache}{$type}) {
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
36 return $val;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
37 } else {
390
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
38 if ($this->_reverse) {
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
39 my $val = $this->{$_items}{$type};
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
40
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
41 unless(defined $val) {
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
42 my $matching;
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
43 while ( my ($k,$v) = each %{$this->{$_items}}) {
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
44 if (isclass($k,$type) && (not($matching) || isclass($k,$matching)) ) {
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
45 $matching = $k;
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
46 $val = $v;
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
47 }
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
48 }
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
49 }
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
50
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
51 return $this->{$_cache}{$type} = $val;
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
52
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
53 } else {
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
54 no strict 'refs';
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
55
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
56 my @isa = $type;
316
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
57
390
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
58 while (@isa) {
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
59 my $sclass = shift @isa;
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
60
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
61 $val = $this->{$_items}{$sclass};
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
62
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
63 return($this->{$_cache}{$type} = $val)
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
64 if defined $val; # zeroes and empty strings are also valid
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
65
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
66 push @isa, @{"${sclass}::ISA"};
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
67 }
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
68 return;
de1f875e8875 added reverse matching lookup to TypeKeyedCollection (find closest descendant)
cin
parents: 317
diff changeset
69 }
316
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
70 }
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
71 }
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
72
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
73 sub Set {
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
74 my ($this,$type,$value) = @_;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
75
317
96a522aeb359 small fixes
cin
parents: 316
diff changeset
76 die ArgException->new(type => 'Invalid type', $type)
96a522aeb359 small fixes
cin
parents: 316
diff changeset
77 if not $type or ref($type);
316
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
78
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
79 $this->{$_items}{$type} = $value;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
80
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
81 delete $this->{$_cache};
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
82
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
83 return $value;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
84 }
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
85
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
86 sub Delete {
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
87 my ($this,$type) = @_;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
88
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
89 if(defined delete $this->{$_items}{$type} ) {
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
90 delete $this->{$_cache};
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
91 return 1;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
92 }
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
93 return;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
94 }
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
95
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
96 1;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
97
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
98 __END__
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
99
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
100 =pod
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
101
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
102 =head1 NAME
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
103
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
104 C<IMPL::TypeKeyedCollection> - коллекция, ключами которой являются типы.
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
105
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
106 =head1 SYNOPSIS
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
107
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
108 =begin code
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
109
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
110 package Foo;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
111
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
112 package Bar;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
113 our @ISA = qw(Foo);
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
114
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
115 package Baz;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
116 our @ISA = qw(Foo);
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
117
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
118 package main;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
119 use IMPL::require {
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
120 TypeKeyedCollection => 'IMPL::TypeKeyedCollection'
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
121 };
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
122
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
123 my $col = TypeKeyedCollection->new({
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
124 Foo => 'base',
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
125 Bar => 'BAAAR'
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
126 });
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
127
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
128 print $col->Get('Foo'); # 'base'
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
129 print $col->Get('Bar'); # 'BAAAR'
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
130 print $col->Get('Baz'); # 'base'
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
131
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
132 =end code
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
133
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
134 =head1 DESCRIPTION
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
135
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
136 Использует иерархию классов для определения наиболее подходяжего значения в
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
137 коллекции.
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
138
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
139 =cut