0.18 ... pretty much ready to go
[gitmo/Moose.git] / lib / Moose / Meta / Class.pm
index 5ea4b61..1dc36aa 100644 (file)
@@ -9,7 +9,10 @@ use Class::MOP;
 use Carp         'confess';
 use Scalar::Util 'weaken', 'blessed', 'reftype';
 
-our $VERSION = '0.07';
+our $VERSION   = '0.10';
+our $AUTHORITY = 'cpan:STEVAN';
+
+use Moose::Meta::Method::Overriden;
 
 use base 'Class::MOP::Class';
 
@@ -22,8 +25,9 @@ sub initialize {
     my $class = shift;
     my $pkg   = shift;
     $class->SUPER::initialize($pkg,
-        ':attribute_metaclass' => 'Moose::Meta::Attribute', 
-        ':instance_metaclass'  => 'Moose::Meta::Instance', 
+        'attribute_metaclass' => 'Moose::Meta::Attribute', 
+        'method_metaclass'    => 'Moose::Meta::Method',
+        'instance_metaclass'  => 'Moose::Meta::Instance', 
         @_);
 }  
 
@@ -99,7 +103,7 @@ sub construct_instance {
 # This is ugly
 sub get_method_map {    
     my $self = shift;
-    my $map  = $self->{'%:methods'}; 
+    my $map  = $self->{'%!methods'}; 
     
     my $class_name       = $self->name;
     my $method_metaclass = $self->method_metaclass;
@@ -115,7 +119,7 @@ sub get_method_map {
         my $gv = B::svref_2object($code)->GV;
         
         my $pkg = $gv->STASH->NAME;
-        if ($pkg->can('meta') && $pkg->meta->isa('Moose::Meta::Role')) {
+        if ($pkg->can('meta') && $pkg->meta && $pkg->meta->isa('Moose::Meta::Role')) {
             #my $role = $pkg->meta->name;
             #next unless $self->does_role($role);
         }
@@ -130,25 +134,6 @@ sub get_method_map {
     return $map;
 }
 
-#sub find_method_by_name {
-#    my ($self, $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;
-#    foreach my $class ($self->class_precedence_list()) {
-#        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);
-#    }
-#}
-
 ### ---------------------------------------------
 
 sub add_attribute {
@@ -228,13 +213,18 @@ sub _fix_metaclass_incompatability {
     foreach my $super (@superclasses) {
         # don't bother if it does not have a meta.
         next unless $super->can('meta');
+        # get the name, make sure we take 
+        # immutable classes into account
+        my $super_meta_name = ($super->meta->is_immutable 
+                                ? $super->meta->get_mutable_metaclass_name
+                                : blessed($super->meta));
         # if it's meta is a vanilla Moose, 
-        # then we can safely ignore it.
-        next if blessed($super->meta) eq 'Moose::Meta::Class';
+        # then we can safely ignore it.        
+        next if $super_meta_name eq 'Moose::Meta::Class';
         # but if we have anything else, 
         # we need to check it out ...
         unless (# see if of our metaclass is incompatible
-                ($self->isa(blessed($super->meta)) &&
+                ($self->isa($super_meta_name) &&
                  # and see if our instance metaclass is incompatible
                  $self->instance_metaclass->isa($super->meta->instance_metaclass)) &&
                 # ... and if we are just a vanilla Moose
@@ -249,9 +239,9 @@ sub _fix_metaclass_incompatability {
             # at this point anyway, so it's very 
             # much an obscure edge case anyway
             $self = $super_meta->reinitialize($self->name => (
-                ':attribute_metaclass' => $super_meta->attribute_metaclass,                            
-                ':method_metaclass'    => $super_meta->method_metaclass,
-                ':instance_metaclass'  => $super_meta->instance_metaclass,
+                'attribute_metaclass' => $super_meta->attribute_metaclass,                            
+                'method_metaclass'    => $super_meta->method_metaclass,
+                'instance_metaclass'  => $super_meta->instance_metaclass,
             ));
         }
     }
@@ -285,7 +275,7 @@ sub _process_attribute {
     }
     else {
         if ($options{metaclass}) {
-            Moose::_load_all_classes($options{metaclass});
+            Class::MOP::load_class($options{metaclass});
             $self->add_attribute($options{metaclass}->new($name, %options));
         }
         else {
@@ -313,14 +303,57 @@ sub _process_inherited_attribute {
     return $new_attr;
 }
 
-package Moose::Meta::Method::Overriden;
-
-use strict;
-use warnings;
-
-our $VERSION = '0.01';
-
-use base 'Class::MOP::Method';
+## -------------------------------------------------
+
+use Moose::Meta::Method::Constructor;
+use Moose::Meta::Method::Destructor;
+
+{
+    # NOTE:
+    # the immutable version of a 
+    # particular metaclass is 
+    # really class-level data so 
+    # we don't want to regenerate 
+    # it any more than we need to
+    my $IMMUTABLE_METACLASS;
+    sub make_immutable {
+        my $self = shift;
+        
+        $IMMUTABLE_METACLASS ||= Class::MOP::Immutable->new($self, {
+            read_only   => [qw/superclasses/],
+            cannot_call => [qw/
+                add_method
+                alias_method
+                remove_method
+                add_attribute
+                remove_attribute
+                add_package_symbol
+                remove_package_symbol            
+                add_role
+            /],
+            memoize     => {
+                class_precedence_list             => 'ARRAY',
+                compute_all_applicable_attributes => 'ARRAY',            
+                get_meta_instance                 => 'SCALAR',     
+                get_method_map                    => 'SCALAR', 
+                # maybe ....
+                calculate_all_roles               => 'ARRAY',    
+            }
+        });   
+        
+        $IMMUTABLE_METACLASS->make_metaclass_immutable(
+            $self,
+            constructor_class => 'Moose::Meta::Method::Constructor',
+            destructor_class  => 'Moose::Meta::Method::Destructor',            
+            inline_destructor => 1,
+            # NOTE: 
+            # no need to do this, 
+            # Moose always does it
+            inline_accessors  => 0,
+            @_,
+        )     
+    }
+}
 
 1;
 
@@ -348,6 +381,8 @@ to the L<Class::MOP::Class> documentation.
 
 =item B<initialize>
 
+=item B<make_immutable>
+
 =item B<new_object>
 
 We override this method to support the C<trigger> attribute option.
@@ -420,7 +455,7 @@ Stevan Little E<lt>stevan@iinteractive.comE<gt>
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright 2006 by Infinity Interactive, Inc.
+Copyright 2006, 2007 by Infinity Interactive, Inc.
 
 L<http://www.iinteractive.com>