$ perl pattern_matching.pl
Name "main::bob" used only once: possible typo at pattern_matching.pl line 50.
Use of uninitialized value $bob in print at pattern_matching.pl line 50.
####
while (my ($k, $v) = each %$locals) {
local ${$k} = $v;
}
####
use strict;
use warnings;
sub same_keys {
my ($left, $right) = @_;
return unless ref $left eq 'HASH' and ref $right eq 'HASH';
return unless keys %$left == keys %$right;
for my $key (keys %$left) {
exists $right->{$key} or return;
}
return 1;
}
sub match ($$$) {
no strict 'refs';
my ($lhs, $rhs, $fun) = @_;
my $locals = {};
# populate locals
match_inner($lhs, $rhs, $locals);
while (my ($k, $v) = each %$locals) {
local ${$k} = $v;
}
return $fun->();
}
sub match_inner {
my ($lhs, $rhs, $locals) = @_;
if (ref $lhs eq '') {
$locals->{$lhs} = $rhs;
}
elsif (ref $lhs eq 'ARRAY') {
if (@$lhs == @$rhs) {
for my $i (0 .. $#$lhs) {
match_inner($lhs->[$i], $rhs->[$i], $locals);
}
}
}
elsif (ref $lhs eq 'HASH') {
if (same_keys($lhs,$rhs)) {
for my $k (keys %$lhs) {
match_inner($lhs->{$k}, $rhs->{$k}, $locals);
}
}
}
}
match "bob", 45, sub {
no strict;
print $bob;
};