blob: b25ab8c05982fd18569801a19d20012b0ea398c6 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
package smartmatch::engine::rjbs;
use strict;
use warnings;
# ABSTRACT: implementation of rjbs's smartmatch proposal
use overload ();
use Scalar::Util qw(blessed reftype);
sub type {
my ($thing) = @_;
if (!defined($thing)) {
return 'undef';
}
elsif (!ref($thing)) {
return 'unknown non-ref';
}
elsif (reftype($thing) eq 'REGEXP') {
return 'Regex';
}
elsif (blessed($thing)) {
if (overload::Method($thing, '~~')) {
return 'Overloaded';
}
elsif (overload::Method($thing, 'qr')) {
return 'Regex';
}
else {
return 'unknown object';
}
}
elsif (reftype($thing) eq 'CODE') {
return 'Code';
}
else {
return 'unknown';
}
}
sub match {
my ($a, $b) = @_;
if (type($b) eq 'undef') {
return !defined($a);
}
elsif (type($b) eq 'Overloaded') {
my $overload = overload::Method($b, '~~');
return $b->$overload($a, 1);
}
elsif (type($b) eq 'Regex') {
return $a =~ $b;
}
elsif (type($b) eq 'Code') {
return $b->($a);
}
else {
$a //= 'undef';
$b //= 'undef';
die "invalid smart match: $a ~~ $b";
}
}
1;
|