Merge pull request quattor#82 from stdweird/configuration_gettree

Configuration: getTree clears any error causing the failure

src/main/perl/Configuration.pm

@@ -47,7 +47,7 @@ Module provides the Configuration class, to manipulate confgurations.
 
 =cut
 
-my $ec = LC::Exception::Context->new->will_store_errors;
+our $ec = LC::Exception::Context->new->will_store_errors;
 
 =item new
 
@@ -464,25 +464,47 @@ sub elementExists
     return $ex;
 }
 
+# Handle failures. Stores the error message and
+# returns undef. All failures should use 'return $self->fail("message");'.
+# No error logging should occur in this module.
+# Based on CAF::Object->fail
+sub fail
+{
+    my ($self, @messages) = @_;
+    $self->{fail} = join('', map {defined($_) ? $_ : '<undef>'} @messages);
+    return;
+}
+
+
 =item getTree ($path)
 
 returns C<getTree> of the element identified by C<$path>.
 Any other optional arguments are passed to C<getTree>.
 
-If the path does not exist, undef is returned.
+If the path does not exist, undef is returned. (Any error
+reason is set as the C<fail> attribute and the error is ignored.)
 
 =cut
 
 sub getTree
 {
     my ($self, $path, @args) = @_;
 
-    return if (! $self->elementExists($path));
+    my $res;
+    if ($self->elementExists($path)) {
+        my $el = $self->getElement($path);
+        if ($el) {
+            $res = $el->getTree(@args);
+        }
+    }
 
-    my $el = $self->getElement($path);
-    return if(! $el);
+    if ($ec->error()) {
+        my $reason = $ec->error()->reason();
+        $ec->ignore_error();
+        return $self->fail($reason);
+    }
 
-    return $el->getTree(@args);
+    return $res;
 }
 
 =pod

src/main/perl/Path.pm

@@ -37,7 +37,7 @@ to manipulate absolute paths
 
 =cut
 
-my $ec = LC::Exception::Context->new->will_store_errors;
+our $ec = LC::Exception::Context->new->will_store_errors;
 
 =item new ($path)
 

src/main/perl/Resource.pm

@@ -24,7 +24,7 @@ EDG::WP4::CCM::Resource - Resource class
  $boolean = $resource->hasNextElement();
  [$property | $resource] = $resource->getNextElement();
  [$property | $resource] = $resource->getCurrentElement();
- $resoruce->reset();
+ $resource->reset();
 
 =head1 DESCRIPTION
 

src/test/perl/test-element.t

@@ -20,6 +20,8 @@ use Cwd;
 
 use CCMTest qw(make_file);
 
+my $ec_cfg = $EDG::WP4::CCM::Configuration::ec;
+
 my $cdtmp = getcwd()."/target/tmp";
 mkdir($cdtmp) if (! -d $cdtmp);
 
@@ -226,6 +228,31 @@ is_deeply($cfg_el->getTree(), $pathdata, "getTree from element instance as expec
 is($config->getValue("$path"), $pathdata, "config->getValue of $path as expected");
 # is a property, not a hash or list
 is_deeply($config->getTree("$path"), $pathdata, "config->getTree of $path as expected");
+
+# Configuration::getTree error handling
+# fail method
+ok(! defined($config->{fail}), "No fail attribute set");
+ok(! defined($config->fail("a", "b")), "Confiuration::fail returns undef");
+is($config->{fail}, "ab", "Configuration fail attribute is set (joined args)");
+
+# cfg->getTree does not throw errors
+if ($ec_cfg->error()) {
+    $ec_cfg->has_been_reported(1);
+}
+# reset fail attribute
+$config->{fail} = undef;
+
+ok(! $ec_cfg->error(), "No errors before testing getTree errorhandling");
+
 ok(! defined($config->getTree("/fake$path")), "config->getTree of /fake$path undefined");
+ok(! defined($config->{fail}),
+   "config->getTree of /fake$path undefined does not set fail attribute (element does not exist)");
+
+ok(! defined($config->getTree("//invalidpath")), "config->getTree of //invalidpath undefined");
+like($config->{fail}, qr{path //invalidpath must be an absolute path},
+   "config->getTree of //invalidpath undefined does sets fail attribute (invalid path throws error)");
+
+ok(! $ec_cfg->error(), "No errors after testing getTree errorhandling");
+diag explain $ec_cfg;
 
 done_testing();