use strict;
use warnings;
-use B;
use Scalar::Util 'blessed';
use Carp 'confess';
-our $VERSION = '0.78';
+our $VERSION = '0.89';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
my ($name, $sigil, $type) = ref $variable eq 'HASH'
? @{$variable}{qw[name sigil type]}
- : $self->_deconstruct_variable_name($variable);
+ : $self->_deconstruct_variable_name($variable);
my $pkg = $self->{'package'};
no strict 'refs';
- no warnings 'redefine', 'misc';
- *{$pkg . '::' . $name} = ref $initial_value ? $initial_value : \$initial_value;
+ no warnings 'redefine', 'misc', 'prototype';
+ *{$pkg . '::' . $name} = ref $initial_value ? $initial_value : \$initial_value;
}
sub remove_package_glob {
return 0 unless exists $namespace->{$name};
- # FIXME:
- # For some really stupid reason
- # a typeglob will have a default
- # value of \undef in the SCALAR
- # slot, so we need to work around
- # this. Which of course means that
- # if you put \undef in your scalar
- # then this is broken.
-
- if (ref($namespace->{$name}) eq 'SCALAR') {
- return ($type eq 'CODE');
- }
- elsif ($type eq 'SCALAR') {
- my $val = *{$namespace->{$name}}{$type};
- return defined(${$val});
- }
- else {
- defined(*{$namespace->{$name}}{$type});
+ my $entry_ref = \$namespace->{$name};
+ if (ref($entry_ref) eq 'GLOB') {
+ if ($type eq 'SCALAR') {
+ return defined(${ *{$entry_ref}{SCALAR} });
+ }
+ else {
+ return defined(*{$entry_ref}{$type});
+ }
+ }
+ else {
+ # a symbol table entry can be -1 (stub), string (stub with prototype),
+ # or reference (constant)
+ return $type eq 'CODE';
}
}
my $namespace = $self->namespace;
+ # FIXME
$self->add_package_symbol($variable)
unless exists $namespace->{$name};
- if (ref($namespace->{$name}) eq 'SCALAR') {
- if ($type eq 'CODE') {
+ my $entry_ref = \$namespace->{$name};
+
+ if (ref($entry_ref) eq 'GLOB') {
+ return *{$entry_ref}{$type};
+ }
+ else{
+ if($type eq 'CODE'){
no strict 'refs';
- return \&{$self->name.'::'.$name};
+ return \&{$self->name . '::' . $name};
}
- else {
+ else{
return undef;
}
}
- else {
- return *{$namespace->{$name}}{$type};
- }
}
sub remove_package_symbol {