From: Jesse Luehrs <doy@tozt.net>
Date: Mon, 27 Sep 2010 08:05:03 +0000 (-0500)
Subject: actually, why not make the meta method renameable
X-Git-Tag: 1.09~9
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=37a46507b7f6a008935b5f26255cda64b3be30ed;p=gitmo%2FClass-MOP.git

actually, why not make the meta method renameable
---

diff --git a/Changes b/Changes
index f9d7223..37a0689 100644
--- a/Changes
+++ b/Changes
@@ -5,7 +5,8 @@ NEXT
   [ENHANCEMENTS]
 
   * It's now possible to tell Class::MOP::Class->create and the metaclass
-    pragma to not install a 'meta' method into classes they manipulate. (doy)
+    pragma to not install a 'meta' method into classes they manipulate,
+    or to install one under a different name. (doy)
 
   * Reinitializing a metaclass no longer removes the existing method and
     attribute objects (it instead fixes them so they are correct for the
diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index 7393ac7..3059968 100644
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -668,13 +668,13 @@ Class::MOP::Instance->meta->add_attribute(
 ## Class::MOP::Object
 
 # need to replace the meta method there with a real meta method object
-Class::MOP::Object->meta->_add_meta_method;
+Class::MOP::Object->meta->_add_meta_method('meta');
 
 ## --------------------------------------------------------
 ## Class::MOP::Mixin
 
 # need to replace the meta method there with a real meta method object
-Class::MOP::Mixin->meta->_add_meta_method;
+Class::MOP::Mixin->meta->_add_meta_method('meta');
 
 require Class::MOP::Deprecated unless our $no_deprecated;
 
diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 96ecf9d..122ed9a 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -504,13 +504,16 @@ sub create {
         || confess "You must pass a HASH ref of methods"
             if exists $options{methods};                  
 
+    $options{meta_name} = 'meta'
+        unless exists $options{meta_name};
+
     my (%initialize_options) = @args;
     delete @initialize_options{qw(
         package
         superclasses
         attributes
         methods
-        no_meta
+        meta_name
         version
         authority
     )};
@@ -518,7 +521,8 @@ sub create {
 
     $meta->_instantiate_module( $options{version}, $options{authority} );
 
-    $meta->_add_meta_method unless $options{no_meta};
+    $meta->_add_meta_method($options{meta_name})
+        if defined $options{meta_name};
 
     $meta->superclasses(@{$options{superclasses}})
         if exists $options{superclasses};
@@ -1436,9 +1440,11 @@ hash reference are method names and values are subroutine references.
 
 An optional array reference of L<Class::MOP::Attribute> objects.
 
-=item * no_meta
+=item * meta_name
 
-If true, a C<meta> method will not be installed into the class.
+Specifies the name to install the C<meta> method for this class under.
+If it is not passed, C<meta> is assumed, and if C<undef> is explicitly
+given, no meta method will be installed.
 
 =back
 
diff --git a/lib/Class/MOP/Mixin/HasMethods.pm b/lib/Class/MOP/Mixin/HasMethods.pm
index 7c62c71..1977d72 100644
--- a/lib/Class/MOP/Mixin/HasMethods.pm
+++ b/lib/Class/MOP/Mixin/HasMethods.pm
@@ -21,14 +21,15 @@ sub _meta_method_class       { 'Class::MOP::Method::Meta'             }
 
 sub _add_meta_method {
     my $self = shift;
+    my ($name) = @_;
     my $existing_method = $self->can('find_method_by_name')
-                              ? $self->find_method_by_name('meta')
-                              : $self->get_method('meta');
+                              ? $self->find_method_by_name($name)
+                              : $self->get_method($name);
     return if $existing_method
            && $existing_method->isa($self->_meta_method_class);
     $self->add_method(
-        'meta' => $self->_meta_method_class->wrap(
-            name                 => 'meta',
+        $name => $self->_meta_method_class->wrap(
+            name                 => $name,
             package_name         => $self->name,
             associated_metaclass => $self,
         )
diff --git a/lib/metaclass.pm b/lib/metaclass.pm
index 192a664..2dee906 100644
--- a/lib/metaclass.pm
+++ b/lib/metaclass.pm
@@ -20,7 +20,7 @@ sub import {
     unshift @args, "metaclass" if @args % 2 == 1;
     my %options = @args;
 
-    my $should_install_meta = !delete $options{no_meta};
+    my $meta_name = exists $options{meta_name} ? $options{meta_name} : 'meta';
     my $metaclass = delete $options{metaclass};
 
     unless ( defined $metaclass ) {
@@ -43,7 +43,8 @@ sub import {
 
     # create a meta object so we can install &meta
     my $meta = $metaclass->initialize($package => %options);
-    $meta->_add_meta_method if $should_install_meta;
+    $meta->_add_meta_method($meta_name)
+        if defined $meta_name;
 }
 
 1;
@@ -83,14 +84,16 @@ metaclass - a pragma for installing and using Class::MOP metaclasses
   );
 
   # if we'd rather not install a 'meta' method, we can do this
-  use metaclass no_meta => 1;
+  use metaclass meta_name => undef;
+  # or if we'd like it to have a different name,
+  use metaclass meta_name => 'my_meta';
 
 =head1 DESCRIPTION
 
 This is a pragma to make it easier to use a specific metaclass
 and a set of custom attribute and method metaclasses. It also
-installs a C<meta> method to your class as well, if the
-C<no_meta> option is not specified.
+installs a C<meta> method to your class as well, unless C<undef>
+is passed to the C<meta_name> option.
 
 =head1 AUTHORS
 
diff --git a/t/049_metaclass_reinitialize.t b/t/049_metaclass_reinitialize.t
index 6cd6fb5..7d8dd50 100644
--- a/t/049_metaclass_reinitialize.t
+++ b/t/049_metaclass_reinitialize.t
@@ -97,7 +97,7 @@ is(Bar->meta->get_attribute('bar')->tset, 'OOF');
 
 {
     package Baz;
-    use metaclass no_meta => 1;
+    use metaclass meta_name => undef;
 
     sub foo {}
     Class::MOP::class_of('Baz')->add_attribute('bar');
diff --git a/t/090_meta_method.t b/t/090_meta_method.t
index 6567f49..774b8b3 100644
--- a/t/090_meta_method.t
+++ b/t/090_meta_method.t
@@ -26,8 +26,25 @@ use Class::MOP;
 
 {
     {
+        package Blarg;
+        use metaclass meta_name => 'blarg';
+    }
+    ok(!Blarg->can('meta'));
+    can_ok('Blarg', 'blarg');
+    isa_ok(Blarg->blarg->find_method_by_name('blarg'),
+           'Class::MOP::Method::Meta');
+
+    my $meta = Class::MOP::Class->create('Blorg', meta_name => 'blorg');
+    ok(!Blorg->can('meta'));
+    can_ok('Blorg', 'blorg');
+    isa_ok(Blorg->blorg->find_method_by_name('blorg'),
+           'Class::MOP::Method::Meta');
+}
+
+{
+    {
         package Foo;
-        use metaclass no_meta => 1;
+        use metaclass meta_name => undef;
     }
 
     my $meta = Class::MOP::class_of('Foo');
@@ -39,7 +56,7 @@ use Class::MOP;
 }
 
 {
-    my $meta = Class::MOP::Class->create('Bar', no_meta => 1);
+    my $meta = Class::MOP::Class->create('Bar', meta_name => undef);
     ok(!$meta->has_method('meta'), "no meta method was installed");
     $meta->add_method(meta => sub { die 'META' });
     lives_ok { $meta->find_method_by_name('meta') } "can do meta-level stuff";