Even though Santa's still stuck in the days of Perl 5.6, he too can have a little Perl 6 for Christmas with the magic of Match::Smart. With Match::Smart you get a a function called smart_match()—instead of a ~~ operator—for all sorts of DWIMy equality testing. With it, we can implement a simple switch statement in our sample code to assign gifts based on kids' behavior:
nick@north# perl mod19.pl
Bob gets a pony
Zack gets a lump of coal
Jerrad gets a pair of socks
Eve gets a lump of coal
Alice gets a pony
Just for fun, Santa decided to try to run the Perl 5.10.0 tests for ~~ with smart_match() and found that it passed 109 of 144 tests1. Not bad, but he noticed some patterns and after reading the documentation more carefully he discovered that many of the failures were due to the fact that the module had been written against Apocalypse 4 which debuted in 2002, and the relevant specification has since been superseded by Synopsis 3.
After consulting perlsyn and making a few simple changes2, he was able to get an updated Smart.pm that only failed 5 tests:
nick@north# perl -Mlib=lib smartmatch_.t | & grep not
not ok 5 - smart_match(\&foo, \&bar): 2
not ok 89 - smart_match([qw(1foo 2bar)], "2"): 1
not ok 90 - smart_match("2", [qw(1foo 2bar)]): 1
not ok 99 - smart_match(2, "2bananas"): 1
not ok 100 - smart_match("2bananas", 2): 1
The first failed test seems reasonable enough, since the tests are run in pairs, each with the operands in opposite order and of course &foo(\&bar) is different from &bar(\&foo).3
The other tests fail due to an apparent inconsistency in Perl 5.10. The tests are written to expect an inability to match, even though 2 == "2bananas" and "2" == "2bar"4. So, with Match::Smart you get a more useful tool than the native feature in 5.10.
Indeed, even though the operand table for (the updated) Match::Smart is more difficult to read than that of Perl 5.10, it also specifies an interesting behavior for objects:
OBJECT STRING $val1->can($val2) && $val1->$val2
i.e; smart match of an object and a string will invoke the object's method specified by the value of the string if available. Perl 5.10 on the other hand requires that ~~ be overloaded to get any behavior beyond what is defined for arrays, hashes, scalars and regexps.
One of the handy things about smart matching, is that it ignores one level of referencing so that \@a ~~ @a is true, which could—for instance—allow you to handle subroutine arguments of greater variety with less code. Of course, since smart_match(@goodboys, @badboys) doesn't work quite the same as @goodboys ~~ @badboys since the arrays are flattened into a single list, you should instead pass referenced arguments like smart_match(\@goodboys, \@badboys).5
1 use Match::Smart ':all'; 2 3 my %kids = ( Alice=>'nice', Bob=>'good', Eve=>'bad', Jerrad=>'???', Zack=>'naughty'); 4 5 printf("%s gets a %s\n", $_, gift($kids{$_}) ) foreach keys %kids; 6 7 sub gift{ 8 my $behavior = shift; 9 10 given $behavior => sub { 11 when [qw/good nice/] => sub { return "pony" }; 12 when [qw/bad naughty/] => sub { return "lump of coal" }; 13 default sub { return "pair of socks" }; #sub is optional 14 } 15 }
1. This required a few modifications to op/smartmatch.t though:
1 --- perl-5.10.0/t/op/smartmatch.t 2007-12-18 05:47:08.000000000 -0500 2 +++ smartmatch_.t 2009-12-19 20:52:26.000000000 -0500 3 @@ -1,8 +1,8 @@ 4 #!./perl 5 6 BEGIN { 7 - chdir 't'; 8 - @INC = '../lib'; 9 +# chdir 't'; 10 +# @INC = '../lib'; 11 require './test.pl'; 12 } 13 use strict; 14 @@ -10,6 +10,8 @@ 15 use Tie::Array; 16 use Tie::Hash; 17 18 +eval "use Match::Smart 'smart_match'" unless $] >= 5.009; 19 + 20 # The feature mechanism is tested in t/lib/feature/smartmatch: 21 # This file tests the semantics of the operator, without worrying 22 # about feature issues such as scoping etc. 23 @@ -45,10 +47,12 @@ 24 die "Bad test spec: ($yn, $left, $right)" 25 unless $yn eq "" || $yn eq "!"; 26 27 - my $tstr = "$left ~~ $right"; 28 + #Bor-fackwards compatability 29 + my $tstr = $] >= 5.009 ? "$left ~~ $right" : "smart_match($left, $right)"; 30 31 my $res; 32 - $res = eval $tstr // ""; #/ <- fix syntax colouring 33 + $res = eval $tstr || ""; #/ <- fix syntax colouring 34 + # No defined-or joy for us in Obsolete-ville 35 36 die $@ if $@ ne ""; 37 ok( ($yn =~ /!/ xor $res), "$tstr: $res");
2. Santa's patch includes corrections for the following changes between Apocalypse 4 and Synopsis 3:
3. Somehow, the test passes in 5.10 though…
4. Numerical operations in Perl treat strings that begin with numbers as the leading number. This is why ("0 but true" && "0 but true" == 0) == 1.
5. It's possible to get a smart_match that will accept two arrays with prototypes, but smart_match also needs to accept two hashes, a hash and an array, a hash and a scalar, etc.