Mercurial > pub > Impl

annotate lib/IMPL/Config/YAMLConfig.pm @ 423:60c2892a577c ref20150831

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
working on base class system
author cin
date Mon, 02 Apr 2018 07:35:23 +0300
parents b0481c071bea
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
422
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
1
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
2 =head1 NAME
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
3
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
4 C<IMPL::Condig::YAMLConfig> - YAML configuration parser for the container
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
5
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
6 =head1 SYNOPSIS
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
7
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
8 =begin code
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
9
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
10 use IMPL::require {
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
11 YAMLConfig => 'IMPL::Config::YAMLConfig',
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
12 Container => 'IMPL::Config::Container'
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
13 };
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
14
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
15 my $config = YAMLConfig->new('config.yaml');
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
16 $config->Load('additional.yaml');
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
17 my $container = Container->new($parent);
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
18 $config->ConfigureContainer($container);
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
19
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
20 =end code
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
21
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
22 =head1 DESCRIPTION
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
23
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
24 This module load YAML configuration and applies it to the container.
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
25
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
26 =head1 MEMBERS
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
27
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
28 =cut
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
29
418
cin
parents:
diff changeset
30 package IMPL::Config::YAMLConfig;
cin
parents:
diff changeset
31 use strict;
cin
parents:
diff changeset
32
422
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
33 use IMPL::Debug;
419
bbc4739c4d48 working on IMPL::Config::Container
cin
parents: 418
diff changeset
34 use IMPL::lang qw(:base);
bbc4739c4d48 working on IMPL::Config::Container
cin
parents: 418
diff changeset
35 use IMPL::Exception();
bbc4739c4d48 working on IMPL::Config::Container
cin
parents: 418
diff changeset
36 use YAML::XS();
422
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
37 use Sub::Util;
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
38 use File::Spec();
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
39 use URI::file();
419
bbc4739c4d48 working on IMPL::Config::Container
cin
parents: 418
diff changeset
40
421
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
41 use IMPL::declare {
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
42 require => {
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
43 ReferenceDescriptor => 'IMPL::Config::ReferenceDescriptor',
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
44 ServiceDescriptor => 'IMPL::Config::ServiceDescriptor',
422
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
45 ValueDescriptor => 'IMPL::Config::ValueDescriptor',
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
46 Descriptor => '-IMPL::Config::Descriptor'
421
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
47 },
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
48 base => [
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
49 'IMPL::Object' => undef
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
50 ],
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
51 props => [
422
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
52 _services => 'ro',
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
53 _stack => 'ro',
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
54 _visited => 'ro',
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
55 _current => 'ro'
421
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
56 ]
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
57 };
419
bbc4739c4d48 working on IMPL::Config::Container
cin
parents: 418
diff changeset
58
421
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
59 sub CTOR {
422
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
60 my ( $this, %args ) = @_;
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
61 $this->_services( {} );
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
62 $this->_stack( [] );
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
63 $this->_visited( {} );
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
64 $this->Load( $args{load} ) if ( $args{load} );
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
65 }
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
66
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
67 sub Load {
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
68 my ( $this, $file ) = @_;
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
69
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
70 dbg_log("Load $file");
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
71 my $prev = $this->_current;
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
72 push @{ $this->_stack }, "$file";
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
73
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
74 dbg_log( "base: ", $prev || '' );
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
75
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
76 $this->_current( $prev ? URI::file->new($file)->abs($prev) : URI::file->new_abs($file))
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
77 unless ref $file;
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
78
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
79 dbg_log( "translated: ", $this->_current);
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
80
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
81 my $config;
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
82
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
83 if ( isscalar($file) ) {
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
84 $this->LoadConfiguration( YAML::XS::Load( ${$file} ) );
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
85 }
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
86 else {
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
87 if ( not ref $file and defined $file ) {
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
88 if ( not $this->_visited->{$this->_current} ) {
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
89 $this->_visited->{$this->_current} = 1;
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
90
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
91 dbg_log("Loading YAML from file ", $this->_current->file);
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
92
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
93 $config = YAML::XS::LoadFile($this->_current->file);
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
94 } else {
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
95 dbg_warn("recursive includes: \n\t", join("\n\t", reverse @{$this->_stack}));
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
96 }
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
97 }
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
98 else {
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
99 $config = YAML::XS::LoadFile($file);
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
100 }
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
101 }
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
102
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
103 $this->LoadConfiguration($config) if defined $config;
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
104
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
105 $this->_current($prev);
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
106 pop @{ $this->_stack };
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
107
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
108 return 1;
421
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
109 }
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
110
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
111 sub LoadConfiguration {
422
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
112 my ( $this, $config ) = @_;
421
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
113
422
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
114 die IMPL::InvalidArgumentException->new('config')
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
115 unless ishash($config);
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
116
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
117 $this->Include( $config->{include} );
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
118
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
119 $this->_services( $this->ParseServices( $config->{services} ) );
419
bbc4739c4d48 working on IMPL::Config::Container
cin
parents: 418
diff changeset
120 }
bbc4739c4d48 working on IMPL::Config::Container
cin
parents: 418
diff changeset
121
422
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
122 sub Include {
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
123 my ( $this, $inc ) = @_;
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
124 if ( isarray($inc) ) {
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
125 $this->Include($_) foreach @$inc;
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
126 }
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
127 elsif ( defined $inc and not ref $inc ) {
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
128 dbg_log("include: $inc");
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
129 $this->Load( $inc );
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
130 }
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
131 }
421
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
132
422
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
133 sub ConfigureContainer {
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
134 my ( $this, $container ) = @_;
421
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
135
422
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
136 die IMPL::InvalidArgumentException->new($container)
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
137 unless $container;
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
138
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
139 foreach my $item ( @{ $this->_services } ) {
421
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
140 $container->Register( $item->{role}, $item->{descriptor} );
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
141 }
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
142
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
143 return $container;
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
144 }
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
145
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
146 sub ParseServices {
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
147 my ( $this, $services ) = @_;
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
148
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
149 return $services
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
150 ? [
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
151 map {
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
152 {
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
153 role => delete $_->{name},
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
154 descriptor => $this->ParseDescriptor($_)
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
155 };
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
156 } @$services
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
157 ]
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
158 : undef;
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
159 }
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
160
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
161 sub ParseDescriptor {
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
162 my ( $this, $data ) = @_;
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
163
422
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
164 my %opts;
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
165 if ( ref $data ) {
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
166 if ( my $type = $data->{'$type'} ) {
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
167 $opts{services} = $this->ParseServices( $data->{services} );
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
168 $opts{type} = $type;
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
169 $opts{args} = $this->ParseParams( $data->{params} )
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
170 if $data->{params};
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
171 $opts{norequire} = $data->{norequire};
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
172 $opts{activation} = $data->{activation};
421
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
173
422
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
174 return ServiceDescriptor->new(%opts);
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
175 }
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
176 elsif ( my $dep = $data->{'$ref'} ) {
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
177 $opts{services} = $this->ParseServices( $data->{services} );
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
178 $opts{lazy} = $data->{lazy};
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
179 $opts{optional} = $data->{optional};
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
180 $opts{default} = $this->ParseDescriptor( $data->{default} )
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
181 if exists $data->{default};
419
bbc4739c4d48 working on IMPL::Config::Container
cin
parents: 418
diff changeset
182
422
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
183 return ReferenceDescriptor->new( $dep, %opts );
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
184 }
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
185 elsif ( my $value = $data->{'$value'} ) {
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
186 my ( $parsed, $raw ) = $this->ParseValue($value);
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
187 $opts{services} = $this->ParseServices( $data->{services} );
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
188 $opts{raw} = $raw;
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
189 return ValueDescriptor->new( $parsed, %opts );
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
190 }
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
191
421
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
192 }
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
193
422
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
194 my ( $parsed, $raw ) = $this->ParseValue($data);
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
195 $opts{raw} = $raw;
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
196 return is( $parsed, Descriptor )
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
197 ? $parsed
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
198 : ValueDescriptor->new( $parsed, %opts );
421
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
199 }
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
200
422
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
201 sub IsDescriptorSpec {
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
202 my ( $this, $spec ) = @_;
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
203 return ( ishash($spec) and grep exists $spec->{$_}, qw($type $ref $value) );
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
204 }
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
205
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
206 sub ParseParams {
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
207 my ( $this, $params ) = @_;
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
208
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
209 if ( isarray($params) ) {
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
210 return [ map $this->ParseDescriptor($_), @$params ];
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
211 }
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
212 elsif ( ishash($params) and not $this->IsDescriptorSpec($params) ) {
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
213 return {
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
214 map { $_, $this->ParseDescriptor( $params->{$_} ) }
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
215 keys %$params
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
216 };
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
217 }
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
218 return $this->ParseDescriptor($params);
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
219 }
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
220
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
221 # parses value and returns a reference to the parsed value, i.e. descriptors
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
222 # are recognized and instantinated.
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
223 # returns ($parsed, $raw)
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
224 # $parsed - the parsed value
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
225 # $raw - the parsed value doesn't contain descriptors
421
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
226 sub ParseValue {
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
227 my ( $this, $value ) = @_;
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
228
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
229 my $raw = 1;
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
230
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
231 if ( ishash($value) ) {
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
232 return ( $this->ParseDescriptor($value), 0 )
422
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
233 if $this->IsDescriptorSpec($value);
421
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
234
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
235 my %res;
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
236 while ( my ( $k, $v ) = each %$value ) {
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
237 my ( $parsed, $flag ) = $this->ParseValue($v);
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
238 $res{$k} = $parsed;
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
239 $raw &&= $flag;
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
240 }
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
241 return ( \%res, $raw );
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
242 }
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
243 elsif ( isarray($value) ) {
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
244 return (
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
245 [
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
246 map {
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
247 my ( $parsed, $flag ) = $this->ParseValue($_);
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
248 $raw &&= $flag;
422
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
249 $parsed;
421
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
250 } @$value
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
251 ],
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
252 $raw
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
253 );
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
254 }
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
255 else {
422
b0481c071bea IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents: 421
diff changeset
256 return ( $value, 1 );
421
7798345304bc working on IMPL::Config, removed old stuff
cin
parents: 419
diff changeset
257 }
418
cin
parents:
diff changeset
258 }
cin
parents:
diff changeset
259
cin
parents:
diff changeset
260 1;