#!perl =pod =head1 NAME smatch - smart matching switch construct =head1 SYNOPSIS smatch $val => [ 1, sub { print "number 1" } ], [ 'a', sub { print 'string a' } ], [ [1,10], sub { print 'number in range' } ], # strings work, too [ @array, 42, sub { print 'number in list' } ], [ qr/\w+/, sub { print 'pattern' } ], [ \%hash, sub { print 'entry in hash' } ], [ \&sub, sub { print 'arg to sub' } ], [ (), sub { print 'default' } ] ; #### =head1 NOTES C aliases $_ to $val and evaluates its subsequent arguments in that context. Each subsequent argument should be an arrayref, whose last element is a coderef. The coderef will be executed if any other element yields a true value after being evaluated according to this table: Input ($in) is Example Operation =============== ============= ================================= Regex qr/foo|bar/ /$in/ Number 3.14 $_ == $in coderef sub { /foo/ } $in->($_) range specifier [100,1000] $in->[0] <= $_ and $_ <= $in->[1] (arrayref) hashref \%hash $in->{$_} any other scalar 'a string' $_ eq $in =cut use strict; use warnings; package Smatch; use Regexp::Common; sub in_range { my ($n, $lo, $hi) = @_; if ($n =~ /^RE{num}{real}$/ and $lo =~ /^$RE{num}{real}$/ and $hi =~ /^$RE{num}{real}$/) { $lo <= $hi or warnings::warnif(misc => 'Invalid range $lo .. $hi'); return ($lo <= $n and $n <= $hi); } else { $lo le $hi or warnings::warnif(misc => 'Invalid range $lo .. $hi'); return ($lo le $n and $n le $hi); } } sub smatch { local *_ = \$_[0]; CASES: for my $caselist (@_[1..$#_] ) { my $coderef = pop @$caselist; if (@$caselist) { for my $case (@$caselist) { if (my $reftype = ref $case) { $coderef->(), last CASES if ($reftype eq 'Regexp' and m{$case}) or ($reftype eq 'ARRAY' and in_range($_, @$case)) or ($reftype eq 'HASH' and $case->{$_}) or ($reftype eq 'CODE' and $case->($_)) or $case eq $_ ; } else { $coderef->(), last CASES if ($case =~ /^$RE{num}{real}$/ and /^$RE{num}{real}/ and $case == $_) or $case eq $_ ; } } } else { $coderef->(); last; } } } package main; my @vals = (1, 10, 'foo1', 'bar', 'leftover'); for my $val (@vals) { no warnings 'exiting'; Smatch::smatch $val => [ 1, sub { print "$_ is 1\n" } ], [ [10, 20], sub { print "$_ hit me\n"; next } ], [ 'foo1', sub { print "$_ matched foo1\n"; next} ], [ { foo1=>1 }, sub { print "$_ found in hash\n" } ], [ qr/1/, sub { print "$_ got me, too?\n" } ], [ sub { s/bar/baz/ }, sub { print "$_ satisfied code\n" } ], [ (), sub { print "$_ fell to the default\n" } ] ; print "Done smatching $val\n"; }