summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2012-06-23 19:08:36 -0500
committerJesse Luehrs <doy@tozt.net>2012-06-23 19:08:36 -0500
commit5f9d80285fff821022074addbfd1bf4476da440a (patch)
tree982b0b5b64631d56e77d85319befae000523bfe0
parentc8179492d84be9703c5e3e54e01d905e11dc98f6 (diff)
downloadsmartmatch-5f9d80285fff821022074addbfd1bf4476da440a.tar.gz
smartmatch-5f9d80285fff821022074addbfd1bf4476da440a.zip
actually, this should be a part of smartmatch itself
-rw-r--r--lib/smartmatch.pm29
-rw-r--r--t/sugar.t20
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;