X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FPackage.pm;h=66faca342215ff5a9b1eb3b6cfd1ff07b202e1c1;hb=28fa06b5d932b8a2f9bc1b6b394893c0d7c9efac;hp=9c6519bce00e28b9b476efe89767267ca12d91c9;hpb=92e250b0af746085306392cd25e053f3000ca3d3;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Package.pm b/lib/Class/MOP/Package.pm index 9c6519b..66faca3 100644 --- a/lib/Class/MOP/Package.pm +++ b/lib/Class/MOP/Package.pm @@ -4,10 +4,11 @@ package Class::MOP::Package; use strict; use warnings; +use B; use Scalar::Util 'blessed'; use Carp 'confess'; -our $VERSION = '0.69_01'; +our $VERSION = '0.78'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -31,6 +32,7 @@ sub initialize { } else { my $meta = ( ref $class || $class )->_new({ 'package' => $package_name, + %options, }); Class::MOP::store_metaclass_by_name($package_name, $meta); @@ -282,26 +284,35 @@ sub get_all_package_symbols { my $namespace = $self->namespace; - return %$namespace unless defined $type_filter; + return $namespace unless defined $type_filter; + my %ret; # for some reason this nasty impl is orders of magnitude faster than a clean version if ( $type_filter eq 'CODE' ) { my $pkg; no strict 'refs'; - return map { + %ret = map { (ref($namespace->{$_}) ? ( $_ => \&{$pkg ||= $self->name . "::$_"} ) - : ( (*{$namespace->{$_}}{CODE}) # the extra parents prevent breakage on 5.8.2 + : ( ref \$namespace->{$_} eq 'GLOB' # don't use {CODE} unless it's really a glob to prevent stringification of stubs + && (*{$namespace->{$_}}{CODE}) # the extra parents prevent breakage on 5.8.2 ? ( $_ => *{$namespace->{$_}}{CODE} ) - : () ) ) + : (do { + my $sym = B::svref_2object(\$namespace->{$_}); + my $svt = ref $sym if $sym; + ($sym && ($svt eq 'B::PV' || $svt eq 'B::IV')) + ? ($_ => ($pkg ||= $self->name)->can($_)) + : () }) ) ) } keys %$namespace; } else { - return map { + %ret = map { $_ => *{$namespace->{$_}}{$type_filter} } grep { !ref($namespace->{$_}) && *{$namespace->{$_}}{$type_filter} } keys %$namespace; } + + return \%ret; } 1; @@ -320,6 +331,10 @@ This is an abstraction of a Perl 5 package, it is a superclass of L and provides all of the symbol table introspection methods. +=head1 INHERITANCE + +B is a subclass of L + =head1 METHODS =over 4