oqapi/webgui
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

replace class's ISA instead of prepending to it

Browse source
This commit is contained in:
Graham Knop 2009-10-19 05:05:02 -05:00
parent d852c58a90
commit cdbc94cdef
2 changed files with 12 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

7
lib/WebGUI/Definition.pm
View file

@ -43,10 +43,6 @@ sub import {
my @propertyList; my @propertyList;
my %properties; my %properties;
if ( my $properties = delete $definition->{properties} ) { if ( my $properties = delete $definition->{properties} ) {
# accept a hash and alphabetize it
if (ref $properties eq 'HASH') {
$properties = [ map { $_ => $properties->{$_} } sort keys %{ $properties } ];
}
for (my $i = 0; $i < @{ $properties }; $i += 2) { for (my $i = 0; $i < @{ $properties }; $i += 2) {
my $property = $properties->[$i]; my $property = $properties->[$i];
push @propertyList, $property; push @propertyList, $property;
@ -109,7 +105,8 @@ sub import {
*{$super . '::set'} = \&_set; *{$super . '::set'} = \&_set;
*{$super . '::update'} = \&_update; *{$super . '::update'} = \&_update;
*{$super . '::instantiate'} = \&_instantiate; *{$super . '::instantiate'} = \&_instantiate;
unshift @{$caller . '::ISA'}, $super; @{$super . '::ISA'} = @{$caller . '::ISA'};
@{$caller . '::ISA'} = ($super);
return; return;
} }

11
t/Definition.t
View file

@ -13,7 +13,7 @@ use warnings;
no warnings qw(uninitialized); no warnings qw(uninitialized);
use Test::More 'no_plan'; #tests => 1; use Test::More 'no_plan'; #tests => 1;
my $called_getProperties;
{ {
package WGT::Class; package WGT::Class;
use WebGUI::Definition ( use WebGUI::Definition (
@ -31,6 +31,12 @@ use Test::More 'no_plan'; #tests => 1;
my $self = $class->instantiate; my $self = $class->instantiate;
return $self; return $self;
} }
sub getProperties {
$called_getProperties = 1;
my $self = shift;
return $self->next::method(@_);
}
} }
my $written; my $written;
@ -80,8 +86,11 @@ is $subclass_object->property2, 'property 2 value',
is_deeply [ $object->getProperties ], ['property1'], is_deeply [ $object->getProperties ], ['property1'],
'class has correct properties'; 'class has correct properties';
ok $called_getProperties, 'able to override getProperties';
undef $called_getProperties;
is_deeply [ $subclass_object->getProperties ], ['property1', 'a_property', 'property2'], is_deeply [ $subclass_object->getProperties ], ['property1', 'a_property', 'property2'],
'subclass has correct properties'; 'subclass has correct properties';
ok $called_getProperties, 'subclass uses correctly overridden getProperties';
is_deeply $object->get, { property1 => 'property 1 value' }, is_deeply $object->get, { property1 => 'property 1 value' },
'get returns hash with correct properties'; 'get returns hash with correct properties';