From: Jesse Luehrs Date: Thu, 23 Sep 2010 08:27:25 +0000 (-0500) Subject: make MMC->create and MMR->create install meta methods properly X-Git-Tag: 1.15~35 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=699a2e32b7c7ef959a47fc09e77b7f5336bb72f9;p=gitmo%2FMoose.git make MMC->create and MMR->create install meta methods properly --- diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index 612df44..9fbec21 100644 --- a/lib/Moose/Meta/Class.pm +++ b/lib/Moose/Meta/Class.pm @@ -22,6 +22,7 @@ use Moose::Error::Default; use Moose::Meta::Class::Immutable::Trait; use Moose::Meta::Method::Constructor; use Moose::Meta::Method::Destructor; +use Moose::Meta::Method::Meta; use Moose::Util; use Class::MOP::MiniTrait; @@ -112,6 +113,8 @@ sub create_anon_class { return $new_class; } +sub _meta_method_class { 'Moose::Meta::Method::Meta' } + sub _anon_cache_key { # Makes something like Super::Class|Super::Class::2=Role|Role::1 return join '=' => ( diff --git a/lib/Moose/Meta/Method/Meta.pm b/lib/Moose/Meta/Method/Meta.pm new file mode 100644 index 0000000..94170fd --- /dev/null +++ b/lib/Moose/Meta/Method/Meta.pm @@ -0,0 +1,63 @@ + +package Moose::Meta::Method::Meta; + +use strict; +use warnings; + +our $VERSION = '1.14'; +$VERSION = eval $VERSION; +our $AUTHORITY = 'cpan:STEVAN'; + +use base 'Moose::Meta::Method', + 'Class::MOP::Method::Meta'; + +sub _is_caller_mop_internal { + my $self = shift; + my ($caller) = @_; + return 1 if $caller =~ /^Moose(?:::|$)/; + return $self->SUPER::_is_caller_mop_internal($caller); +} + +# XXX: ugh multiple inheritance +sub wrap { + my $class = shift; + return $class->Class::MOP::Method::Meta::wrap(@_); +} + +1; + +__END__ + +=pod + +=head1 NAME + +Moose::Meta::Method::Meta - A Moose Method metaclass for C methods + +=head1 DESCRIPTION + +This class is a subclass of L that +provides additional Moose-specific functionality, all of which is +private. + +To understand this class, you should read the the +L documentation. + +=head1 BUGS + +See L for details on reporting bugs. + +=head1 AUTHOR + +Jesse Luehrs Edoy at tozt dot net + +=head1 COPYRIGHT AND LICENSE + +Copyright 2006-2010 by 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/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm index f524283..2dff118 100644 --- a/lib/Moose/Meta/Role.pm +++ b/lib/Moose/Meta/Role.pm @@ -18,6 +18,7 @@ use Moose::Meta::Role::Attribute; use Moose::Meta::Role::Method; use Moose::Meta::Role::Method::Required; use Moose::Meta::Role::Method::Conflicting; +use Moose::Meta::Method::Meta; use Moose::Util qw( ensure_all_roles ); use Class::MOP::MiniTrait; @@ -365,6 +366,7 @@ sub update_package_cache_flag { } +sub _meta_method_class { 'Moose::Meta::Method::Meta' } ## ------------------------------------------------------------------ ## subroles @@ -482,6 +484,7 @@ sub create { package attributes methods + no_meta version authority )}; @@ -490,10 +493,7 @@ sub create { $meta->_instantiate_module( $options{version}, $options{authority} ); - # FIXME totally lame - $meta->add_method('meta' => sub { - $role->initialize(ref($_[0]) || $_[0]); - }); + $meta->_add_meta_method if !$options{no_meta}; if (exists $options{attributes}) { foreach my $attribute_name (keys %{$options{attributes}}) { diff --git a/xt/author/pod_coverage.t b/xt/author/pod_coverage.t index f6e9a1b..866845f 100644 --- a/xt/author/pod_coverage.t +++ b/xt/author/pod_coverage.t @@ -58,6 +58,7 @@ my %trustme = ( ) ], 'Moose::Meta::Method::Destructor' => [ 'initialize_body', 'options' ], + 'Moose::Meta::Method::Meta' => [ 'wrap' ], 'Moose::Meta::Role' => [ qw( alias_method get_method_modifier_list