From 22bbf2e23cd93ded46850eb39a53bede4be0621a Mon Sep 17 00:00:00 2001
From: Colin Kuskie <colink@perldreamer.com>
Date: Tue, 23 Mar 2010 11:54:19 -0700
Subject: [PATCH] Check the Asset, not the class, and make sure it is loaded.

---
 lib/WebGUI/AssetLineage.pm            |  4 +--
 lib/WebGUI/Role/Asset/Subscribable.pm | 35 ++++++++++++++-------------
 t/tests/Test/WebGUI/Asset.pm          | 35 ++++++++++++++++++++++-----
 3 files changed, 49 insertions(+), 25 deletions(-)

diff --git a/lib/WebGUI/AssetLineage.pm b/lib/WebGUI/AssetLineage.pm
index dd8aeed5b..7711aefb8 100644
--- a/lib/WebGUI/AssetLineage.pm
+++ b/lib/WebGUI/AssetLineage.pm
@@ -72,6 +72,7 @@ sub addChild {
 	my $now         = shift || $session->datetime->time();
 	my $options     = shift;
     # Check for valid parentage using validParent on child's class
+    WebGUI::Asset->loadModule($properties->{className});
     if (! $properties->{className}->validParent($session, $self)) {
         return undef;
     }
@@ -997,9 +998,8 @@ sub validParent {
     my $session        = shift;
     my $asset          = shift || $session->asset;
     my $parent_classes = $class->valid_parent_classes;
-    my $valid_parent   = 0;
     foreach my $parentClass (@{ $class->valid_parent_classes}) {
-        return 1 if $class->isa($parentClass);
+        return 1 if $asset->isa($parentClass);
     }
     return 0;
 }
diff --git a/lib/WebGUI/Role/Asset/Subscribable.pm b/lib/WebGUI/Role/Asset/Subscribable.pm
index 392f7ce97..aa9e231cc 100644
--- a/lib/WebGUI/Role/Asset/Subscribable.pm
+++ b/lib/WebGUI/Role/Asset/Subscribable.pm
@@ -64,31 +64,32 @@ Subclass the method to create a new group for subscribers for the new asset.
 
 =cut
 
-sub duplicate {
+override duplicate => sub {
     my $self        = shift;
     my $properties  = shift;
-    my $newSelf     = $self->next::method( $properties );
+    my $newSelf     = super();
     $newSelf->update({ subscriptionGroupId => '' });
     $newSelf->createSubscriptionGroup;
     return $newSelf;
-}
+};
 
 #----------------------------------------------------------------------------
 
 =head2 addRevision ( properties [, revisionDate, options ] )
 
-Override addRevision to set skipNotification to 0 for each new revision.
+Extend addRevision to set skipNotification to 0 for each new revision.
 
 =cut
 
-sub addRevision {
+around addRevision => sub {
+    my $orig        = shift;
     my $self        = shift;
     my $properties  = shift;
     
     $properties->{ skipNotification     } = 0;
 
-    return $self->maybe::next::method( $properties, @_ );
-}
+    return $self->$orig( $properties, @_ );
+};
 
 #----------------------------------------------------------------------------
 
@@ -120,14 +121,14 @@ want to be able to subscribe to children)
 
 =cut
 
-sub commit { 
+override commit => sub {
     my ( $self, @args ) = @_;
-    $self->maybe::next::method( @args );
+    super();
     if ( !$self->shouldSkipNotification ) {
         $self->notifySubscribers;
     }
     return;
-}
+};
 
 #----------------------------------------------------------------------------
 
@@ -424,16 +425,16 @@ Subclass the method to remove the subscription group.
 
 =cut
 
-sub purge {
+override purge => sub {
     my $self    = shift;
     my $options = shift;
 
     my $group   = $self->getSubscriptionGroup();
     $group->delete;
-    $self->next::method($options);
+    super();
 
     return;
-}
+};
 
 #----------------------------------------------------------------------------
 
@@ -444,7 +445,7 @@ revision.
 
 =cut
 
-sub setSkipNotification {
+override setSkipNotification => sub {
     my $self    = shift;
     my $value   = shift;
     $value      = defined $value ? $value : 1;
@@ -454,7 +455,7 @@ sub setSkipNotification {
     } );
 
     return;
-}
+};
 
 #----------------------------------------------------------------------------
 
@@ -464,10 +465,10 @@ Returns true if the asset should skip notifications.
 
 =cut
 
-sub shouldSkipNotification {
+override shouldSkipNotification => sub {
     my $self    = shift;
     return $self->skipNotification ? 1 : 0;
-}
+};
 
 #----------------------------------------------------------------------------
 
diff --git a/t/tests/Test/WebGUI/Asset.pm b/t/tests/Test/WebGUI/Asset.pm
index 518dd1c63..fc4e25748 100644
--- a/t/tests/Test/WebGUI/Asset.pm
+++ b/t/tests/Test/WebGUI/Asset.pm
@@ -14,13 +14,33 @@ use Test::More;
 use Test::Deep;
 use Test::Exception;
 use WebGUI::Test;
+use WebGUI::Utility;
 
 sub assetUiLevel {
-     return 1;
+    return 1;
 }
 
 sub list_of_tables {
-     return [qw/assetData/];
+    return [qw/assetData/];
+}
+
+sub getMyParent {
+    my $test    = shift;
+    my $session = $test->session;
+    my $parentClasses = $test->class->valid_parent_classes;
+    my $default       = WebGUI::Asset->getDefault($session);
+    if (WebGUI::Utility::isIn('WebGUI::Asset', @{ $parentClasses}) ) {
+        return $default;
+    }
+    else {
+        my $class = $parentClasses->[0];
+        note "Adding a parent of $class";
+        my $parent = $default->addChild({
+            className => $class,
+        }, undef, undef, {skipNotification => 1, skipAutoCommitWorkflows => 1,});
+        addToCleanup($parent);
+        return $parent;
+    }
 }
 
 sub _constructor : Test(4) {
@@ -173,11 +193,14 @@ sub write_update : Test(8) {
 sub keywords : Test(3) {
     my $test    = shift;
     my $session = $test->session;
-    note "keywords";
-    my $default = WebGUI::Asset->getDefault($session);
-    my $asset = $default->addChild({
+    note "keywords for ".$test->class;
+    use Data::Dumper;
+    warn Dumper $test->class->valid_parent_classes;
+    my $parent = $test->getMyParent;
+    note "got parent and it is a ".ref $parent;
+    my $asset  = $parent->addChild({
         className => $test->class,
-    });
+    }, undef, undef, {skipNotification => 1, skipAutoCommitWorkflows => 1,});
     addToCleanup($asset);
     can_ok $asset, 'keywords';
     $asset->keywords('chess set');