Perl 5.10 added rudimentary grammar support in its regular expressions. You could define many subpatterns directly in your pattern, use them to define larger subpatterns, and, finally, when you have everything in place, let Perl do the work.

There are other ways, some more powerful, that let you do the same thing. This Item is not about those, however, but you can read about Regex::Grammars, Parse::RecDescent on your own. Also, you’re not going to get much of a recommendation of which one you should use for your task. We don’t know your situation.

To understand this new syntax, you have to study it from the ground up. It’s not simple, and the terse documentation in perlre doesn’t do much to help.

Referencing a subpattern

The first part you need is the ability to call a named part of the pattern (to label a subpattern, see Item 31. Use named captures to label matches). To re-match a labeled subpattern, you use:

(?&NAME)

You can use that syntax to rerun a subpattern later:

use v5.10;

my $pattern = qr/
	(?<cat>Buster|Mimi)
	\s+
	(?&cat)
	/x;

foreach ( 'Buster Mimi', 'Mimi Buster', 'Buster', 'Buster Buster' ) {
	say "$_ ", m/$pattern/p ? "matched" : 'nope!';
	}

The labeled subpattern has an alternation where either cat name can match. When you reference it again, you re-run the alternation and you can match either cat name again:

Buster Mimi matched
Mimi Buster matched
Buster nope!
Buster Buster matched

This is not that same thing as matching the same text a labeled capture group already matched. That’s the \k<NAME>:

\k<NAME>

This pattern is a different beast. Whichever cat name matches first also has to match second:

use v5.10;

my $pattern = qr/
	(?<cat>Buster|Mimi)
	\s+
	\k<cat>
	/x;

foreach ( 'Buster Mimi', 'Mimi Buster', 'Buster', 'Buster Buster' ) {
	say "$_ ", m/$pattern/p ? "matched" : 'nope!';
	}

Now only one of the strings matches because only one string repeats a cat’s name:

Buster Mimi nope!
Mimi Buster nope!
Buster nope!
Buster Buster matched

Although you won’t see it here, the (?&NAME) syntax is the trick to matching a recursive pattern since the reference can appear inside the pattern it references.

Conditional match

The second building block you need starts with a conditional submatch:

(?(condition)yes-pattern|no-pattern)

That condition can be many things, most of which won’t appear in this Item. Although you see the | character, but this isn’t an alteration. It’s like an alternation because the | separates distinct subpatterns, but unlike an alternation because this will only ever try one of the subpatterns and you only get two subpatterns.

The simplest condition is just an ordinal number, which is true only if that capture group matched. Here’s a pattern that has two capture groups:

use v5.10;

my $pattern = qr/
	(?:           # parens for grouping
		(B)     # $1
		|         # alternation
		(M)     # $2
	)
	(?(1)uster|imi) # conditional match
	/x;

foreach ( qw(Mimi Buster Muster Bimi Roscoe) ) {
	say "$_ ", m/$pattern/p ? "matched ${^MATCH}" : 'nope!';
	}

In this pattern, if the (B) matches, the conditional uses uster from the conditional. Otherwise, it uses imi. However, the only thing that can match besides a (B) is the other part of the alteration, the (M). The output shows that only Mimi or Buster matches:

Mimi matched Mimi
Buster matched Buster
Muster nope!
Bimi nope!
Roscoe nope!

You get the same results if you use (2) as the condition and re-arrange the order of the patterns:

my $pattern = qr/
	(?:(B)|(M))
	(?(2)imi|uster)
	/x;

Putting it together

The condition can also be the literal (DEFINE). In that case, Perl only allows a yes-branch. And, as its condition implies, it merely defines the patterns and does not execute them.

This means that you can create and label the subpatterns that you need, but not actually assert that any of them match the string. The definitions are just there. This pattern defines and labels three subpatterns then uses none of them:

use v5.10;

my $pattern = qr/
	(?(DEFINE)
		(?<cat>Buster)
		(?<dog>Addie)
		(?<bird>Poppy)
	)
	Mimi
	/x;

foreach ( 'Buster Mimi', 'Roscoe', 'Buster', 'Mimi' ) {
	say "$_ ", m/$pattern/ ? "matched" : 'nope!';
	}

It’s as if the DEFINE bit is not even there:

Buster Mimi matched
Roscoe nope!
Buster nope!
Mimi matched

Outside the (DEFINE), you can reference any of the subpatterns that you created:

use v5.10;

my $pattern = qr/
	(?(DEFINE)
		(?<cat>Buster)
		(?<dog>Addie)
		(?<bird>Poppy)
	)
	(?&cat)
	/x;

foreach ( 'Buster Mimi', 'Roscoe', 'Buster', 'Mimi' ) {
	say "$_ ", m/$pattern/ ? "matched" : 'nope!';
	}

Now Buster matches because you reference that defined subpattern:

Buster Mimi matched
Roscoe nope!
Buster matched
Mimi nope!

Now it’s time for the grammar. Inside the (DEFINE), you can reference subpatterns you haven’t defined yet, and your subpatterns can get arbitrarily complex:

use v5.10;

my $pattern = qr/
	(?(DEFINE)
		(?<male> Buster | Roscoe )
		(?<female> Mimi | Juliet )
		(?<cat> (?&male) | (?&female) )
		(?<dog>Addie)
		(?<bird>Poppy)
	)
	(?&cat)
	/x;

foreach ( 'Addie', 'Roscoe', 'Buster', 'Mimi' ) {
	say "$_ ", m/$pattern/ ? "matched" : 'nope!';
	}

Even though the cat names are in two different subpatterns, the cat subpattern unifies them so all the cat names match:

Addie nope!
Roscoe matched
Buster matched
Mimi matched

You should now be able to understand this regular expression from Tom Christainsen (appearing Stackoverflow). You might have to pick it apart, but you know how all the parts fit together to match the Internet Message Format defined in RFC 5322:

$rfc5322 = qr{

   (?(DEFINE)

     (?<address>         (?&mailbox) | (?&group))
     (?<mailbox>         (?&name_addr) | (?&addr_spec))
     (?<name_addr>       (?&display_name)? (?&angle_addr))
     (?<angle_addr>      (?&CFWS)? < (?&addr_spec) > (?&CFWS)?)
     (?<group>           (?&display_name) : (?:(?&mailbox_list) | (?&CFWS))? ; (?&CFWS)?)
     (?<display_name>    (?&phrase))
     (?<mailbox_list>    (?&mailbox) (?: , (?&mailbox))*)

     (?<addr_spec>       (?&local_part) \@ (?&domain))
     (?<local_part>      (?&dot_atom) | (?&quoted_string))
     (?<domain>          (?&dot_atom) | (?&domain_literal))
     (?<domain_literal>  (?&CFWS)? \[ (?: (?&FWS)? (?&dcontent))* (?&FWS)?
                                   \] (?&CFWS)?)
     (?<dcontent>        (?&dtext) | (?&quoted_pair))
     (?<dtext>           (?&NO_WS_CTL) | [\x21-\x5a\x5e-\x7e])

     (?<atext>           (?&ALPHA) | (?&DIGIT) | [!#\$%&'*+-/=?^_`{|}~])
     (?<atom>            (?&CFWS)? (?&atext)+ (?&CFWS)?)
     (?<dot_atom>        (?&CFWS)? (?&dot_atom_text) (?&CFWS)?)
     (?<dot_atom_text>   (?&atext)+ (?: \. (?&atext)+)*)

     (?<text>            [\x01-\x09\x0b\x0c\x0e-\x7f])
     (?<quoted_pair>     \\ (?&text))

     (?<qtext>           (?&NO_WS_CTL) | [\x21\x23-\x5b\x5d-\x7e])
     (?<qcontent>        (?&qtext) | (?&quoted_pair))
     (?<quoted_string>   (?&CFWS)? (?&DQUOTE) (?:(?&FWS)? (?&qcontent))*
                          (?&FWS)? (?&DQUOTE) (?&CFWS)?)

     (?<word>            (?&atom) | (?&quoted_string))
     (?<phrase>          (?&word)+)

     # Folding white space
     (?<FWS>             (?: (?&WSP)* (?&CRLF))? (?&WSP)+)
     (?<ctext>           (?&NO_WS_CTL) | [\x21-\x27\x2a-\x5b\x5d-\x7e])
     (?<ccontent>        (?&ctext) | (?&quoted_pair) | (?&comment))
     (?<comment>         \( (?: (?&FWS)? (?&ccontent))* (?&FWS)? \) )
     (?<CFWS>            (?: (?&FWS)? (?&comment))*
                         (?: (?:(?&FWS)? (?&comment)) | (?&FWS)))

     # No whitespace control
     (?<NO_WS_CTL>       [\x01-\x08\x0b\x0c\x0e-\x1f\x7f])

     (?<ALPHA>           [A-Za-z])
     (?<DIGIT>           [0-9])
     (?<CRLF>            \x0d \x0a)
     (?<DQUOTE>          ")
     (?<WSP>             [\x20\x09])
   )

   (?&address)

}x;

If that’s not clever enough for you, try Tom’s use of (DEFINE) to properly parse HTML.

Things to remember

• You can reference a named subpattern with (?&NAME)
• You can choose a subpattern with a condition (?(condition)yes-pattern|no-pattern)
• You can define and label subpatterns for later use with (DEFINE)

You’re already using a dualvar without knowing it. The $! variable, which holds the value of the last system error, is most often used in its string form:

open my $fh, '>', $filename or die "Error: $!";

If something goes wrong with that open, you’ll get an error such as these:

No such file or directory
Permission denied

Both of those error messages have numbers associated with them. You can output their numeric value

open my $fh, '>', $filename or die $! + 0;

Now the errors are numbers, which correspond to the errno value for the system call:

2
13

These numbers are keys in the %!, and the value for that key is true if that was the last system error.

Perl, on its own, doesn’t give you a way to create this sort of variable yourself. When you assign a new value to a scalar, whether string or number, Perl clears the previous values it has. When you use a number as a string, Perl converts it to a string, and the same the other way around.

You can watch this with Devel::Peek. Here’s a program that sets a string value:

use Devel::Peek;

my $value = 'abc';

Dump( $value );

In the scalar record, the POK flag is set, indicating the variable has a string form, and the PV slot has a value (see perlguts for more details):

SV = PV(0x100801070) at 0x100827810
  REFCNT = 1
  FLAGS = (PADMY,POK,pPOK)
  PV = 0x100202870 "abc"\0
  CUR = 3
  LEN = 16

If you set a numeric value, the flags are different:

use Devel::Peek;

my $value = 137;

Dump( $value );

Now there’s an IOK flag, and one of the numeric slots, in this case the IV, is set:

SV = IV(0x100827800) at 0x100827810
  REFCNT = 1
  FLAGS = (PADMY,IOK,pIOK)
  IV = 137

However, if you take the numeric value and use it in a string context, Perl also creates a string version. Now the scalar has both the IOK and POK flags, and both the IV and PV slots have values:

137
SV = PVIV(0x100809208) at 0x100827840
  REFCNT = 1
  FLAGS = (PADMY,IOK,POK,pIOK,pPOK)
  IV = 137
  PV = 0x100202870 "137"\0
  CUR = 3
  LEN = 16

If you change the variable, some of those flags disappear, even though the values don’t necessarily disappear:

use v5.10;
use Devel::Peek;

my $value = 137;

$value = 'Buster';

Dump( $value );

Now the scalar’s value should be just Buster, but the IV slot still has the old 137. However, the IOK flag is gone:

SV = PVIV(0x100809208) at 0x100827840
  REFCNT = 1
  FLAGS = (PADMY,POK,pPOK)
  IV = 137
  PV = 0x100202870 "Buster"\0
  CUR = 6
  LEN = 16

When you set the new value, and Perl hadn’t used it in a numeric context yet, there was no need to go through the work to translate the string value to the number value. Instead, it just unset the flag that denotes its okay to use the value as a number. You have to use it as a number to again:

use v5.10;
use Devel::Peek;

my $value = 137;

$value = 'Buster';

say $value + 0;

Dump( $value );

Now Perl converts it to a number and sets the numeric flags again:

0
SV = PVNV(0x100801e30) at 0x100827840
  REFCNT = 1
  FLAGS = (PADMY,POK,pIOK,pNOK,pPOK)
  IV = 0
  NV = 0
  PV = 0x100202870 "Buster"\0
  CUR = 6
  LEN = 16

That’s how it works if you go through the Perl interface, but if you play it a scalar through the XS interface, you can set whatever flags and values that you like. That’s exactly what Scalar::Util‘s dualvar does that for you:

use v5.10;
use Devel::Peek;
use Scalar::Util qw(dualvar);

my $value = dualvar 137, 'Buster';

Dump( $value );

say "$value";
say $value + 0;

Now you have a scalar which has unrelated numeric and string values, and the flags for both values are set:

SV = PVNV(0x100802010) at 0x1008277c8
  REFCNT = 1
  FLAGS = (PADMY,IOK,POK,pIOK,pPOK)
  IV = 137
  NV = 0
  PV = 0x100202870 "Buster"\0
  CUR = 6
  LEN = 16
Buster
137

Things to remember

• Scalars can have both numeric and string values at the same time
• Those two values can be unrelated
• You can create your own dualvar with Scalar::Util

This problem has a couple tricky parts. To run a test server from your own test suite, your server needs to bind to a port that’s not already in use. When it has a port, it needs to communicate that to your test script.

Another problem, which you won’t consider for this Item, involves the configurability of your program so you can change the hostname and port during the test. This Item assumes you’ve taken are of that bit.

The Test::Fake::HTTPD module can create a web server directly from your test script. This example creates a web server that returns the same JSON response for every request:

use Test::More;
use Test::Fake::HTTPD;

use Mojo::UserAgent;

my $httpd = run_http_server {
	my $request = shift;

	return [
		200,
		[ 'Content-Type' => 'application/json' ],
		[ '{ "cat": "Buster" }' ]
		];
	};

ok( defined $httpd, 'Got a web server' );

diag( sprintf "You can connect to your server at %s.\n", $httpd->host_port );

my $response = Mojo::UserAgent->new->get(
	$httpd->endpoint
	)->res;

diag( $response->to_string );
is( $response->json->{cat}, 'Buster', 'Cat is Buster' );

done_testing();

The test output shows the a message telling you the host and port, as well as the response:

ok 1 - Got a web server
# You can connect to your server at 127.0.0.1:50602.
# HTTP/1.1 200 OK
# Content-Type: application/json
# Date: Wed, 07 Dec 2011 08:44:40 GMT
# Content-Length: 19
# Server: libwww-perl-daemon/6.00
#
# { "cat": "Buster" }
ok 2 - Cat is Buster
1..2

When the test script ends (or the web server variable goes out of scope, so there’s nothing for you to cleanup. It’s a disposable web server.

In your web server, you can do anything that you like. It doesn’t have to implement everything, or even close to everything, that the production server does. It just has to return responses that you can use in your tests. That means that you get to control not only the success, but also the failures.

That Server line gives you a hint about what created the $request object—it’s LWP behind the scenes, so it’s HTTP::Request. You can get the requested path with the uri method and decide what to do:

use strict;
use warnings;

use Test::More;
use Test::Fake::HTTPD;

use Mojo::UserAgent;
use URI;

my $httpd = run_http_server {
	my $request = shift;

	my $uri = $request->uri;

	return do {
		if( $uri->path eq '/' ) {
			[
				200,
				[ 'Content-Type' => 'text/plain' ],
				[ "Ask about our cats!" ],
			]
			}
		elsif( $uri->path eq '/cats' ) {
			[
				200,
				[ 'Content-Type' => 'application/json' ],
				[ '{ "cat": "Buster" }' ],
			]
			}
		elsif( $uri->path eq '/dogs' ) {
			[
				408,
				[ 'Content-Type' => 'text/plain' ],
				[ "We don't walk dogs" ],
			]
			}
		else {
			[
				404,
				[ 'Content-Type' => 'text/plain' ],
				[ "Not Found" ],
			]
			}
		}
	};

ok( defined $httpd, 'Got a web server' );
diag( sprintf "You can connect to your server at %s.\n", $httpd->host_port );

my $uri = URI->new( $httpd->endpoint );
isa_ok( $uri, 'URI' );

subtest '/' => sub {
	plan tests => 3;

	my $this = $uri->clone;
	isa_ok( $this, 'URI' );
	$this->path( '/' );

	my $response = Mojo::UserAgent->new->get( $this )->res;

	is( $response->headers->content_type,
		'text/plain', 'Top level is plain text' );
	like( $response->body , qr/cats/, 'Top level has cats' );
	};

subtest '/cats' => sub {
	plan tests => 2;

	my $this = $uri->clone;
	isa_ok( $this, 'URI' );
	$this->path( '/cats' );

	my $response = Mojo::UserAgent->new->get( $this )->res;

	is( $response->headers->content_type,
		'application/json', '/cats returns JSON' );
	};

subtest '/not_there' => sub {
	plan tests => 2;

	my $this = $uri->clone;
	isa_ok( $this, 'URI' );
	$this->path( '/not_there' );

	my $response = Mojo::UserAgent->new->get( $this )->res;

	is( $response->code,
		'404', '/not_there returns 404' );
	};

done_testing();

With subtests organized around accesses to paths, the TAP isn’t so hard to read (although you probably won’t have to look at it yourself):

ok 1 - Got a web server
# You can connect to your server at 127.0.0.1:50498.
ok 2 - The object isa URI
    1..3
    ok 1 - The object isa URI
    ok 2 - Top level is plain text
    ok 3 - Top level has cats
ok 3 - /
    1..2
    ok 1 - The object isa URI
    ok 2 - /cats returns JSON
ok 4 - /cats
    1..2
    ok 1 - The object isa URI
    ok 2 - /not_there returns 404
ok 5 - /not_there
1..5

If you need to use the same test webserver in more than one test script, you move it into its own file.

use strict;
use warnings;

use Test::More;

use Mojo::UserAgent;
use URI;

require 'server.pl';
my $httpd = get_http_server();

ok( defined $httpd, 'Got a web server' );
diag( sprintf "You can connect to your server at %s.\n", $httpd->host_port );

my $uri = URI->new( $httpd->endpoint );
isa_ok( $uri, 'URI' );

...

The server.pl file wraps the call to run_http_server. But, if you are going to do that, you might as well skip the convenience method and set up your own object. You can change the timeout value, for instance:

use Test::Fake::HTTPD;

sub get_http_server {
	my $httpd = Test::Fake::HTTPD->new(
		timeout => 30,
		);

	$httpd->run( sub {
		my $request = shift;
		...;
		} );

	$httpd;
	}

Different test scripts each get their own test web server. If you’re running several tests scripts in parallel, you’ll start several servers at the same time, which not be that kind to your system or to the other people using it. If you don’t like that, you could set up a single server at the start of your test run, share it with all tests, and shut down everything at the end, although you won’t see that in this Item.

Things to remember

• Test web interactions locally
• Use Test::Fake::HTTPD to create cheap, disposable web servers

The empty pattern, //

The empty pattern is a special case that’s designed to give you a list of characters. This pattern specifically has nothing in it and is different than a pattern that matches an empty string (that’s next). For this, split returns a list of characters:

use utf8;

use Data::Printer;
my @characters = split //, 'Büster';

p( @characters );

The output shows a list of characters:

[
    [0] "B",
    [1] "ü",
    [2] "s",
    [3] "t",
    [4] "e",
    [5] "r"
]

This is specifically characters, not grapheme clusters. Depending on the normalization of your source code or input, you can get different results:

use utf8;

use Data::Printer;
use Unicode::Normalize qw(NFD);

my @characters = split //, NFD( 'Büster' );

p( @characters );

Now the grapheme cluster ü is actually two characters, the u (U+0075 ʟᴀᴛɪɴ sᴍᴀʟʟ ʟᴇᴛᴛᴇʀ ᴜ) and the ¨ (U+0308 ᴄᴏᴍʙɪɴɪɴɢ ᴅɪᴀᴇʀᴇsɪs), instead of the single ü (U+00FC ʟᴀᴛɪɴ sᴍᴀʟʟ ʟᴇᴛᴛᴇʀ ᴜ ᴡɪᴛʜ ᴅɪᴀᴇʀᴇsɪs):

[
    [0] "B",
    [1] "u",
    [2] "̈",
    [3] "s",
    [4] "t",
    [5] "e",
    [6] "r"
]

You can review grapheme clusters in Treat Unicode strings as grapheme clusters.

Matching the empty string

Successfully matching no characters isn’t really a special case, but people are sometimes surprised about it because it seems special. Your split pattern might match an empty string. This is different from the empty pattern because you actually have a pattern, even if it might match zero characters. This is also distinct from a pattern that doesn’t match:

use v5.10;

my $_ = 'Mimi';

say "Matched empty pattern" if //;
say "Matched optional whitespace" if /\s*/;
say "Matched zero width assertion" if /(?=\w+)/;
say "How did Buster match?" if /Buster/;

The first three of these patterns match successfully but matches zero characters, while the fourth fails:

Matched empty pattern
Matched optional whitespace
Matched zero width assertion

It’s easy to construct a pattern that will match zero characters even though it matches successfully. The ? (zero or one) and * (zero or more) quantifiers do that quite nicely. Zero width assertions, such as the boundaries and lookarounds, do that too. If the pattern can match zero characters successfully, Perl splits into characters:

use Data::Printer;
my @characters = split /\s*/, 'Buster';

p( @characters );

[
    [0] "B",
    [1] "u",
    [2] "s",
    [3] "t",
    [4] "e",
    [5] "r"
]

The pattern doesn’t have to match zero characters for all separators.

use Data::Printer;
my @characters = split /\s*/, 'Buster and Mimi';

p( @characters );

Notice that there are no spaces in @characters, since split matched those as separator characters:

[
    [0]  "B",
    [1]  "u",
    [2]  "s",
    [3]  "t",
    [4]  "e",
    [5]  "r",
    [6]  "a",
    [7]  "n",
    [8]  "d",
    [9]  "M",
    [10] "i",
    [11] "m",
    [12] "i"
]

The single space, ‘ ‘

The single space in quotes, single or double, is a special case. It splits on whitespace, but unlike the pattern that is a single space, the one in quotes discards empty leading fields:

use Data::Printer;
my @characters = split ' ', '  Buster and Mimi';

p( @characters );

You get just the non-whitespace with no empty fields:

[
    [0] "Buster",
    [1] "and",
    [2] "Mimi"
]

This behavior comes from awk:

#!/usr/bin/awk -f
BEGIN {
    string="  Buster Mimi Roscoe";
    search=" ";
    n=split(string,array," ");
    print("[");
    for (i=1;i<=n;i++) {
        printf("    [%d] \"%s\"\n",i,array[i]);
    }
    print("]");
    exit;
}

You end up with almost the same input, although the indices are one greater:

[
    [1] "Buster"
    [2] "Mimi"
    [3] "Roscoe"
]

Back in Perl, if you tried that with the normal match operator delimiters, you get a different result:

use Data::Printer;
my @characters = split / /, '  Buster and Mimi';

p( @characters );

This time you kept the empty leading fields:

[
    [0] "",
    [1] "",
    [2] "Buster",
    [3] "and",
    [4] "Mimi"
]

If you include the m in front of the quotes though, you lose the special magic:

use Data::Printer;
my @characters = split m' ', '  Buster and Mimi';

p( @characters );

The empty leading fields are back:

[
    [0] "",
    [1] "",
    [2] "Buster",
    [3] "and",
    [4] "Mimi"
]

Splitting lines

The special pattern of just the beginning-of-line anchor, even without the /m flag, breaks a multi-line string into lines:

use Data::Printer;

my $string = <<'HERE';
Line one
Line two
Line three
HERE

my @lines = split /^/, $string;

p( @lines );

Even without the /m you get separate lines:

[
    [0] "Line one
",
    [1] "Line two
",
    [2] "Line three
"
]

This only works if the pattern is exactly /^/. If you put anything else in the pattern, you don't get the special behavior, even if it's a zero width match:

...; # same as before

my @lines = split /^(?=Line)/, $string;  # Oops

p( @lines );

Now there's only one field:

[
    [0] "Line one
Line two
Line three
Line four
"
]

Things to remember

• The empty pattern // splits on characters, but not grapheme clusters
• A zero width successful match splits on characters too
• The single space in quotes splits on whitespace and discards leading empty fields
• The ^ anchor by itself splits into lines, even without the /m

First, remember the forms of grep. There’s a single expression version and a block version:

grep EXPR, @input       # with a comma
grep { ... } @input     # no comma

That block, the {...}, is an inline subroutine where the current element shows up in $_:

my @odds = grep { $_ % 2 } @input;

For either form, there’s a scalar and list return value, depending on context (Item 12. Understand context and how it affects operations):

my @array = grep ...;
my $count = grep ...;

You can make your own subroutines that work just like grep. The prototype character & tells perl to expect a subroutine reference. However, it can only be the first argument. To try it, define a subroutine that takes a single argument, a code reference:

sub run_it (&) {
	my $sub = shift;
	$sub->();
	}

You can call that subroutine in several ways. You can use a block, the sub keyword with a block, or a reference to a subroutine, or a reference to a named subroutine:

use v5.10;

sub named { say "I have a name" }

my $result = run_it { say "Hello!" };
   $result = run_it sub { say "I have a keyword!" };
   $result = run_it \&named;

However, perl is not smart enough to recognize other forms. It won’t like a scalar variable that might have a code reference later, and it can’t take a bareword that is the name of a defined subroutine (like sort will). These are compile-time errors:

use v5.10;

sub named { say "I have a name" }
my $code_ref = \&named;

my $result = run_it $code_ref;
   $result = run_it named;
   $result = run_it &named;

Handling grep’s second argument

Now you can take a code reference as an argument. The next part of the grep syntax is the the input. You could use the @ character to denote a list of arguments (not an array argument), and that appears to work:

use v5.10;
use warnings;

sub do_with_array (&@) {
	my( $sub, @args ) = @_;
	my @output;

	foreach my $elem ( @args ) {
		local $_ = $elem;
		push @output, $sub->();
		}
	return @output;
}

sub other_cats { qw(Ellie Ginger) }

my @cats = qw(Buster Mimi Roscoe);

@result = do_with_array { say $_ } @cats;
@result = do_with_array { say $_ } qw(Buster Mimi Roscoe);
@result = do_with_array { say $_ } 1 .. 10;
@result = do_with_array { say $_ } other_cats();

Like grep which can alias $_ to the original data, you can also means that you can change the original data with your subroutine argument if you use @_ (Item 114. Know when arrays are modified in a loop):

use v5.10;
use warnings;

sub do_with_array (&@) {
   my $sub = shift;
   my @output;
   local $_;

   foreach ( @_ ) {
	   push @output, $sub->();
   }
   return @output;
}

my @original   = qw(1 2 3);
my @new        = do_with_array { $_ += 2 } @original;
say "new = @new";             # 3 4 5
say "original = @original";  # 3 4 5

You might try the \@ prototype, but that limits you in other ways. Now perl expects a named array as an argument. You cannot use an array reference, range, literal list, or the return values from a subroutine call. It’s a named array or an error. That’s no good.

Likewise, you might use the + prototype introduced in Perl 5.14. This allows you to use an array or an array reference argument. Perl doesn’t complain if you use a range or a subroutine call, but it also doesn’t do the right thing:

use v5.10;
use warnings;

sub do_with_array (&+) {
	my( $sub, $array ) = @_;
	my @output;

	foreach my $elem ( @$array ) {
		local $_ = $elem;
		push @output, $sub->();
		}
	return @output;
}

sub other_cats { qw(Ellie Ginger) }

my @cats = qw(Buster Mimi Roscoe);

@result = do_with_array { say $_ } @cats;
@result = do_with_array { say $_ } [ 'a' .. 'g' ];
@result = do_with_array { say $_ } 1 .. 10;
@result = do_with_array { say $_ } other_cats();

The named subroutine and the array reference work just fine. Perl does something weird with the range, and the subroutine call appears to not happen at all:

Buster
Mimi
Roscoe
a
b
c
d
e
f
g
Use of uninitialized value $. in range (or flip) at run_it.pl line 21.

Not only that, but the + prototype character also allows named hashes and hash references:

use v5.10;
use warnings;

sub do_with_array (&+) {
	my( $sub, $array ) = @_;
	my @output;

	foreach my $elem ( @$array ) {
		local $_ = $elem;
		push @output, $sub->();
		}
	return @output;
}

my %cats = qw(Buster Mimi Roscoe Ellie);

@result = do_with_array { say $_ } %cats;
@result = do_with_array { say $_ } { 'a' => 'b' };

You don’t get an error until runtime when you try the array dereference:

Not an ARRAY reference at run_it.pl line 8.

You can check these things at runtime, though. This reminds you, as we said in Understand why you probably don’t need prototypes, that prototypes probably don’t do what you think. You end up doing a lot of the work that most people think prototypes do for you:

use v5.10;
use warnings;
use Carp;

sub do_with_array (&+) {
	my( $sub, $array ) = @_;
	croak "do_with_array takes an array argument"
		unless ref $array eq ref [];

	my @output;

	foreach my $elem ( @$array ) {
		local $_ = $elem;
		push @output, $sub->();
		}

	return @output;
}

my @cats = qw(Buster Mimi Roscoe Ellie);
my %cats = map { $_, 1 } @cats;

@result = do_with_array { say $_ } @cats;
@result = do_with_array { say $_ } %cats;

Handling context

We explained context in Item 12. Understand context and how it affects operations, and if you want to emulate grep you have to handle them. In list context grep returns a list, in scalar context it returns a count, and in void context it potentially does nothing. You really only need to handle the void case. In this case, you’ll simply return without doing anything:

use v5.10;
use warnings;
use Carp;

sub do_with_array (&+) {
	return unless defined wantarray;
	my( $sub, $array ) = @_;
	croak "do_with_array takes an array argument"
		unless ref $array eq ref [];

	my @output;

	foreach my $elem ( @$array ) {
		local $_ = $elem;
		push @output, $sub->();
		}

	return @output;
}

The list and scalar contexts come from returning an array. When you return a named array, you get the same results as assigning an array. In list context you get the list elements, and in scalar context you get the count. If you want to return something different, such as a list instead of a named array, you have to do more work:

	return wantarray ? qw( a b c ) : 3;

So, once again, prototypes half solve the problem, but leave you with more work to do.

Things to remember

• Use the & prototype character to specify a code reference argument
• If the code reference argument argument is the first argument, you can leave off the sub keyword
• The reference has to be a block of code or a reference to a named subroutine, and specifically not a scalar variable