Mercurial > pub > Impl

annotate Lib/IMPL/TypeKeyedCollection.pm @ 395:212cc86e470b

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