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 (file)
--- 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 (file)
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<meta> methods
+
+=head1 DESCRIPTION
+
+This class is a subclass of L<Class::MOP::Method::Meta> that
+provides additional Moose-specific functionality, all of which is
+private.
+
+To understand this class, you should read the the
+L<Class::MOP::Method::Meta> documentation.
+
+=head1 BUGS
+
+See L<Moose/BUGS> for details on reporting bugs.
+
+=head1 AUTHOR
+
+Jesse Luehrs E<lt>doy at tozt dot net<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006-2010 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+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 (file)
--- 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 (file)
--- 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