package Search::OpenSearch::Engine;
use Moose;
use Types::Standard
    qw( Str Num Int ArrayRef HashRef InstanceOf Maybe Object Bool );
use Carp;
use Scalar::Util qw( blessed );
use Search::OpenSearch::Types;
use Search::OpenSearch::Facets;
use Search::OpenSearch::Response::XML;
use Search::OpenSearch::Response::JSON;
use Search::OpenSearch::Response::ExtJS;
use Search::OpenSearch::Response::Tiny;
use Search::Tools::XML;
use Search::Tools::UTF8;
use Search::Tools;
use CHI;
use Time::HiRes qw( time );
use Data::Dump qw( dump );
use JSON;

use namespace::sweep;

my $facets_type = Search::OpenSearch::Types->facets;
has 'index' => ( is => 'rw', isa => ArrayRef, );
has 'facets' => (
    is     => 'rw',
    isa    => Maybe [$facets_type],
    coerce => $facets_type->coercion,
);
has 'fields' => ( is => 'rw', isa => Maybe [ArrayRef], );
has 'link' => ( is => 'rw', isa => Str, builder => 'init_link' );
has 'cache' => ( is => 'rw', isa => Maybe [Object], builder => 'init_cache' );
has 'cache_ttl' => ( is => 'rw', isa => Int,  default => sub { 60 * 60 } );
has 'cache_ok'  => ( is => 'rw', isa => Bool, default => sub {1} );
has 'do_not_hilite' =>
    ( is => 'rw', isa => HashRef, lazy => 1, default => sub { {} } );
has 'searcher' => (
    is      => 'rw',
    isa     => Maybe [Object],
    lazy    => 1,
    builder => 'init_searcher'
);
has 'indexer' => (
    is      => 'rw',
    isa     => Maybe [Object],
    lazy    => 1,
    builder => 'init_indexer'
);
has 'suggester' => (
    is      => 'rw',
    isa     => Maybe [Object],
    lazy    => 1,
    builder => 'init_suggester',
);
has 'snipper_config' => (
    is      => 'rw',
    isa     => HashRef,
    lazy    => 1,
    builder => 'init_snipper_config'
);
has 'hiliter_config' => (
    is      => 'rw',
    isa     => HashRef,
    lazy    => 1,
    builder => 'init_hiliter_config'
);
has 'parser_config' => (
    is      => 'rw',
    isa     => HashRef,
    lazy    => 1,
    builder => 'init_parser_config'
);
has 'indexer_config' => (
    is      => 'rw',
    isa     => HashRef,
    lazy    => 1,
    builder => 'init_indexer_config'
);
has 'searcher_config' => (
    is      => 'rw',
    isa     => HashRef,
    lazy    => 1,
    builder => 'init_searcher_config'
);
has 'suggester_config' => (
    is      => 'rw',
    isa     => HashRef,
    builder => 'init_suggester_config'
);
has 'logger' => (
    is      => 'rw',
    isa     => Maybe [Object],
    lazy    => 1,
    builder => 'init_logger'
);
has 'debug' =>
    ( is => 'rw', isa => Bool, default => sub { $ENV{SOS_DEBUG} || 0 } );
has 'error' => ( is => 'rw', isa => Maybe [Str], );
has 'array_field_values' => ( is => 'rw', isa => Bool, default => sub {1} );
has 'response_version' => ( is => 'rw', isa => Str, builder => 'version' );
has 'default_response_format' => (
    is      => 'rw',
    isa     => Maybe [Str],
    builder => 'init_default_response_format',
);
has 'cache_key_seed' =>
    ( is => 'rw', isa => Maybe [Str], builder => 'init_cache_key_seed' );

our $VERSION = '0.399_03';

sub BUILD {
    my $self = shift;
    return $self;
}

sub version {
    my $self = shift;
    my $class = ref $self ? ref($self) : $self;
    no strict 'refs';
    return ${"${class}::VERSION"};
}

sub init_cache {
    my $self = shift;
    return unless $self->cache_ok;
    return CHI->new(
        driver           => 'File',
        dir_create_mode  => 0770,
        file_create_mode => 0660,
        root_dir         => "/tmp/opensearch_cache",
    );
}

sub init_snipper_config {
    return { as_sentences => 1, strip_markup => 1 };
}

sub init_hiliter_config {
    return { class => 'h', tag => 'b' };
}

sub init_parser_config {
    return {};
}

sub init_indexer_config {
    return {};
}

sub init_searcher_config {
    return {};
}

sub init_suggester_config {
    return {};
}

sub init_link     {''}
sub init_searcher { confess "$_[0] does not implement init_searcher()" }
sub init_indexer  { confess "$_[0] does not implement init_indexer()" }
sub type          { confess "$_[0] does not implement type()" }
sub has_rest_api  {0}

sub get_allowed_http_methods {
    confess "$_[0] does not implement get_allowed_http_methods";
}
sub init_default_response_format {'XML'}
sub init_cache_key_seed          {'search-opensearch-engine'}

sub search {
    my $self  = shift;
    my %args  = @_;
    my $query = $args{'q'};
    confess "query required" unless defined $query;
    my $start_time   = time();
    my $offset       = $args{'o'} || 0;
    my $sort_by      = $args{'s'} || 'score DESC';
    my $page_size    = $args{'p'} || 25;
    my $apply_hilite = $args{'h'};
    $apply_hilite = 1 unless defined $apply_hilite;
    my $count_only = $args{'c'} || 0;
    my $limits     = $args{'L'} || [];
    my $boolop     = $args{'b'} || 'AND';
    my $include_results = $args{'r'};
    $include_results = 1 unless defined $include_results;
    my $include_facets = $args{'f'};
    $include_facets = 1 unless defined $include_facets;
    my $response_fields = $args{'x'} || $self->fields;

    if ( $self->debug and $self->logger ) {
        $self->logger->log( dump( \%args ) );
    }

    my $format
        = $args{'t'}
        || $args{'format'}
        || $self->default_response_format;

    # backwards compat
    if ( $format eq 'xml' or $format eq 'json' ) {
        $format = uc($format);
    }

    my $response_class = $args{response_class}
        || 'Search::OpenSearch::Response::' . $format;

    if ( !ref($limits) ) {
        $limits = [ split( m/,/, $limits ) ];
    }
    my @limits;
    for my $limit (@$limits) {
        my ( $field, $low, $high ) = split( m/\|/, $limit );
        my $range = $self->set_limit(
            field => $field,
            lower => $low,
            upper => $high,
        );
        push @limits, $range;
    }
    my $searcher = $self->searcher or croak "searcher not defined";
    my $results = $searcher->search(
        to_utf8("$query"),
        {   start          => $offset,
            max            => $page_size,
            order          => $sort_by,
            limit          => \@limits,
            default_boolop => $boolop,
        }
    );
    my $search_time = sprintf( "%0.5f", time() - $start_time );
    my $start_build = time();
    my $res_query   = $results->query;
    my $query_tree  = $res_query->tree;
    if ( $self->debug and $self->logger ) {
        $self->logger->log( dump $query_tree );
    }
    my $response = $response_class->new(
        debug        => $self->debug,
        total        => $results->hits,
        json_query   => to_json($query_tree),
        parsed_query => $res_query->stringify,
        query        => to_utf8($query),
        search_time  => $search_time,
        link         => ( $args{'u'} || $args{'link'} || $self->link ),
        version => ( $self->response_version || $self->version ),
        engine    => blessed($self) . ' ' . $self->version(),
        sort_info => $sort_by,
    );
    if ( $self->suggester ) {
        $response->suggestions( $self->suggester->suggest("$query") );
    }
    if ( $self->debug and $self->logger ) {
        $self->logger->log(
            "include_results=$include_results include_facets=$include_facets count_only=$count_only"
        );
        $self->logger->log( "response_fields=" . dump($response_fields) );
    }

    if ( $include_results && !$count_only ) {
        $response->fields($response_fields);
        $response->offset($offset);
        $response->page_size($page_size);
        $response->results(
            $self->build_results(
                fields       => $response_fields,
                results      => $results,
                page_size    => $page_size,
                apply_hilite => $apply_hilite,
                query        => $query,
                args         => \%args,             # original args
            )
        );
    }
    if ( $include_facets && !$count_only ) {
        $response->facets(
            $self->get_facets( to_utf8($query), $results, \%args ) );
    }
    my $build_time = sprintf( "%0.5f", time() - $start_build );
    $response->build_time($build_time);
    return $response;
}

sub set_limit {
    my $self  = shift;
    my %args  = @_;
    my @range = ( $args{field}, $args{lower}, $args{upper} );
    return \@range;
}

sub get_facets_cache_key {
    my $self = shift;
    my ( $query, $args ) = @_;
    return sprintf( "%s.%s.%s", $self->cache_key_seed(), ref($self), $query );
}

sub get_facets {
    my $self      = shift;
    my $query     = shift;
    my $results   = shift;
    my $cache_key = $self->get_facets_cache_key( $query, @_ );
    my $cache     = $self->cache or return;

    my $facets;
    if ( $cache->get($cache_key) ) {
        if ( $self->debug and $self->logger ) {
            $self->logger->log("get facets for '$cache_key' from cache");
        }
        $facets = $cache->get($cache_key);
    }
    else {
        if ( $self->debug and $self->logger ) {
            $self->logger->log("build facets for '$cache_key'");
        }
        $facets = $self->build_facets( $query, $results, @_ );
        $cache->set( $cache_key, $facets, $self->cache_ttl );
    }
    return $facets;
}

sub build_facets {
    croak ref(shift) . " must implement build_facets()";
}

sub build_results {
    my $self      = shift;
    my %args      = @_;
    my $fields    = $args{fields} || $self->fields || [];
    my $results   = $args{results} or croak "no results defined";
    my $page_size = $args{page_size} || 25;
    my $q         = $args{query};
    confess "query required" unless defined $q;
    my @results;
    my $count          = 0;
    my %snipper_config = %{ $self->snipper_config };
    my %hiliter_config = %{ $self->hiliter_config };
    my %parser_config  = %{ $self->parser_config };
    my $XMLer          = Search::Tools::XML->new;
    my $query          = Search::Tools->parser(%parser_config)->parse($q);
    my $snipper = Search::Tools->snipper( query => $query, %snipper_config );
    my $hiliter = Search::Tools->hiliter( query => $query, %hiliter_config );

    while ( my $result = $results->next ) {
        push @results,
            $self->process_result(
            result       => $result,
            hiliter      => $hiliter,
            snipper      => $snipper,
            XMLer        => $XMLer,
            fields       => $fields,
            apply_hilite => $args{apply_hilite},
            args         => \%args,
            );
        last if ++$count >= $page_size;
    }
    return \@results;
}

sub process_result {
    my ( $self, %args ) = @_;
    my $result       = $args{result};
    my $hiliter      = $args{hiliter};
    my $XMLer        = $args{XMLer};
    my $snipper      = $args{snipper};
    my $fields       = $args{fields};
    my $apply_hilite = $args{apply_hilite};

    my $title = $XMLer->escape( $result->title || '' );

    # escape the summary *after* we snip it
    my $summary = $result->summary || '';

    # \003 is the record-delimiter in Swish3
    # the default behaviour is just to ignore it
    # and replace with a single space, but a subclass (like JSON)
    # might want to split on it to get an array of values
    $title =~ s/\003/ /g;
    $summary =~ s/\003/ /g;

    my %res = ( score => $result->score, );
    for my $field (@$fields) {
        my $str = $result->get_property($field) || '';

        if ( $self->array_field_values ) {
            if ( !$apply_hilite or $self->no_hiliting($field) ) {
                $res{$field}
                    = [ map { $XMLer->escape($_) } split( m/\003/, $str ) ];
            }
            else {
                $res{$field} = [
                    map {
                        $hiliter->light(
                            $XMLer->escape( $snipper->snip($_) ) )
                        }
                        split( m/\003/, $str )
                ];
            }
        }
        else {
            $str =~ s/\003/ /g;
            if ( !$apply_hilite or $self->no_hiliting($field) ) {
                $res{$field} = $XMLer->escape($str);
            }
            else {
                $res{$field} = $hiliter->light(
                    $XMLer->escape( $snipper->snip($str) ) );
            }
        }
    }

    # set the reserved fields *after* we loop fields,
    # so that the reserved fields are always strings.
    $res{uri}     = $result->uri;
    $res{mtime}   = $result->mtime;
    $res{title}   = ( $apply_hilite ? $hiliter->light($title) : $title );
    $res{summary} = (
          $apply_hilite
        ? $hiliter->light( $XMLer->escape( $snipper->snip($summary) ) )
        : $XMLer->escape($summary)
    );
    return \%res;
}

sub no_hiliting {
    my ( $self, $field ) = @_;
    return $self->{do_not_hilite}->{$field};
}

1;

__END__

=head1 NAME

Search::OpenSearch::Engine - abstract base class

=head1 SYNOPSIS

 use Search::OpenSearch::Engine;
 my $engine = Search::OpenSearch::Engine->new(
    index       => [qw( path/to/index1 path/to/index2 )],
    facets      => {
        names       => [qw( color size flavor )],
        sample_size => 10_000,
    },
    fields      => [qw( color size flavor )],   # result attributes in response
    indexer_config  => {
        somekey => somevalue,
    },
    searcher_config => {
        anotherkey => anothervalue,
    },
    suggester_config => {
        akey => avalue,
    },
    cache_ok        => 1,
    cache           => CHI->new(
        driver           => 'File',
        dir_create_mode  => 0770,
        file_create_mode => 0660,
        root_dir         => "/tmp/opensearch_cache",
    ),
    cache_ttl       => 3600,
    do_not_hilite   => { color => 1 },
    snipper_config  => { as_sentences => 1 },        # see Search::Tools::Snipper
    hiliter_config  => { class => 'h', tag => 'b' }, # see Search::Tools::HiLiter
    parser_config   => {},                           # see Search::Query::Parser
    
 );
 my $response = $engine->search(
    q   => 'quick brown fox',   # query
    s   => 'score desc',        # sort order
    o   => 0,                   # offset
    p   => 25,                  # page size
    h   => 1,                   # highlight query terms in results
    c   => 0,                   # count total only (same as f=0 r=0)
    L   => 'field|low|high',    # limit results to inclusive range
    f   => 1,                   # include facets
    r   => 1,                   # include results
    t   => 'XML',               # or JSON
    u   => 'http://yourdomain.foo/opensearch/',
    b   => 'AND',               # or OR
    x   => [qw( foo bar )],     # return only a subset of fields
 );
 print $response;

=head1 DESCRIPTION

Search::OpenSearch::Engine is an abstract base class. It defines
some sane method behavior based on the SWISH::Prog::Searcher API.

=head1 METHODS

This class is a subclass of Rose::ObjectX::CAF. Only new or overridden
methods are documented here.

=head2 version

Returns the $VERSION for the Engine.

=head2 init

Sets up the new object.

=head2 init_searcher

Subclasses must implement this method. If the Searcher object
acts like a SWISH::Prog::Searcher, then search() will Just Work.
Otherwise, your Engine subclass should likely override search() as well.

=head2 init_suggester

Subclasses may implement this method. It should return an 
object that acts like L<LucyX::Suggester>: it should
have a method called suggest() which expects a query string
and returns an array ref of strings which will
be included in the Response under the B<suggestions> key.

=head2 search( I<args> )

See the SYNOPSIS.

Returns a Search::OpenSearch::Response object based on the format
specified in I<args>.

=head2 set_limit( I<args> )

Called internally by search(). The I<args> will be three key/value pairs,
with keys "field," "low", and "high".

=head2 facets

Get/set a Search::OpenSearch::Facets object.

=head2 index

Get/set the location of the inverted indexes to be searched. The value
is intented to be used in init_searcher().

=head2 searcher

The value returned by init_searcher().

=head2 suggester

The value returned by init_suggester().

=head2 fields

Get/set the arrayref of field names to be fetched for each search result.

=head2 type

Should return a unique identifier for your Engine subclass.
Default is to croak().

=head2 link

The base URI for Responses. Passed to Response->link.

=head2 get_facets_cache_key( I<query>, I<search_args> )

Returns a string used to key the facets cache. Override this
method in a subclass to implement more nuanced string
construction.

=head2 get_facets( I<query>, I<results> )

Checks the cache for facets related to I<query> and, if found,
returns them. If not found, calls build_facets(), which must
be implemented by each Engine subclass.

=head2 build_facets( I<query>, I<results> )

Default will croak. Engine subclasses must implement this method
to provide Facet support.

=head2 build_results( I<results> )

I<results> should be an iterator like SWISH::Prog::Results.

Returns an array ref of hash refs, each corresponding to a single
search result.

=head2 process_result( I<hash_of_args> )

Called by build_results for each result object. I<hash_of_args> is
a list of key/value pairs that includes:

=over

=item result

The values returned from results->next.

=item hiliter

A Search::Tools::HiLiter object.

=item snipper

A Search::Tools::Snipper object.

=item XMLer

A Search::Tools::XML object.

=item fields

Array ref of fields defined in the new() constructor.

=back

Returns a hash ref, where each key is a field name.

=head2 cache_ok

If set to C<0>, no internal cache object will be created for you.
You can still set one in the B<cache> param, but the
automatic creation is turned off.

=head2 cache

Get/set the internal CHI object. Defaults to the File driver.
Typically passed as param in new().

=head2 init_cache_key_seed

The string used in get_facets_cache_key() to construct
the key for caching facets. You can set in new() with 'cache_key_seed'
or override in a base class.

=head2 cache_ttl

Get/set the cache key time-to-live. Default is 1 hour.
Typically passed as param in new().

=head2 do_not_hilite

Get/set the hash ref of field names that should not be hilited
in a Response.
Typically passed as param in new().

=head2 snipper_config

Get/set the hash ref of Search::Tools::Snipper->new params.
Typically passed as param in new().

=head2 hiliter_config

Get/set the hash ref of Search::Tools::HiLiter->new params.
Typically passed as param in new().

=head2 parser_config

Get/set the hash ref of Search::Tools::QueryParser->new params.
Typically passed as param in new().

=head2 indexer_config

Get/set the hash ref available to subclasses that implement
a REST API. Typically passed as param in new().

=head2 searcher_config

Get/set the hash ref available to subclasses in init_searcher().
Typically passed as param in new().

=head2 suggester_config

Get/set the hash ref available to subclasses that implement
init_suggester(). Typically passed as param in new().

=head2 no_hiliting( I<field_name> )

By default, looks up I<field_name> in the do_no_hilite() hash, but
you can override this method to implement whatever logic you want.

=head2 logger( I<logger_object> )

Get/set an optional logging object, which must implement a method
called B<log> and expect a single string.

=head2 has_rest_api( 0|1 )

Override this method in a subclass in order to indicate support
for more than just searching an index. Examples include
support for DELETE, PUT, POST and GET HTTP methods on particular
documents in the index.

Default is false.

=head2 get_allowed_http_methods

Override this method in a subclass in order to indicate the
supported HTTP methods. Assumes has_rest_api() is true.

=head2 debug([boolean])

Get/set the debug flag for messaging on stderr.

=head2 init_default_response_format

Returns default response format. Defaults to 'XML'.

=head2 error

Get/set the error value for the Engine. 

=head2 array_field_values([boolean])

Return all non-default field values as array refs rather than strings.
This supports the multi-value \003 separator used by L<SWISH::3>.

=head2 response_version

The version string to include in Response. Defaults to version().

=head2 init_cache

Builder method for B<cache>.

=head2 init_hiliter_config

Builder method for B<hiliter_config>.

=head2 init_indexer_config

Builder method for B<indexer_config>.

=head2 init_parser_config

Builder method for B<parser_config>.

=head2 init_searcher_config

Builder method for B<searcher_config>.

=head2 init_snipper_config

Builder method for B<snipper_config>.

=head2 init_suggester_config

Builder method for B<suggester_config>.

=head1 AUTHOR

Peter Karman, C<< <karman at cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-search-opensearch at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Search-OpenSearch>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

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

    perldoc Search::OpenSearch


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Search-OpenSearch>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Search-OpenSearch>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Search-OpenSearch>

=item * Search CPAN

L<http://search.cpan.org/dist/Search-OpenSearch/>

=back

=head1 COPYRIGHT & LICENSE

Copyright 2010 Peter Karman.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

