Документация
HTML CSS PHP PERL другое

Section 7.1.  Referencing a Named Subroutine

 
Previous
Table of Contents
Next

7.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!
Professor: By my calculations, you must be Skipper!

Whew! That's 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, we have to figure out what other subroutines to call. We could certainly do it with enough hard-to-maintain code, but we can simplify the process by adding a bit of indirection, just as we did with arrays and hashes.

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

my $ref_to_greeter = \&skipper_greets;

We'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. Perl stores the reference to the subroutine (a coderef) 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 we would have written it before we heard of references (including the optional ampersand prefix):

& skipper_greets ( 'Gilligan' )

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

& { $ref_to_greeter } ( 'Gilligan' )

There we 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, we can drop the braces:

& $ref_to_greeter ( 'Gilligan' )

We 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 in a larger data structure, as you'll see in a moment.

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

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

First, inside the parentheses, we 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.

We've seen the coderefs in a scalar variable and as an element of a list. Can we 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 we look up in the hash to get to a coderef. Then we dereference that coderef, passing it the name of the person being greeted, and we 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 = (
  Gilligan  => \&gilligan_greets,
  Skipper   => \&skipper_greets,
  Professor => \&professor_greets,
);

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 = (
  Gilligan  => \&gilligan_greets,
  Skipper   => \&skipper_greets,
  Professor => \&professor_greets,
);

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!


Previous
Table of Contents
Next
© 2000- NIV