From: Stevan Little Date: Sat, 5 Apr 2008 15:48:32 +0000 (+0000) Subject: adding the MooseX::MetaDescription stuff distilled from Ernst X-Git-Tag: 0.04~42 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c13295c80061a10bc2612b024bfdb52687d3a3b0;p=gitmo%2FMooseX-MetaDescription.git adding the MooseX::MetaDescription stuff distilled from Ernst --- c13295c80061a10bc2612b024bfdb52687d3a3b0 diff --git a/lib/MooseX/MetaDescription.pm b/lib/MooseX/MetaDescription.pm new file mode 100644 index 0000000..5dcf4bd --- /dev/null +++ b/lib/MooseX/MetaDescription.pm @@ -0,0 +1,53 @@ +package MooseX::MetaDescription; +use Moose; + +use MooseX::MetaDescription::Meta::Class; +use MooseX::MetaDescription::Meta::Attribute; + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +no Moose; 1; + +__END__ + +=pod + +=head1 NAME + +MooseX::MetaDescription - A Moosey solution to this problem + +=head1 SYNOPSIS + + use MooseX::MetaDescription; + +=head1 DESCRIPTION + +=head1 METHODS + +=over 4 + +=item B<> + +=back + +=head1 BUGS + +All complex software has bugs lurking in it, and this module is no +exception. If you find a bug please either email me, or add the bug +to cpan-RT. + +=head1 AUTHOR + +Stevan Little Estevan.little@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2008 Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/MooseX/MetaDescription/Description.pm b/lib/MooseX/MetaDescription/Description.pm new file mode 100644 index 0000000..0008015 --- /dev/null +++ b/lib/MooseX/MetaDescription/Description.pm @@ -0,0 +1,50 @@ +package MooseX::MetaDescription::Description; +use Moose; + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +no Moose; 1; + +__END__ + +=pod + +=head1 NAME + +MooseX::MetaDescription::Description - A Moosey solution to this problem + +=head1 SYNOPSIS + + use MooseX::MetaDescription::Description; + +=head1 DESCRIPTION + +=head1 METHODS + +=over 4 + +=item B<> + +=back + +=head1 BUGS + +All complex software has bugs lurking in it, and this module is no +exception. If you find a bug please either email me, or add the bug +to cpan-RT. + +=head1 AUTHOR + +Stevan Little Estevan.little@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2008 Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/MooseX/MetaDescription/Description/Attribute.pm b/lib/MooseX/MetaDescription/Description/Attribute.pm new file mode 100644 index 0000000..0b945f6 --- /dev/null +++ b/lib/MooseX/MetaDescription/Description/Attribute.pm @@ -0,0 +1,59 @@ +package MooseX::MetaDescription::Description::Attribute; +use Moose; + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +extends 'MooseX::MetaDescription::Description'; + +has 'attribute' => ( + is => 'ro', + does => 'MooseX::MetaDescription::Meta::Attribute::Trait', + weak_ref => 1, + required => 1, +); + +no Moose; 1; + +__END__ + +=pod + +=head1 NAME + +MooseX::MetaDescription::Description::Attribute - A Moosey solution to this problem + +=head1 SYNOPSIS + + use MooseX::MetaDescription::Description::Attribute; + +=head1 DESCRIPTION + +=head1 METHODS + +=over 4 + +=item B<> + +=back + +=head1 BUGS + +All complex software has bugs lurking in it, and this module is no +exception. If you find a bug please either email me, or add the bug +to cpan-RT. + +=head1 AUTHOR + +Stevan Little Estevan.little@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2008 Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/MooseX/MetaDescription/Description/Class.pm b/lib/MooseX/MetaDescription/Description/Class.pm new file mode 100644 index 0000000..23a2f73 --- /dev/null +++ b/lib/MooseX/MetaDescription/Description/Class.pm @@ -0,0 +1,59 @@ +package MooseX::MetaDescription::Description::Class; +use Moose; + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +extends 'MooseX::MetaDescription::Description'; + +has 'class' => ( + isa => 'MooseX::MetaDescription::Meta::Class', + is => 'ro', + weak_ref => 1, + required => 1, +); + +no Moose; 1; + +__END__ + +=pod + +=head1 NAME + +MooseX::MetaDescription::Description::Class - A Moosey solution to this problem + +=head1 SYNOPSIS + + use MooseX::MetaDescription::Description::Class; + +=head1 DESCRIPTION + +=head1 METHODS + +=over 4 + +=item B<> + +=back + +=head1 BUGS + +All complex software has bugs lurking in it, and this module is no +exception. If you find a bug please either email me, or add the bug +to cpan-RT. + +=head1 AUTHOR + +Stevan Little Estevan.little@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2008 Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/MooseX/MetaDescription/Meta/Attribute.pm b/lib/MooseX/MetaDescription/Meta/Attribute.pm new file mode 100644 index 0000000..688e61c --- /dev/null +++ b/lib/MooseX/MetaDescription/Meta/Attribute.pm @@ -0,0 +1,53 @@ +package MooseX::MetaDescription::Meta::Attribute; +use Moose; + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +extends 'Moose::Meta::Attribute'; + with 'MooseX::MetaDescription::Meta::Attribute::Trait'; + +no Moose; 1; + +__END__ + +=pod + +=head1 NAME + +MooseX::MetaDescription::Meta::Attribute - A Moosey solution to this problem + +=head1 SYNOPSIS + + use MooseX::MetaDescription::Meta::Attribute; + +=head1 DESCRIPTION + +=head1 METHODS + +=over 4 + +=item B<> + +=back + +=head1 BUGS + +All complex software has bugs lurking in it, and this module is no +exception. If you find a bug please either email me, or add the bug +to cpan-RT. + +=head1 AUTHOR + +Stevan Little Estevan.little@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2008 Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/MooseX/MetaDescription/Meta/Attribute/Trait.pm b/lib/MooseX/MetaDescription/Meta/Attribute/Trait.pm new file mode 100644 index 0000000..3692411 --- /dev/null +++ b/lib/MooseX/MetaDescription/Meta/Attribute/Trait.pm @@ -0,0 +1,75 @@ +package MooseX::MetaDescription::Meta::Attribute::Trait; +use Moose::Role; + +use MooseX::MetaDescription::Description::Attribute; + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +has 'description' => ( + is => 'ro', + isa => 'HashRef', + lazy => 1, + default => sub { +{} }, +); + +has 'metadescription' => ( + is => 'ro', + isa => 'MooseX::MetaDescription::Description', + lazy => 1, + default => sub { + my $self = shift; + + # TODO: handle traits ... + + MooseX::MetaDescription::Description::Attribute->new( + %{$self->description}, + attribute => $self, + ) + }, +); + +no Moose::Role; 1; + +__END__ + +=pod + +=head1 NAME + +MooseX::MetaDescription::Meta::Attribute::Trait - A Moosey solution to this problem + +=head1 SYNOPSIS + + use MooseX::MetaDescription::Meta::Attribute::Trait; + +=head1 DESCRIPTION + +=head1 METHODS + +=over 4 + +=item B<> + +=back + +=head1 BUGS + +All complex software has bugs lurking in it, and this module is no +exception. If you find a bug please either email me, or add the bug +to cpan-RT. + +=head1 AUTHOR + +Stevan Little Estevan.little@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2008 Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/MooseX/MetaDescription/Meta/Class.pm b/lib/MooseX/MetaDescription/Meta/Class.pm new file mode 100644 index 0000000..3e0395c --- /dev/null +++ b/lib/MooseX/MetaDescription/Meta/Class.pm @@ -0,0 +1,77 @@ +package MooseX::MetaDescription::Meta::Class; +use Moose; + +use MooseX::MetaDescription::Description::Class; + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +extends 'Moose::Meta::Class'; + +has 'description' => ( + is => 'ro', + isa => 'HashRef', + lazy => 1, + default => sub { +{} }, +); + +has 'metadescription' => ( + is => 'ro', + isa => 'MooseX::MetaDescription::Description', + lazy => 1, + default => sub { + my $self = shift; + + # TODO: handle traits ... + + MooseX::MetaDescription::Description::Class->new( + %{$self->description}, + class => $self, + ) + }, +); + +no Moose; 1; + +__END__ + +=pod + +=head1 NAME + +MooseX::MetaDescription::Meta::Class - A Moosey solution to this problem + +=head1 SYNOPSIS + + use MooseX::MetaDescription::Meta::Class; + +=head1 DESCRIPTION + +=head1 METHODS + +=over 4 + +=item B<> + +=back + +=head1 BUGS + +All complex software has bugs lurking in it, and this module is no +exception. If you find a bug please either email me, or add the bug +to cpan-RT. + +=head1 AUTHOR + +Stevan Little Estevan.little@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2008 Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/t/000_load.t b/t/000_load.t new file mode 100644 index 0000000..1e5f285 --- /dev/null +++ b/t/000_load.t @@ -0,0 +1,19 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More no_plan => 1; +use Test::Exception; + +BEGIN { + use_ok('MooseX::MetaDescription'); + + use_ok('MooseX::MetaDescription::Meta::Class'); + use_ok('MooseX::MetaDescription::Meta::Attribute'); + use_ok('MooseX::MetaDescription::Meta::Attribute::Trait'); + + use_ok('MooseX::MetaDescription::Description'); + use_ok('MooseX::MetaDescription::Description::Class'); + use_ok('MooseX::MetaDescription::Description::Attribute'); +} diff --git a/t/001_basic.t b/t/001_basic.t new file mode 100644 index 0000000..4fcfb5d --- /dev/null +++ b/t/001_basic.t @@ -0,0 +1,81 @@ +#!/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'; + use Moose; + + __PACKAGE__->meta->description->{'Hello'} = 'World'; + + has 'bar' => ( + metaclass => 'MooseX::MetaDescription::Meta::Attribute', + is => 'ro', + isa => 'Str', + default => sub { 'Foo::bar' }, + description => { + baz => 'Foo::bar::baz', + gorch => 'Foo::bar::gorch', + } + ); + + has 'baz' => ( + traits => [ 'MooseX::MetaDescription::Meta::Attribute::Trait' ], + is => 'ro', + isa => 'Str', + default => sub { 'Foo::baz' }, + description => { + bar => 'Foo::baz::bar', + gorch => 'Foo::baz::gorch', + } + ); +} + +# check the meta-desc + +my $foo_class = Foo->meta; +is($foo_class->metadescription->class, $foo_class, '... got the circular ref'); + +my $bar_attr = Foo->meta->get_attribute('bar'); +is($bar_attr->metadescription->attribute, $bar_attr, '... got the circular ref'); + +my $baz_attr = Foo->meta->get_attribute('baz'); +is($baz_attr->metadescription->attribute, $baz_attr, '... got the circular ref'); + +# check the actual descs + +foreach my $foo ('Foo', Foo->new) { + is_deeply( + $foo->meta->description, + { 'Hello' => 'World' }, + '... got the right class description' + ); + + is_deeply( + $foo->meta->get_attribute('bar')->description, + { + baz => 'Foo::bar::baz', + gorch => 'Foo::bar::gorch', + }, + '... got the right class description' + ); + + is_deeply( + $foo->meta->get_attribute('baz')->description, + { + bar => 'Foo::baz::bar', + gorch => 'Foo::baz::gorch', + }, + '... got the right class description' + ); +} +