From: Jesse Luehrs Date: Fri, 31 Jul 2009 02:42:16 +0000 (-0500) Subject: add a function to more easily create metaclass/trait aliases X-Git-Tag: 0.89~14 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=27f2f43f0c7ec26e19cdfbdf0357c8c53acc1795;p=gitmo%2FMoose.git add a function to more easily create metaclass/trait aliases --- diff --git a/Changes b/Changes index 0d8a3e7..c2983e9 100644 --- a/Changes +++ b/Changes @@ -18,6 +18,10 @@ next version - Make "use Moose -metaclass => 'Foo'" do alias resolution, like -traits does. (doy) + * Moose::Util + - Add functions meta_class_alias and meta_attribute_alias for creating + aliases for class and attribute metaclasses and metatraits. (doy) + 0.88 Fri Jul 24, 2009 * Moose::Manual::Contributing - Re-write the Moose::Manual::Contributing document to reflect diff --git a/lib/Moose/Manual/Delta.pod b/lib/Moose/Manual/Delta.pod index cf98390..5fe7aea 100644 --- a/lib/Moose/Manual/Delta.pod +++ b/lib/Moose/Manual/Delta.pod @@ -21,6 +21,15 @@ send us a patch. C<< use Moose -metaclass => 'Foo' >> now does alias resolution, just like C<-traits> (and the C and C options to C). +Added two functions C and C to +L, to simplify aliasing metaclasses and metatraits. This is +a wrapper around the old + + package Moose::Meta::Class::Custom::Trait::FooTrait; + sub register_implementation { 'My::Meta::Trait' } + +way of doing this. + =head1 Version 0.84 When an attribute generates I accessors, we now warn. This is to help diff --git a/lib/Moose/Util.pm b/lib/Moose/Util.pm index 33b22b8..48dfc2b 100644 --- a/lib/Moose/Util.pm +++ b/lib/Moose/Util.pm @@ -24,6 +24,8 @@ my @exports = qw[ resolve_metaclass_alias add_method_modifier english_list + meta_attribute_alias + meta_class_alias ]; Sub::Exporter::setup_exporter({ @@ -148,6 +150,15 @@ sub resolve_metatrait_alias { return resolve_metaclass_alias( @_, trait => 1 ); } +sub _build_alias_package_name { + my ($type, $name, $trait) = @_; + return 'Moose::Meta::' + . $type + . '::Custom::' + . ( $trait ? 'Trait::' : '' ) + . $name; +} + { my %cache; @@ -158,12 +169,9 @@ sub resolve_metatrait_alias { return $cache{$cache_key}{$metaclass_name} if $cache{$cache_key}{$metaclass_name}; - my $possible_full_name - = 'Moose::Meta::' - . $type - . '::Custom::' - . ( $options{trait} ? "Trait::" : "" ) - . $metaclass_name; + my $possible_full_name = _build_alias_package_name( + $type, $metaclass_name, $options{trait} + ); my $loaded_class = Class::MOP::load_first_existing_class( $possible_full_name, @@ -216,6 +224,30 @@ sub _caller_info { return \%info; } +sub _create_alias { + my ($type, $name, $trait, $for) = @_; + my $package = _build_alias_package_name($type, $name, $trait); + Class::MOP::Class->initialize($package)->add_method( + register_implementation => sub { $for } + ); +} + +sub meta_attribute_alias { + my ($to, $from) = @_; + $from ||= caller; + my $meta = Class::MOP::class_of($from); + my $trait = $meta->isa('Moose::Meta::Role'); + _create_alias('Attribute', $to, $trait, $from); +} + +sub meta_class_alias { + my ($to, $from) = @_; + $from ||= caller; + my $meta = Class::MOP::class_of($from); + my $trait = $meta->isa('Moose::Meta::Role'); + _create_alias('Class', $to, $trait, $from); +} + 1; __END__ @@ -318,6 +350,14 @@ Given a list of scalars, turns them into a proper list in English ("one and two", "one, two, three, and four"). This is used to help us make nicer error messages. +=item B + +=item B + +Create an alias from the class C<$from> (or the current package, if +C<$from> is unspecified), so that +L works properly. + =back =head1 TODO diff --git a/t/400_moose_util/006_create_alias.t b/t/400_moose_util/006_create_alias.t new file mode 100644 index 0000000..bed8292 --- /dev/null +++ b/t/400_moose_util/006_create_alias.t @@ -0,0 +1,102 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 8; +use Test::Moose qw(does_ok); + +BEGIN { + package Foo::Meta::Role; + use Moose::Role; + Moose::Util::meta_class_alias + FooRole => 'Foo::Meta::Role'; + + package Foo::Meta::Class; + use Moose; + extends 'Moose::Meta::Class'; + with 'Foo::Meta::Role'; + Moose::Util::meta_class_alias + FooClass => 'Foo::Meta::Class'; + + package Foo::Meta::Role::Attribute; + use Moose::Role; + Moose::Util::meta_attribute_alias + FooAttrRole => 'Foo::Meta::Role::Attribute'; + + package Foo::Meta::Attribute; + use Moose; + extends 'Moose::Meta::Attribute'; + with 'Foo::Meta::Role::Attribute'; + Moose::Util::meta_attribute_alias + FooAttrClass => 'Foo::Meta::Attribute'; + + package Bar::Meta::Role; + use Moose::Role; + Moose::Util::meta_class_alias 'BarRole'; + + package Bar::Meta::Class; + use Moose; + extends 'Moose::Meta::Class'; + with 'Bar::Meta::Role'; + Moose::Util::meta_class_alias 'BarClass'; + + package Bar::Meta::Role::Attribute; + use Moose::Role; + Moose::Util::meta_attribute_alias 'BarAttrRole'; + + package Bar::Meta::Attribute; + use Moose; + extends 'Moose::Meta::Attribute'; + with 'Bar::Meta::Role::Attribute'; + Moose::Util::meta_attribute_alias 'BarAttrClass'; +} + +package FooWithMetaClass; +use Moose -metaclass => 'FooClass'; + +has bar => ( + metaclass => 'FooAttrClass', + is => 'ro', +); + + +package FooWithMetaTrait; +use Moose -traits => 'FooRole'; + +has bar => ( + traits => [qw(FooAttrRole)], + is => 'ro', +); + +package BarWithMetaClass; +use Moose -metaclass => 'BarClass'; + +has bar => ( + metaclass => 'BarAttrClass', + is => 'ro', +); + + +package BarWithMetaTrait; +use Moose -traits => 'BarRole'; + +has bar => ( + traits => [qw(BarAttrRole)], + is => 'ro', +); + +package main; +my $fwmc_meta = FooWithMetaClass->meta; +my $fwmt_meta = FooWithMetaTrait->meta; +isa_ok($fwmc_meta, 'Foo::Meta::Class'); +isa_ok($fwmc_meta->get_attribute('bar'), 'Foo::Meta::Attribute'); +does_ok($fwmt_meta, 'Foo::Meta::Role'); +does_ok($fwmt_meta->get_attribute('bar'), 'Foo::Meta::Role::Attribute'); + +my $bwmc_meta = BarWithMetaClass->meta; +my $bwmt_meta = BarWithMetaTrait->meta; +isa_ok($bwmc_meta, 'Bar::Meta::Class'); +isa_ok($bwmc_meta->get_attribute('bar'), 'Bar::Meta::Attribute'); +does_ok($bwmt_meta, 'Bar::Meta::Role'); +does_ok($bwmt_meta->get_attribute('bar'), 'Bar::Meta::Role::Attribute');