X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FClass.pm;h=400ddd3b741387c7c560057b07d565148301b46e;hb=5e57b7e6c595e4d4d893bda929beea1ee92f4c45;hp=3bf20ef1007312f0f5971ec6c58ccff6e5bba8e9;hpb=a142dd51c410623246cb36d5e5f718a6a22efea4;p=gitmo%2FClass-MOP.git

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 3bf20ef..400ddd3 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -11,10 +11,10 @@ use Class::MOP::Method::Constructor;
 
 use Carp         'confess';
 use Scalar::Util 'blessed', 'reftype', 'weaken';
-use Sub::Name 'subname';
+use Sub::Name    'subname';
 use Devel::GlobalDestruction 'in_global_destruction';
 
-our $VERSION   = '0.89';
+our $VERSION   = '0.91';
 $VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
@@ -343,16 +343,12 @@ sub create {
 
 sub get_attribute_map        { $_[0]->{'attributes'}                  }
 sub attribute_metaclass      { $_[0]->{'attribute_metaclass'}         }
-sub method_metaclass         { $_[0]->{'method_metaclass'}            }
-sub wrapped_method_metaclass { $_[0]->{'wrapped_method_metaclass'}    }
 sub instance_metaclass       { $_[0]->{'instance_metaclass'}          }
 sub immutable_trait          { $_[0]->{'immutable_trait'}             }
 sub constructor_class        { $_[0]->{'constructor_class'}           }
 sub constructor_name         { $_[0]->{'constructor_name'}            }
 sub destructor_class         { $_[0]->{'destructor_class'}            }
 
-sub _method_map              { $_[0]->{'methods'}                     }
-
 # Instance Construction & Cloning
 
 sub new_object {
@@ -596,56 +592,6 @@ sub class_precedence_list {
 
 ## Methods
 
-sub wrap_method_body {
-    my ( $self, %args ) = @_;
-
-    ('CODE' eq ref $args{body})
-        || confess "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)
-        || confess "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');
-        }
-
-        $method->attach_to_class($self);
-        $self->_method_map->{$method_name} = $method;
-    }
-    else {
-        # If a raw code reference is supplied, its method object is not created.
-        # The method object won't be created until required.
-        $body = $method;
-    }
-
-
-    my ( $current_package, $current_name ) = Class::MOP::get_code_info($body);
-
-    if ( !defined $current_name || $current_name eq '__ANON__' ) {
-        my $full_method_name = ($self->name . '::' . $method_name);
-        subname($full_method_name => $body);
-    }
-
-    $self->add_package_symbol(
-        { sigil => '&', type => 'CODE', name => $method_name },
-        $body,
-    );
-}
-
 {
     my $fetch_and_prepare_method = sub {
         my ($self, $method_name) = @_;
@@ -662,12 +608,17 @@ sub add_method {
             # and now make sure to wrap it
             # even if it is already wrapped
             # because we need a new sub ref
-            $method = $wrapped_metaclass->wrap($method);
+            $method = $wrapped_metaclass->wrap($method,
+                package_name => $self->name,
+                name         => $method_name,
+            );
         }
         else {
             # now make sure we wrap it properly
-            $method = $wrapped_metaclass->wrap($method)
-                unless $method->isa($wrapped_metaclass);
+            $method = $wrapped_metaclass->wrap($method,
+                package_name => $self->name,
+                name         => $method_name,
+            ) unless $method->isa($wrapped_metaclass);
         }
         $self->add_method($method_name => $method);
         return $method;
@@ -723,77 +674,6 @@ sub alias_method {
     shift->add_method(@_);
 }
 
-sub _code_is_mine {
-    my ( $self, $code ) = @_;
-
-    my ( $code_package, $code_name ) = Class::MOP::get_code_info($code);
-
-    return $code_package && $code_package eq $self->name
-        || ( $code_package eq 'constant' && $code_name eq '__ANON__' );
-}
-
-sub has_method {
-    my ($self, $method_name) = @_;
-    (defined $method_name && $method_name)
-        || confess "You must define a method name";
-
-    return defined($self->get_method($method_name));
-}
-
-sub get_method {
-    my ($self, $method_name) = @_;
-    (defined $method_name && $method_name)
-        || confess "You must define a method name";
-
-    my $method_map    = $self->_method_map;
-    my $method_object = $method_map->{$method_name};
-    my $code = $self->get_package_symbol({
-        name  => $method_name,
-        sigil => '&',
-        type  => 'CODE',
-    });
-
-    unless ( $method_object && $method_object->body == ( $code || 0 ) ) {
-        if ( $code && $self->_code_is_mine($code) ) {
-            $method_object = $method_map->{$method_name}
-                = $self->wrap_method_body(
-                body                 => $code,
-                name                 => $method_name,
-                associated_metaclass => $self,
-                );
-        }
-        else {
-            delete $method_map->{$method_name};
-            return undef;
-        }
-    }
-
-    return $method_object;
-}
-
-sub remove_method {
-    my ($self, $method_name) = @_;
-    (defined $method_name && $method_name)
-        || confess "You must define a method name";
-
-    my $removed_method = delete $self->get_method_map->{$method_name};
-    
-    $self->remove_package_symbol(
-        { sigil => '&', type => 'CODE', name => $method_name }
-    );
-
-    $removed_method->detach_from_class if $removed_method;
-
-    $self->update_package_cache_flag; # still valid, since we just removed the method from the map
-
-    return $removed_method;
-}
-
-sub get_method_list {
-    my $self = shift;
-    return grep { $self->has_method($_) } keys %{ $self->namespace };
-}
-
 sub find_method_by_name {
     my ($self, $method_name) = @_;
     (defined $method_name && $method_name)
@@ -1547,50 +1427,14 @@ include indirect subclasses.
 
 =back
 
-=head2 Method introspection and creation
-
-These methods allow you to introspect a class's methods, as well as
-add, remove, or change methods.
+=head2 Method introspection
 
-Determining what is truly a method in a Perl 5 class requires some
-heuristics (aka guessing).
-
-Methods defined outside the package with a fully qualified name (C<sub
-Package::name { ... }>) will be included. Similarly, methods named
-with a fully qualified name using L<Sub::Name> are also included.
-
-However, we attempt to ignore imported functions.
-
-Ultimately, we are using heuristics to determine what truly is a
-method in a class, and these heuristics may get the wrong answer in
-some edge cases. However, for most "normal" cases the heuristics work
-correctly.
+See L<Class::MOP::Package/Method introspection and creation> for
+methods that operate only on the current class.  Class::MOP::Class adds
+introspection capabilities that take inheritance into account.
 
 =over 4
 
-=item B<< $metaclass->get_method($method_name) >>
-
-This will return a L<Class::MOP::Method> for the specified
-C<$method_name>. If the class does not have the specified method, it
-returns C<undef>
-
-=item B<< $metaclass->has_method($method_name) >>
-
-Returns a boolean indicating whether or not the class defines the
-named method. It does not include methods inherited from parent
-classes.
-
-=item B<< $metaclass->get_method_map >>
-
-Returns a hash reference representing the methods defined in this
-class. The keys are method names and the values are
-L<Class::MOP::Method> objects.
-
-=item B<< $metaclass->get_method_list >>
-
-This will return a list of method I<names> for all methods defined in
-this class.
-
 =item B<< $metaclass->get_all_methods >>
 
 This will traverse the inheritance hierarchy and return a list of all
@@ -1628,38 +1472,6 @@ This method returns the first method in any superclass matching the
 given name. It is effectively the method that C<SUPER::$method_name>
 would dispatch to.
 
-=item B<< $metaclass->add_method($method_name, $method) >>
-
-This method takes a method name and a subroutine reference, and adds
-the method to the class.
-
-The subroutine reference can be a L<Class::MOP::Method>, and you are
-strongly encouraged to pass a meta method object instead of a code
-reference. If you do so, that object gets stored as part of the
-class's method map directly. If not, the meta information will have to
-be recreated later, and may be incorrect.
-
-If you provide a method object, this method will clone that object if
-the object's package name does not match the class name. This lets us
-track the original source of any methods added from other classes
-(notably Moose roles).
-
-=item B<< $metaclass->remove_method($method_name) >>
-
-Remove the named method from the class. This method returns the
-L<Class::MOP::Method> object for the method.
-
-=item B<< $metaclass->method_metaclass >>
-
-Returns the class name of the method metaclass, see
-L<Class::MOP::Method> for more information on the method metaclass.
-
-=item B<< $metaclass->wrapped_method_metaclass >>
-
-Returns the class name of the wrapped method metaclass, see
-L<Class::MOP::Method::Wrapped> for more information on the wrapped
-method metaclass.
-
 =back
 
 =head2 Attribute introspection and creation