The Effective Perler

I’ll be at OSCON on Tuesday, July 17, but you don’t have to find me to get up to 37% off Effective Perl Programming. That’s a slightly lower price than Amazon. To get that discount, you have to buy the book at Pearson’s booth in the exhibition hall. You’ll need to track me down on Tuesday afternoon or evening if you want me to sign your book.

If you can’t make it to OSCON, you can still get 35% off the cover price by ordering directly from the InformIT discount link or using the OSCON2012 discount code when you check out. Instead of navigating their site, you can go directly to our book.

If you’re not sure you want the book, you can look at a free sample chapter, which is also 35% off during OSCON.

Pod::Simple 3.21 changed its behavior when it encountered a non-ASCII character in Pod without an encoding. Instead of handling it quietly, it now gives a warning. That’s not so bad, but Test::Pod uses Pod::Simple, and whenever it sees a warning, pod_ok fails, as it did in my Mac::Errors module:

#   Failed test 'POD test for blib/lib/Mac/Errors.pm'
#   at .../Test/Pod.pm line 182.
# blib/lib/Mac/Errors.pm (2776): Non-ASCII character seen before =encoding in 'donÍt'. Assuming ISO8859-1
# Looks like you failed 1 test of 2.
t/pod.t ...........
Dubious, test returned 1 (wstat 256, 0x100)
Failed 1/2 subtests

Unfortunately, the Pod tests are the sort that shouldn’t stop an installation, which is why many developers have a separate area for author tests (which I’ll cover in an upcoming Item). Outside of that, you have to fix the Pod.

There are two things here. First, I have a genuine error here. The module is auto generated from other source files and the “donÍt” is a mistake; it should be “don’t” (with a smart quote) or even better, “don’t”. Test::Pod didn’t catch this before. So, that’s not bad.

More importantly, telling Perl that the source code is UTF-8 isn’t enough. When you use the utf8 pragma, the perl interpreter reads the source as UTF-8:

use utf8;

However, a Pod parser ignores all the code. It looks for Pod sections and never sees that pragma, nor does it care. You have to tell the pod which encoding you have if you want to use something outside of ASCII:

=encoding utf8

I hadn’t used that in Mac::Errors, or any of my other modules, although in some of them I had used genuine UTF-8 sequences. Now any person using Test::Pod with the latest Pod::Simple won’t be able to install those modules normally. That is, until I fix them.

I could use other encodings, such as ISO-8859-1, as long as I declare the right thing and save the file correctly.

Things to remember

• The utf8 pragma doesn’t affect the Pod
• Pod::Simple assumes ASCII unless you tell it otherwise
• Declare your Pod encoding with the =encoding directive

The Perl Authors Upload Server (PAUSE) is responsible for analyzing distributions on their way to CPAN. PAUSE indexes the distributions to discover the package names that it contains so it can add them to the data files that many of the CPAN clients use to figure out what to download to install the module that you request. It also compares the package names that it finds to a list of permissions it maintains.

The mldistwatch program is reponsible for this bit. It tries two things to find the packages in the distribution. If it can read the META.yml (or META.json) to get the data. Otherwise, it examines files directory to look for package declarations. Sometimes these come up with the wrong answers.

First, there’s an easy fix to package statements in code. After ignoring text in Pod or after __END__ or __DATA__, PAUSE looks for package statements appearing on a single line:

# from PAUSE::pmfile::packages_per_pmfile()
           $pline =~ m{
                      (.*)
                      \bpackage\s+
                      ([\w\:\']+)
                      \s*
                      (?: $ | [\}\;] | ($version::STRICT) )
                    }x

If your complete package statement isn’t on a single line, then that won’t match it. Since Perl has insignificant whitespace, including vertical whitespace, you could to this:

package
    hide::this::package;

You might even leave yourself (or other developers) a note about the importance of that whitespace now:

package # hide from pause
    hide::this::package;

Indeed, if you grep CPAN, you’ll find hide from pause in many distributions.

That’s the easy way, although it’s kludgey and relies on a special case in the PAUSE code. Other indexers might not honor it. There’s a better way for you to explicitly tell an indexer what namespaces you want to advertise. You add them to the provides section of META.yml:

provides:
  Cats::Buster:
	file: lib/Cats/Buster.pm
	version: 0.01

The data in come from the META-spec. Module::Build will automatically create these entries in META.yml for you. The indexer can use these to know what’s in the distribution without directly examining module files.

If there are multiple packages declarations, all of them shown up in META.yml:

provides:
  Cats::Buster:
    file: lib/Test/Provides.pm
    version: 0.01
  Cats::Mimi:
    file: lib/Test/Provides.pm
    version: 0,02
  version:
    file: lib/Test/Provides.pm
    version: 0.01

Notice that version shows up in that list. You may have included it in your module to extend or override parts of that core module, but you don't want people who want the real version to install your module to get it. You might only declare that package in your module as a temporary workaround and don't intend it to be a permanent part of the work. They probably wouldn't be able to do that anyway since PAUSE would recognize that you included a package for which you do not have permissions and would not index it. A site such as CPAN Search might mark your otherwise good distribution as "UNAUTHORIZED. Module::Build doesn't know to exclude version, at least not by default.

To hide that package from indexers, you can specify it in no_index. In Build.PL, you can use META_ADD to specify that parts of the META-spec not already supported by other arguments to new:

use Module::Build;

my $builder = Module::Build->new(
	...,
	meta_add => {
		no_index => {
			package   => [ qw( version Local ) ],
			directory => [ qw( t/inc inc ) ],
			file      => [ qw( t/lib/test.pm ) ],
			namespace => [ qw( Local ) ],
			},
		},
);

The directory and file keys tell the indexer to ignore those parts of the distribution. The package tells the indexer to ignore exactly those packages. The curious one is namespace, which tells the indexer to ignore namespaces under that namespace.

Likewise, you can do the same in Makefile.PL with a recent enough version:

use ExtUtils::Makemaker 6.48;

WriteMakefile(
	...,
	META_ADD => {
		no_index => {
			package   => [ qw( version Local ) ],
			directory => [ qw( t/inc inc ) ],
			file      => [ qw( t/lib/test.pm ) ],
			namespace => [ qw( Local ) ],
			},
		},
	);

Otherwise, it examines the module files to find package statements, but it does it without running the code.

But, what if provides and no_index have conflicting instructions? The META-spec doesn't give any guidance for indexers in those cases. PAUSE filters on no_index last. This means that PAUSE and other indexers might leave out files you specify in provides but then exclude in no_index.

Things to remember

• Spread the package statement over two or more lines to hide it from PAUSE
• Use provides to advertise the namespaces a distribution comprises.
• Use no_index to limit what an indexer sees or reports.

Perl 5.14 added an auto-dereferencing features to the hash and array operators, and I wrote about those in Use array references with the array operators. I’ve never particularly liked that feature, but I don’t have to like everything. Additionally, Perl 5.12 expanded the job of keys and values to also work on arrays.

chromatic has explicated a problem with each, which is both an array and hash operator. He details it in Inadvertent Inconsistencies: each in Perl 5.12 and Inadvertent Inconsistencies: each versus Autoderef. In short, if you use it with a reference, Perl doesn’t know until it actually executes the each if it’s going to use it’s array or hash behavior (and in some cases, blow up with either). However, as the programmer, I probably know which behavior I want:

while( my( $index, $value ) = each $ref ) { my $elem = $other_array->[$index]; } # I want array behavior
while( my( $key, $value ) = each $ref ) { ... } # I want hash behavior

The problem isn’t when it blows up, which is easy to catch (it blows up). If you get the wrong sort of reference, you’ll get nonsensical indices or keys. If you have an array reference, you’ll get numbers with the first return value. If you have a hash reference, you’ll get strings. If you get strings but treat them as array indices, you’ll likely always get array index 0, unless the key is a number. You might even get an odd index. If the key is 123Buster, you’ll get array index 123 due to Perl’s numification. Going the other way, using an array reference when you expected a hash, you’ll have to find keys that are whole numbers.

Effective programs reduce ambiguity in their code, but this new feature increases it. It’s easy to fix; you dereference them yourself. If you have the wrong reference type, you’ll find out right away:

while( my( $index, $value ) = each @$ref ) { my $elem = $other_array->[$index]; } # I want array behavior
while( my( $key, $value ) = each %$ref ) { ... } # I want hash behavior

If you really wanted to keep the auto-dereferencing feature, you could check the reference type before you use it, but what’s the point of saving a character with the auto-dereferencing if you have to wrap the whole thing in a guard condition?

if( ref $ref eq ref [] ) {
    while( my( $index, $value ) = each @$ref ) { ... }
    }

Now keys has the same problem. You can use that either with an array or a hash, but at some point you’re probably going to have to know what sort of reference you have so you can use the key to dereference it. At that point, you effectively declare what sort of reference it should have been. If you have the wrong sort of reference, your script dies:

my $ref = [ ... ];
foreach my $key ( keys $ref ) {
    my $elem = $ref->{$index}; # Big error!
    }

This problem is the unintended consequence of letting the other array and hash operators take a scalar variable as an argument and letting the parser automatically add the bits to dereference. David Golden wanted more magic syntax and the patch wasn’t so tough. To get the nicer syntax in some cases you end up dealing with more special cases. I noted this at the time David proposed it, but his enthusiasm for the interesting parts of the problem steamrolled over the bad parts.

Perl comes with extracts of the Unicode character data, but it hasn’t been easy to look up all of the information Perl knows about a character. Perl v5.15.7 adds a way to created an inverted map based on the property that you want to access.

The Unicode::UCD module gives you access to some of the information about a character:

use Unicode::UCD 'charinfo';
use charnames qw(:full);
use Data::Dumper;

my $charinfo   = charinfo(
	ord( "\N{SMILING CAT FACE WITH OPEN MOUTH}" )
	);
print Dumper( $charinfo );

The output has many of the properties, but not all of them:

$VAR1 = {
		  'digit' => '',
		  'bidi' => 'ON',
		  'category' => 'So',
		  'code' => '1F63A',
		  'script' => 'Common',
		  'combining' => 0,
		  'upper' => '',
		  'name' => 'SMILING CAT FACE WITH OPEN MOUTH',
		  'unicode10' => '',
		  'decomposition' => '',
		  'comment' => '',
		  'mirrored' => 'N',
		  'lower' => '',
		  'numeric' => '',
		  'decimal' => '',
		  'title' => '',
		  'block' => 'Emoticons'
		};

This doesn’t include the Age of the character, that is, when the character was added to Unicode. This might seem like a silly thing to know, but it came in handy typesetting Programming Perl. We had problems with some characters but we couldn’t see a pattern until we looked at the age of all the problem characters. Any character added after Unicode 4.0 didn’t typeset correctly. It took some annoying work to get the age by scanning through each age until that property matched:

#!/Users/brian/bin/perls/perl5.15.7

use v5.10;
use utf8;

use List::Util qw(first);

my @chars =  ( 'a', '→', '⣽', "\N{SMILING CAT FACE WITH OPEN MOUTH}" );

my @ages = qw( 1.1 2.1 2.0 3.0 3.1 3.2 4.0 4.1 5.0 5.1 5.2 6.0 );

foreach my $char ( @chars ) {
	my $age = first { $char =~ /\p{Age=$_}/ } @ages;
	say "Age: $age";
	}

It works, but it’s an unsatisifying kludge:

a Age: 1.1
→ Age: 1.1
⣽ Age: 3.0
😺 Age: 6.0

Now, Unicode::UCD has a prop_invmap to create an index based on a property you choose and a _search_invlist to return the offset in the map:

#!/Users/brian/bin/perls/perl5.15.7

use 5.15.7;
use utf8;

use charnames qw(:full);
use List::Util qw(first);
use Unicode::UCD;

my @chars =  ( 'a', '→', '⣽', "\N{SMILING CAT FACE WITH OPEN MOUTH}" );

my @ages = qw( 1.1 2.1 2.0 3.0 3.1 3.2 4.0 4.1 5.0 5.1 5.2 6.0 );

foreach my $char ( @chars ) {
	my $age = age_of_char( $char );
	say "$char Age: $age";
	}

sub age_of_char {
	my( $char ) = @_;
	# create the inverted list, once
	# can only initialize as scalar
	state $inv = _make_age_inverted_list();

	my $i = Unicode::UCD::_search_invlist($inv->[0], ord $char);
	return $inv->[1][$i];
	}

# create the inverted list, once
sub _make_age_inverted_list {
	state( $list, $map, $format, $default, $init );
	unless( $init++ ) {
		($list, $map, $format, $default) = Unicode::UCD::prop_invmap("Age");
		$format eq "s" || die "wrong format $format";
		}
	return [ $list, $map ];
	}

That looks like a lot of work, but most of it happens once to setup the inversion map.

You might think that you know how to compare strings regardless of case, and you’re probably wrong. After you read this Item, you’ll be able to do it correctly and without doing any more work than you were doing before. Perl handles all the details for you.

If you grew up in the ASCII world, case insensitivity is a difference of literally one bit, so changing case is setting or unsetting a bit in the octet that represents that character.

If you’ve read the Perl FAQ, you may have seen this quip:

“Perl” is the name of the language. Only the “P” is capitalized. The name of the interpreter (the program which runs the Perl script) is “perl” with a lowercase “p”.

When Larry Wall was asked what the difference between “Perl” and “perl”, he said “One bit”. It’s literally a difference of flipping one bit in the ASCII representation. That’s as complicated as ASCII case folding gets.

The capital letter P has the ordinal value 0b1010000. The small letter p, which shows up later in the ASCII sequence, has the ordinal value 0b1110000. This makes it extremely easy to write routines to change between upper and lower cases:

use v5.10;

say "  U L";
say "-----";

foreach my $char ( qw(p P a b c A B C) ) {
	my $lower = chr( ord($char) | 0b0100000 );
	my $upper = chr( ord($char) & 0b1011111 );

	say "$char $upper $lower";
	}

The output shows what you’d expect for the upper and lower cases:

  U L
-----
p P p
P P p
a A a
b B b
c C c
A A a
B B b
C C c

Since bit flipping is easy to do, it’s very easy for even primitive computers to quickly change case (assuming that you’re not so primitive as to not have two cases). But, this only works if you restrict the output to the ASCII letters. If you want to handle non-letters, you have to do a bit more work to ensure that you don’t shift them into other characters:

use v5.10;

say "  U L";
say "-----";

foreach my $char ( qw(p P a b c A B C # !) ) {
	my $upper = uppercase( $char );
	my $lower = lowercase( $char );

	say "$char $upper $lower";
	}

 sub lowercase {
 	my $_ = shift;
  	my $ord = ord();

 	return $_ unless $ord >= 0x41 and $ord <= 0x5A;
	return chr( $ord ^ 0b100000 );
	}

 sub uppercase {
 	my $_ = shift;
 	my $ord = ord();

 	return $_ unless $ord >= 0x61 and $ord <= 0x7A;
	return chr( $ord ^ 0b100000 );
	}

Now the non-letters stay the same character:

  U L
-----
p P p
P P p
a A a
b B b
c C c
A A a
B B b
C C c
# # #
! ! !

This almost works for Latin-* encodings too. When you move out of the ASCII sequence into Unicode, you don't have this luxury, and it's not merely a representational issue.

If you were infected with ASCII early, you've grown up thinking that you can go back and forth between upper and lower cases and always get the same result. Outside of ASCII, that's not necessarily true. Consider the word "Reichwaldstraße", a common street name in Germany. The "straße" has the special character ß (U+00DF ʟᴀᴛɪɴ ꜱᴍᴀʟʟ ʟᴇᴛᴛᴇʀ ꜱʜᴀʀᴘ ꜱ). which is a ligature of a long s, the fancy ſ (U+017F ʟᴀᴛɪɴ ꜱᴍᴀʟʟ ʟᴇᴛᴛᴇʀ ʟᴏɴɢ ꜱ) that you may have seen in historical documents, and the familiar short s. Put them together, ſs, and move them close enough and you can see how you would end up with ß once you connect the hanging portion of the long s with the top of the short s. The UCS has an uppercase version (U+1E9E ʟᴀᴛɪɴ ᴄᴀᴘᴛɪᴀʟ ʟᴇᴛᴛᴇʀ ꜱʜᴀʀᴘ ꜱ), although no one uses it aside from saying that no one uses it. U+1E9E lowercases to U+00DF, but U+00DF has no single character uppercase version; it's the two characters SS. The lowercase of SS, however, is ss:

use utf8;

my $string = "Reichwaldstraße";

my $upper = uc( $string );
my $lower = lc( $upper  );

print <<"HERE";
Started with: $string
Upper:        $upper
Lower:        $lower
HERE

The output shows that you don't get back to the original:

Started with: Reichwaldstraße
Upper:        REICHWALDSTRASSE
Lower:        reichwaldstrasse

There's another s that causes problems: the Greek sigma, which comes in two lowercase forms. One appears in the middle of words and the other appears at the end, as in όσος, where σ and ς represent the same thing, just in different forms mandated by their position:

use utf8;

my $char = "όσος";

my $upper = uc( $char );
my $lower = lc( $upper );

print <<"HERE";
Started with: $char
Upper:        $upper
Lower:        $lower
HERE

Again, the lowercase version at the end is different than what you started with:

Started with: όσος
Upper:        ΌΣΟΣ
Lower:        όσοσ

This means that you can't merely use lc to normalize text for case insensitive comparison. These won't compare correctly:

lc( "Reichwaldstraße" ) eq lc( "REICHWALDSTRASSE" );  # Nope!
lc( 'όσος' ) eq lc( 'ΌΣΟΣ' );                         # Nope!

You might object that these are different strings and that they shouldn't be the same, but where did these strings start? Perhaps that REICHWALDSTRASSE was not originally all uppercase, but changed by some stupid filters between you and the original information (and with a name like mine, I know about stupid casing filters). That's part of the ASCII infection.

So, lc is the wrong way. Sadly, we do this incorrectly in Learning Perl, when we show this subroutine we want to sort:

sub case_insensitive { "\L$a" cmp "\L$b" }

The Unicode specification solves this with its case folding rules. In short, it folds characters with different case forms into a common form. There's not a rule for this; they do it by exhaustion, specifying the common form for each fold. The common form is defined in the Unicode Character Database, which the Perl developers have digested into the files you find in the unicore/ directory in your Perl library. Here's a few lines from unicore/CaseFolding.txt:

0050; C; 0070; # LATIN CAPITAL LETTER P
0051; C; 0071; # LATIN CAPITAL LETTER Q
0052; C; 0072; # LATIN CAPITAL LETTER R
00DF; F; 0073 0073; # LATIN SMALL LETTER SHARP S
03A3; C; 03C3; # GREEK CAPITAL LETTER SIGMA
03C2; C; 03C3; # GREEK SMALL LETTER FINAL SIGMA
FB00; F; 0066 0066; # LATIN SMALL LIGATURE FF
FB01; F; 0066 0069; # LATIN SMALL LIGATURE FI
FB02; F; 0066 006C; # LATIN SMALL LIGATURE FL
FB03; F; 0066 0066 0069; # LATIN SMALL LIGATURE FFI
FB04; F; 0066 0066 006C; # LATIN SMALL LIGATURE FFL

The first column is the code number of the original character, the second is the type of folding (explained in the data file and coming up later), and the third column are the code numbers that form the common, folded ("equivalent") version. Essentially, it's a big hash. Notice that some of the folded versions are multiple characters. You're not going to get that with bit fiddling.

Case folding takes the character in the first column and turns them into the characters in the third column, then takes the result and does it again until there are no more folds possible. It keeps doing that until there is nothing to replace. Characters that don't have an entry in this file fold into themselves. You case fold to compare strings, not to normalize strings for storage or other uses. Case folding makes case insensitive comparisons very fast, but it also loses information that you can't recover. You can read the exact rules in Section 5.18, "Case mapping", of the Unicode Standard.

To see how that works, try that with Reichwaldstraße and όσος. All characters except two stay the same, and two use the mapping from unicore/CaseFolding.txt:

• Reichwaldstraße → reichwaldstrasse
• REICHWALDSTRASSE → reichwaldstrasse
• όσος → ΌΣΟΣ
• ΌΣΟΣ → όσοσ

To implement these operations, Perl v5.16 adds the fc built-in function. Instead of lc, use that:

use v5.15.8;  # until we get v5.16  XXX feature
fc( "Reichwaldstraße" ) eq fc( "REICHWALDSTRASSE" );  # Yep!
fc( 'όσος' ) eq fc( 'ΌΣΟΣ' );                         # Yep!

If you don't have v5.16, you can use the fc front the Unicode::CaseFold module on CPAN.

If you wanted to do this inside a double-quoted string, you can use the \F case shift operator (but be aware of the things we noted in Understand the order of operations in double quoted contexts). Our Learning Perl example could change to:

sub case_insensitive { "\F$a" cmp "\F$b" }

More complicated folds

Looking back at the extract of unicore/CaseFolding.txt, you might remember that I skipped over the second column, the mapping status. Those letters stand for different folding rules:

• C: common case folding
• F: full case folding (strings may grow in length)
• S: simple case folding (map to single characters)
• T: special case for uppercase I and dotted uppercase I

The "T" status stands in for folds that the general rules can't handle, mostly some characters from Turkish and similar languages.

So far, Perl's fc only handles the "F" status for full case folding. It doesn't handle the special folding you'll find in unicore/SpecialCasing.txt that has the oddball situations, such as multiple source characters folding onto other multiple characters. If you want to handle those, you're on your own, although the Unicode::Casing module on CPAN might help.

Many of the folding rules depend on the source language, so you'll probably want to pay special attention if you are using that language or completely ignore them if you are not.

Besides that, the Universal Character Set gives people much more of a chance to mess up. Suppose that you want to write "β-carotene", that thing you get from carrots. That first character is β (U+03B2 ɢʀᴇᴇᴋ ꜱᴍᴀʟʟ ʟᴇᴛᴛᴇʀ ʙᴇᴛᴀ). Some people might think it looks like ß (U+00DF ʟᴀᴛɪɴ ꜱᴍᴀʟʟ ʟᴇᴛᴛᴇʀ ꜱʜᴀʀᴘ ꜱ), and that's good enough for them. No amount of case folding is going to let you know that someone used an incorrect character. But, this is also one of the benefits of Unicode: characters know what they are.

Another correct way

There's another correct way to check strings regardless of case. You can use the /i flag on the match operator. The Unicode-aware Perl regex engine handles the rest:

use utf8;
use v5.15.7;

use Set::CrossProduct;

my $string = "Reichwaldstraße";

my $upper = uc( $string );
my $lower = lc( $upper  );

my $sets = Set::CrossProduct->new(
	[
	[ $string, $upper, $lower ],
	[ $string, $upper, $lower ],
	]
	);

foreach my $tuple ( $sets->combinations ) {
	my( $l, $r ) = @$tuple;
	next if $l eq $r;

	say "lc($r) eq lc($l)  ? ", lc($r) eq lc($l) ? "matched" : "failed";
	say "fc($r) eq fc($l)  ? ", fc($r) eq fc($l) ? "matched" : "failed";
	say "$r =~ m/$l/i      ? ", $l =~ m/$r/i ? "matched" : "failed";

	say;
	}

In the output, you can see that lc sometimes fails, but that the fc and m//i always works:

lc(REICHWALDSTRASSE) eq lc(Reichwaldstraße)  → failed
fc(REICHWALDSTRASSE) eq fc(Reichwaldstraße)  → matched
REICHWALDSTRASSE =~ m/Reichwaldstraße/i      → matched

lc(reichwaldstrasse) eq lc(Reichwaldstraße)  → failed
fc(reichwaldstrasse) eq fc(Reichwaldstraße)  → matched
reichwaldstrasse =~ m/Reichwaldstraße/i      → matched

lc(Reichwaldstraße) eq lc(REICHWALDSTRASSE)  → failed
fc(Reichwaldstraße) eq fc(REICHWALDSTRASSE)  → matched
Reichwaldstraße =~ m/REICHWALDSTRASSE/i      → matched

lc(reichwaldstrasse) eq lc(REICHWALDSTRASSE)  → matched
fc(reichwaldstrasse) eq fc(REICHWALDSTRASSE)  → matched
reichwaldstrasse =~ m/REICHWALDSTRASSE/i      → matched

lc(Reichwaldstraße) eq lc(reichwaldstrasse)  → failed
fc(Reichwaldstraße) eq fc(reichwaldstrasse)  → matched
Reichwaldstraße =~ m/reichwaldstrasse/i      → matched

lc(REICHWALDSTRASSE) eq lc(reichwaldstrasse)  → matched
fc(REICHWALDSTRASSE) eq fc(reichwaldstrasse)  → matched
REICHWALDSTRASSE =~ m/reichwaldstrasse/i      → matched

The match operator isn't useful for sort though, since you can only tell if the strings are the same.

Things to remember

• Case-folding is more complicated than merely lowercasing.
• The fc does proper case folding according to the Unicode standard.
• The \F case fold operator does full case folding in double-quoted contexts.

What if you want to write a recursive subroutine but you don’t know the name of the current subroutine? Since Perl is a dynamic language and code references are first class objects, you might not know the name of the code reference, if it even has a name. Perl 5.16 introduces __SUB__ as a special sequence to return a reference to the current subroutine. You could almost do the same thing without the new feature, but each of those have drawbacks you might want to avoid.

Although __SUB__ looks like __FILE__, __LINE__, and __PACKAGE__, each of which are compile-time directives, the __SUB__ happens at run time so you can use it with subroutines you define later.

First, consider how you’d try to do this without the __SUB__ feature. You could declare a variable to hold a subroutine reference then in a later statement define the subroutine. Since you’ve already declared the variable, you can use it in the definition. Perl won’t de-reference it until you actually run the subroutine, so it doesn’t matter that it’s not a reference yet:

use v5.10;

my $sub;

$sub = sub {
	state $count = 10;
	say $count;
	return if --$count < 0;
	$sub->();
	};

$sub->();

Your output is a countdown:

10
9
8
7
6
5
4
3
2
1
0

To do that, there are two requirements: the code reference must be stored in a variable, and the variable must already be defined. That’s not always convenient. Not only that, your anonymous subroutine contains a reference to itself, so you’d either have to play games with weak references or just let the reference live forever. Neither of those are attractive.

Rafa�l Garcia-Suarez solved these problems by creating Sub::Current to give you a ROUTINE function that returns a reference to the current subroutine, even if it is a named subroutine:

use v5.10;
use Sub::Current;

sub countdown {
	state $count = 10;
	say $count;
	return if --$count < 0;
	ROUTINE->();
	};

countdown();

You might want to define these code references as a single statement, even you don’t need to. This is useful for inline subroutines where you want to define the code reference in the parameter list:

use v5.10;
use Sub::Current;

sub run { $_[0]->() };

run( sub {
		state $count = 10;
		say $count;
		return if --$count < 0;
		ROUTINE->();
		}
	);

You may want to define the subroutine in one statement as a return value:

use v5.10;
use Sub::Current;

sub factory {
	my $start = shift;
	sub {
		state $count = $start;
		say $count;
		return if --$count < 0;
		ROUTINE->();
		}
	};

factory(4)->();

Using this module has the disadvantage of a CPAN dependency, although a very light one because it’s self contained. There’s another module, Devel::Caller, from Richard Clamp that can can get a code reference from any level in the call stack, including the current level:

use v5.10;
use Devel::Caller qw(caller_cv);

sub factory {
	my $start = shift;
	sub {
		state $count = $start;
		say $count;
		return if --$count < 0;
		caller_cv(0)->();
		}
	};

factory(7)->();

Perl 5.16 lets you do the same thing without the CPAN module:

use v5.15.6;  # until v5.16 is released

sub factory {
	my $start = shift;
	sub {
		state $count = $start;
		say $count;
		return if --$count < 0;
		__SUB__->();
		}
	};

As with many new features added since Perl v5.10, you can enable __SUB__ with a use VERSION statement,
as you see in the previous example, or with the feature pragma and the current_sub import:

use feature qw(say state current_sub);

sub factory {
	my $start = shift;
	sub {
		state $count = $start;
		say $count;
		return if --$count < 0;
		__SUB__->();
		}
	};

factory(7)->();

Things to remember

• Perl v5.16 provides the __SUB__ directive to return a reference to the currently running subroutine
• Import this new feature by requiring the Perl version or through
  the feature pragma

• Prior to Perl v5.16, you can do this the same thing with Sub::Current

Perl’s powerful string manipulation tools include case-shifting operators that change the parts of a double-quoted string. There are many other things that happen in a double-quoted string too, so you need to know where these operators fit in with each other.

A double-quoted string has three features:

• Variable interpolation
• Escaped and logical characters
• Case shift operators

You might have missed this because the documentation doesn’t emphasize it. There is a single sentence in perlop, but in relation to the regular expression operators and the \Q:

For double-quoted strings, the quoting from \Q is applied after interpolation and escapes are processed.

If you don’t pay attention to the order of these operations, you’ll get results that you might not expect. The problem is that the order of operations isn’t the same in all double-quoted contexts.

In strings, the order of operations is the same as listed earlier:

• Variable interpolation
• Escaped and logical characters
• Case shift operators

Variable interpolation

You already know about variable interpolation. This is one of Perl’s greatest features, and the one I miss the most when I have to use a different language:

my $cat = 'Roscoe';
my $string = "Buster $cat Mimi";

In a double quoted context, Perl substitutes the value of $cat. You end up with Buster Roscoe Mimi.

Case-shift operators

The case-shift operators change parts of a double-quoted string. Although we call them “case shift”, not all of them change the case.

The \F and fc are new for the yet unreleased Perl v5.16. Those will show up in a different Item. Notice there’s no \f for a fcfirst. That double-quoted sequence already means “form feed”, the instruction to printers to stop the current page and start a new page.

Look at some examples using these in a double-quoted string:

% perl -e 'print "\ubuster\n"'
Buster
% perl -e 'print "\LBUSTER\n"'
buster
% perl -e 'print "\Ubuster\n"'
BUSTER
% perl -e 'print "\Ubus\Eter\n"'
BUSter
% perl -e 'print "\LBUST\EER\n"'
bustER
% perl -e 'print "\QP*rl\n"'
P\*rl\

That last one is a bit odd. It looks like it ends with a \. It doesn’t really end like that because there’s a newline that \Q quoted:

% perl -e 'print "\QP*rl\n"' | hexdump -C
00000000  50 5c 2a 72 6c 5c 0a                 |P\*rl\.|
00000007

Perl handled the “\n” before it handled the \Q, but the meta-character quoter thinks the newline is a special character so it escapes it. An escaped newline is just a newline, though.

Now, combine these with variable interpolation. Perl handles the variables first then does the case shifting:

use 5.14.1;

my $cat = 'Buster';

say "Roscoe $cat Mimi";
say "Roscoe \U$cat Mimi";
say "Roscoe \U$cat\E Mimi";

The results are probably not surprising. The first line is just interpolation, the second line uppercases everything from \U to the end, and the third line uppercases only the parts between the \U and the \E:

Roscoe Buster Mimi
Roscoe BUSTER MIMI
Roscoe BUSTER Mimi

If the case shift happens after interpolation, you might think that you could interpolate a case shift:

use 5.14.1;

my $cat = '\UBuster'; # no case shift in a single quote!

say "Roscoe $cat Mimi";

That doesn’t work though. The intended case shift operator shows up as literal characters because Perl doesn’t do double processing:

Roscoe \UBuster Mimi

A \U inside the string doesn’t bother the escaped characters because Perl has already processed those:

use 5.14.1;

my $cat = 'Buster';

say "Roscoe \U$cat\a\n Mimi";

The “\n” is still a newline and the “\a” is still the bell, and everything after the \U is uppercased (if it has an uppercase equivalent).

That seems simple enough. It’s variable interpolation followed by character escapes followed by case shifting. But this is Perl, so it can’t be that easy.

Regular expression double quoting

The regular expression operators (qr, m//, and s///) handle the double quote operations differently. From perlop:

For the pattern of regex operators (qr//, m// and s///), the quoting from \Q is applied after interpolation is processed, but before escapes are processed.

Now the order is of operations is:

• Variable interpolation
• Case shift operators
• Escaped and logical characters

You can see this when you print the stringified forms of the patterns:

% perl -le 'print qr/\Q\n/'
(?-xism:\\n)
% perl -le 'print qr/\U\n/'
(?-xism:\N)

You probably expect all of these to match, but not all of them do:

% perl -le 'print "\n" =~ qr/\n/ ? "Yes" : "No"'
Yes
% perl -le 'print "\n" =~ qr/\Q\n/ ? "Yes" : "No"'
No
% perl -le 'print "\n" =~ qr/\U\n/ ? "Yes" : "No"'
No
% perl -le 'print "\n" =~ qr/\l\n/ ? "Yes" : "No"'
Yes
% perl -le 'print "\n" =~ qr/\L\n/ ? "Yes" : "No"'
Yes

The last two times are curious. The \l and \L leave the n as a lowercase n so in the last step, the \n is still a newline. Those two tests still match.

This means that you can construct a string and a pattern with the same sequence of characters, but they might not match:

% perl -le 'print "\Q\n" =~ qr/\Q\n/ ? "Yes" : "No"'
No
% perl -le 'print "\U\n" =~ qr/\U\n/ ? "Yes" : "No"'
No
% perl -le 'print "\L\n" =~ qr/\L\n/ ? "Yes" : "No"'
Yes

It’s even worse. What does the \N mean? It depends on the Perl version:

% perl5.10.1 -le 'print "\n" =~ qr/\N/ ? "Yes" : "No"'
Missing braces on \N{} in regex; marked by <-- HERE in m/\N <-- HERE / at -e line 1.
% perl5.12.1 -le 'print "\n" =~ qr/\N/ ? "Yes" : "No"'
No
% perl5.14.1 -le 'print "\n" =~ qr/\N/ ? "Yes" : "No"'
No

Perl v5.12 added \N as "not a newline" to replace the . no matter which default regex switches you have. That's why Perl v5.10 thinks you have an incomplete \N{CHARNAME}. The others match a newline because the case shift happens in the middle of the process:

% perl5.10.1 -le 'print "\n" =~ qr/\L\N/ ? "Yes" : "No"'
Yes
% perl5.14.1 -le 'print "\n" =~ qr/\L\N/ ? "Yes" : "No"'
Yes
% perl5.8.9 -le 'print "\n" =~ qr/\L\N/ ? "Yes" : "No"'
Missing braces on \N{} at -e line 1, near "\L"
Execution of -e aborted due to compilation errors.

With the \N{CHARNAME} syntax, you can match characters by their name in the Universal Character Set. Here you match an uppercase A:

% perl -Mcharnames=:full -le 'print "A" =~ qr/\N{LATIN CAPITAL LETTER A}/ ? "Yes" : "No"'
Yes

If you put a \L in front of that, you might think it would match the lowercase version of the named letter. There's no such luck because the \L affects the pattern before the \N{CHARNAME}:

% perl -Mcharnames=:full -le 'print "A" =~ qr/\L\N{LATIN CAPITAL LETTER A}/ ? "Yes" : "No"'
No
% perl -Mcharnames=:full -le 'print "a" =~ qr/\L\N{LATIN CAPITAL LETTER A}/ ? "Yes" : "No"'
No

The \N turns into a newline and the braces are now for a quantifier with a non-number in it:

% perl -Mcharnames=:full -le 'print qr/\L\N{LATIN CAPITAL LETTER A}/'
(?-xism:\n{u+41})

You might think that this would match anything since that should probably turn into \n{0} just like the values in the array index turn into integers. The perlre section on "Quantifiers" don't say what should happen, but if it's not a number, the braces become literals. Here's a simple demonstration that those braces are literals:

% perl -le 'print "\n{a}" =~ qr/\n{a}/ ? "Yes" : "No"'
Yes

Here's the pattern you created before, and that you want to match now:

% perl -Mcharnames=:full -le 'print qr/\L\N{LATIN CAPITAL LETTER A}/'
(?^u:\n{u+41})

It doesn't match a lowercase a:

$ perl -Mcharnames=:full -le 'print "a" =~ qr/\L\N{LATIN CAPITAL LETTER A}/ ? "Yes" : "No"'
No

It doesn't match a newline either. The pattern in \n{u+41} and that's not a quantifier. There are some characters after the \n, so the target string doesn't have enough characters to match:

% perl -Mcharnames=:full -le 'print "\n" =~ qr/\L\N{LATIN CAPITAL LETTER A}/ ? "Yes" : "No"'
No

Using the regular expression text doesn't work either, which you might miss on the first pass:

% perl -Mcharnames=:full -le 'print "\n{u+41}" =~ qr/\L\N{LATIN CAPITAL LETTER A}/ ? "Yes" : "No"'
No

Of course! That + is a quantifier, so it isn't a literal character that should show up in the string. So this works:

% perl -Mcharnames=:full -le 'print "\n{u41}" =~ qr/\L\N{LATIN CAPITAL LETTER A}/ ? "Yes" : "No"'
Yes

This works too because you can have one or more of u:

% perl -Mcharnames=:full -le 'print "\n{uuuuu41}" =~ qr/\L\N{LATIN CAPITAL LETTER A}/ ? "Yes" : "No"'
Yes

If you don't want the \L to extend into character name sequence, you can use the \E to limit its effect:

% perl -Mcharnames=:full -le 'print "bar" =~ qr/\LB\E\N{LATIN SMALL LETTER A}r/ ? "Yes" : "No"'
Yes

Things to remember

• The double quote string constructor handles variable interpolation, special characters, and case shift operators in that order.
• The regular expression operators handles variable interpolation, case shift operators, and special characters in that order.
• Double-quoted interpolation in a match operator happens before regular expression compilation.
• The min-max quantifier is only a quantifier if you give it numbers. Otherwise, it's literal characters.

Two years ago, Josh McAdams and I started The Effective Perler as an extension of the second edition of Effective Perl Programming. Since then, roughly once a week, we added one meaty Item a week. Last month, we published our 100th Item. With the 120 Items in the book, that’s a lot of items.

I have a new plan for 2012 onward. It’s much harder to find topics now and it takes much longer to research and write them. I’ve exhausted all of the advice I have and all of the easy topics. When I think I have a good idea, I now know to search everything else I’ve already written. More than a couple of times I thought I had the next week’s idea, but it was already in the book or on the website.

The search for content has another problem: I don’t want to add Items for anything that’s already been written�not just by me, but by anyone. I don’t want to repeat content unless I have a different take on it and I can illuminate something new.

I’m not going to do weekly big Items anymore. I’ll try one a month, I think. I’ll see how it goes.

There’s still roomer for shorter content, such as the short demonstrations of new features, and ideas that don’t have have 1,000 words in them. There are also many interesting, although esoteric, features that I would probably never recommend for production code.

This doesn’t mean that I’m going to write less, though. If I do less for The Effective Perler, I can do more somewhere else. There another edition of Intermediate Perl that needs attention, the Learning Perl website, or a few other things.

Many people have asked for Items about specific modules, but that’s not really the idea of The Effective Perler. We want to teach people about core Perl and thinking in Perl. Modules are essentially all the same�they give you an interface and you do what the interface tells you to do. For the most part, they are just subroutines or method calls. There’s not much interesting there. You already know how to do that. The much more interesting advice is researching modules, but we put that in the book already.

[ This is the 100th Item we've shared with you in the two years this blog has been around. We deserve a holiday and we're taking it, so read us next year! Happy Holidays.]

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)