MooseX::Role::Matcher - generic object matching based on attributes and methods

MooseX-Role-Matcher documentation Contained in the MooseX-Role-Matcher distribution.

Index

Code Index:

NAME

Top

MooseX::Role::Matcher - generic object matching based on attributes and methods

VERSION

Top

version 0.05

SYNOPSIS

Top

  package Person;
  use Moose;
  with 'MooseX::Role::Matcher' => { default_match => 'name' };

  has name  => (is => 'ro', isa => 'Str');
  has age   => (is => 'ro', isa => 'Num');
  has phone => (is => 'ro', isa => 'Str');

  package main;
  my @people = (
      Person->new(name => 'James', age => 22, phone => '555-1914'),
      Person->new(name => 'Jesse', age => 22, phone => '555-6287'),
      Person->new(name => 'Eric',  age => 21, phone => '555-7634'),
  );

  # is James 22?
  $people[0]->match(age => 22);

  # which people are not 22?
  my @not_twenty_two = Person->grep_matches([@people], '!age' => 22);

  # do any of the 22-year-olds have a phone number ending in 4?
  Person->any_match([@people], age => 22, phone => qr/4$/);

  # does everyone's name start with either J or E?
  Person->all_match([@people], name => [qr/^J/, qr/^E/]);

  # find the first person whose name is 4 characters long (using the
  # default_match of name)
  my $four = Person->first_match([@people], sub { length == 4 });

DESCRIPTION

Top

This role adds flexible matching and searching capabilities to your Moose class. It provides a match method, which tests attributes and methods of your object against strings, regexes, or coderefs, and also provides several class methods for using match on lists of objects.

PARAMETERS

Top

MooseX::Role::Matcher is a parameterized role (see MooseX::Role::Parameterized). The parameters it takes are:

default_match

Which attribute/method to test against by default, if none are specified explicitly. Setting default_match to 'foo' allows using $obj->match('bar') rather than $obj->match(foo => 'bar').

allow_missing_methods

If set to true, matching against a method that doesn't exist is treated as though matching against undef. Otherwise, the match call dies.

METHODS

Top

first_match

  my $four = Person->first_match([@people], sub { length == 4 });

Class method which takes an arrayref of objects in the class that consumed this role, and calls match on each object in the arrayref, passing it the remaining arguments, and returns the first object for which match returns true.

grep_matches

  my @not_twenty_two = Person->grep_matches([@people], '!age' => 22);

Class method which takes an arrayref of objects in the class that consumed this role, and calls match on each object in the arrayref, passing it the remaining arguments, and returns the each object for which match returns true.

any_match

  Person->any_match([@people], age => 22, number => qr/4$/);

Class method which takes an arrayref of objects in the class that consumed this role, and calls match on each object in the arrayref, passing it the remaining arguments, and returns true if any match calls return true, otherwise returns false.

all_match

  Person->all_match([@people], name => [qr/^J/, qr/^E/]);

Class method which takes an arrayref of objects in the class that consumed this role, and calls match on each object in the arrayref, passing it the remaining arguments, and returns false if any match calls return false, otherwise returns true.

match

  $person->match(age => 22);

This method provides the majority of the functionality of this role. It accepts a hash of arguments, with keys being the methods (usually attributes) of the object to be tested, and values being things to test against them. Possible types of values are:

SCALAR

Returns true if the result of the method is equal to (eq) the value of the scalar, otherwise returns false.

REGEXP

Returns true if the result of the method matches the regexp, otherwise returns false.

CODEREF

Calls the coderef with $_ set to the result of the method, returning true if the coderef returns true, and false otherwise.

UNDEF

Returns true if the method returns undef, or if the object doesn't have a method by this name, otherwise returns false.

ARRAYREF

Matches the result of the method against each element in the arrayref as described above, returning true if any of the submatches return true, and false otherwise.

HASHREF

If the method does not return an object which does MooseX::Role::Matcher, returns false. Otherwise, returns the result of calling match on the returned object, with the contents of the hashref as arguments.

Method names can also be given with a leading '!', which inverts that test. The first key can be omitted from the argument list if it is the method name passed to the default_match parameter when composing this role.

AUTHOR

Top

  Jesse Luehrs <doy at tozt dot net>

COPYRIGHT AND LICENSE

Top

This software is copyright (c) 2008-2009 by Jesse Luehrs.

This is free software; you can redistribute it and/or modify it under the same terms as perl itself.

TODO

Top

Better error handling/reporting

SEE ALSO

Top

Moose

MooseX::Role::Parameterized

BUGS

Top

No known bugs.

Please report any bugs through RT: email bug-moosex-role-matcher at rt.cpan.org, or browse to http://rt.cpan.org/NoAuth/ReportBug.html?Queue=MooseX-Role-Matcher.

SUPPORT

Top

You can find this documentation for this module with the perldoc command.

    perldoc MooseX::Role::Matcher

You can also look for information at:

* AnnoCPAN: Annotated CPAN documentation

http://annocpan.org/dist/MooseX-Role-Matcher

* CPAN Ratings

http://cpanratings.perl.org/d/MooseX-Role-Matcher

* RT: CPAN's request tracker

http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooseX-Role-Matcher

* Search CPAN

http://search.cpan.org/dist/MooseX-Role-Matcher

MooseX-Role-Matcher documentation Contained in the MooseX-Role-Matcher distribution. 
#!/usr/bin/perl
package MooseX::Role::Matcher;
our $VERSION = '0.05';

use MooseX::Role::Parameterized;
use List::Util qw/first/;
use List::MoreUtils qw/any all/;


parameter default_match => (
    isa => 'Str',
);

parameter allow_missing_methods => (
    isa => 'Bool',
);

role {
my $p = shift;
my $default = $p->default_match;
my $allow_missing_methods = $p->allow_missing_methods;

method _apply_to_matches => sub {
    my $class = shift;
    my $on_match = shift;
    my @list = @{ shift() };
    my @matchers = @_;
    $on_match->(sub { $_->match(@matchers) }, @list);
};


method first_match => sub {
    my $class = shift;
    $class->_apply_to_matches(\&first, @_);
};


method grep_matches => sub {
    my $class = shift;
    my $grep = sub { my $code = shift; grep { $code->() } @_ };
    $class->_apply_to_matches($grep, @_);
};


method any_match => sub {
    my $class = shift;
    $class->_apply_to_matches(\&any, @_);
};


method all_match => sub {
    my $class = shift;
    $class->_apply_to_matches(\&all, @_);
};

method _match => sub {
    my $self = shift;
    my $value = shift;
    my $seek = shift;

    # first check seek types that could match undef
    if (!defined $seek) {
        return !defined $value;
    }
    elsif (ref($seek) eq 'CODE') {
        local $_ = $value;
        return $seek->();
    }
    elsif (ref($seek) eq 'ARRAY') {
        for (@$seek) {
            return 1 if $self->_match($value => $_);
        }
        return 0;
    }
    # then bail out if we still have an undef value
    elsif (!defined $value) {
        return 0;
    }
    # and now check seek types that would error with an undef value
    elsif (ref($seek) eq 'Regexp') {
        return $value =~ $seek;
    }
    elsif (ref($seek) eq 'HASH') {
        return 0 unless blessed($value) &&
                        $value->does('MooseX::Role::Matcher');
        return $value->match(%$seek);
    }
    return $value eq $seek;
};


method match => sub {
    my $self = shift;
    unshift @_, $default if @_ % 2 == 1;
    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 =~ /^(!)?(.*)$/;
        confess blessed($self) . " has no method named $name"
            unless $self->can($name) || $allow_missing_methods;
        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;