How to create a Perl subroutine that accepts a block of code

Question

I have a set of subroutines that look like this:

sub foo_1($) {
  my $name = shift;
  my $f; 

  run_something();
  open($f, $name) or die ("Couldn't open $name");
  while (<$f>) {
    //Something for foo_1()
  }
  close($f); 
  do_something_else();

}

And I have like four or more that look the same, the only thing that changes is the body of the while block. I'd like to abstract this and stop copy-pasting the code around.

• Is there a way to code a subroutine that accepts a block of code and executes it?

To give more context, the different foo subroutines are a different Finite State Machine (FSM) that read the contents of different files and feed the data to a hash reference. Maybe there is a more intelligent thing to do than what I am trying to accomplish.

Carbonous

Generally speaking, function prototypes aren't necessary and I find them to be kinda useless. – Jerroldjerroll

@Jerroldjerroll Can you elaborate a bit, please? – Carbonous

=> In this case, using the ($) prototype may not mean what you think it means. It does mean "give me one argument", but it also means "impose scalar context on that argument". So if you had an array with one element in it, and called foo_1 @array, then foo_1 would be passed the number 1, which is the count of the elements in the array. To actually get the first argument, you would need to call it as foo_1 $array[0]. If you did not have the prototype, then you could have called it as foo_1 @array and it would have worked properly. – Platform

... Some Perl programmers call this imposition of context "action at a distance" since there is nothing about the function call itself that tells you the argument will be in scalar context (and that may be a source of hard to find bugs). In general, you should restrict prototype usage in Perl to those times where you want to write a function that is parsed like a built-in function (such as in my answer below). Argument validation can be done at runtime with a line like @_ == 1 or die "function takes 1 argument" at the top of the subroutine. – Platform

@Eric Good! I was really meaning to impose a "scalar context" to the argument to foo_1 (as in the example the only arg was a filename) but I was not completely aware of the "only for functions like the built-ins" part. Thank you. – Carbonous

Answer 1

Perl offers a system called subroutine prototypes that allow you to write user subs that get parsed in a way similar to the builtin functions. The builtins that you want to emulate are map, grep, or sort which can each take a block as their first argument.

To do that with prototypes, you use sub name (&) {...} where the & tells perl that the first argument to the function is either a block (with or without sub), or a literal subroutine \&mysub. The (&) prototype specifies one and only one argument, if you need to pass multiple arguments after the code block, you could write it as (&@) which means, a code block followed by a list.

sub higher_order_fn (&@) {
    my $code = \&{shift @_}; # ensure we have something like CODE

    for (@_) {
        $code->($_);
    }
}

That subroutine will run the passed in block on every element of the passed in list. The \&{shift @_} looks a bit cryptic, but what it does is shifts off the first element of the list, which should be a code block. The &{...} dereferences the value as a subroutine (invoking any overloading), and then the \ immediately takes the reference to it. If the value was a CODE ref, then it is returned unchanged. If it was an overloaded object, it is turned into code. If it could not be coerced into CODE, an error is thrown.

To call this subroutine, you would write:

higher_order_fn {$_ * 2} 1, 2, 3;
# or
higher_order_fn(sub {$_ * 2}, 1, 2, 3);

The (&@) prototype that lets you write the argument as a map/grep like block only works when using the higher order function as a function. If you are using it as a method, you should omit the prototype and write it this way:

sub higher_order_method {
    my $self = shift;
    my $code = \&{shift @_};
    ...
    $code->() for @_;
}
...
$obj->higher_order_method(sub {...}, 'some', 'more', 'args', 'here');

Platform

...continued (I hit enter by mistake) I'd like to know why is it that you use \&{shift @_}. Why is this different from the other answers people gave me? I am pretty new to Perl (but I have coded some time in Haskell, Java, Scheme, and C). Thanks. – Carbonous

it is a terse way of verifying that the argument is actually a code reference. expanded it means something like do {my $x = shift; ref $x eq 'CODE' ? $x : overload::Overloaded($_[0], '&{}') ? \&$x : die "not a code reference"} . The prototype is a compile time constraint that checks for a code reference for you, but it can be bypassed by calling the sub with a & sigil (or by calling the code as a method). The \&{shift @_} is an additional check against that bypass. – Platform

I read again your answer a couple more times and now I understand. Thanks. – Carbonous

Excellent! Thank you very much, Eric. Your comment above didn't show until after I wrote mine. It was what I imagined. Thanks again! – Carbonous

Even though you kind-of-mixed your answer with the higher-order list manipulation functions, I chose yours as the best. Thanks. – Carbonous

my $code = \&{shift @_} also turns strings into references to the named sub. – Hertzog

Answer 2

sub bar {
   my ($coderef) = @_;
   ⁝
   $coderef->($f, @arguments);
   ⁝
}

bar(sub { my ($f) = @_; while … }, @other_arguments);

or perhaps a bit less tangled with a named coderef:

my $while_sub = sub {
    my ($f) = @_;
    while …
    ⁝
};
bar($while_sub, @other_arguments);

---

Edit: The Higher-Order Perl book is full of this sort of programming.

Expire

Thank you very much. I think I'll read that book. Sounds fun! – Carbonous

Answer 3

You want the & prototype.

sub foo(&@) {
    my ($callback) = shift;
    ...
    $callback->(...);
    ...
}

makes

foo { ... } ...;

equivalent to

foo(sub { ... }, ...);

Hertzog

Answer 4

Although others already answered the question I was still missing the reference to the official Perl documentation.

http://perldoc.perl.org/perlsub.html#Prototypes

Dulosis