Added unit tests and some more

* Added unit tests.
* Constructor parameter "interpolation" renamed to
  "interpolate_variables".
* Constructor parameter "processing_directives" renamed to
  "process_directives".
* Added accessors "interpolate_variables" and "process_directives".
* Fixed bugs revealed during writing unit tests.

Author: Eugene Ponizovsky

Makefile.PL

@@ -27,7 +27,7 @@ WriteMakefile(
       license    => 'http://dev.perl.org/licenses/',
     },
   },
-  ABSTRACT_FROM => 'lib/App/Environ.pm',
+  ABSTRACT_FROM => 'lib/Config/Loader.pm',
   AUTHOR        => 'Eugene Ponizovsky <[email protected]>',
   LICENSE       => 'perl',
 );

lib/Config/Loader.pm

@@ -49,12 +49,10 @@ sub new {
   my $self = bless {}, $self_class;
 
   $self->{dirs} = $params{dirs} || ['.'];
-  $self->{interpolation}
-      = exists $params{interpolation} ? $params{interpolation} : 1;
-  $self->{processing_directives}
-      = exists $params{processing_directives}
-      ? $params{processing_directives}
-      : 1;
+  $self->{interpolate_variables} = exists $params{interpolate_variables}
+      ? $params{interpolate_variables} : 1;
+  $self->{process_directives} = exists $params{process_directives}
+      ? $params{process_directives} : 1;
 
   $self->{_hash_merge} = Hash::Merge->new( 'CONFIG_PRECEDENT' );
   $self->{_config}     = undef;
@@ -63,6 +61,22 @@ sub new {
   return $self;
 }
 
+{
+  no strict 'refs';
+
+  foreach my $name ( qw( interpolate_variables process_directives ) ) {
+    *{$name} = sub {
+      my $self = shift;
+
+      if ( @_ ) {
+        $self->{$name} = shift;
+      }
+
+      return $self->{$name};
+    }
+  }
+}
+
 sub load {
   my $self            = shift;
   my @config_sections = @_;
@@ -140,7 +154,7 @@ sub _build_tree {
 
       if ( @not_found ) {
         croak "Can't locate " . join( ', ', @not_found )
-            . " in directories: " . join( ', ', @{ $self->{dirs} } );
+            . " in " . join( ', ', @{ $self->{dirs} } );
       }
     }
   }
@@ -172,25 +186,28 @@ sub _process_node {
 
   return unless defined $node;
 
-  if ( ref($node) eq 'HASH' && $self->{processing_directives} ) {
-    if ( defined $node->{'var'} ) {
+  if ( ref($node) eq 'HASH' && $self->{process_directives} ) {
+    if ( defined $node->{var} ) {
       $node = $self->_resolve_var( $node->{var} );
     }
     elsif ( defined $node->{include} ) {
       $node = $self->_build_tree( $node->{include} );
     }
-    elsif ( defined $node->{underlay} ) {
-      my $layer = delete $node->{underlay};
-      $layer = $self->_process_layer($layer);
-      $node = $self->{_hash_merge}->merge( $layer, $node );
-    }
-    elsif ( defined $node->{overlay} ) {
-      my $layer = delete $node->{overlay};
-      $layer = $self->_process_layer($layer);
-      $node = $self->{_hash_merge}->merge( $node, $layer );
+    else {
+      if ( defined $node->{underlay} ) {
+        my $layer = delete $node->{underlay};
+        $layer = $self->_process_layer($layer);
+        $node = $self->{_hash_merge}->merge( $layer, $node );
+      }
+
+      if ( defined $node->{overlay} ) {
+        my $layer = delete $node->{overlay};
+        $layer = $self->_process_layer($layer);
+        $node = $self->{_hash_merge}->merge( $node, $layer );
+      }
     }
   }
-  elsif ( $self->{interpolation} ) { # SCALAR
+  elsif ( $self->{interpolate_variables} ) { # SCALAR
     $node =~ s/\$((\$?)\{([^\}]*)\})/
         $2 ? $1 : $self->_resolve_var( $3 )/ge;
   }
@@ -250,7 +267,7 @@ sub _resolve_var {
       else { # ARRAY
         if ( $token =~ m/\D/ ) {
           die "Argument \"$token\" isn't numeric in array element:"
-              . " \${$var_name}\n";
+              . " $var_name\n";
         }
 
         last unless defined $pointer->[$token];
@@ -270,6 +287,10 @@ sub _resolve_var {
     }
   }
 
+  unless ( defined $vars->{$var_name} ) {
+    $vars->{$var_name} = '';
+  }
+
   return $vars->{$var_name};
 }
 
@@ -291,6 +312,10 @@ and variables interpolation support
 
 =head2 load()
 
+=head2 interpolate_variables
+
+=head2 process_directives
+
 =head1 AUTHOR
 
 Eugene Ponizovsky, E<lt>[email protected]E<gt>

t/00-base.t

@@ -0,0 +1,15 @@
+use 5.008000;
+use strict;
+use warnings;
+
+use Test::More tests => 3;
+
+my $T_CLASS;
+
+BEGIN {
+  $T_CLASS = 'Config::Loader';
+  use_ok($T_CLASS);
+}
+
+can_ok( $T_CLASS, 'new' );
+my $config_loader = new_ok($T_CLASS);

t/01-accessors.t

@@ -0,0 +1,48 @@
+use 5.008000;
+use strict;
+use warnings;
+
+use Test::More tests => 8;
+use Config::Loader;
+
+my $CONFIG_LOADER = Config::Loader->new();
+
+can_ok( $CONFIG_LOADER, 'interpolate_variables' );
+can_ok( $CONFIG_LOADER, 'process_directives' );
+
+t_interpolate_variables($CONFIG_LOADER);
+t_process_directives($CONFIG_LOADER);
+
+
+sub t_interpolate_variables {
+  my $config_loader = shift;
+
+  my $interpolate_variables = $config_loader->interpolate_variables;
+  is( $interpolate_variables, 1, 'get variable interpolation switch value' );
+
+  $config_loader->interpolate_variables(undef);
+  is( $config_loader->interpolate_variables,
+      undef, 'disable variable interpolation' );
+
+  $config_loader->interpolate_variables(1);
+  is( $config_loader->interpolate_variables, 1,
+      "enable variable interpolation" );
+
+  return;
+}
+
+sub t_process_directives {
+  my $config_loader = shift;
+
+  my $process_directives = $config_loader->process_directives;
+  is( $process_directives, 1, 'get directive processing switch value' );
+
+  $config_loader->process_directives(undef);
+  is( $config_loader->process_directives,
+      undef, 'disable directive processing' );
+
+  $config_loader->process_directives(1);
+  is( $config_loader->process_directives, 1, "enable directive processing" );
+
+  return;
+}