diff options
author | Jesse Luehrs <doy@tozt.net> | 2012-06-23 19:08:36 -0500 |
---|---|---|
committer | Jesse Luehrs <doy@tozt.net> | 2012-06-23 19:08:36 -0500 |
commit | 5f9d80285fff821022074addbfd1bf4476da440a (patch) | |
tree | 982b0b5b64631d56e77d85319befae000523bfe0 /lib | |
parent | c8179492d84be9703c5e3e54e01d905e11dc98f6 (diff) | |
download | smartmatch-5f9d80285fff821022074addbfd1bf4476da440a.tar.gz smartmatch-5f9d80285fff821022074addbfd1bf4476da440a.zip |
actually, this should be a part of smartmatch itself
Diffstat (limited to 'lib')
-rw-r--r-- | lib/smartmatch.pm | 29 |
1 files changed, 29 insertions, 0 deletions
diff --git a/lib/smartmatch.pm b/lib/smartmatch.pm index 19d0320..8cbbc9e 100644 --- a/lib/smartmatch.pm +++ b/lib/smartmatch.pm @@ -79,6 +79,35 @@ sub unimport { delete $^H{'smartmatch/engine'}; } +=head1 FUNCTIONS + +=head2 get_smartmatch_callback($level) + +Returns a coderef which will call smartmatching on its two arguments, with the +smartmatch implementation used at caller level C<$level>. + +=cut + +sub get_smartmatch_callback { + my ($level) = @_; + $level++; + my $hh = (caller($level))[10]; + my $engine = $hh ? $hh->{'smartmatch/engine'} : undef; + + my $recurse; + if ($engine) { + $recurse = eval <<"RECURSE"; + use smartmatch '$engine'; + sub { \$_[0] ~~ \$_[1] } +RECURSE + } + else { + $recurse = sub { $_[0] ~~ $_[1] }; + } + + return $recurse; +} + =head1 BUGS No known bugs. |