X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FClass.pm;h=b2cb51d9e665aca776a84672703039d0c4e5ceeb;hb=9d6dce77cd867d92c418eb4fcfd199eaca6efc10;hp=8625e3601c6e565e743dbbabb314aa9fbaa09a7b;hpb=373a16aed9249f13e466532ef9a840b92a61f173;p=gitmo%2FClass-MOP.git

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 8625e36..b2cb51d 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -9,7 +9,7 @@ use Scalar::Util 'blessed', 'reftype', 'weaken';
 use Sub::Name    'subname';
 use B            'svref_2object';
 
-our $VERSION = '0.15';
+our $VERSION = '0.17';
 
 use base 'Class::MOP::Module';
 
@@ -93,7 +93,7 @@ my $ANON_CLASS_PREFIX = 'Class::MOP::Class::__ANON__::SERIAL::';
         $class = blessed($class) || $class;
         # now create the metaclass
         my $meta;
-        if ($class =~ /^Class::MOP::/) {    
+        if ($class =~ /^Class::MOP::Class$/) {    
             $meta = bless { 
                 '$:package'             => $package_name, 
                 '%:attributes'          => {},
@@ -299,10 +299,9 @@ sub clone_instance {
 
 sub superclasses {
     my $self = shift;
-    no strict 'refs';
     if (@_) {
         my @supers = @_;
-        @{$self->name . '::ISA'} = @supers;
+        @{$self->get_package_symbol('@ISA')} = @supers;
         # NOTE:
         # we need to check the metaclass 
         # compatability here so that we can 
@@ -311,7 +310,7 @@ sub superclasses {
         # we don't know about
         $self->check_metaclass_compatability();
     }
-    @{$self->name . '::ISA'};
+    @{$self->get_package_symbol('@ISA')};
 }
 
 sub class_precedence_list {
@@ -342,11 +341,11 @@ sub add_method {
         || confess "Your code block must be a CODE reference";
     my $full_method_name = ($self->name . '::' . $method_name);    
 
+    # FIXME:
+    # dont bless subs, its bad mkay
     $method = $self->method_metaclass->wrap($method) unless blessed($method);
     
-    no strict 'refs';
-    no warnings 'redefine';
-    *{$full_method_name} = subname $full_method_name => $method;
+    $self->add_package_symbol("&${method_name}" => subname $full_method_name => $method);
 }
 
 {
@@ -420,31 +419,33 @@ sub alias_method {
     # use reftype here to allow for blessed subs ...
     ('CODE' eq (reftype($method) || ''))
         || confess "Your code block must be a CODE reference";
-    my $full_method_name = ($self->name . '::' . $method_name);
 
+    # FIXME:
+    # dont bless subs, its bad mkay
     $method = $self->method_metaclass->wrap($method) unless blessed($method);    
         
-    no strict 'refs';
-    no warnings 'redefine';
-    *{$full_method_name} = $method;
+    $self->add_package_symbol("&${method_name}" => $method);
+}
+
+sub find_method_by_name {
+    my ($self, $method_name) = @_;
+    return $self->name->can($method_name);
 }
 
 sub has_method {
     my ($self, $method_name) = @_;
     (defined $method_name && $method_name)
         || confess "You must define a method name";    
-
-    my $sub_name = ($self->name . '::' . $method_name);   
     
-    no strict 'refs';
-    return 0 if !defined(&{$sub_name});        
-    my $method = \&{$sub_name};
+    return 0 if !$self->has_package_symbol("&${method_name}");        
+    my $method = $self->get_package_symbol("&${method_name}");
     return 0 if (svref_2object($method)->GV->STASH->NAME || '') ne $self->name &&
                 (svref_2object($method)->GV->NAME || '')        ne '__ANON__';      
-    
-    # at this point we are relatively sure 
-    # it is our method, so we bless/wrap it 
+
+    # FIXME:
+    # dont bless subs, its bad mkay
     $self->method_metaclass->wrap($method) unless blessed($method);
+    
     return 1;
 }
 
@@ -454,9 +455,8 @@ sub get_method {
         || confess "You must define a method name";
 
     return unless $self->has_method($method_name);
-
-    no strict 'refs';    
-    return \&{$self->name . '::' . $method_name};
+ 
+    return $self->get_package_symbol("&${method_name}");
 }
 
 sub remove_method {
@@ -466,8 +466,7 @@ sub remove_method {
     
     my $removed_method = $self->get_method($method_name);    
     
-    no strict 'refs';
-    delete ${$self->name . '::'}{$method_name}
+    $self->remove_package_symbol("&${method_name}")
         if defined $removed_method;
         
     return $removed_method;
@@ -475,8 +474,7 @@ sub remove_method {
 
 sub get_method_list {
     my $self = shift;
-    no strict 'refs';
-    grep { $self->has_method($_) } keys %{$self->name . '::'};
+    grep { $self->has_method($_) } $self->list_all_package_symbols;
 }
 
 sub compute_all_applicable_methods {
@@ -564,9 +562,6 @@ sub add_attribute {
     $attribute->attach_to_class($self);
     $attribute->install_accessors();
     $self->get_attribute_map->{$attribute->name} = $attribute;
-
-	# FIXME
-	# in theory we have to tell everyone the slot structure may have changed
 }
 
 sub has_attribute {
@@ -964,6 +959,13 @@ C<$method_name> is actually a method. However, it will DWIM about
 This will return a CODE reference of the specified C<$method_name>, 
 or return undef if that method does not exist.
 
+=item B<find_method_by_name ($method_name>
+
+This will return a CODE reference of the specified C<$method_name>,
+or return undef if that method does not exist.
+
+Unlike C<get_method> this will also look in the superclasses.
+
 =item B<remove_method ($method_name)>
 
 This will attempt to remove a given C<$method_name> from the class. 
@@ -1227,10 +1229,12 @@ This will attempt to remove the package variable at C<$variable_name>.
 
 =back
 
-=head1 AUTHOR
+=head1 AUTHORS
 
 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 
+Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
+
 =head1 COPYRIGHT AND LICENSE
 
 Copyright 2006 by Infinity Interactive, Inc.