Mercurial > pub > Impl
annotate lib/IMPL/Config/YAMLConfig.pm @ 427:09e0086a82a7 ref20150831 tip
Merge
author | cin |
---|---|
date | Tue, 15 May 2018 00:51:33 +0300 |
parents | b0481c071bea |
children |
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 | 30 package IMPL::Config::YAMLConfig; |
31 use strict; | |
32 | |
422
b0481c071bea
IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents:
421
diff
changeset
|
33 use IMPL::Debug; |
419 | 34 use IMPL::lang qw(:base); |
35 use IMPL::Exception(); | |
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 | 40 |
421 | 41 use IMPL::declare { |
42 require => { | |
43 ReferenceDescriptor => 'IMPL::Config::ReferenceDescriptor', | |
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 | 47 }, |
48 base => [ | |
49 'IMPL::Object' => undef | |
50 ], | |
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 | 56 ] |
57 }; | |
419 | 58 |
421 | 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 | 109 } |
110 | |
111 sub LoadConfiguration { | |
422
b0481c071bea
IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents:
421
diff
changeset
|
112 my ( $this, $config ) = @_; |
421 | 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 | 120 } |
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 | 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 | 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 | 140 $container->Register( $item->{role}, $item->{descriptor} ); |
141 } | |
142 | |
143 return $container; | |
144 } | |
145 | |
146 sub ParseServices { | |
147 my ( $this, $services ) = @_; | |
148 | |
149 return $services | |
150 ? [ | |
151 map { | |
152 { | |
153 role => delete $_->{name}, | |
154 descriptor => $this->ParseDescriptor($_) | |
155 }; | |
156 } @$services | |
157 ] | |
158 : undef; | |
159 } | |
160 | |
161 sub ParseDescriptor { | |
162 my ( $this, $data ) = @_; | |
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 | 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 | 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 | 192 } |
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 | 199 } |
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 | 226 sub ParseValue { |
227 my ( $this, $value ) = @_; | |
228 | |
229 my $raw = 1; | |
230 | |
231 if ( ishash($value) ) { | |
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 | 234 |
235 my %res; | |
236 while ( my ( $k, $v ) = each %$value ) { | |
237 my ( $parsed, $flag ) = $this->ParseValue($v); | |
238 $res{$k} = $parsed; | |
239 $raw &&= $flag; | |
240 } | |
241 return ( \%res, $raw ); | |
242 } | |
243 elsif ( isarray($value) ) { | |
244 return ( | |
245 [ | |
246 map { | |
247 my ( $parsed, $flag ) = $this->ParseValue($_); | |
248 $raw &&= $flag; | |
422
b0481c071bea
IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents:
421
diff
changeset
|
249 $parsed; |
421 | 250 } @$value |
251 ], | |
252 $raw | |
253 ); | |
254 } | |
255 else { | |
422
b0481c071bea
IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents:
421
diff
changeset
|
256 return ( $value, 1 ); |
421 | 257 } |
418 | 258 } |
259 | |
260 1; |