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 +++++++++++++++++++++++++++++
 t/sugar.t         | 20 +-------------------
 2 files changed, 30 insertions(+), 19 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.
diff --git a/t/sugar.t b/t/sugar.t
index b397b8f..48a14cf 100644
--- a/t/sugar.t
+++ b/t/sugar.t
@@ -25,27 +25,9 @@ sub any {
     return sub {
         my ($lval) = @_;
 
-        my $recurse = get_smartmatch_callback();
+        my $recurse = smartmatch::get_smartmatch_callback(1);
         return List::MoreUtils::any { $recurse->($lval, $_) } @rvals;
     }
 }
 
-sub get_smartmatch_callback {
-    my $hh = (caller(2))[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;
-}
-
 done_testing;
-- 
cgit v1.2.3