first rev of new definition class

2009-10-12 05:41:04 -05:00 · 2009-10-12 05:41:04 -05:00 · 34182a39ee
commit 34182a39ee
parent 814bde6b93
3 changed files with 410 additions and 0 deletions
--- a/t/Definition.t
+++ b/t/Definition.t
@ -0,0 +1,126 @@
+#-------------------------------------------------------------------
+# WebGUI is Copyright 2001-2009 Plain Black Corporation.
+#-------------------------------------------------------------------
+# Please read the legal notices (docs/legal.txt) and the license
+# (docs/license.txt) that came with this distribution before using
+# this software.
+#-------------------------------------------------------------------
+# http://www.plainblack.com                     info@plainblack.com
+#-------------------------------------------------------------------
+
+use strict;
+use warnings;
+no warnings qw(uninitialized);
+
+use Test::More 'no_plan'; #tests => 1;
+
+{
+    package WGT::Class;
+    use WebGUI::Definition (
+        attribute1 => 'attribute 1 value',
+        properties => [
+            property1 => {
+                label => 'property1 label',
+                defaultValue => sub { return shift },
+            },
+        ],
+    );
+
+    sub new {
+        my $class = shift;
+        my $self = $class->instantiate;
+        return $self;
+    }
+}
+
+my $written;
+{
+    package WGT::SubClass;
+    use base qw(WGT::Class);
+    use WebGUI::Definition (
+        attribute2 => 'attribute 2 value',
+        properties => {
+            property2 => {
+                label => 'property2 label',
+                defaultValue => sub { return "dynamic value" },
+            },
+            a_property => {
+                defaultValue => 1,
+            },
+        },
+    );
+
+    sub write {
+        my $self = shift;
+        $written = 1;
+    }
+
+    sub _set_a_property {
+        my $self = shift;
+        my $value = shift;
+        return "$value - BLAH";
+    }
+}
+
+my $object = WGT::Class->new;
+my $subclass_object = WGT::SubClass->new;
+
+can_ok $object, qw(getProperties getProperty get update getAttribute instantiate property1);
+can_ok $subclass_object, qw(getProperties getProperty get update getAttribute instantiate property1 property2 a_property);
+
+is $object->property1('property 1 value'), 'property 1 value',
+    'property mutator returns newly set value';
+is $object->property1, 'property 1 value',
+    'property accessor returns correct value';
+
+is $subclass_object->property2('property 2 value'), 'property 2 value',
+    'property mutator returns newly set value';
+is $subclass_object->property2, 'property 2 value',
+    'property accessor returns correct value';
+
+is_deeply [ $object->getProperties ], ['property1'],
+    'class has correct properties';
+is_deeply [ $subclass_object->getProperties ], ['property1', 'a_property', 'property2'],
+    'subclass has correct properties';
+
+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' },
+    'get returns hash with correct properties';
+
+is_deeply $object->getProperty('property1'), { label => 'property1 label', defaultValue => $object },
+    'getProperty returns correct hash for object';
+is_deeply $subclass_object->getProperty('property2'), { label => 'property2 label', defaultValue => 'dynamic value' },
+    'getProperty returns correct hash for subclass object';
+
+is $object->getAttribute('attribute1'), 'attribute 1 value',
+    'object has correct attribute';
+is $subclass_object->getAttribute('attribute1'), 'attribute 1 value',
+    'subclass object has correct inherited attribute';
+is $subclass_object->getAttribute('attribute2'), 'attribute 2 value',
+    'subclass object has correct own value';
+
+ok eval { $object->update; 1},
+    'update works when no write sub available';
+ok eval { $subclass_object->update; 1},
+    'update works when write sub available';
+ok $written,
+    'update calls write';
+
+$object->update({ property1 => 'new value', nonproperty => 'other value' });
+
+is $object->property1, 'new value', 'update sets all properties';
+
+$object->property1(undef);
+
+is $object->property1, undef, 'able to set undef as property value';
+
+is +WGT::Class->instantiate(property1 => 'property value')->property1, 'property value',
+    'instantiate sets correct values';
+
+is $subclass_object->a_property('value'), 'value - BLAH', 'accessor calls custom filter if needed';
+
+
+#->update
+#->new
+