pub/Impl: lib/IMPL/Config/YAMLConfig.pm annotate

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

IMPL::Config::Container tests, YAMLConfiguration now works and tested

author	cin
date	Sun, 20 Aug 2017 00:20:41 +0300
parents	7798345304bc
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 3f38dabaf5cc sync cin parents: diff changeset	30 package IMPL::Config::YAMLConfig;
3f38dabaf5cc sync cin parents: diff changeset	31 use strict;
3f38dabaf5cc sync 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 3f38dabaf5cc sync cin parents: diff changeset	258 }
3f38dabaf5cc sync cin parents: diff changeset	259
3f38dabaf5cc sync cin parents: diff changeset	260 1;

Mercurial > pub > Impl

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