initial copy/paste from taeb

1 files changed, 87 insertions, 0 deletions

diff --git a/lib/MooseX/Role/Searchable.pm b/lib/MooseX/Role/Searchable.pm
new file mode 100644
index 0000000..3ec380a
--- /dev/null
+++ b/lib/MooseX/Role/Searchable.pm
@@ -0,0 +1,87 @@
+#!/usr/bin/perl
+package MooseX::Role::Searchable;
+use Moose::Role;
+use List::Util qw/first/;
+use List::MoreUtils qw/any apply/;
+
+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(identity => $matcher) } @_));
+    }
+
+    my $value = shift;
+
+    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 Moose::Role;
+
+1;