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; };