From 5f9d80285fff821022074addbfd1bf4476da440a Mon Sep 17 00:00:00 2001
From: Jesse Luehrs <doy@tozt.net>
Date: Sat, 23 Jun 2012 19:08:36 -0500
Subject: actually, this should be a part of smartmatch itself

---
 lib/smartmatch.pm | 29 +++++++++++++++++++++++++++++
 1 file changed, 29 insertions(+)

(limited to 'lib')

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.
-- 
cgit v1.2.3-54-g00ecf