diff options
author | Jesse Luehrs <doy@tozt.net> | 2011-07-07 12:49:48 -0500 |
---|---|---|
committer | Jesse Luehrs <doy@tozt.net> | 2011-07-07 12:49:48 -0500 |
commit | 76c4f384d2991a7306dd8fe8256fbd662357d967 (patch) | |
tree | a17d63c52bc7df96c4fa3c65809fd02d7ccc80a5 | |
parent | 8a2d38913277e00d20ca3cb0f46d64c72e167f1e (diff) | |
download | smartmatch-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.pm | 31 |
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; |