incredibly messy, and easy to get wrong. This module hides all of that behind a
simple API.
+NOTE: Most methods in this class require a variable specification that includes
+a sigil. If this sigil is absent, it is assumed to represent the IO slot.
+
=head1 METHODS
=cut
'@' => 'ARRAY',
'%' => 'HASH',
'&' => 'CODE',
+ '' => 'IO',
);
sub _deconstruct_variable_name {
my ($self, $variable) = @_;
- (defined $variable)
+ (defined $variable && length $variable)
|| confess "You must pass a variable name";
my $sigil = substr($variable, 0, 1, '');
- (defined $sigil)
- || confess "The variable name must include a sigil";
-
- (exists $SIGIL_MAP{$sigil})
- || confess "I do not recognize that sigil '$sigil'";
-
- return ($variable, $sigil, $SIGIL_MAP{$sigil});
+ if (exists $SIGIL_MAP{$sigil}) {
+ return ($variable, $sigil, $SIGIL_MAP{$sigil});
+ }
+ else {
+ return ("${sigil}${variable}", '', $SIGIL_MAP{''});
+ }
}
}
my $namespace = $self->namespace;
# FIXME
- $self->add_package_symbol($variable)
- unless exists $namespace->{$name};
+ if (!exists $namespace->{$name}) {
+ my $initial = $type eq 'ARRAY' ? []
+ : $type eq 'HASH' ? {}
+ : \undef;
+ $self->add_package_symbol($variable, $initial)
+ }
my $entry_ref = \$namespace->{$name};
# no doubt this is grossly inefficient and
# could be done much easier and faster in XS
- my ($scalar_desc, $array_desc, $hash_desc, $code_desc) = (
+ my ($scalar_desc, $array_desc, $hash_desc, $code_desc, $io_desc) = (
{ sigil => '$', type => 'SCALAR', name => $name },
{ sigil => '@', type => 'ARRAY', name => $name },
{ sigil => '%', type => 'HASH', name => $name },
{ sigil => '&', type => 'CODE', name => $name },
+ { sigil => '', type => 'IO', name => $name },
);
- my ($scalar, $array, $hash, $code);
+ my ($scalar, $array, $hash, $code, $io);
if ($type eq 'SCALAR') {
$array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc);
$hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc);
$code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc);
+ $io = $self->get_package_symbol($io_desc) if $self->has_package_symbol($io_desc);
}
elsif ($type eq 'ARRAY') {
$scalar = $self->get_package_symbol($scalar_desc) if $self->has_package_symbol($scalar_desc);
$hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc);
$code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc);
+ $io = $self->get_package_symbol($io_desc) if $self->has_package_symbol($io_desc);
}
elsif ($type eq 'HASH') {
$scalar = $self->get_package_symbol($scalar_desc) if $self->has_package_symbol($scalar_desc);
$array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc);
$code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc);
+ $io = $self->get_package_symbol($io_desc) if $self->has_package_symbol($io_desc);
}
elsif ($type eq 'CODE') {
$scalar = $self->get_package_symbol($scalar_desc) if $self->has_package_symbol($scalar_desc);
$array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc);
$hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc);
+ $io = $self->get_package_symbol($io_desc) if $self->has_package_symbol($io_desc);
+ }
+ elsif ($type eq 'IO') {
+ $scalar = $self->get_package_symbol($scalar_desc) if $self->has_package_symbol($scalar_desc);
+ $array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc);
+ $hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc);
+ $code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc);
}
else {
confess "This should never ever ever happen";
$self->add_package_symbol($array_desc => $array) if defined $array;
$self->add_package_symbol($hash_desc => $hash) if defined $hash;
$self->add_package_symbol($code_desc => $code) if defined $code;
+ $self->add_package_symbol($io_desc => $io) if defined $io;
}
=head2 list_all_package_symbols $type_filter