Component: support component redirection

src/main/perl/Component.pm

@@ -348,7 +348,7 @@ sub _redirect
 
     my $redirect;
 
-    # TODO: prevent loop
+    # TODO: prevent loop?
     local $@;
     eval {
         my $varname = $whoami."::REDIRECT";
@@ -390,16 +390,17 @@ sub _redirect
             load $childpackagename;
         };
         if ($@) {
-            $self->error("bad Perl code in $childpackagename: $@");
+            $self->error("REDIRECT bad Perl code in $childpackagename: $@");
             return;
         }
 
         # no real point in reporting the warnings on error
         # and we must be sure that $@ does not get redefined during $self->warn
         foreach my $warn (@warns) {
-            $self->warn("Warning during loading of package $childpackagename: $warn");
+            $self->warn("REDIRECT warning during loading of package $childpackagename: $warn");
         }
 
+        $self->verbose("Redirecting to $childname (package $childpackagename)");
         bless($self, $childpackagename);
 
         return $self->$method($config);

src/test/perl/NCM/Component/Component1/Regular.pm

@@ -0,0 +1,12 @@
+package NCM::Component::Component1::Regular;
+
+use strict;
+use warnings;
+use parent qw(NCM::Component::component1);
+
+sub Configure
+{
+    return __PACKAGE__." Configure";
+}
+
+1;

src/test/perl/NCM/Component/Component1/Subby.pm

@@ -0,0 +1,13 @@
+package NCM::Component::Component1::Subby;
+
+use strict;
+use warnings;
+use parent qw(NCM::Component::component1);
+
+
+sub Unconfigure
+{
+    return __PACKAGE__." Unconfigure";
+}
+
+1;

src/test/perl/NCM/Component/component1.pm

@@ -0,0 +1,13 @@
+package NCM::Component::component1;
+
+use strict;
+use warnings;
+
+use parent qw(NCM::Component);
+use Readonly;
+Readonly our $REDIRECT => {
+    name => 'otherone',
+    default => 'Regular',
+};
+
+1;

src/test/perl/component.t

@@ -8,7 +8,7 @@ BEGIN {
 }
 
 use Test::More;
-use Test::Quattor qw(component1 component-fqdn);
+use Test::Quattor qw(component1 component1_redirect component1_redirect_none);
 use Test::Quattor::Object;
 
 # insert the this_app before load but after Test::Quattor
@@ -20,7 +20,7 @@ BEGIN {
 }
 
 use NCM::Component;
-
+use NCM::Component::component1;
 
 =head1 NoAction is set on load via this_app
 
@@ -34,10 +34,46 @@ my $obj = Test::Quattor::Object->new();
 =head1 test NCM::Component init
 
 =cut
-
+my $cfg = get_config_for_profile('component1');
 my $cmp1 = NCM::Component->new('component1', $obj);
 isa_ok($cmp1, 'NCM::Component', 'NCM::Component instance 1 created');
 is($cmp1->prefix(), "/software/components/component1", "prefix for component1");
 
+=head1 Configure / Unconfigure
+
+=cut
+
+ok(!defined($cmp1->Configure($cfg)), "NCM::Component returns undef (not implemented)");
+is($obj->{LOGLATEST}->{ERROR}, 'Configure() method not implemented by component', 'Configure not implemented error');
+
+ok(!defined($cmp1->Unconfigure($cfg)), "NCM::Component returns undef (not implemented)");
+is($obj->{LOGLATEST}->{ERROR}, 'Unconfigure() method not implemented by component', 'Unconfigure not implemented error');
+
+=head1 redirect
+
+=cut
+
+my $cfgr = get_config_for_profile('component1_redirect');
+
+$cmp1 = NCM::Component::component1->new('component1', $obj);
+isa_ok($cmp1, 'NCM::Component::component1', 'is a NCM::Component::component1');
+is($cmp1->Configure($cfg), 'NCM::Component::Component1::Regular Configure', 'Redirect to default Regular');
+isa_ok($cmp1, 'NCM::Component::Component1::Regular', 'is now a NCM::Component::Component1::Regular');
+ok(!defined($cmp1->Unconfigure($cfg)), 'Redirect to default Regular has no Unconfigure');
+
+
+$cmp1 = NCM::Component::component1->new('component1', $obj);
+isa_ok($cmp1, 'NCM::Component::component1', 'is a NCM::Component::component1');
+ok(!defined($cmp1->Configure($cfgr)), 'Redirect to name Subby has no Configure');
+isa_ok($cmp1, 'NCM::Component::Component1::Subby', 'is now a NCM::Component::Component1::Subby');
+is($cmp1->Unconfigure($cfgr), 'NCM::Component::Component1::Subby Unconfigure', 'Redirect to name Subby');
+
+my $cfgn = get_config_for_profile('component1_redirect_none');
+$cmp1 = NCM::Component::component1->new('component1', $obj);
+ok(!defined($cmp1->Configure($cfgn)), "NCM::Component returns undef (redirect does not exist)");
+like($obj->{LOGLATEST}->{ERROR},
+     qr{REDIRECT bad Perl code in NCM::Component::Component1::DoesNotExist: Can't locate NCM/Component/Component1/DoesNotExist.pm in \@INC},
+     'redirect does not exist error');
+
 
 done_testing;

src/test/resources/component1_redirect.pan

@@ -0,0 +1,6 @@
+object template component1_redirect;
+
+
+prefix "/software/components/component1";
+"active" = true;
+"otherone" = "Subby";

src/test/resources/component1_redirect_none.pan

@@ -0,0 +1,6 @@
+object template component1_redirect_none;
+
+
+prefix "/software/components/component1";
+"active" = true;
+"otherone" = "DoesNotExist";