annotate lib/IMPL/Config/Hierarchy.pm @ 422:b0481c071bea ref20150831

IMPL::Config::Container tests, YAMLConfiguration now works and tested
author cin
date Sun, 20 Aug 2017 00:20:41 +0300
parents 3d24b10dd0d5
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
412
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
1 package IMPL::Config::Hierarchy;
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
2 use strict;
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
3
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
4 use IMPL::Exception();
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
5 use IMPL::lang qw(:base);
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
6 use IMPL::clone;
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
7 use IMPL::declare {
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
8 base => {
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
9 'IMPL::Object' => undef
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
10 },
415
3d24b10dd0d5 working on IMPL::Config::Container
cin
parents: 414
diff changeset
11 props => [
412
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
12 roles => '*rw',
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
13 _cache => '*rw'
415
3d24b10dd0d5 working on IMPL::Config::Container
cin
parents: 414
diff changeset
14 ]
412
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
15 };
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
16
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
17 sub CTOR {
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
18 my ( $this, $roles ) = @_;
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
19
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
20 if ( is( $roles, SELF ) ) {
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
21 $this->roles( clone( $roles->roles ) );
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
22 }
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
23 elsif ( ishash($roles) ) {
415
3d24b10dd0d5 working on IMPL::Config::Container
cin
parents: 414
diff changeset
24 $this->roles({});
3d24b10dd0d5 working on IMPL::Config::Container
cin
parents: 414
diff changeset
25 while(my ($n, $p) = each %$roles) {
3d24b10dd0d5 working on IMPL::Config::Container
cin
parents: 414
diff changeset
26 $this->AddRole($n,$p);
3d24b10dd0d5 working on IMPL::Config::Container
cin
parents: 414
diff changeset
27 }
412
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
28 }
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
29 elsif ( isarray($roles) ) {
415
3d24b10dd0d5 working on IMPL::Config::Container
cin
parents: 414
diff changeset
30 $this->roles( { map { $_, undef } @$roles } );
412
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
31 }
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
32 else {
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
33 $this->roles( {} );
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
34 }
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
35 }
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
36
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
37 sub AddRole {
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
38 my ( $this, $role, $parent ) = @_;
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
39
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
40 $parent = isarray($parent) ? $parent : [$parent]
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
41 if $parent;
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
42
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
43 die IMPL::InvalidArgumentException->new('role') unless $role;
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
44
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
45 $this->roles->{$role} = $parent;
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
46 }
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
47
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
48 sub GetLinearRoleHash {
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
49 my ( $this, $role ) = @_;
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
50
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
51 return [] unless $role;
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
52
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
53 my $cache = $this->{$_cache}{$role};
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
54
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
55 unless ($cache) {
414
ec6f2d389d1e working on IMPL::Config::Bag
cin
parents: 413
diff changeset
56 $cache = { $role, 1 };
412
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
57
415
3d24b10dd0d5 working on IMPL::Config::Container
cin
parents: 414
diff changeset
58 my @roles = ([$role, 1]);
413
af8d359ee4cc working on di container
cin
parents: 412
diff changeset
59
412
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
60 while (my $r = shift @roles ) {
413
af8d359ee4cc working on di container
cin
parents: 412
diff changeset
61 my ($name, $level) = @$r;
af8d359ee4cc working on di container
cin
parents: 412
diff changeset
62
af8d359ee4cc working on di container
cin
parents: 412
diff changeset
63 $cache->{$name} = $level;
af8d359ee4cc working on di container
cin
parents: 412
diff changeset
64 if(my $parents = $this->{$roles}{$name}) {
af8d359ee4cc working on di container
cin
parents: 412
diff changeset
65 foreach my $p (@$parents) {
415
3d24b10dd0d5 working on IMPL::Config::Container
cin
parents: 414
diff changeset
66 next if $cache->{$p};
3d24b10dd0d5 working on IMPL::Config::Container
cin
parents: 414
diff changeset
67 push @roles, [$p, $cache->{$p} = $level + 1];
413
af8d359ee4cc working on di container
cin
parents: 412
diff changeset
68 }
412
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
69 }
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
70 }
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
71 $this->{$_cache}{$role} = $cache;
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
72 }
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
73
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
74 return $cache;
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
75 }
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
76
30e8c6a74937 working on di container (role based registrations)
cin
parents:
diff changeset
77 1;