File Coverage

blib/lib/Search/GIN/Query/Attributes.pm

Criterion	Covered	Total	%
statement	8	10	80.0
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	12	14	85.7

use strict;
use warnings;
package Search::GIN::Query::Attributes;
BEGIN {
  $Search::GIN::Query::Attributes::AUTHORITY = 'cpan:NUFFIN';
}
# ABSTRACT: Create attributes-based GIN queries
$Search::GIN::Query::Attributes::VERSION = '0.09';
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__

=pod

=encoding UTF-8

=head1 NAME

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

=head1 VERSION

version 0.09

=head1 SYNOPSIS

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

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

=head1 DESCRIPTION

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.

=head1 METHODS/SUBROUTINES

=head2 new

Creates a new query.

=head1 ATTRIBUTES

=head2 attributes

Attributes of the object you want to find.

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

=head1 AUTHOR

יובל קוג'מן (Yuval Kogman) <[e-mail]>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2008 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.

=cut