summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2011-07-07 12:49:48 -0500
committerJesse Luehrs <doy@tozt.net>2011-07-07 12:49:48 -0500
commit76c4f384d2991a7306dd8fe8256fbd662357d967 (patch)
treea17d63c52bc7df96c4fa3c65809fd02d7ccc80a5
parent8a2d38913277e00d20ca3cb0f46d64c72e167f1e (diff)
downloadsmartmatch-engine-rjbs-76c4f384d2991a7306dd8fe8256fbd662357d967.tar.gz
smartmatch-engine-rjbs-76c4f384d2991a7306dd8fe8256fbd662357d967.zip
add implementation of rjbs's proposal
http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2011-07/msg00226.html
-rw-r--r--lib/smartmatch/engine/rjbs.pm31
1 files changed, 31 insertions, 0 deletions
diff --git a/lib/smartmatch/engine/rjbs.pm b/lib/smartmatch/engine/rjbs.pm
new file mode 100644
index 0000000..fb2dfc6
--- /dev/null
+++ b/lib/smartmatch/engine/rjbs.pm
@@ -0,0 +1,31 @@
+package smartmatch::engine::rjbs;
+use strict;
+use warnings;
+
+use overload ();
+use Scalar::Util qw(blessed reftype);
+
+sub match {
+ my ($a, $b) = @_;
+
+ if (!defined($b)) {
+ return !defined($a);
+ }
+ elsif (blessed($b) && my $overload = overload::Method($b, '~~')) {
+ return $b->$overload($a, 1);
+ }
+ elsif (reftype($b) eq 'REGEXP') {
+ return $a =~ $b;
+ }
+ elsif (blessed($b) && my $overload = overload::Method($b, '=~')) {
+ return $a =~ $b;
+ }
+ elsif (!blessed($b) && reftype($b) eq 'CODE') {
+ return $b->($a);
+ }
+ else {
+ die "invalid smart match: $a ~~ $b";
+ }
+}
+
+1;