0.42

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

diff --git a/lib/Class/MOP/Package.pm b/lib/Class/MOP/Package.pm
index 2e507fe..3020727 100644 (file)
--- a/lib/Class/MOP/Package.pm
+++ b/lib/Class/MOP/Package.pm
@@ -7,7 +7,7 @@ use warnings;
 use Scalar::Util 'blessed';
 use Carp         'confess';
 
-our $VERSION   = '0.05';
+our $VERSION   = '0.07';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Class::MOP::Object';
@@ -28,7 +28,7 @@ sub initialize {
     # until we can bootstrap it
     no strict 'refs';
     return bless { 
-        '$:package'   => $package_name,
+        '$!package'   => $package_name,
         # NOTE:
         # because of issues with the Perl API 
         # to the typeglob in some versions, we 
@@ -36,7 +36,7 @@ sub initialize {
         # reference to the hash in the accessor. 
         # Ideally we could just store a ref and 
         # it would Just Work, but oh well :\
-        '%:namespace' => \undef,
+        '%!namespace' => \undef,
     } => $class;
 }
 
@@ -46,7 +46,7 @@ sub initialize {
 # all these attribute readers will be bootstrapped 
 # away in the Class::MOP bootstrap section
 
-sub name      { $_[0]->{'$:package'}   }
+sub name      { $_[0]->{'$!package'}   }
 sub namespace { 
     # NOTE:
     # because of issues with the Perl API 
@@ -124,10 +124,13 @@ sub has_package_symbol {
     # this. Which of course means that 
     # if you put \undef in your scalar
     # then this is broken.
-    
-    if ($type eq 'SCALAR') {    
+
+    if (ref($self->namespace->{$name}) eq 'SCALAR') {
+        return ($type eq 'CODE' ? 1 : 0);
+    }
+    elsif ($type eq 'SCALAR') {    
         my $val = *{$self->namespace->{$name}}{$type};
-        defined(${$val}) ? 1 : 0;        
+        return defined(${$val}) ? 1 : 0;        
     }
     else {
         defined(*{$self->namespace->{$name}}{$type}) ? 1 : 0;
@@ -141,7 +144,19 @@ sub get_package_symbol {
 
     $self->add_package_symbol($variable)
         unless exists $self->namespace->{$name};
-    return *{$self->namespace->{$name}}{$type};
+
+    if (ref($self->namespace->{$name}) eq 'SCALAR') {
+        if ($type eq 'CODE') {
+            no strict 'refs';
+            return \&{$self->name.'::'.$name};
+        }
+        else {
+            return undef;
+        }
+    }
+    else {
+        return *{$self->namespace->{$name}}{$type};
+    }
 }
 
 sub remove_package_symbol {
@@ -194,7 +209,10 @@ sub list_all_package_symbols {
     # type (SCALAR|ARRAY|HASH|CODE)
     my $namespace = $self->namespace;
     return grep { 
-        defined(*{$namespace->{$_}}{$type_filter}) 
+        (ref($namespace->{$_})
+            ? (ref($namespace->{$_}) eq 'SCALAR' && $type_filter eq 'CODE')
+            : (ref(\$namespace->{$_}) eq 'GLOB'
+               && defined(*{$namespace->{$_}}{$type_filter})));
     } keys %{$namespace};
 }
 
@@ -272,15 +290,13 @@ which match the filter (either SCALAR, ARRAY, HASH or CODE).
 
 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.
+Copyright 2006, 2007 by Infinity Interactive, Inc.
 
 L<http://www.iinteractive.com>
 
 This library is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself.
 
-=cut
\ No newline at end of file
+=cut