From 76c4f384d2991a7306dd8fe8256fbd662357d967 Mon Sep 17 00:00:00 2001
From: Jesse Luehrs <doy@tozt.net>
Date: Thu, 7 Jul 2011 12:49:48 -0500
Subject: add implementation of rjbs's proposal

http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2011-07/msg00226.html
---
 lib/smartmatch/engine/rjbs.pm | 31 +++++++++++++++++++++++++++++++
 1 file changed, 31 insertions(+)
 create mode 100644 lib/smartmatch/engine/rjbs.pm

(limited to 'lib')

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