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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
#!/usr/bin/perl
package MooseX::Role::Searchable;
use MooseX::Role::Parameterized;
use List::Util qw/first/;
use List::MoreUtils qw/any apply/;
parameter default_match => (
is => 'ro',
isa => 'Str',
);
role {
my $p = shift;
my $default = $p->default_match;
sub _apply_to_matches {
my $on_match = shift;
my $code = shift;
my $matcher = shift;
# pass in a coderef? return the first for which the coderef is true
if (ref($matcher) eq 'CODE') {
return $on_match->(sub { $code->($_) }, (grep { $matcher->($_) } @_));
}
# pass in a regex? return the first item for which the regex matches ID
if (ref($matcher) eq 'Regexp') {
return $on_match->(sub { $code->($_) }, (grep { $_->match($default => $matcher) } @_));
}
my $value = shift;
if (!defined($value)) {
# they passed in only one argument. assume they are checking identity
($matcher, $value) = ($default, $matcher);
}
return $on_match->(sub { $code->($_) }, (grep { $_->match($matcher => $value) } @_));
}
sub first_match {
_apply_to_matches(\&first, @_);
}
sub each_match {
_apply_to_matches(\&apply, @_);
}
sub grep_matches {
# XXX: can you use grep like this?
_apply_to_matches(\&grep, @_);
}
sub any_match {
_apply_to_matches(\&any, @_);
}
sub _match {
my $self = shift;
my $value = shift;
my $seek = shift;
return !defined $value if !defined $seek;
return 0 if !defined $value;
return $value =~ $seek if ref($seek) eq 'Regexp';
return $seek->($value) if ref($seek) eq 'CODE';
if (ref($seek) eq 'ARRAY') {
for (@$seek) {
return 1 if $self->_match($value => $_);
}
}
return $value eq $seek;
}
sub match {
my $self = shift;
my %args = @_;
# All the conditions must be true for true to be returned. Return
# immediately if a false condition is found.
for my $matcher (keys %args) {
my ($invert, $name) = $matcher =~ /^(not_)?(.*)$/;
my $value = $self->can($name) ? $self->$name : undef;
my $seek = $args{$matcher};
my $matched = $self->_match($value => $seek) ? 1 : 0;
if ($invert) {
return 0 if $matched;
}
else {
return 0 unless $matched;
}
}
return 1;
}
};
no MooseX::Role::Parameterized;
1;
|
