Item 29: Use subroutines to create other subroutines.

It's easy to get a Perl subroutine to "return" another subroutine. Just create and return a code ref a reference to another subroutine (see Item 30). There are two mechanisms for creating code refs: the reference operator \ and the anonymous subroutine constructor sub { } :

sub named { print "Named!\n" }
sub code_ref1 { \&named; }	Return a reference to &named .
sub code_ref2 { sub { print "Anonymous!\n" }; }	Return a reference to an anonymous subroutine.

The simplest and (I think) most aesthetically pleasing way to call a subroutine from a code ref is via the dereferencing arrow -> : ^[9]

^[9] This feature was added fairly recently. If your version of Perl doesn't support it, use the alternative syntax.

$func1 = code_ref1; $func2 = code_ref2;	$func1 and $func2 contain code refs.
$func1->(); $func2->();	Named! Anonymous!
&$func1(); &$func2();	Alternative syntax for the above.

Of course, the example above doesn't do anything particularly useful. It shows how to return and call code refs, sure, but it's just a useless extra level of indirection. This isn't a productive way to code unless we can return subroutines whose functionality is computed at run time.

Creating closures

An interesting thing happens when an anonymous subroutine uses a my variable defined in an enclosing scope. Each time the enclosing scope is entered, the subroutine gets a different copy of the my variable. An anonymous subroutine that refers to a my variable from an enclosing scope is called a closure . Or, stated another way, a closure is an anonymous subroutine that has access to private variables of its own that are otherwise inaccessible.

Closures are a tricky subject, best approached with some examples. First, let's look at a very simple use of closures:

for (0..2) { my $time = time;	A new $time each time.
push @stamp, sub { $time }; sleep 2; }	Each new anonymous subroutine has its very own $time .
for (0..2) { print "stamp->($_): ", $stamp[$_]->(), "\n"; }	Prints: stamp->(0): 877051119 stamp->(1): 877051121 stamp->(2): 877051123

The first loop generates three code refs, each of which is a reference to a separate copy of sub { $time } . Each of those copies has its own copy of $time , created when my $time was encountered at the top of the loop. Each copy of $time can be accessed by the copy of sub { $time } that it is bound to, even (or especially ) later in the execution of the program when the my variable has gone out of scope.

Generally, subroutines are used to generate closures:

sub make_counter { my $i = 0; sub { $i++ }; }	Create and return a closure. Each copy of the subroutine has its own counter $i .
$count1 = make_counter; $count2 = make_counter; print "count1 is ", $count1->(), "\n"; print "count1 is ", $count1->(), "\n"; print "count2 is ", $count2->(), "\n"; print "count2 is ", $count2->(), "\n";	Prints: count1 is 0 count1 is 1 count2 is 0 count2 is 1

Each time make_counter is called, it returns a reference to a new copy of sub { $i++ } , with its own private copy of $i . When one of those copies is called later, it still has access to its copy of $i even though the call comes from outside the scope that originally defined the my variable.

Perl closures have uses that parallel those of object-oriented constructs (see Item 49). Whereas object-oriented programming is all about data with associated functions, closures are all about functions with associated data. Two or more closures can even share a common set of variables, allowing a programming style that starts to look very object-oriented indeed:

Closures can share a set of variables.

This example illustrates how closures can share variables. The subroutine make_iter creates closures that can be used to traverse an array several elements at a time.
sub make_iter { my $aref = shift; die "make_iter requires array ref" unless ref($aref) eq 'ARRAY'; my $i;	The subroutine make_iter takes an array ref and returns a hash ref containing pairs of names and code refs. $i and $aref are shared.
{ 'next' => sub { my $n = shift; if ($n + $i > @$aref) { $n = @$aref - $i; } my @result = @$aref[$i .. $i+$n-1]; $i += $n; @result; },	The next subroutine takes a numeric argument and returns that many values from the array pointed to by $aref . It also increments the $i counter.
	There is some range-checking.
'position' => sub { if (@_) { my $new = shift; $i = $new if $new >= 0 and $new <= $#$aref; return; } else { $i; } } } }	If supplied an argument, the position subroutine sets the current iterating position $i within the $aref array.
	If not supplied an argument, position returns the current iterating position.
	Code refs are returned in an anonymous hash so callers don't get them mixed up.
@a = (1..10);	Here's our sample array.
($next_a, $posn_a) = @{make_iter \@a}{'next', 'position'};	Assign returned code refs to $next_a and $posn_a .
$posn_a->(2); while ((@b) = $next_a->(3)) { print join(", ", @b), "\n"; } print "posn now: ", $posn_a->(), "\n";	Start at index 2 . 3, 4, 5 6, 7, 8 9, 10 posn now: 10

While the subroutines generated in the next example aren't, strictly speaking, closures, the following illustrates the use of eval to create code refs whose bodies are read from a file:

sub make_binary { eval "sub { $_[0] }"; } while (<DATA>) { my ($name, $code) = split /\s+/, $_, 2; $op{$name} = make_binary $code; }	Subroutine to create a code ref with string eval (see Item 54 ). Read subroutine bodies from <DATA> and create code refs out of them.
for (sort keys %op) { print "2 $_ 3 = ", $op{$_}->(2, 3), "\n"; } __DATA__ add $_[0] + $_[1] sub $_[0] - $_[1] mul $_[0] * $_[1] div $_[0] / $_[1] max $_[0] > $_[1] ? $_[0] : $_[1]	Call each of the subroutines for arguments (2, 3) . When run, prints: 2 add 3 = 5 2 div 3 = 0.6666666667 2 max 3 = 3 2 mul 3 = 6 2 sub 3 = -1 (Note sorted order.)

Creating subroutines for pattern matching

It's not uncommon to need to perform one or more pattern matches that are specified at run time. For example, you might be writing a Perl program to sort through your mail or news. Such a program would likely read in a "kill file" of patterns to match against the headers. You can specify matches at run time by interpolating variables into regular expressions, but such regular expressions will be repeatedly compiled (see Item 22), at a considerable cost in speed. The /o option provides a means for compiling a pattern match containing interpolated variables only once. However, if you have several such matches to deal with, you are faced with a bit of a sticky wicket.

Using closures in combination with eval allows you to generate subroutines that have particular regular expressions "locked in" with the same flexibility (and efficiency!) as if the expressions were specified at compile time. Here's how it's done:

Create pattern matching subroutines with closures and string eval .

sub make_grep { my $pat = shift; eval 'sub { grep /$pat/o, @_ }'; }	The subroutine "factory." The pattern is passed in as the first (only) parameter as a string.
$find_us = make_grep q/(?i)\b(josephrandal)\b/;	Create a code ref in $find_us that looks for joseph or randal , case ignored.
@found = &$find_us(<STDIN>);	Find all matching lines from STDIN .

The key to this construct is the use of string eval in make_grep . Using /o inside string eval still means "compile once," but "once" now means once per eval , not once per program execution. It almost seems like cheating.

If you want plain old pattern matching instead of grep -ing, that's easy enough:

sub make_match { my $pat = shift; eval 'sub { $_[0] =~ /$pat/o; }' }	A similar subroutine that creates just a pattern match.
$is_big = make_match q/\b(biglargehuge)\b/;	Create a subroutine looking for big , large or huge .
if ($is_big->($_)) { ... }	Use it.