in reply to rough approximation to pattern matching using local
The only way I can see to getting close to what you want is to eval the subroutines into existence at runtime, something like this:
#! perl -slw use strict; use Data::Dump qw[ pp ]; 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_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); } } } } sub match ($$$) { my ($lhs, $rhs, $fun) = @_; my $locals = {}; # populate locals match_inner($lhs, $rhs, $locals); my( $code, $k, $v ) = "{\n"; $code .= " my \$$k = '$v';\n" while ($k, $v) = each %$locals; $code .= $fun . "\n}"; print $code; return eval $code; } my $sub = match "bob", 45, q[ sub { print $bob; }; ]; pp $sub; $sub->(); my $sub2 = match ['bill','john'], [123, 'jack' ], q[ sub { print $bill, ' ', $john; } ]; pp $sub2; &$sub2; __END__ C:\test>1114414.pl { my $bob = '45'; sub { print $bob; }; } sub { "???" } 45 { my $john = 'jack'; my $bill = '123'; sub { print $bill, ' ', $john; } } sub { "???" } 123 jack
But I doubt that actually allows what you're really aiming for.
|
|---|