6.1 Referencing a Named Subroutine

The Skipper and Gilligan are having a conversation:

sub skipper_greets {
  my $person = shift;
  print "Skipper: Hey there, $person!\n";
}

sub gilligan_greets {
  my $person = shift;
  if ($person eq "Skipper") {
    print "Gilligan: Sir, yes, sir, $person!\n";
  } else {
    print "Gilligan: Hi, $person!\n";
  }
}

skipper_greets("Gilligan");
gilligan_greets("Skipper");

This results in:

Skipper: Hey there, Gilligan!
Gilligan: Sir, yes, sir, Skipper!

So far, nothing unusual has happened. Note however that Gilligan has two different behaviors, depending on whether he's addressing the Skipper or someone else.

Now, have the Professor walk into the hut. Both of the Minnow crew greet the newest participant:

skipper_greets("Professor");
gilligan_greets("Professor");

which results in

Skipper: Hey there, Professor!
Gilligan: Hi, Professor!

Now the Professor feels obligated to respond:

sub professor_greets {
  my $person = shift;
  print "Professor: By my calculations, you must be $person!\n";
}

professor_greets("Gilligan");
professor_greets("Skipper");

resulting in:

Professor: By my calculations, you must be Gilligan!\n";
Professor: By my calculations, you must be Skipper!\n";

Whew. A lot of typing and not very general. If each person's behavior is in a separate named subroutine and a new person walks in the door, you have to figure out what other subroutines to call. You could certainly do it with enough hard-to-maintain code, but you can simplify the process by adding a bit of indirection, just as you did with arrays and hashes.

First, let's introduce the "take a reference to" operator. It actually needs no introduction because it's that very same backslash again:

my $ref_to_greeter = \&skipper_greets;

You're taking a reference to the subroutine skipper_greets( ). Note that the preceding ampersand is mandatory here, and the lack of trailing parentheses is also intentional. The reference to the subroutine (a coderef) is stored within $ref_to_greeter, and like all other references, it fits nearly anywhere a scalar fits.

There's only one reason to get back to the original subroutine by dereferencing the coderef: to invoke it. Dereferencing a code reference is similar to dereferencing other references. First start with the way you would have written it before you heard of references (including the optional ampersand prefix):

& skipper_greets ( "Gilligan" )

Next, you replace the name of the subroutine with curly braces around the thing holding the reference:

& { $ref_to_greeter } ( "Gilligan" )

There you have it. This construct invokes the subroutine currently referenced by $ref_to_greeter, passing it the single Gilligan parameter.

But boy-oh-boy, is that ugly or what? Luckily, the same reference simplification rules apply. If the value inside the curly braces is a simple scalar variable, you can drop the braces:

& $ref_to_greeter ( "Gilligan" )

You can also flip it around a bit with the arrow notation:

$ref_to_greeter -> ( "Gilligan" )

That last form is particularly handy when the coderef is contained within a larger data structure, as you'll see in a moment.

To have both Gilligan and the Skipper greet the Professor, you merely need to iterate over all the subroutines:

for my $greet (\&skipper_greets, \&gilligan_greets) {
  $greet->("Professor");
}

First, inside the parentheses, you create a list of two items, each of which is a coderef. The coderefs are then individually dereferenced, invoking the corresponding subroutine and passing it the Professor string.

You've seen the coderefs in a scalar variable and as an element of a list. Can you put these coderefs into a larger data structure? Certainly. Create a table that maps people to the behavior they exhibit to greet others, and then rewrite that previous example using the table:

sub skipper_greets {
  my $person = shift;
  print "Skipper: Hey there, $person!\n";
}

sub gilligan_greets {
  my $person = shift;
  if ($person eq "Skipper") {
    print "Gilligan: Sir, yes, sir, $person!\n";
  } else {
    print "Gilligan: Hi, $person!\n";
  }
}

sub professor_greets {
  my $person = shift;
  print "Professor: By my calculations, you must be $person!\n";
}

my %greets = (
  "Gilligan" => \&gilligan_greets,
  "Skipper" => \&skipper_greets,
  "Professor" => \&professor_greets,
);

for my $person (qw(Skipper Gilligan)) {
  $greets{$person}->("Professor");
}

Note that $person is a name, which you look up in the hash to get to a coderef. Then you dereference that coderef, passing it the name of the person being greeted, and you get the correct behavior, resulting in:

Skipper: Hey there, Professor!
Gilligan: Hi, Professor!

Now have everyone greet everyone, in a very friendly room:

sub skipper_greets {
  my $person = shift;
  print "Skipper: Hey there, $person!\n";
}

sub gilligan_greets {
  my $person = shift;
  if ($person eq "Skipper") {
    print "Gilligan: Sir, yes, sir, $person!\n";
  } else {
    print "Gilligan: Hi, $person!\n";
  }
}

sub professor_greets {
  my $person = shift;
  print "Professor: By my calculations, you must be $person!\n";
}

my %greets = ... as before ...

my @everyone = sort keys %greets;
for my $greeter (@everyone) {
  for my $greeted (@everyone) {
    $greets{$greeter}->($greeted)
      unless $greeter eq $greeted; # no talking to yourself
  }
}

This results in:

Gilligan: Hi, Professor!
Gilligan: Sir, yes, sir, Skipper!
Professor: By my calculations, you must be Gilligan!
Professor: By my calculations, you must be Skipper!
Skipper: Hey there, Gilligan!
Skipper: Hey there, Professor!

Hmm. That's a bit complex. Let's let them walk into the room one at a time:

sub skipper_greets {
  my $person = shift;
  print "Skipper: Hey there, $person!\n";
}

sub gilligan_greets {
  my $person = shift;
  if ($person eq "Skipper") {
    print "Gilligan: Sir, yes, sir, $person!\n";
  } else {
    print "Gilligan: Hi, $person!\n";
  }
}

sub professor_greets {
  my $person = shift;
  print "Professor: By my calculations, you must be $person!\n";
}

my %greets = ... as before ...

my @room; # initially empty
for my $person (qw(Gilligan Skipper Professor)) {
  print "\n";
  print "$person walks into the room.\n";
  for my $room_person (@room) {
    $greets{$person}->($room_person); # speaks
    $greets{$room_person}->($person); # gets reply
  }
  push @room, $person; # come in, get comfy
}

The result is a typical day on that tropical island:

Gilligan walks into the room.

Skipper walks into the room.
Skipper: Hey there, Gilligan!
Gilligan: Sir, yes, sir, Skipper!

Professor walks into the room.
Professor: By my calculations, you must be Gilligan!
Gilligan: Hi, Professor!
Professor: By my calculations, you must be Skipper!
Skipper: Hey there, Professor!