# Class attributes
+# ... these functions have to touch the symbol table itself,.. yuk
+
sub add_package_symbol {
my ($self, $variable, $initial_value) = @_;
my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable);
no strict 'refs';
- no warnings 'misc', 'redefine';
- *{$self->name . '::' . $name} = $initial_value;
+ no warnings 'redefine', 'misc';
+ *{$self->name . '::' . $name} = ref $initial_value ? $initial_value : \$initial_value;
+}
+
+sub remove_package_glob {
+ my ($self, $name) = @_;
+ no strict 'refs';
+ delete ${$self->name . '::'}{$name};
}
+# ... these functions deal with stuff on the namespace level
+
sub has_package_symbol {
my ($self, $variable) = @_;
my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable);
- return 0 unless exists $self->namespace->{$name};
+ return 0 unless exists $self->namespace->{$name};
defined *{$self->namespace->{$name}}{$type} ? 1 : 0;
}
my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable);
- return *{$self->namespace->{$name}}{$type}
- if exists $self->namespace->{$name};
- $self->add_package_symbol($variable);
+ $self->add_package_symbol($variable)
+ unless exists $self->namespace->{$name};
+ return *{$self->namespace->{$name}}{$type};
}
sub remove_package_symbol {
my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable);
+ # FIXME:
+ # no doubt this is grossly inefficient and
+ # could be done much easier and faster in XS
+
+ my ($scalar, $array, $hash, $code);
if ($type eq 'SCALAR') {
- undef ${$self->namespace->{$name}};
+ $array = $self->get_package_symbol('@' . $name) if $self->has_package_symbol('@' . $name);
+ $hash = $self->get_package_symbol('%' . $name) if $self->has_package_symbol('%' . $name);
+ $code = $self->get_package_symbol('&' . $name) if $self->has_package_symbol('&' . $name);
}
elsif ($type eq 'ARRAY') {
- undef @{$self->namespace->{$name}};
+ $scalar = $self->get_package_symbol('$' . $name) if $self->has_package_symbol('$' . $name);
+ $hash = $self->get_package_symbol('%' . $name) if $self->has_package_symbol('%' . $name);
+ $code = $self->get_package_symbol('&' . $name) if $self->has_package_symbol('&' . $name);
}
elsif ($type eq 'HASH') {
- undef %{$self->namespace->{$name}};
+ $scalar = $self->get_package_symbol('$' . $name) if $self->has_package_symbol('$' . $name);
+ $array = $self->get_package_symbol('@' . $name) if $self->has_package_symbol('@' . $name);
+ $code = $self->get_package_symbol('&' . $name) if $self->has_package_symbol('&' . $name);
}
elsif ($type eq 'CODE') {
- # FIXME:
- # this is crap, it is probably much
- # easier to write this in XS.
- my ($scalar, @array, %hash);
- $scalar = ${$self->namespace->{$name}} if defined *{$self->namespace->{$name}}{SCALAR};
- @array = @{$self->namespace->{$name}} if defined *{$self->namespace->{$name}}{ARRAY};
- %hash = %{$self->namespace->{$name}} if defined *{$self->namespace->{$name}}{HASH};
- {
- no strict 'refs';
- delete ${$self->name . '::'}{$name};
- }
- ${$self->namespace->{$name}} = $scalar if defined $scalar;
- @{$self->namespace->{$name}} = @array if scalar @array;
- %{$self->namespace->{$name}} = %hash if keys %hash;
+ $scalar = $self->get_package_symbol('$' . $name) if $self->has_package_symbol('$' . $name);
+ $array = $self->get_package_symbol('@' . $name) if $self->has_package_symbol('@' . $name);
+ $hash = $self->get_package_symbol('%' . $name) if $self->has_package_symbol('%' . $name);
}
else {
confess "This should never ever ever happen";
}
+
+ $self->remove_package_glob($name);
+
+ $self->add_package_symbol(('$' . $name) => $scalar) if defined $scalar;
+ $self->add_package_symbol(('@' . $name) => $array) if defined $array;
+ $self->add_package_symbol(('%' . $name) => $hash) if defined $hash;
+ $self->add_package_symbol(('&' . $name) => $code) if defined $code;
}
sub list_all_package_symbols {
=item B<remove_package_symbol>
+=item B<remove_package_glob>
+
=item B<list_all_package_symbols>
=back