From d852c58a903f10de14266daedf90de06d466806d Mon Sep 17 00:00:00 2001
From: Graham Knop <graham@plainblack.com>
Date: Wed, 14 Oct 2009 17:06:17 -0500
Subject: [PATCH] inject methods into a superclass instead of the class itself

---
 lib/WebGUI/Definition.pm | 31 +++++++++++++++----------------
 t/Definition.t           |  6 +++---
 2 files changed, 18 insertions(+), 19 deletions(-)

diff --git a/lib/WebGUI/Definition.pm b/lib/WebGUI/Definition.pm
index b2ebbfa09..9dcfa04c6 100644
--- a/lib/WebGUI/Definition.pm
+++ b/lib/WebGUI/Definition.pm
@@ -24,6 +24,8 @@ use Sub::Name ();
 use Clone ();
 use mro ();
 
+my $gen_package = 0;
+
 sub import {
     my $class = shift;
     if (! @_) {
@@ -33,6 +35,9 @@ sub import {
     my $caller = caller;
     # ensure we are using c3 method resolution
     mro::set_mro($caller, 'c3');
+    $gen_package++;
+    my $super = __PACKAGE__ . '::_gen' . $gen_package;
+    mro::set_mro($super, 'c3');
 
     # construct an ordered list and hash of the properties
     my @propertyList;
@@ -52,26 +57,18 @@ sub import {
     # accessors for properties
     for my $property ( @propertyList ) {
         no strict 'refs';
-        $class->_install($caller, $property, sub {
+        $class->_install($super, $property, sub {
             if (@_ > 1) {
                 my $value = $_[1];
-                # call _set_$property with set value and use return value for actual value
-                if (my $set = $_[0]->can('_set_' . $property)) {
-                    $value = $_[0]->$set($value);
-                }
                 return $_[0]{properties}{$property} = $value;
             }
             else {
-                # call _get_$property and use return
-                if (my $get = $_[0]->can('_get_' . $property)) {
-                    return $_[0]->$get($_[1]);
-                }
                 return $_[0]{properties}{$property};
             }
         });
     }
 
-    $class->_install($caller, 'getProperty', sub {
+    $class->_install($super, 'getProperty', sub {
         my $self = shift;
         my $property = shift;
         if (exists $properties{$property}) {
@@ -89,7 +86,7 @@ sub import {
         return $self->maybe::next::method($property);
     });
 
-    $class->_install($caller, 'getProperties', sub {
+    $class->_install($super, 'getProperties', sub {
         my $self = shift;
         my %props = map { $_ => 1 } @propertyList;
         # remove any properties from superclass list that exist in this class
@@ -98,7 +95,7 @@ sub import {
         return @allProperties;
     });
 
-    $class->_install($caller, 'getAttribute', sub {
+    $class->_install($super, 'getAttribute', sub {
         my $self = shift;
         my $attribute = shift;
         if ( exists $definition->{$attribute} ) {
@@ -108,10 +105,12 @@ sub import {
     });
 
     no strict 'refs';
-    *{$caller . '::get'} = \&_get;
-    *{$caller . '::set'} = \&_set;
-    *{$caller . '::update'} = \&_update;
-    *{$caller . '::instantiate'} = \&_instantiate;
+    *{$super . '::get'} = \&_get;
+    *{$super . '::set'} = \&_set;
+    *{$super . '::update'} = \&_update;
+    *{$super . '::instantiate'} = \&_instantiate;
+    unshift @{$caller . '::ISA'}, $super;
+    return;
 }
 
 sub _install {
diff --git a/t/Definition.t b/t/Definition.t
index 5882b21a1..75883c1b2 100644
--- a/t/Definition.t
+++ b/t/Definition.t
@@ -55,10 +55,10 @@ my $written;
         $written = 1;
     }
 
-    sub _set_a_property {
+    sub a_property {
         my $self = shift;
         my $value = shift;
-        return "$value - BLAH";
+        return $self->next::method("$value - BLAH");
     }
 }
 
@@ -85,7 +85,7 @@ is_deeply [ $subclass_object->getProperties ], ['property1', 'a_property', 'prop
 
 is_deeply $object->get, { property1 => 'property 1 value' },
     'get returns hash with correct properties';
-is_deeply $subclass_object->get, { property1 => undef, a_property => undef, property2 => 'property 2 value' },
+is_deeply $subclass_object->get, { property1 => undef, a_property => ' - BLAH', property2 => 'property 2 value' },
     'get returns hash with correct properties';
 
 is_deeply $object->getProperty('property1'), { label => 'property1 label', defaultValue => $object },