use Carp qw(confess);
use Scalar::Util qw(reftype);
+use Symbol;
+# before 5.12, assigning to the ISA glob would make it lose its magical ->isa
+# powers
+use constant BROKEN_ISA_ASSIGNMENT => ($] < 5.012);
=head1 SYNOPSIS
my $entry_ref = \$namespace->{$name};
if (reftype($entry_ref) eq 'GLOB') {
- if ( $type eq 'SCALAR' ) {
- return defined ${ *{$entry_ref}{SCALAR} };
+ # XXX: assigning to any typeglob slot also initializes the SCALAR slot,
+ # and saying that an undef scalar variable doesn't exist is probably
+ # vaguely less surprising than a scalar variable popping into existence
+ # without anyone defining it
+ if ($type eq 'SCALAR') {
+ return defined ${ *{$entry_ref}{$type} };
}
else {
return defined *{$entry_ref}{$type};
my $namespace = $self->namespace;
- if ($opts{vivify} && !exists $namespace->{$name}) {
- if ($type eq 'ARRAY') {
- $self->add_package_symbol(
- $variable,
- # setting our own arrayref manually loses the magicalness or
- # something
- $name eq 'ISA' ? () : ([])
- );
- }
- elsif ($type eq 'HASH') {
- $self->add_package_symbol($variable, {});
+ if (!exists $namespace->{$name}) {
+ if ($opts{vivify}) {
+ if ($type eq 'ARRAY') {
+ if (BROKEN_ISA_ASSIGNMENT) {
+ $self->add_package_symbol(
+ $variable,
+ $name eq 'ISA' ? () : ([])
+ );
+ }
+ else {
+ $self->add_package_symbol($variable, []);
+ }
+ }
+ elsif ($type eq 'HASH') {
+ $self->add_package_symbol($variable, {});
+ }
+ elsif ($type eq 'SCALAR') {
+ $self->add_package_symbol($variable);
+ }
+ elsif ($type eq 'IO') {
+ $self->add_package_symbol($variable, Symbol::geniosym);
+ }
+ elsif ($type eq 'CODE') {
+ confess "Don't know how to vivify CODE variables";
+ }
+ else {
+ confess "Unknown type $type in vivication";
+ }
}
else {
- # FIXME
- $self->add_package_symbol($variable)
+ if ($type eq 'CODE') {
+ # this effectively "de-vivifies" the code slot. if we don't do
+ # this, referencing the coderef at the end of this function
+ # will cause perl to auto-vivify a stub coderef in the slot,
+ # which isn't what we want
+ $self->add_package_symbol($variable);
+ }
}
}
Returns a list of package variable names in the package, without sigils. If a
C<type_filter> is passed, it is used to select package variables of a given
type, where valid types are the slots of a typeglob ('SCALAR', 'CODE', 'HASH',
-etc).
+etc). Note that if the package contained any C<BEGIN> blocks, perl will leave
+an empty typeglob in the C<BEGIN> slot, so this will show up if no filter is
+used (and similarly for C<INIT>, C<END>, etc).
=cut
# type (SCALAR|ARRAY|HASH|CODE)
if ($type_filter eq 'CODE') {
return grep {
- (ref($namespace->{$_})
- ? (ref($namespace->{$_}) eq 'SCALAR')
- : (ref(\$namespace->{$_}) eq 'GLOB'
- && defined(*{$namespace->{$_}}{CODE})));
+ # any non-typeglob in the symbol table is a constant or stub
+ ref(\$namespace->{$_}) ne 'GLOB'
+ # regular subs are stored in the CODE slot of the typeglob
+ || defined(*{$namespace->{$_}}{CODE})
+ } keys %{$namespace};
+ }
+ elsif ($type_filter eq 'SCALAR') {
+ return grep {
+ ref(\$namespace->{$_}) eq 'GLOB'
+ && defined(${*{$namespace->{$_}}{'SCALAR'}})
+ } keys %{$namespace};
+ }
+ else {
+ return grep {
+ ref(\$namespace->{$_}) eq 'GLOB'
+ && defined(*{$namespace->{$_}}{$type_filter})
} keys %{$namespace};
- } else {
- return grep { *{$namespace->{$_}}{$type_filter} } keys %{$namespace};
}
}