418
|
1 package IMPL::Config::YAMLConfig;
|
|
2 use strict;
|
|
3
|
419
|
4 use IMPL::lang qw(:base);
|
|
5 use IMPL::Exception();
|
|
6 use YAML::XS();
|
|
7
|
421
|
8 use IMPL::declare {
|
|
9 require => {
|
|
10 ReferenceDescriptor => 'IMPL::Config::ReferenceDescriptor',
|
|
11 ServiceDescriptor => 'IMPL::Config::ServiceDescriptor',
|
|
12 ValueDescriptor => 'IMPL::Config::ValueDescriptor'
|
|
13 },
|
|
14 base => [
|
|
15 'IMPL::Object' => undef
|
|
16 ],
|
|
17 props => [
|
|
18 container => 'ro'
|
|
19 ]
|
|
20 };
|
419
|
21
|
421
|
22 sub CTOR {
|
|
23 my ( $this, $container ) = @_;
|
|
24 die IMPL::InvalidArgumentException('container')
|
|
25 unless $container;
|
|
26 $this->container($container);
|
|
27 }
|
|
28
|
|
29 sub LoadConfiguration {
|
|
30 my ( $this, $file ) = @_;
|
|
31
|
|
32 $this->Configure(
|
|
33 isscalar($file)
|
|
34 ? YAML::XS::Load( ${$file} )
|
|
35 : YAML::XS::LoadFile($file)
|
|
36 );
|
419
|
37 }
|
|
38
|
418
|
39 sub Configure {
|
421
|
40 my ( $this, $config ) = @_;
|
|
41
|
|
42 die IMPL::InvalidArgumentException('config')
|
|
43 unless ishash($config);
|
|
44
|
|
45 my $container = $this->container;
|
|
46 foreach my $item ( @{ $this->ParseServices( $config->{services} ) } ) {
|
|
47 $container->Register( $item->{role}, $item->{descriptor} );
|
|
48 }
|
|
49
|
|
50 return $container;
|
|
51 }
|
|
52
|
|
53 sub ParseServices {
|
|
54 my ( $this, $services ) = @_;
|
|
55
|
|
56 return $services
|
|
57 ? [
|
|
58 map {
|
|
59 {
|
|
60 role => delete $_->{name},
|
|
61 descriptor => $this->ParseDescriptor($_)
|
|
62 };
|
|
63 } @$services
|
|
64 ]
|
|
65 : undef;
|
|
66 }
|
|
67
|
|
68 sub ParseDescriptor {
|
|
69 my ( $this, $data ) = @_;
|
|
70
|
|
71 my %opts = ( onwer => $this->container() );
|
|
72
|
|
73 if ( my $type = $data->{'$type'} ) {
|
|
74 $opts{services} = $this->ParseServices( $data->{services} );
|
|
75 $opts{type} = $type;
|
|
76 $opts{args} = $this->ParseDescriptor( $data->{params} )
|
|
77 if $data->{params};
|
|
78 $opts{norequire} = $data->{norequire};
|
|
79 $opts{activation} = $data->{activation};
|
419
|
80
|
421
|
81 return ServiceDescriptor->new(%opts);
|
|
82 }
|
|
83 elsif ( my $dep = $data->{'$ref'} ) {
|
|
84 $opts{services} = $this->ParseServices( $data->{services} );
|
|
85 $opts{lazy} = $data->{lazy};
|
|
86 $opts{optional} = $data->{optional};
|
|
87 $opts{default} = $this->ParseDescriptor( $data->{default} )
|
|
88 if exists $data->{default};
|
|
89
|
|
90 return ReferenceDesriptor->new( $dep, %opts );
|
|
91 }
|
|
92 elsif ( my $value = $data->{'$value'} ) {
|
|
93 my ( $parsed, $raw ) = $this->ParseValue($value);
|
|
94 $opts{services} = $this->ParseServices( $data->{services} );
|
|
95 $opts{raw} = $raw;
|
|
96 return ValueDescriptor->new( $parsed, %opts );
|
|
97 }
|
|
98 else {
|
|
99 my ( $parsed, $raw ) = $this->ParseValue($value);
|
|
100 $opts{raw} = $raw;
|
|
101 return ValueDescriptor->new( $parsed, %opts );
|
|
102 }
|
|
103 }
|
|
104
|
|
105 sub ParseValue {
|
|
106 my ( $this, $value ) = @_;
|
|
107
|
|
108 my $raw = 1;
|
|
109
|
|
110 if ( ishash($value) ) {
|
|
111 return ( $this->ParseDescriptor($value), 0 )
|
|
112 if grep exists $value->{$_}, qw($type $ref $value);
|
|
113
|
|
114 my %res;
|
|
115 while ( my ( $k, $v ) = each %$value ) {
|
|
116 my ( $parsed, $flag ) = $this->ParseValue($v);
|
|
117 $res{$k} = $parsed;
|
|
118 $raw &&= $flag;
|
|
119 }
|
|
120 return ( \%res, $raw );
|
|
121 }
|
|
122 elsif ( isarray($value) ) {
|
|
123 return (
|
|
124 [
|
|
125 map {
|
|
126 my ( $parsed, $flag ) = $this->ParseValue($_);
|
|
127 $raw &&= $flag;
|
|
128 return $parsed;
|
|
129 } @$value
|
|
130 ],
|
|
131 $raw
|
|
132 );
|
|
133 }
|
|
134 else {
|
|
135 return ($value, 1);
|
|
136 }
|
418
|
137 }
|
|
138
|
|
139 1;
|
|
140
|
|
141 __END__
|
|
142
|
|
143 =pod
|
|
144
|
421
|
145 =head1 NAME
|
|
146
|
|
147 =head1 SYNOPSIS
|
|
148
|
|
149 =
|
418
|
150
|
419
|
151 =cut
|