summaryrefslogtreecommitdiffstats
path: root/lib/smartmatch/engine/rjbs.pm
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;