X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FPackage.pm;h=36e3dbd57543874e01f619d1cb6064a47bf60e00;hb=41ffa8a4aa857c1af10e51521b1b37c7d33826c8;hp=6cb2e1b9ff5a197fa02999ef6b731442ca332d20;hpb=26159d550061b6c3865a88c3fe6afd4ac4565d92;p=gitmo%2FClass-MOP.git

diff --git a/lib/Class/MOP/Package.pm b/lib/Class/MOP/Package.pm
index 6cb2e1b..36e3dbd 100644
--- a/lib/Class/MOP/Package.pm
+++ b/lib/Class/MOP/Package.pm
@@ -4,11 +4,10 @@ package Class::MOP::Package;
 use strict;
 use warnings;
 
-use B;
-use Scalar::Util 'blessed';
+use Scalar::Util 'blessed', 'reftype';
 use Carp         'confess';
 
-our $VERSION   = '0.83';
+our $VERSION   = '0.90';
 $VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
@@ -59,18 +58,26 @@ sub reinitialize {
 
 sub _new {
     my $class = shift;
-    my $options = @_ == 1 ? $_[0] : {@_};
 
-    # NOTE:
-    # because of issues with the Perl API 
-    # to the typeglob in some versions, we 
-    # need to just always grab a new 
-    # reference to the hash in the accessor. 
-    # Ideally we could just store a ref and 
-    # it would Just Work, but oh well :\
-    $options->{namespace} ||= \undef;
+    return Class::MOP::Class->initialize($class)->new_object(@_)
+        if $class ne __PACKAGE__;
+
+    my $params = @_ == 1 ? $_[0] : {@_};
+
+    return bless {
+        package   => $params->{package},
+
+        # NOTE:
+        # because of issues with the Perl API
+        # to the typeglob in some versions, we
+        # need to just always grab a new
+        # reference to the hash in the accessor.
+        # Ideally we could just store a ref and
+        # it would Just Work, but oh well :\
 
-    bless $options, $class;
+        namespace => \undef,
+
+    } => $class;
 }
 
 # Attributes
@@ -146,34 +153,31 @@ sub remove_package_glob {
 # ... these functions deal with stuff on the namespace level
 
 sub has_package_symbol {
-    my ($self, $variable) = @_;
+    my ( $self, $variable ) = @_;
 
-    my ($name, $sigil, $type) = ref $variable eq 'HASH'
+    my ( $name, $sigil, $type )
+        = ref $variable eq 'HASH'
         ? @{$variable}{qw[name sigil type]}
         : $self->_deconstruct_variable_name($variable);
-    
+
     my $namespace = $self->namespace;
-    
-    return 0 unless exists $namespace->{$name};   
-    
-    # FIXME:
-    # For some really stupid reason 
-    # a typeglob will have a default
-    # value of \undef in the SCALAR 
-    # slot, so we need to work around
-    # this. Which of course means that 
-    # if you put \undef in your scalar
-    # then this is broken.
-
-    if (ref($namespace->{$name}) eq 'SCALAR') {
-        return ($type eq 'CODE');
-    }
-    elsif ($type eq 'SCALAR') {    
-        my $val = *{$namespace->{$name}}{$type};
-        return defined(${$val});
+
+    return 0 unless exists $namespace->{$name};
+
+    my $entry_ref = \$namespace->{$name};
+    if ( reftype($entry_ref) eq 'GLOB' ) {
+        if ( $type eq 'SCALAR' ) {
+            return defined( ${ *{$entry_ref}{SCALAR} } );
+        }
+        else {
+            return defined( *{$entry_ref}{$type} );
+        }
     }
     else {
-        defined(*{$namespace->{$name}}{$type});
+
+        # a symbol table entry can be -1 (stub), string (stub with prototype),
+        # or reference (constant)
+        return $type eq 'CODE';
     }
 }
 
@@ -186,21 +190,24 @@ sub get_package_symbol {
 
     my $namespace = $self->namespace;
 
+    # FIXME
     $self->add_package_symbol($variable)
         unless exists $namespace->{$name};
 
-    if (ref($namespace->{$name}) eq 'SCALAR') {
-        if ($type eq 'CODE') {
+    my $entry_ref = \$namespace->{$name};
+
+    if ( ref($entry_ref) eq 'GLOB' ) {
+        return *{$entry_ref}{$type};
+    }
+    else {
+        if ( $type eq 'CODE' ) {
             no strict 'refs';
-            return \&{$self->name.'::'.$name};
+            return \&{ $self->name . '::' . $name };
         }
         else {
             return undef;
         }
     }
-    else {
-        return *{$namespace->{$name}}{$type};
-    }
 }
 
 sub remove_package_symbol {