inheriting class desc
Stevan Little [Wed, 7 May 2008 01:40:30 +0000 (01:40 +0000)]
Changes
MANIFEST
lib/MooseX/MetaDescription.pm
lib/MooseX/MetaDescription/Description.pm
lib/MooseX/MetaDescription/Meta/Class.pm
lib/MooseX/MetaDescription/Meta/Trait.pm
t/001_basic.t
t/003_inheriting_meta_desc.t
t/004_inheriting_class_meta_desc.t [new file with mode: 0644]

diff --git a/Changes b/Changes
index 611acb8..99f4dde 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,16 @@
 Revision history for Perl extension MooseX::MetaDescription
 
+0.02
+    * MooseX::MetaDescription::Meta::Trait
+      - making metadescription attribute default
+        also load the metadescription class
+    
+    * MooseX::MetaDescription::Meta::Class
+      - descriptions will now "inherit" by 
+        default, unless you specify the 
+        description explicitly
+        - added test for this
+
 0.01 Friday, May 2, 2008
     - extracted from Ernst project into it's 
       own package, cause it is useful 
\ No newline at end of file
index 6f63d03..654263c 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -21,4 +21,5 @@ t/000_load.t
 t/001_basic.t
 t/002_custom_description.t
 t/003_inheriting_meta_desc.t
+t/004_inheriting_class_meta_desc.t
 t/010_meta_desc_traits.t
index 3baa9e0..e88653c 100644 (file)
@@ -21,11 +21,13 @@ MooseX::MetaDescription - A framework for adding additional metadata to Moose cl
 =head1 SYNOPSIS
 
     package Foo;
-    use metaclass 'MooseX::MetaDescription::Meta::Class';
+    use metaclass 'MooseX::MetaDescription::Meta::Class' => (
+        # add class-level metadata
+        description => {
+            'Hello' => 'World'
+        }
+    );
     use Moose;
-    
-    # add class-level metadata
-    __PACKAGE__->meta->description->{'Hello'} = 'World';
 
     has 'bar' => (
         metaclass   => 'MooseX::MetaDescription::Meta::Attribute',
index 5e0298b..99ed908 100644 (file)
@@ -1,7 +1,7 @@
 package MooseX::MetaDescription::Description;
 use Moose;
 
-our $VERSION   = '0.01';
+our $VERSION   = '0.02';
 our $AUTHORITY = 'cpan:STEVAN';
 
 has 'descriptor' => (
index 3778917..80fedfe 100644 (file)
@@ -1,11 +1,26 @@
 package MooseX::MetaDescription::Meta::Class;
 use Moose;
 
-our $VERSION   = '0.01';
+our $VERSION   = '0.02';
 our $AUTHORITY = 'cpan:STEVAN';
 
 extends 'Moose::Meta::Class';
    with 'MooseX::MetaDescription::Meta::Trait';
+   
+has '+description' => (
+   default => sub {
+       my $self   = shift;
+       my @supers = $self->linearized_isa;
+       shift @supers;
+       my %desc;
+       foreach my $super (@supers) {
+            if ($super->meta->isa('MooseX::MetaDescription::Meta::Class')) {
+                %desc = (%{ $super->meta->description }, %desc)
+            }
+       }
+       \%desc;
+   },
+);   
 
 no Moose; 1;
 
index 11ccb01..babd49a 100644 (file)
@@ -1,7 +1,7 @@
 package MooseX::MetaDescription::Meta::Trait;
 use Moose::Role;
 
-our $VERSION   = '0.01';
+our $VERSION   = '0.02';
 our $AUTHORITY = 'cpan:STEVAN';
 
 has 'description' => (
@@ -12,12 +12,12 @@ has 'description' => (
 );
 
 has 'metadescription_classname' => (
-    is      => 'ro',
+    is      => 'rw',
     isa     => 'Str', 
     lazy    => 1,  
     default => sub {
         'MooseX::MetaDescription::Description'
-    }  
+    }
 );
 
 has 'metadescription' => (
@@ -30,6 +30,8 @@ has 'metadescription' => (
         my $metadesc_class = $self->metadescription_classname;
         my $desc           = $self->description;
         
+        Class::MOP::load_class($metadesc_class);
+        
         if (my $traits = delete $desc->{traits}) {
             my $meta = Moose::Meta::Class->create_anon_class(
                 superclasses => [ $metadesc_class ],
index 8d99d73..7c3dbbf 100644 (file)
@@ -12,11 +12,13 @@ BEGIN {
 
 {
     package Foo;
-    use metaclass 'MooseX::MetaDescription::Meta::Class';
+    use metaclass 'MooseX::MetaDescription::Meta::Class' => (
+        description => {
+            'Hello' => 'World'
+        }
+    );
     use Moose;
     
-    __PACKAGE__->meta->description->{'Hello'} = 'World';
-    
     has 'bar' => (
         metaclass   => 'MooseX::MetaDescription::Meta::Attribute',
         is          => 'ro',
@@ -43,6 +45,7 @@ BEGIN {
 # check the meta-desc
 
 my $foo_class = Foo->meta;
+isa_ok($foo_class, 'MooseX::MetaDescription::Meta::Class');
 isa_ok($foo_class->metadescription, 'MooseX::MetaDescription::Description');
 is($foo_class->metadescription->descriptor, $foo_class, '... got the circular ref');
 
index a4ced5a..c433ed2 100644 (file)
@@ -12,7 +12,7 @@ BEGIN {
 
 {
     package Foo;
-    use Moose;
+    use Moose;  
     
     has 'bar' => (
         metaclass   => 'MooseX::MetaDescription::Meta::Attribute',
diff --git a/t/004_inheriting_class_meta_desc.t b/t/004_inheriting_class_meta_desc.t
new file mode 100644 (file)
index 0000000..ceff575
--- /dev/null
@@ -0,0 +1,86 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More no_plan => 1;
+use Test::Exception;
+
+BEGIN {
+    use_ok('MooseX::MetaDescription');
+}
+
+{
+    package Foo;
+    use metaclass 'MooseX::MetaDescription::Meta::Class' => (
+        description => {
+            'Hello' => 'World',
+            'World' => 'Hello',
+        }
+    );
+    use Moose;
+
+    package Bar;
+    use Moose;
+
+    extends 'Foo';
+    
+    __PACKAGE__->meta->description->{'Hello'} = 'Earth';
+    
+    package Baz;
+    use Moose;
+
+    extends 'Bar';
+}
+
+# check the meta-desc
+
+my $foo_class = Foo->meta;
+isa_ok($foo_class, 'MooseX::MetaDescription::Meta::Class');
+isa_ok($foo_class->metadescription, 'MooseX::MetaDescription::Description');
+is($foo_class->metadescription->descriptor, $foo_class, '... got the circular ref');
+
+my $bar_class = Bar->meta;
+isa_ok($bar_class, 'MooseX::MetaDescription::Meta::Class');
+isa_ok($bar_class->metadescription, 'MooseX::MetaDescription::Description');
+is($bar_class->metadescription->descriptor, $bar_class, '... got the circular ref');
+
+my $baz_class = Baz->meta;
+isa_ok($baz_class, 'MooseX::MetaDescription::Meta::Class');
+isa_ok($baz_class->metadescription, 'MooseX::MetaDescription::Description');
+is($baz_class->metadescription->descriptor, $baz_class, '... got the circular ref');
+
+
+foreach my $x ('Foo', Foo->new) {
+    is_deeply(
+        $x->meta->description,
+        { 
+            'Hello' => 'World',
+            'World' => 'Hello'            
+        },
+        '... got the right class description'
+    );
+}
+
+foreach my $x ('Bar', Bar->new) {
+    is_deeply(
+        $x->meta->description,
+        { 
+            'Hello' => 'Earth',
+            'World' => 'Hello'            
+        },
+        '... got the right class description'
+    );
+}
+
+foreach my $x ('Baz', Baz->new) {
+    is_deeply(
+        $x->meta->description,
+        { 
+            'Hello' => 'Earth',
+            'World' => 'Hello'            
+        },
+        '... got the right class description'
+    );
+}
+