Search::GIN::Query::Attributes - Create attributes-based GIN queries

Search-GIN documentation Contained in the Search-GIN distribution.

Index

Code Index:

NAME

Top

Search::GIN::Query::Attributes - Create attributes-based GIN queries

VERSION

Top

version 0.08

SYNOPSIS

Top

    use Search::GIN::Query::Attributes;

    my $query = Search::GIN::Query::Attributes->new(
        attributes => {
            name => 'Homer',
        },
    );

DESCRIPTION

Top

Creates an attributes-based GIN query that can be used to search records in a storage.

This is a ready-to-use query that uses an object's attributes to search through the storage.

METHODS/SUBROUTINES

Top

new

Creates a new query.

ATTRIBUTES

Top

attributes

Attributes of the object you want to find.

    my $query = Search::GIN::Query::Attributes->new(
        attributes => {
            name => 'Homer',
            city => 'Springfield',
        },
    );

AUTHOR

Top

Yuval Kogman <nothingmuch@cpan.org>

COPYRIGHT AND LICENSE

Top

This software is copyright (c) 2010 by Yuval Kogman, Infinity Interactive.

This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself.

Search-GIN documentation Contained in the Search-GIN distribution. 
use strict;
use warnings;
package Search::GIN::Query::Attributes;
BEGIN {
  $Search::GIN::Query::Attributes::VERSION = '0.08';
}
# ABSTRACT: Create attributes-based GIN queries

use Moose;
use Carp qw(croak);
use namespace::clean -except => [qw(meta)];

with qw(
    Search::GIN::Query
    Search::GIN::Keys::Deep
);

has attributes => (
    isa => "HashRef",
    is  => "rw",
    required => 1,
);

has compare => (
    isa => "Str|CodeRef",
    is  => "rw",
    default => "compare_naive",
);

sub extract_values {
    my $self = shift;

    return (
        method => "all",
        values => [ $self->process_keys($self->attributes) ],
    );
}

sub consistent {
    my ( $self, $index, $obj ) = @_;

    my $class = ref $obj;

    my $meta = Class::MOP::get_metaclass_by_name($class);

    my $query = $self->attributes;

    my %got;

    foreach my $attr_name ( keys %$query ) {
        my $expected = $query->{$attr_name};

        my $meta_attr = $meta->find_attribute_by_name($attr_name) || return;
        $got{$attr_name} = $meta_attr->get_value($obj);
    }

    my $cmp = $self->compare;

    return $self->$cmp( \%got, $query );
}

sub compare_naive {
    my ( $self, $got, $exp ) = @_;

    return unless keys %$got == keys %$exp;

    foreach my $key ( keys %$exp ) {
        return unless overload::StrVal($got->{$key}) eq overload::StrVal($exp->{$key});
    }

    return 1;
}

sub compare_test_deep {
    my ( $self, $got, $exp ) = @_;

    require Test::Deep::NoTest;
    Test::Deep::NoTest::eq_deeply($got, $exp);
}

# FIXME Data::Compare too

__PACKAGE__->meta->make_immutable;

1;





__END__