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
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
=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',
package MooseX::MetaDescription::Description;
use Moose;
-our $VERSION = '0.01';
+our $VERSION = '0.02';
our $AUTHORITY = 'cpan:STEVAN';
has 'descriptor' => (
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;
package MooseX::MetaDescription::Meta::Trait;
use Moose::Role;
-our $VERSION = '0.01';
+our $VERSION = '0.02';
our $AUTHORITY = 'cpan:STEVAN';
has 'description' => (
);
has 'metadescription_classname' => (
- is => 'ro',
+ is => 'rw',
isa => 'Str',
lazy => 1,
default => sub {
'MooseX::MetaDescription::Description'
- }
+ }
);
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 ],
{
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',
# 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');
{
package Foo;
- use Moose;
+ use Moose;
has 'bar' => (
metaclass => 'MooseX::MetaDescription::Meta::Attribute',
--- /dev/null
+#!/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'
+ );
+}
+