File Coverage

blib/lib/Catmandu/Store/Solr/Bag.pm

Criterion	Covered	Total	%
statement	27	72	37.5
branch	0	20	0.0
condition	0	14	0.0
subroutine	9	18	50.0
pod	0	6	0.0
total	36	130	27.6

package Catmandu::Store::Solr::Bag;

use Catmandu::Sane;
use Catmandu::Util qw(:is);
use Carp qw(confess);
use Catmandu::Hits;
use Catmandu::Store::Solr::Searcher;
use Catmandu::Store::Solr::CQL;
use Catmandu::Error;
use Moo;
use MooX::Aliases;

our $VERSION = "0.0303";

with 'Catmandu::Bag';
with 'Catmandu::CQLSearchable';
with 'Catmandu::Buffer';

has cql_mapping => (is => 'ro');

has bag_key => (is => 'lazy', alias => 'bag_field');

sub _build_bag_key {
    $_[0]->store->bag_key;
}

sub generator {
    my ($self)    = @_;
    my $store     = $self->store;
    my $name      = $self->name;
    my $limit     = $self->buffer_size;
    my $bag_field = $self->bag_field;
    my $query     = qq/$bag_field:"$name"/;
    sub {
        state $start = 0;
        state $hits;
        unless ($hits && @$hits) {
            $hits = $store->solr->search(
                $query,
                {
                    start      => $start,
                    rows       => $limit,
                    defType    => "lucene",
                    facet      => "false",
                    spellcheck => "false"
                }
            )->content->{response}{docs};
            $start += $limit;
        }
        my $hit = shift(@$hits) || return;
        $self->map_fields($hit);
        $hit;
    };
}

sub count {
    my ($self)    = @_;
    my $name      = $self->name;
    my $bag_field = $self->bag_field;
    my $res       = $self->store->solr->search(
        qq/$bag_field:"$name"/,
        {
            rows       => 0,
            facet      => "false",
            spellcheck => "false",
            defType    => "lucene",
        }
    );
    $res->content->{response}{numFound};
}

sub get {
    my ($self, $id) = @_;
    my $name      = $self->name;
    my $id_field  = $self->id_field;
    my $bag_field = $self->bag_field;
    my $res       = $self->store->solr->search(
        qq/$bag_field:"$name" AND $id_field:"$id"/,
        {
            rows       => 1,
            facet      => "false",
            spellcheck => "false",
            defType    => "lucene",
        }
    );
    my $hit = $res->content->{response}{docs}->[0] || return;
    $self->map_fields($hit);
    $hit;
}

sub add {
    my ($self, $data) = @_;

    my $bag_field = $self->bag_field;

    my @fields = (WebService::Solr::Field->new($bag_field => $self->name));

    for my $key (keys %$data) {
        next if $key eq $bag_field;
        my $val = $data->{$key};
        if (is_array_ref($val)) {
            is_value($_) && push @fields,
                WebService::Solr::Field->new($key => $_)
                foreach @$val;
        }
        elsif (is_value($val)) {
            push @fields, WebService::Solr::Field->new($key => $val);
        }
    }

    $self->buffer_add(WebService::Solr::Document->new(@fields));

    if ($self->buffer_is_full) {
        $self->commit;
    }
}

sub delete {
    my ($self, $id) = @_;
    my $name      = $self->name;
    my $id_field  = $self->id_field;
    my $bag_field = $self->bag_field;
    $self->store->solr->delete_by_query(
        qq/$bag_field:"$name" AND $id_field:"$id"/);
}

sub delete_all {
    my ($self)    = @_;
    my $name      = $self->name;
    my $bag_field = $self->bag_field;
    $self->store->solr->delete_by_query(qq/$bag_field:"$name"/);
}

sub delete_by_query {
    my ($self, %args) = @_;
    my $name      = $self->name;
    my $bag_field = $self->bag_field;
    $self->store->solr->delete_by_query(
        qq/$bag_field:"$name" AND ($args{query})/);
}

sub commit {
    my ($self) = @_;
    my $solr = $self->store->solr;
    my $err;
    if ($self->buffer_used) {
        eval {$solr->add($self->buffer)} or push @{$err ||= []}, $@;
        $self->clear_buffer;
    }
    unless ($self->store->{_tx}) {
        eval {$solr->commit} or push @{$err ||= []}, $@;
    }

    if (defined $err && $self->store->on_error eq 'throw') {
        Catmandu::Error->throw($err->[0]);
    }
}

sub search {
    my ($self, %args) = @_;

    my $query = delete $args{query};
    my $start = delete $args{start};
    my $limit = delete $args{limit};
    my $bag   = delete $args{reify};

    my $name      = $self->name;
    my $id_field  = $self->id_field;
    my $bag_field = $self->bag_field;

    my $bag_fq = qq/{!type=lucene}$bag_field:"$name"/;

    if ($args{fq}) {
        if (is_array_ref($args{fq})) {
            $args{fq} = [$bag_fq, @{$args{fq}}];
        }
        else {
            $args{fq} = [$bag_fq, $args{fq}];
        }
    }
    else {
        $args{fq} = $bag_fq;
    }

    my $res = $self->store->solr->search($query,
        {%args, start => $start, rows => $limit});

    my $set = $res->content->{response}{docs};

    if ($bag) {
        $set = [map {$bag->get($_->{$id_field})} @$set];
    }
    else {
        $self->map_fields($_) for (@$set);
    }

    my $hits = Catmandu::Hits->new(
        {
            limit => $limit,
            start => $start,
            total => $res->content->{response}{numFound},
            hits  => $set,
        }
    );

    if ($res->facet_counts) {
        $hits->{facets} = $res->facet_counts;
    }

    if ($res->spellcheck) {
        $hits->{spellcheck} = $res->spellcheck;
    }
    if ($res->content->{highlighting}) {
        $hits->{highlighting} = $res->content->{highlighting};
    }

    $hits;
}

sub searcher {
    my ($self, %args) = @_;
    Catmandu::Store::Solr::Searcher->new(%args, bag => $self);
}

sub translate_sru_sortkeys {
    my ($self, $sortkeys) = @_;
    join(',',
        grep {defined $_} map {$self->_translate_sru_sortkey($_)} split /\s+/,
        $sortkeys);
}

sub _translate_sru_sortkey {
    my ($self, $sortkey) = @_;
    my ($field, $schema, $asc) = split /,/, $sortkey;
    $field || return;
    if (my $map = $self->cql_mapping) {
        $field = lc $field;
        $field =~ s/(?<=[^_])_(?=[^_])//g
            if $map->{strip_separating_underscores};
        $map = $map->{indexes} || return;
        $map = $map->{$field}  || return;
        $map->{sort} || return;
        if (ref $map->{sort} && $map->{sort}{field}) {
            $field = $map->{sort}{field};
        }
        elsif (ref $map->{field}) {
            $field = $map->{field}->[0];
        }
        elsif ($map->{field}) {
            $field = $map->{field};
        }
    }
    $asc //= 1;
    "${field} " . ($asc ? "asc" : "desc");
}

sub translate_cql_query {
    my ($self, $query) = @_;
    Catmandu::Store::Solr::CQL->new(mapping => $self->cql_mapping)
        ->parse($query);
}

sub normalize_query {
    $_[1] || "{!type=lucene}*:*";
}

sub map_fields {
    my ($self, $item) = @_;
    delete $item->{$self->bag_field};
}

=head1 SEE ALSO

L<Catmandu::Bag>, L<Catmandu::Searchable>

=cut

1;