From: Dave Rolsky <autarch@urth.org>
Date: Fri, 28 Aug 2009 20:34:20 +0000 (-0500)
Subject: work in progress on getting rt 48985 changes working with moose
X-Git-Tag: 0.90~12
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0385d05e7648ab02440ab32aa0ac3ffd0100a102;p=gitmo%2FMoose.git

work in progress on getting rt 48985 changes working with moose
---

diff --git a/lib/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm
index 8e5ef62..69f111e 100644
--- a/lib/Moose/Meta/Role.pm
+++ b/lib/Moose/Meta/Role.pm
@@ -361,129 +361,8 @@ sub does_role {
     return 0;
 }
 
-## ------------------------------------------------------------------
-## methods
-
-sub get_method_map {
-    my $self = shift;
-
-    my $current = Class::MOP::check_package_cache_flag($self->name);
-
-    if (defined $self->{'_package_cache_flag'} && $self->{'_package_cache_flag'} == $current) {
-        return $self->{'methods'} ||= {};
-    }
-
-    $self->{_package_cache_flag} = $current;
-
-    my $map  = $self->{'methods'} ||= {};
-
-    my $role_name        = $self->name;
-    my $method_metaclass = $self->method_metaclass;
-
-    my $all_code = $self->get_all_package_symbols('CODE');
-
-    foreach my $symbol (keys %{ $all_code }) {
-        my $code = $all_code->{$symbol};
-
-        next if exists  $map->{$symbol} &&
-                defined $map->{$symbol} &&
-                        $map->{$symbol}->body == $code;
-
-        my ($pkg, $name) = Class::MOP::get_code_info($code);
-        my $meta = Class::MOP::class_of($pkg);
-
-        if ($meta && $meta->isa('Moose::Meta::Role')) {
-            my $role = $meta->name;
-            next unless $self->does_role($role);
-        }
-        else {
-            # NOTE:
-            # in 5.10 constant.pm the constants show up
-            # as being in the right package, but in pre-5.10
-            # they show up as constant::__ANON__ so we
-            # make an exception here to be sure that things
-            # work as expected in both.
-            # - SL
-            unless ($pkg eq 'constant' && $name eq '__ANON__') {
-                next if ($pkg  || '') ne $role_name ||
-                        (($name || '') ne '__ANON__' && ($pkg  || '') ne $role_name);
-            }
-        }
-
-        $map->{$symbol} = $method_metaclass->wrap(
-            $code,
-            package_name => $role_name,
-            name         => $name
-        );
-    }
-
-    return $map;
-}
-
-sub get_method {
-    my ($self, $name) = @_;
-    $self->get_method_map->{$name};
-}
-
-sub has_method {
-    my ($self, $name) = @_;
-    exists $self->get_method_map->{$name} ? 1 : 0
-}
-
-# FIXME this is copy-pasted from Class::MOP::Class
-# refactor to inherit from some common base
-sub wrap_method_body {
-    my ( $self, %args ) = @_;
-
-    ('CODE' eq ref $args{body})
-        || Moose->throw_error("Your code block must be a CODE reference");
-
-    $self->method_metaclass->wrap(
-        package_name => $self->name,
-        %args,
-    );
-}
-
-sub add_method {
-    my ($self, $method_name, $method) = @_;
-    (defined $method_name && $method_name)
-    || Moose->throw_error("You must define a method name");
-
-    my $body;
-    if (blessed($method)) {
-        $body = $method->body;
-        if ($method->package_name ne $self->name) {
-            $method = $method->clone(
-                package_name => $self->name,
-                name         => $method_name
-            ) if $method->can('clone');
-        }
-    }
-    else {
-        $body = $method;
-        $method = $self->wrap_method_body( body => $body, name => $method_name );
-    }
-
-    $method->attach_to_class($self);
-
-    $self->get_method_map->{$method_name} = $method;
-
-    my $full_method_name = ($self->name . '::' . $method_name);
-    $self->add_package_symbol(
-        { sigil => '&', type => 'CODE', name => $method_name },
-        subname($full_method_name => $body)
-    );
-
-    $self->update_package_cache_flag; # still valid, since we just added the method to the map, and if it was invalid before that then get_method_map updated it
-}
-
 sub find_method_by_name { (shift)->get_method(@_) }
 
-sub get_method_list {
-    my $self = shift;
-    grep { !/^meta$/ } keys %{$self->get_method_map};
-}
-
 sub alias_method {
     Carp::cluck("The alias_method method is deprecated. Use add_method instead.\n");
 
@@ -914,8 +793,6 @@ L<Moose::Meta::Role::Method>.
 
 =item B<< $metarole->get_method_list >>
 
-=item B<< $metarole->get_method_map >>
-
 =item B<< $metarole->find_method_by_name($name) >>
 
 These methods are all identical to the methods of the same name in
diff --git a/lib/Moose/Meta/Role/Application/ToRole.pm b/lib/Moose/Meta/Role/Application/ToRole.pm
index eae329b..8c86051 100644
--- a/lib/Moose/Meta/Role/Application/ToRole.pm
+++ b/lib/Moose/Meta/Role/Application/ToRole.pm
@@ -73,6 +73,7 @@ sub apply_attributes {
 sub apply_methods {
     my ($self, $role1, $role2) = @_;
     foreach my $method_name ($role1->get_method_list) {
+        next if $method_name eq 'meta';
 
         unless ( $self->is_method_excluded($method_name) ) {
             if (   $role2->has_method($method_name)
diff --git a/lib/Moose/Meta/Role/Composite.pm b/lib/Moose/Meta/Role/Composite.pm
index bb21545..528747e 100644
--- a/lib/Moose/Meta/Role/Composite.pm
+++ b/lib/Moose/Meta/Role/Composite.pm
@@ -25,8 +25,8 @@ __PACKAGE__->meta->add_attribute('name' => (reader => 'name'));
 # package to store our methods in,
 # we use a HASH ref instead.
 # - SL
-__PACKAGE__->meta->add_attribute('methods' => (
-    reader  => 'get_method_map',
+__PACKAGE__->meta->add_attribute('_methods' => (
+    reader  => '_method_map',
     default => sub { {} }
 ));
 
@@ -95,7 +95,24 @@ sub add_method {
         $method = $self->wrap_method_body( body => $body, name => $method_name );
     }
 
-    $self->get_method_map->{$method_name} = $method;
+    $self->_method_map->{$method_name} = $method;
+}
+
+sub get_method_list {
+    my $self = shift;
+    return keys %{ $self->_method_map };
+}
+
+sub has_method {
+    my ($self, $method_name) = @_;
+
+    return exists $self->_method_map->{$method_name};
+}
+
+sub get_method {
+    my ($self, $method_name) = @_;
+
+    return $self->_method_map->{$method_name};
 }
 
 sub apply_params {