diff 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
line wrap: on
line diff
--- a/lib/IMPL/Config/YAMLConfig.pm	Sun Jul 16 22:59:39 2017 +0300
+++ b/lib/IMPL/Config/YAMLConfig.pm	Sun Aug 20 00:20:41 2017 +0300
@@ -1,49 +1,142 @@
+
+=head1 NAME
+
+C<IMPL::Condig::YAMLConfig> - YAML configuration parser for the container
+
+=head1 SYNOPSIS
+
+=begin code
+
+use IMPL::require {
+    YAMLConfig => 'IMPL::Config::YAMLConfig',
+    Container => 'IMPL::Config::Container'
+};
+
+my $config = YAMLConfig->new('config.yaml');
+$config->Load('additional.yaml');
+my $container = Container->new($parent);
+$config->ConfigureContainer($container);
+
+=end code
+
+=head1 DESCRIPTION
+
+This module load YAML configuration and applies it to the container. 
+
+=head1 MEMBERS
+
+=cut
+
 package IMPL::Config::YAMLConfig;
 use strict;
 
+use IMPL::Debug;
 use IMPL::lang qw(:base);
 use IMPL::Exception();
 use YAML::XS();
+use Sub::Util;
+use File::Spec();
+use URI::file();
 
 use IMPL::declare {
     require => {
         ReferenceDescriptor => 'IMPL::Config::ReferenceDescriptor',
         ServiceDescriptor   => 'IMPL::Config::ServiceDescriptor',
-        ValueDescriptor     => 'IMPL::Config::ValueDescriptor'
+        ValueDescriptor     => 'IMPL::Config::ValueDescriptor',
+        Descriptor          => '-IMPL::Config::Descriptor'
     },
     base => [
         'IMPL::Object' => undef
     ],
     props => [
-        container => 'ro'
+        _services => 'ro',
+        _stack    => 'ro',
+        _visited  => 'ro',
+        _current  => 'ro'
     ]
 };
 
 sub CTOR {
-    my ( $this, $container ) = @_;
-    die IMPL::InvalidArgumentException('container')
-      unless $container;
-    $this->container($container);
+    my ( $this, %args ) = @_;
+    $this->_services( {} );
+    $this->_stack( [] );
+    $this->_visited( {} );
+    $this->Load( $args{load} ) if ( $args{load} );
+}
+
+sub Load {
+    my ( $this, $file ) = @_;
+
+    dbg_log("Load $file");
+    my $prev = $this->_current;
+    push @{ $this->_stack }, "$file";
+    
+    dbg_log( "base: ", $prev || '' );
+
+    $this->_current( $prev ? URI::file->new($file)->abs($prev) : URI::file->new_abs($file))
+      unless ref $file;
+    
+    dbg_log( "translated: ", $this->_current);
+
+    my $config;
+
+    if ( isscalar($file) ) {
+        $this->LoadConfiguration( YAML::XS::Load( ${$file} ) );
+    }
+    else {
+        if ( not ref $file and defined $file ) {
+            if ( not $this->_visited->{$this->_current} ) {
+                $this->_visited->{$this->_current} = 1;
+                
+                dbg_log("Loading YAML from file ", $this->_current->file);
+                
+                $config = YAML::XS::LoadFile($this->_current->file);
+            } else {
+                dbg_warn("recursive includes: \n\t", join("\n\t", reverse @{$this->_stack}));
+            }
+        }
+        else {
+            $config = YAML::XS::LoadFile($file);
+        }
+    }
+
+    $this->LoadConfiguration($config) if defined $config;
+
+    $this->_current($prev);
+    pop @{ $this->_stack };
+
+    return 1;
 }
 
 sub LoadConfiguration {
-    my ( $this, $file ) = @_;
+    my ( $this, $config ) = @_;
 
-    $this->Configure(
-          isscalar($file)
-        ? YAML::XS::Load( ${$file} )
-        : YAML::XS::LoadFile($file)
-    );
+    die IMPL::InvalidArgumentException->new('config')
+      unless ishash($config);
+
+    $this->Include( $config->{include} );
+
+    $this->_services( $this->ParseServices( $config->{services} ) );
 }
 
-sub Configure {
-    my ( $this, $config ) = @_;
+sub Include {
+    my ( $this, $inc ) = @_;
+    if ( isarray($inc) ) {
+        $this->Include($_) foreach @$inc;
+    }
+    elsif ( defined $inc and not ref $inc ) {
+        dbg_log("include: $inc");
+        $this->Load( $inc );
+    }
+}
 
-    die IMPL::InvalidArgumentException('config')
-      unless ishash($config);
+sub ConfigureContainer {
+    my ( $this, $container ) = @_;
 
-    my $container = $this->container;
-    foreach my $item ( @{ $this->ParseServices( $config->{services} ) } ) {
+    die IMPL::InvalidArgumentException->new($container)
+      unless $container;
+
+    foreach my $item ( @{ $this->_services } ) {
         $container->Register( $item->{role}, $item->{descriptor} );
     }
 
@@ -68,40 +161,68 @@
 sub ParseDescriptor {
     my ( $this, $data ) = @_;
 
-    my %opts = ( onwer => $this->container() );
+    my %opts;
+    if ( ref $data ) {
+        if ( my $type = $data->{'$type'} ) {
+            $opts{services} = $this->ParseServices( $data->{services} );
+            $opts{type}     = $type;
+            $opts{args}     = $this->ParseParams( $data->{params} )
+              if $data->{params};
+            $opts{norequire}  = $data->{norequire};
+            $opts{activation} = $data->{activation};
 
-    if ( my $type = $data->{'$type'} ) {
-        $opts{services} = $this->ParseServices( $data->{services} );
-        $opts{type}     = $type;
-        $opts{args}     = $this->ParseDescriptor( $data->{params} )
-          if $data->{params};
-        $opts{norequire}  = $data->{norequire};
-        $opts{activation} = $data->{activation};
+            return ServiceDescriptor->new(%opts);
+        }
+        elsif ( my $dep = $data->{'$ref'} ) {
+            $opts{services} = $this->ParseServices( $data->{services} );
+            $opts{lazy}     = $data->{lazy};
+            $opts{optional} = $data->{optional};
+            $opts{default}  = $this->ParseDescriptor( $data->{default} )
+              if exists $data->{default};
 
-        return ServiceDescriptor->new(%opts);
+            return ReferenceDescriptor->new( $dep, %opts );
+        }
+        elsif ( my $value = $data->{'$value'} ) {
+            my ( $parsed, $raw ) = $this->ParseValue($value);
+            $opts{services} = $this->ParseServices( $data->{services} );
+            $opts{raw}      = $raw;
+            return ValueDescriptor->new( $parsed, %opts );
+        }
+
     }
-    elsif ( my $dep = $data->{'$ref'} ) {
-        $opts{services} = $this->ParseServices( $data->{services} );
-        $opts{lazy}     = $data->{lazy};
-        $opts{optional} = $data->{optional};
-        $opts{default}  = $this->ParseDescriptor( $data->{default} )
-          if exists $data->{default};
 
-        return ReferenceDesriptor->new( $dep, %opts );
-    }
-    elsif ( my $value = $data->{'$value'} ) {
-        my ( $parsed, $raw ) = $this->ParseValue($value);
-        $opts{services} = $this->ParseServices( $data->{services} );
-        $opts{raw}      = $raw;
-        return ValueDescriptor->new( $parsed, %opts );
-    }
-    else {
-        my ( $parsed, $raw ) = $this->ParseValue($value);
-        $opts{raw} = $raw;
-        return ValueDescriptor->new( $parsed, %opts );
-    }
+    my ( $parsed, $raw ) = $this->ParseValue($data);
+    $opts{raw} = $raw;
+    return is( $parsed, Descriptor )
+      ? $parsed
+      : ValueDescriptor->new( $parsed, %opts );
 }
 
+sub IsDescriptorSpec {
+    my ( $this, $spec ) = @_;
+    return ( ishash($spec) and grep exists $spec->{$_}, qw($type $ref $value) );
+}
+
+sub ParseParams {
+    my ( $this, $params ) = @_;
+
+    if ( isarray($params) ) {
+        return [ map $this->ParseDescriptor($_), @$params ];
+    }
+    elsif ( ishash($params) and not $this->IsDescriptorSpec($params) ) {
+        return {
+            map { $_, $this->ParseDescriptor( $params->{$_} ) }
+              keys %$params
+        };
+    }
+    return $this->ParseDescriptor($params);
+}
+
+# parses value and returns a reference to the parsed value, i.e. descriptors
+# are recognized and instantinated.
+# returns ($parsed, $raw)
+#   $parsed - the parsed value
+#   $raw - the parsed value doesn't contain descriptors
 sub ParseValue {
     my ( $this, $value ) = @_;
 
@@ -109,7 +230,7 @@
 
     if ( ishash($value) ) {
         return ( $this->ParseDescriptor($value), 0 )
-          if grep exists $value->{$_}, qw($type $ref $value);
+          if $this->IsDescriptorSpec($value);
 
         my %res;
         while ( my ( $k, $v ) = each %$value ) {
@@ -125,27 +246,15 @@
                 map {
                     my ( $parsed, $flag ) = $this->ParseValue($_);
                     $raw &&= $flag;
-                    return $parsed;
+                    $parsed;
                 } @$value
             ],
             $raw
         );
     }
     else {
-        return ($value, 1);
+        return ( $value, 1 );
     }
 }
 
 1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-=head1 SYNOPSIS
-
-=
-
-=cut