Merge branch 'review/dams' into devel

lib/Dancer/Object.pm

@@ -28,7 +28,35 @@ sub init {1}
 
 # meta information about classes
 my $_attrs_per_class = {};
-sub get_attributes { $_attrs_per_class->{$_[0]} }
+sub get_attributes {
+    my ($class, $visited_parents) = @_;
+    # $visited_parents keeps track of parent classes we already handled, to
+    # avoid infinite recursion (in case of dependancies loop). It's not stored as class singleton, otherwise
+    # get_attributes wouldn't be re-entrant.
+    $visited_parents ||= {};
+    my @attributes = @{$_attrs_per_class->{$class} || [] };
+    my @parents;
+    { no strict 'refs';
+      @parents = @{"$class\::ISA"}; }
+    foreach my $parent (@parents) {
+        # cleanup $parent
+        $parent =~ s/'/::/g;
+        $parent =~ /^::/
+          and $parent = 'main' . $parent;
+
+        # check we didn't visited it already
+        $visited_parents->{$parent}++
+          and next;
+
+        # check it's a Dancer::Object
+        $parent->isa(__PACKAGE__)
+          or next;
+
+        # merge parents attributes
+        push @attributes, @{$parent->get_attributes($visited_parents)};
+    }
+    return \@attributes;
+}
 
 # accessors builder
 sub attributes {

t/00_base/06_dancer_object.t

@@ -8,7 +8,7 @@ use Dancer::ModuleLoader;
 plan skip_all => "the Clone module is needed for this test"
     unless Dancer::ModuleLoader->load('Clone');
 
-plan tests => 12;
+plan tests => 19;
 
 use Dancer::Object;
 
@@ -38,3 +38,29 @@ is $p->age, $p2->age, "clone values are OK";
 
 my $attrs = Person->get_attributes();
 is_deeply $attrs, ['name', 'age', 'sex'], "attributes are ok";
+
+{
+    package Person::Child;
+    use base 'Person';
+    __PACKAGE__->attributes('parent');
+}
+
+my $child = Person::Child->new();
+ok $child->parent($p), 'setting parent';
+ok $child->name('bob'), 'setting child name';
+ok $child->age(5), 'setting child age';
+
+is $child->age, 5, 'age is ok';
+is $child->parent->sex, 'male', 'age is ok';
+my $child_attrs = Person::Child->get_attributes();
+is_deeply $child_attrs, ['parent', 'name', 'age', 'sex'], "attributes are ok";
+
+{
+    package Person::Child::Blond;
+    use base 'Person::Child';
+    __PACKAGE__->attributes('hair_length');
+}
+
+my $blond_child = Person::Child::Blond->new();
+my $blond_child_attrs = Person::Child::Blond->get_attributes();
+is_deeply $blond_child_attrs, ['hair_length', 'parent', 'name', 'age', 'sex'], "attributes are ok";