X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FPackage.pm;h=3020727d0c6eb3754f6cde4956a74e5e502a1ba8;hb=9195ddff0447e2e618ab3b227aeb3574f6c8cb17;hp=62c9e156a90207213f834b6ab996d6ccd44c2abb;hpb=823a5d313b1973a47b951dd60599b36af8093345;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Package.pm b/lib/Class/MOP/Package.pm index 62c9e15..3020727 100644 --- 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.06'; +our $VERSION = '0.07'; our $AUTHORITY = 'cpan:STEVAN'; use base 'Class::MOP::Object'; @@ -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,9 +209,10 @@ sub list_all_package_symbols { # type (SCALAR|ARRAY|HASH|CODE) my $namespace = $self->namespace; return grep { - defined(*{$namespace->{$_}}{$type_filter}) - } grep { - ref(\$namespace->{$_}) eq 'GLOB' + (ref($namespace->{$_}) + ? (ref($namespace->{$_}) eq 'SCALAR' && $type_filter eq 'CODE') + : (ref(\$namespace->{$_}) eq 'GLOB' + && defined(*{$namespace->{$_}}{$type_filter}))); } keys %{$namespace}; } @@ -274,8 +290,6 @@ which match the filter (either SCALAR, ARRAY, HASH or CODE). Stevan Little Estevan@iinteractive.comE -Yuval Kogman Enothingmuch@woobling.comE - =head1 COPYRIGHT AND LICENSE Copyright 2006, 2007 by Infinity Interactive, Inc. @@ -285,4 +299,4 @@ L 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