some doc cleanup

[gitmo/Moose.git] / lib / Moose / Meta / Class.pm

diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index c5730ae..f5b4ee1 100644 (file)
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -7,9 +7,9 @@ use warnings;
 use Class::MOP;
 
 use Carp         'confess';
-use Scalar::Util 'weaken', 'blessed', 'reftype';
+use Scalar::Util 'weaken', 'blessed';
 
-our $VERSION   = '0.21';
+our $VERSION   = '0.52';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use Moose::Meta::Method::Overriden;
@@ -25,11 +25,13 @@ __PACKAGE__->meta->add_attribute('roles' => (
 sub initialize {
     my $class = shift;
     my $pkg   = shift;
-    $class->SUPER::initialize($pkg,
-        'attribute_metaclass' => 'Moose::Meta::Attribute',
-        'method_metaclass'    => 'Moose::Meta::Method',
-        'instance_metaclass'  => 'Moose::Meta::Instance',
-        @_);
+    return Class::MOP::get_metaclass_by_name($pkg) 
+        || $class->SUPER::initialize($pkg,
+                'attribute_metaclass' => 'Moose::Meta::Attribute',
+                'method_metaclass'    => 'Moose::Meta::Method',
+                'instance_metaclass'  => 'Moose::Meta::Instance',
+                @_
+            );    
 }
 
 sub create {
@@ -157,7 +159,7 @@ sub construct_instance {
     # have to kludge it in the end.
     my $instance = $params{'__INSTANCE__'} || $meta_instance->create_instance();
     foreach my $attr ($class->compute_all_applicable_attributes()) {
-        $attr->initialize_instance_slot($meta_instance, $instance, \%params)
+        $attr->initialize_instance_slot($meta_instance, $instance, \%params);
     }
     return $instance;
 }
@@ -177,9 +179,10 @@ sub get_method_map {
     my $class_name       = $self->name;
     my $method_metaclass = $self->method_metaclass;
 
-    foreach my $symbol ($self->list_all_package_symbols('CODE')) {
+    my %all_code = $self->get_all_package_symbols('CODE');
 
-        my $code = $self->get_package_symbol('&' . $symbol);
+    foreach my $symbol (keys %all_code) {
+        my $code = $all_code{$symbol};
 
         next if exists  $map->{$symbol} &&
                 defined $map->{$symbol} &&
@@ -201,12 +204,26 @@ sub get_method_map {
             #next unless $self->does_role($role);
         }
         else {
-            next if ($pkg  || '') ne $class_name &&
-                    ($name || '') ne '__ANON__';
+            
+            # 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 $class_name ||
+                        (($name || '') ne '__ANON__' && ($pkg  || '') ne $class_name);
+            }
 
         }
 
-        $map->{$symbol} = $method_metaclass->wrap($code);
+        $map->{$symbol} = $method_metaclass->wrap(
+            $code,
+            package_name => $class_name,
+            name         => $symbol
+        );
     }
 
     return $map;
@@ -310,36 +327,23 @@ sub _apply_all_roles {
 
 sub _process_attribute {
     my ( $self, $name, @args ) = @_;
-    my %options = ((scalar @args == 1 && ref($args[0]) eq 'HASH') ? %{$args[0]} : @args);
+
+    @args = %{$args[0]} if scalar @args == 1 && ref($args[0]) eq 'HASH';
 
     if ($name =~ /^\+(.*)/) {
-        return $self->_process_inherited_attribute($1, %options);
+        return $self->_process_inherited_attribute($1, @args);
     }
     else {
-        my $attr_metaclass_name = $options{metaclass}
-            ? Moose::Util::resolve_metaclass_alias( Attribute => $options{metaclass} )
-            : $self->attribute_metaclass;
-
-        if (my $traits = $options{traits}) {
-            my @traits = map {
-                Moose::Util::resolve_metatrait_alias( Attribute => $_ )
-                    or
-                $_
-            } @$traits;
-
-            my $class = Moose::Meta::Class->create_anon_class(
-                superclasses => [ $attr_metaclass_name ],
-                roles        => [ @traits ],
-                cache        => 1,
-            );
-
-            $attr_metaclass_name = $class->name;
-        }
-        
-        return $attr_metaclass_name->new($name, %options);
+        return $self->_process_new_attribute($name, @args);
     }
 }
 
+sub _process_new_attribute {
+    my ( $self, $name, @args ) = @_;
+
+    $self->attribute_metaclass->interpolate_class_and_new($name, @args);
+}
+
 sub _process_inherited_attribute {
     my ($self, $attr_name, %options) = @_;
     my $inherited_attr = $self->find_attribute_by_name($attr_name);
@@ -372,7 +376,6 @@ sub create_immutable_transformer {
            remove_method
            add_attribute
            remove_attribute
-           add_package_symbol
            remove_package_symbol
            add_role
        /],
@@ -383,7 +386,19 @@ sub create_immutable_transformer {
            get_method_map                    => 'SCALAR',
            # maybe ....
            calculate_all_roles               => 'ARRAY',
-       }
+       },
+       # NOTE:
+       # this is ugly, but so are typeglobs, 
+       # so whattayahgonnadoboutit
+       # - SL
+       wrapped => { 
+           add_package_symbol => sub {
+               my $original = shift;
+               confess "Cannot add package symbols to an immutable metaclass" 
+                   unless (caller(2))[3] eq 'Class::MOP::Package::get_package_symbol'; 
+               goto $original->body;
+           },
+       },       
     });
     return $class;
 }