immutable refacotring

[gitmo/Class-MOP.git] / lib / Class / MOP / Class.pm

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 2501688..96d1402 100644 (file)
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -4,18 +4,19 @@ package Class::MOP::Class;
 use strict;
 use warnings;
 
+use Class::MOP::Instance;
+use Class::MOP::Method::Wrapped;
+
 use Carp         'confess';
 use Scalar::Util 'blessed', 'reftype', 'weaken';
 use Sub::Name    'subname';
 use B            'svref_2object';
 
-our $VERSION   = '0.19';
+our $VERSION   = '0.21';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Class::MOP::Module';
 
-use Class::MOP::Instance;
-
 # Self-introspection 
 
 sub meta { Class::MOP::Class->initialize(blessed($_[0]) || $_[0]) }
@@ -69,7 +70,6 @@ sub construct_class_instance {
                         : blessed($class))
                     : $class);
 
-    $class = blessed($class) || $class;
     # now create the metaclass
     my $meta;
     if ($class =~ /^Class::MOP::Class$/) {
@@ -173,6 +173,7 @@ sub check_metaclass_compatability {
 
     sub is_anon_class {
         my $self = shift;
+        no warnings 'uninitialized';
         $self->name =~ /^$ANON_CLASS_PREFIX/ ? 1 : 0;        
     }
 
@@ -190,6 +191,7 @@ sub check_metaclass_compatability {
     # really need to be handled explicitly
     sub DESTROY {
         my $self = shift;
+        no warnings 'uninitialized';        
         return unless $self->name =~ /^$ANON_CLASS_PREFIX/;
         my ($serial_id) = ($self->name =~ /^$ANON_CLASS_PREFIX(\d+)/);
         no strict 'refs';     
@@ -274,7 +276,9 @@ sub get_method_map {
     foreach my $symbol ($self->list_all_package_symbols('CODE')) {
         my $code = $self->get_package_symbol('&' . $symbol);
         
-        next if exists $map->{$symbol} && $map->{$symbol}->body == $code;        
+        next if exists  $map->{$symbol} && 
+                defined $map->{$symbol} && 
+                        $map->{$symbol}->body == $code;        
         
         my $gv = svref_2object($code)->GV;
         next if ($gv->STASH->NAME || '') ne $class_name &&
@@ -413,7 +417,7 @@ sub add_method {
             $method = $self->find_next_method_by_name($method_name);
             # die if it does not exist
             (defined $method)
-                || confess "The method '$method_name' is not found in the inherience hierarchy for this class";
+                || confess "The method '$method_name' is not found in the inherience hierarchy for class " . $self->name;
             # and now make sure to wrap it 
             # even if it is already wrapped
             # because we need a new sub ref
@@ -523,8 +527,23 @@ sub get_method_list {
 
 sub find_method_by_name {
     my ($self, $method_name) = @_;
-    # FIXME
-    return $self->name->can($method_name);
+    (defined $method_name && $method_name)
+        || confess "You must define a method name to find"; 
+    # keep a record of what we have seen
+    # here, this will handle all the 
+    # inheritence issues because we are 
+    # using the &class_precedence_list
+    my %seen_class;
+    my @cpl = $self->class_precedence_list();
+    foreach my $class (@cpl) {
+        next if $seen_class{$class};
+        $seen_class{$class}++;
+        # fetch the meta-class ...
+        my $meta = $self->initialize($class);
+        return $meta->get_method($method_name) 
+            if $meta->has_method($method_name);
+    }
+    return;
 }
 
 sub compute_all_applicable_methods {
@@ -609,7 +628,20 @@ sub add_attribute {
     # make sure it is derived from the correct type though
     ($attribute->isa('Class::MOP::Attribute'))
         || confess "Your attribute must be an instance of Class::MOP::Attribute (or a subclass)";    
+
+    # first we attach our new attribute
+    # because it might need certain information 
+    # about the class which it is attached to
     $attribute->attach_to_class($self);
+    
+    # then we remove attributes of a conflicting 
+    # name here so that we can properly detach 
+    # the old attr object, and remove any 
+    # accessors it would have generated
+    $self->remove_attribute($attribute->name)
+        if $self->has_attribute($attribute->name);
+        
+    # then onto installing the new accessors
     $attribute->install_accessors();
     $self->get_attribute_map->{$attribute->name} = $attribute;
 }
@@ -626,8 +658,10 @@ sub get_attribute {
     (defined $attribute_name && $attribute_name)
         || confess "You must define an attribute name";
     return $self->get_attribute_map->{$attribute_name} 
-        if $self->has_attribute($attribute_name);   
-    return; 
+    # NOTE:
+    # this will return undef anyway, so no need ...
+    #    if $self->has_attribute($attribute_name);   
+    #return; 
 } 
 
 sub remove_attribute {
@@ -994,8 +1028,11 @@ C<$method_name> is actually a method. However, it will DWIM about
 
 =item B<get_method ($method_name)>
 
-This will return a CODE reference of the specified C<$method_name>, 
-or return undef if that method does not exist.
+This will return a Class::MOP::Method instance related to the specified 
+C<$method_name>, or return undef if that method does not exist.
+
+The Class::MOP::Method is codifiable, so you can use it like a normal 
+CODE reference, see L<Class::MOP::Method> for more information.
 
 =item B<find_method_by_name ($method_name>
 
@@ -1173,6 +1210,11 @@ It should be noted that any accessor, reader/writer or predicate
 methods which the C<$attribute_meta_object> has will be installed 
 into the class at this time.
 
+B<NOTE>
+If an attribute already exists for C<$attribute_name>, the old one 
+will be removed (as well as removing all it's accessors), and then 
+the new one added.
+
 =item B<has_attribute ($attribute_name)>
 
 Checks to see if this class has an attribute by the name of