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 | |
parent | c8179492d84be9703c5e3e54e01d905e11dc98f6 (diff) | |
download | smartmatch-5f9d80285fff821022074addbfd1bf4476da440a.tar.gz smartmatch-5f9d80285fff821022074addbfd1bf4476da440a.zip |
actually, this should be a part of smartmatch itself
-rw-r--r-- | lib/smartmatch.pm | 29 | ||||
-rw-r--r-- | 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. @@ -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; |