Perl: Cross-references in nested datastructures? - perl

Question

Is there a clean way to, at declaration time, make a stored hash value point to another value in the same datastructure?
For example, say I have a datastructure for command callbacks:
my %commands = (
'a' => {
'init' => sub { return "common initializer"; },
'run' => sub { return "run a"; }
},
'b' => {
'init' => sub { return "init b"; },
'run' => sub { return "run b"; }
},
'c' => {
'init' => sub { return "common initializer"; },
'run' => sub { return "run c"; }
}
);
I know this could be rewritten as:
sub common_initializer() { return "common initializer"; }
my %commands = (
'a' => {
'init' => \&common_initializer,
'run' => sub { return "run a"; }
},
'b' => {
'init' => sub { return "init b"; },
'run' => sub { return "run b"; }
},
'c' => {
'init' => \&common_initializer,
'run' => sub { return "run c"; }
}
);
This works but the subroutines are no longer all anonymous. Double-initialization is another option:
sub get_commands($;$) {
my ($_commands, $pass) = #_;
%$_commands = (
'a' => {
'init' => sub { return "common initializer"; },
'run' => sub { return "run a"; }
},
'b' => {
'init' => sub { return "init b"; },
'run' => sub { return "run b"; }
},
'c' => {
'init' => $$_commands{'a'}{'init'},
'run' => sub { return "run c"; }
}
);
get_commands($_commands, 1) unless (defined $pass);
}
my %commands;
get_commands(\%commands);
This works but it's rather kludgy and expensive. I'm using subroutines in the example above but I'd like this to work for any datatype. Is there a cleaner way to do this in Perl?

Answer 1

I believe that using a named subroutine might be the best option. E.g.:
sub foo { return "foo" }
my %commands ( "a" => { 'init' => \&foo } );
It is easily repeatable, contained and even allows you to add arguments dynamically.
But you can also use a lookup-table:
my %commands ( "a" => {
'init' => "foo",
'run' => "foo"
});
my %run = ( "foo" => sub { return "run foo" });
my %init = ( "foo" => sub { return "init foo" });
print "The run for 'a' is: " . $run{ $commands{a}{run} }->() . "\n";
This looks a bit more complicated to me, but it would work for any datatype, as you requested.
I see that you are using prototypes, e.g. sub foo($;$). You should be aware that these are optional, and they do not do what most people think. Most often you can skip these, and your code will be improved. Read the documentation.

Answer 2

Is there a clean way to, at declaration time, make a stored hash value point to another value in the same datastructure?
Impossible, by definition. You can't look up a value in the hash before you actually assign it to the hash. As such, solutions of the form my %h = ...; can't possibly work.
If you want to avoid duplication, you have two options:
my $common_val = ...;
my %h = ( a => $common_val, b => $common_val );
my %h = ( a => ..., b => undef );
$h{b} = $h{a};
(The first is best because it gives a name to the common thing.)
What I would probably do instead is use classes or objects. Inheritance and composition (e.g. roles) provide convenient means of sharing code between classes.
Classes:
my %commands = (
a => ClassA,
b => ClassB,
);
Objects:
my %commands = (
a => ClassA->new(),
b => ClassB->new(),
);
Either way, the caller would look like this:
$commands{$id}->init();
Taking it one step further, you could get rid of %commands entirely by naming the classes Command::a, Command::b, etc. Then all you'd need is
( "Command::" . $id )->init();
You're effectively using plugins at this point. There are modules that might make using a plugin even more shiny.

Answer 3

Note: Answering my own question but I'm still open to other solutions.
One alternate approach I've come up with is to mark cross-references with specially-formatted strings. At runtime the datastructure is traversed and any such strings are replaced with pointers to the values they name.
This is lighter-weight than the double-initialization method I mentioned in my question. It also has the advantage of keeping everything referenced in the datastructure within the datastructure (i.e. subroutines are all inline). I'm using subroutine references in the example below but this technique can be adapted for use with arbitrary datatypes (i.e. by removing the sanity check).
Here's an example:
#!/usr/bin/perl
use strict;
sub ALIAS($$#);
sub COOK(\%);
my %h = (
'a' => {
'init' => sub { return "common initializer\n"; },
'run' => sub { return "common run\n"; },
},
'b' => {
'init' => sub { return "init b\n"; },
'run' => "ALIAS {'a'}{'run'}"
},
'c' => {
ALIAS 'init' => '{a}{"init"}',
'run' => sub { return "run c\n"; },
},
);
COOK(%h);
print "Init a: " . &{$h{'a'}{'init'}}();
print "Init b: " . &{$h{'b'}{'init'}}();
print "Init c: " . &{$h{'c'}{'init'}}();
print "Run a: " . &{$h{'a'}{'run'}}();
print "Run b: " . &{$h{'b'}{'run'}}();
print "Run c: " . &{$h{'c'}{'run'}}();
# Replaces function aliases with references to the pointed to functions.
#
# Alias format is 'ALIAS {COMMAND}{FUNCTION}' where COMMAND and FUNCTION are
# the top-level and second-level keys in the passed datastructure. Both
# COMMAND and FUNCTION can optionally be quoted. See also ALIAS(...) for
# some syntatic sugar.
#
# IN: %commands -> Hash containing command descriptors (passed by reference)
sub COOK(\%) {
my ($_commands) = #_;
# Loop through commands...
foreach my $command ( keys %$_commands ) {
# Loop through functions...
foreach my $function ( keys %{$$_commands{$command}} ) {
# Only consider strings
next if ( ref $$_commands{$command}{$function} );
# Does the string look like an alias?
if ( $$_commands{$command}{$function}
=~ /^ALIAS\s+
\{
(
(?: [a-zA-Z0-9_-]+ ) |
(?:'[a-zA-Z0-9_-]+') |
(?:"[a-zA-Z0-9_-]+")
)
\}
\{
(
(?: [a-zA-Z0-9_-]+ ) |
(?:'[a-zA-Z0-9_-]+') |
(?:"[a-zA-Z0-9_-]+")
)
\}
$/x ) {
# Matched, find where it points to
my ($link_to_command, $link_to_function) = ($1, $2);
$link_to_command =~ s/['"]//g;
$link_to_function =~ s/['"]//g;
# Sanity check
unless (ref $$_commands{$link_to_command}{$link_to_function} eq 'CODE') {
die "In COOK(...), {$command}{$function} points to " .
"{$link_to_command}{$link_to_function} " .
"which is not a subroutine reference";
}
# Replace string with reference to pointed-to function
$$_commands{$command}{$function}
= $$_commands{$link_to_command}{$link_to_function};
} # END - Alias handler
} # END - Functions loop
} # END - Commands loop
} # END - COOK(...)
# Function providing syntatic sugar to let one write:
# ALIAS 'key' => "{command}{function}"
#
# instead of:
# 'key' => "ALIAS {command}{function}"
#
# This makes aliased functions more visible and makes it easier to write an
# appropriate code syntax highlighting pattern.
#
# See also COOK(...)
sub ALIAS($$#) {
my ($key, $alias, #rest) = #_;
return $key, "ALIAS $alias", #rest;
}
When run, this outputs:
Init a: common initializer
Init b: init b
Init c: common initializer
Run a: common run
Run b: common run
Run c: run c