Mercurial > pub > Impl

annotate lib/IMPL/Config/YAMLConfig.pm @ 426:eed50c01e758 ref20150831

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Split off the core module, added Dist-Zilla config
author cin
date Tue, 15 May 2018 00:51:01 +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;