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=2e507fe17c06f466a40bbc9e6760079f52169189;hpb=b1897d4d804dc11f86868052ecb6997a04821df3;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Package.pm b/lib/Class/MOP/Package.pm index 2e507fe..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.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 Estevan@iinteractive.comE -Yuval Kogman Enothingmuch@woobling.comE - =head1 COPYRIGHT AND LICENSE -Copyright 2006 by Infinity Interactive, Inc. +Copyright 2006, 2007 by Infinity Interactive, Inc. 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