File Coverage

blib/lib/KinoSearch.pm

Criterion	Covered	Total	%
statement	286	334	85.6
branch	36	62	58.0
condition	7	22	31.8
subroutine	101	116	87.0
pod	11	45	24.4
total	441	579	76.1

use strict;
use warnings;

package KinoSearch;

use 5.008003;
use Exporter;

our $VERSION = '0.315';
$VERSION = eval $VERSION;

use XSLoader;
# This loads a large number of disparate subs.
BEGIN { XSLoader::load( 'KinoSearch', '0.315' ) }

BEGIN {
    push our @ISA, 'Exporter';
    our @EXPORT_OK = qw( to_clownfish to_perl kdump );
}

use KinoSearch::Autobinding;

sub kdump {
    require Data::Dumper;
    my $kdumper = Data::Dumper->new( [@_] );
    $kdumper->Sortkeys( sub { return [ sort keys %{ $_[0] } ] } );
    $kdumper->Indent(1);
    warn $kdumper->Dump;
}

sub error {$KinoSearch::Object::Err::error}

{
    package KinoSearch::Util::IndexFileNames;
    BEGIN {
        push our @ISA, 'Exporter';
        our @EXPORT_OK = qw(
            extract_gen
            latest_snapshot
        );
    }
}

{
    package KinoSearch::Util::StringHelper;
    BEGIN {
        push our @ISA, 'Exporter';
        our @EXPORT_OK = qw(
            utf8_flag_on
            utf8_flag_off
            to_base36
            from_base36
            utf8ify
            utf8_valid
            cat_bytes
        );
    }
}

{
    # Temporary back compat.
    package KinoSearch::Doc;
    BEGIN { our @ISA = qw( KinoSearch::Document::Doc ) }
    package KinoSearch::Architecture;
    BEGIN { our @ISA = qw( KinoSearch::Plan::Architecture ) }
    package KinoSearch::FieldType;
    BEGIN { our @ISA = qw( KinoSearch::Plan::FieldType ) }
    package KinoSearch::FieldType::BlobType;
    BEGIN { our @ISA = qw( KinoSearch::Plan::BlobType ) }
    package KinoSearch::FieldType::Float32Type;
    BEGIN { our @ISA = qw( KinoSearch::Plan::Float32Type ) }
    package KinoSearch::FieldType::Float64Type;
    BEGIN { our @ISA = qw( KinoSearch::Plan::Float64Type ) }
    package KinoSearch::FieldType::Int32Type;
    BEGIN { our @ISA = qw( KinoSearch::Plan::Int32Type ) }
    package KinoSearch::FieldType::Int64Type;
    BEGIN { our @ISA = qw( KinoSearch::Plan::Int64Type ) }
    package KinoSearch::FieldType::FullTextType;
    BEGIN { our @ISA = qw( KinoSearch::Plan::FullTextType ) }
    package KinoSearch::FieldType::StringType;
    BEGIN { our @ISA = qw( KinoSearch::Plan::StringType ) }
    package KinoSearch::Indexer;
    BEGIN { our @ISA = qw( KinoSearch::Index::Indexer ) }
    package KinoSearch::Obj::BitVector;
    BEGIN { our @ISA = qw( KinoSearch::Object::BitVector ) }
    package KinoSearch::QueryParser;
    BEGIN { our @ISA = qw( KinoSearch::Search::QueryParser ) }
    package KinoSearch::Search::HitCollector;
    BEGIN { our @ISA = qw( KinoSearch::Search::Collector ) }
    package KinoSearch::Search::HitCollector::BitCollector;
    BEGIN { our @ISA = qw( KinoSearch::Search::Collector::BitCollector ) }
    package KinoSearch::Search::Searchable;
    BEGIN { our @ISA = qw( KinoSearch::Search::Searcher ) }
    package KinoSearch::Search::Similarity;
    BEGIN { our @ISA = qw( KinoSearch::Index::Similarity ) }
    package KinoSearch::Schema;
    BEGIN { our @ISA = qw( KinoSearch::Plan::Schema ) }
    package KinoSearch::Searcher;
    BEGIN { our @ISA = qw( KinoSearch::Search::IndexSearcher ) }
    package KinoSearch::Util::BitVector;
    BEGIN { our @ISA = qw( KinoSearch::Object::BitVector ) }
}

{
    package KinoSearch::Analysis::Inversion;

    our %new_PARAMS = (
        # params
        text => undef
    );
}

{
    package KinoSearch::Analysis::Stemmer;
    sub lazy_load_snowball {
        require Lingua::Stem::Snowball;
        KinoSearch::Analysis::Stemmer::_copy_snowball_symbols();
    }
}

{
    package KinoSearch::Analysis::Stopalizer;
    use KinoSearch qw( to_clownfish );

    sub gen_stoplist {
        my ( undef, $language ) = @_;
        require Lingua::StopWords;
        $language = lc($language);
        if ( $language =~ /^(?:da|de|en|es|fi|fr|hu|it|nl|no|pt|ru|sv)$/ ) {
            my $stoplist
                = Lingua::StopWords::getStopWords( $language, 'UTF-8' );
            return to_clownfish($stoplist);
        }
        return undef;
    }
}

{
    package KinoSearch::Analysis::Token;

    our %new_PARAMS = (
        text         => undef,
        start_offset => undef,
        end_offset   => undef,
        pos_inc      => 1,
        boost        => 1.0,
    );
}

{
    package KinoSearch::Analysis::Tokenizer;

    sub compile_token_re { return qr/$_[1]/ }

    sub new {
        my ( $either, %args ) = @_;
        my $token_re = delete $args{token_re};
        $args{pattern} = "$token_re" if $token_re;
        return $either->_new(%args);
    }
}

{
    package KinoSearch::Document::Doc;
    use Storable qw( nfreeze thaw );
    use bytes;
    no bytes;

    use overload
        fallback => 1,
        '%{}'    => \&get_fields;

    sub serialize_fields {
        my ( $self, $outstream ) = @_;
        my $buf = nfreeze( $self->get_fields );
        $outstream->write_c32( bytes::length($buf) );
        $outstream->print($buf);
    }

    sub deserialize_fields {
        my ( $self, $instream ) = @_;
        my $len = $instream->read_c32;
        my $buf;
        $instream->read( $buf, $len );
        $self->set_fields( thaw($buf) );
    }
}

{
    package KinoSearch::Object::I32Array;
    our %new_PARAMS = ( ints => undef );
}

{
    package KinoSearch::Object::LockFreeRegistry;
    sub DESTROY { }    # leak all
}

{
    package KinoSearch::Object::Obj;
    use KinoSearch qw( to_clownfish to_perl );
    sub load { return $_[0]->_load( to_clownfish( $_[1] ) ) }
}

{
    package KinoSearch::Object::VTable;

    sub find_parent_class {
        my ( undef, $package ) = @_;
        no strict 'refs';
        for my $parent ( @{"$package\::ISA"} ) {
            return $parent if $parent->isa('KinoSearch::Object::Obj');
        }
        return;
    }

    sub novel_host_methods {
        my ( undef, $package ) = @_;
        no strict 'refs';
        my $stash   = \%{"$package\::"};
        my $methods = KinoSearch::Object::VArray->new(
            capacity => scalar keys %$stash );
        while ( my ( $symbol, $glob ) = each %$stash ) {
            next if ref $glob;
            next unless *$glob{CODE};
            $methods->push( KinoSearch::Object::CharBuf->new($symbol) );
        }
        return $methods;
    }

    sub _register {
        my ( undef, %args ) = @_;
        my $singleton_class = $args{singleton}->get_name;
        my $parent_class    = $args{parent}->get_name;
        if ( !$singleton_class->isa($parent_class) ) {
            no strict 'refs';
            push @{"$singleton_class\::ISA"}, $parent_class;
        }
    }

    no warnings 'redefine';
    sub DESTROY { }    # leak all
}

{
    package KinoSearch::Index::Indexer;

    sub new {
        my ( $either, %args ) = @_;
        my $flags = 0;
        $flags |= CREATE   if delete $args{'create'};
        $flags |= TRUNCATE if delete $args{'truncate'};
        return $either->_new( %args, flags => $flags );
    }

    our %add_doc_PARAMS = ( doc => undef, boost => 1.0 );
}

{
    package KinoSearch::Index::IndexReader;
    use Carp;

    sub new {
        confess(
            "IndexReader is an abstract class; use open() instead of new()");
    }
    sub lexicon {
        my $self       = shift;
        my $lex_reader = $self->fetch("KinoSearch::Index::LexiconReader");
        return $lex_reader->lexicon(@_) if $lex_reader;
        return;
    }
    sub posting_list {
        my $self = shift;
        my $plist_reader
            = $self->fetch("KinoSearch::Index::PostingListReader");
        return $plist_reader->posting_list(@_) if $plist_reader;
        return;
    }
    sub offsets { shift->_offsets->to_arrayref }
}

{
    package KinoSearch::Index::PolyReader;
    use KinoSearch qw( to_clownfish );

    sub try_read_snapshot {
        my ( undef, %args ) = @_;
        my ( $snapshot, $folder, $path ) = @args{qw( snapshot folder path )};
        eval { $snapshot->read_file( folder => $folder, path => $path ); };
        if   ($@) { return KinoSearch::Object::CharBuf->new($@) }
        else      { return undef }
    }

    sub try_open_segreaders {
        my ( $self, $segments ) = @_;
        my $schema      = $self->get_schema;
        my $folder      = $self->get_folder;
        my $snapshot    = $self->get_snapshot;
        my $seg_readers = KinoSearch::Object::VArray->new(
            capacity => scalar @$segments );
        my $segs = to_clownfish($segments);    # FIXME: Don't convert twice.
        eval {
            # Create a SegReader for each segment in the index.
            my $num_segs = scalar @$segments;
            for ( my $seg_tick = 0; $seg_tick < $num_segs; $seg_tick++ ) {
                my $seg_reader = KinoSearch::Index::SegReader->new(
                    schema   => $schema,
                    folder   => $folder,
                    segments => $segs,
                    seg_tick => $seg_tick,
                    snapshot => $snapshot,
                );
                $seg_readers->push($seg_reader);
            }
        };
        if ($@) {
            return KinoSearch::Object::CharBuf->new($@);
        }
        return $seg_readers;
    }
}

{
    package KinoSearch::Index::Segment;
    use KinoSearch qw( to_clownfish );
    sub store_metadata {
        my ( $self, %args ) = @_;
        $self->_store_metadata( %args,
            metadata => to_clownfish( $args{metadata} ) );
    }
}

{
    package KinoSearch::Index::SegReader;

    sub try_init_components {
        my $self = shift;
        my $arch = $self->get_schema->get_architecture;
        eval { $arch->init_seg_reader($self); };
        if ($@) { return KinoSearch::Object::CharBuf->new($@); }
        return;
    }
}

{
    package KinoSearch::Index::SortCache;
    our %value_PARAMS = ( ord => undef, );
}

{
    package KinoSearch::Search::Compiler;
    use Carp;
    use Scalar::Util qw( blessed );

    sub new {
        my ( $either, %args ) = @_;
        if ( !defined $args{boost} ) {
            confess("'parent' is not a Query")
                unless ( blessed( $args{parent} )
                and $args{parent}->isa("KinoSearch::Search::Query") );
            $args{boost} = $args{parent}->get_boost;
        }
        return $either->do_new(%args);
    }
}

{
    package KinoSearch::Search::Query;

    sub make_compiler {
        my ( $self, %args ) = @_;
        $args{boost} = $self->get_boost unless defined $args{boost};
        return $self->_make_compiler(%args);
    }
}

{
    package KinoSearch::Search::SortRule;

    my %types = (
        field  => FIELD(),
        score  => SCORE(),
        doc_id => DOC_ID(),
    );

    sub new {
        my ( $either, %args ) = @_;
        my $type = delete $args{type} || 'field';
        confess("Invalid type: '$type'") unless defined $types{$type};
        return $either->_new( %args, type => $types{$type} );
    }
}

{
    package KinoSearch::Object::BitVector;
    sub to_arrayref { shift->to_array->to_arrayref }
}

{
    package KinoSearch::Object::ByteBuf;
    {
        # Override autogenerated deserialize binding.
        no warnings 'redefine';
        sub deserialize { shift->_deserialize(@_) }
    }
}

{
    package KinoSearch::Object::ViewByteBuf;
    use Carp;
    sub new { confess "ViewByteBuf objects can only be created from C." }
}

{
    package KinoSearch::Object::CharBuf;

    {
        # Defeat obscure bugs in the XS auto-generation by redefining clone()
        # and deserialize().  (Because of how the typemap works for CharBuf*,
        # the auto-generated methods return UTF-8 Perl scalars rather than
        # actual CharBuf objects.)
        no warnings 'redefine';
        sub clone       { shift->_clone(@_) }
        sub deserialize { shift->_deserialize(@_) }
    }
}

{
    package KinoSearch::Object::ViewCharBuf;
    use Carp;
    sub new { confess "ViewCharBuf has no public constructor." }
}

{
    package KinoSearch::Object::ZombieCharBuf;
    use Carp;
    sub new { confess "ZombieCharBuf objects can only be created from C." }
    sub DESTROY { }
}

{
    package KinoSearch::Object::Err;
    sub do_to_string { shift->to_string }
    use Scalar::Util qw( blessed );
    use Carp qw( confess longmess );
    use overload
        '""'     => \&do_to_string,
        fallback => 1;

    sub new {
        my ( $either, $message ) = @_;
        my ( undef, $file, $line ) = caller;
        $message .= ", $file line $line\n";
        return $either->_new(
            mess => KinoSearch::Object::CharBuf->new($message) );
    }

    sub do_throw {
        my $err = shift;
        $err->cat_mess( longmess() );
        die $err;
    }

    our $error;
    sub set_error {
        my $val = $_[1];
        if ( defined $val ) {
            confess("Not a KinoSearch::Object::Err")
                unless ( blessed($val)
                && $val->isa("KinoSearch::Object::Err") );
        }
        $error = $val;
    }
    sub get_error {$error}
}

{
    package KinoSearch::Object::Hash;
    no warnings 'redefine';
    sub deserialize { shift->_deserialize(@_) }
}

{
    package KinoSearch::Object::VArray;
    no warnings 'redefine';
    sub clone       { CORE::shift->_clone }
    sub deserialize { CORE::shift->_deserialize(@_) }
}

{
    package KinoSearch::Store::FileHandle;
    BEGIN {
        push our @ISA, 'Exporter';
        our @EXPORT_OK = qw( build_fh_flags );
    }

    sub build_fh_flags {
        my $args  = shift;
        my $flags = 0;
        $flags |= FH_CREATE     if delete $args->{create};
        $flags |= FH_READ_ONLY  if delete $args->{read_only};
        $flags |= FH_WRITE_ONLY if delete $args->{write_only};
        $flags |= FH_EXCLUSIVE  if delete $args->{exclusive};
        return $flags;
    }

    sub open {
        my ( $either, %args ) = @_;
        $args{flags} ||= 0;
        $args{flags} |= build_fh_flags( \%args );
        return $either->_open(%args);
    }
}

{
    package KinoSearch::Store::FSFileHandle;

    sub open {
        my ( $either, %args ) = @_;
        $args{flags} ||= 0;
        $args{flags}
            |= KinoSearch::Store::FileHandle::build_fh_flags( \%args );
        return $either->_open(%args);
    }
}

{
    package KinoSearch::Store::FSFolder;
    use File::Spec::Functions qw( rel2abs );
    sub absolutify { return rel2abs( $_[1] ) }
}

{
    package KinoSearch::Store::RAMFileHandle;

    sub open {
        my ( $either, %args ) = @_;
        $args{flags} ||= 0;
        $args{flags}
            |= KinoSearch::Store::FileHandle::build_fh_flags( \%args );
        return $either->_open(%args);
    }
}

{
    package KinoSearch::Util::Debug;
    BEGIN {
        push our @ISA, 'Exporter';
        our @EXPORT_OK = qw(
            DEBUG
            DEBUG_PRINT
            DEBUG_ENABLED
            ASSERT
            set_env_cache
            num_allocated
            num_freed
            num_globals
        );
    }
}

{
    package KinoSearch::Util::Json;
    use Scalar::Util qw( blessed );
    use KinoSearch qw( to_clownfish );
    use KinoSearch::Util::StringHelper qw( utf8_valid utf8_flag_on );
    use JSON::XS qw();

    my $json_encoder = JSON::XS->new->pretty(1)->canonical(1);

    sub slurp_json {
        my ( undef, %args ) = @_;
        my $result;
        my $instream = $args{folder}->open_in( $args{path} )
            or return;
        my $len = $instream->length;
        my $json;
        $instream->read( $json, $len );
        if ( utf8_valid($json) ) {
            utf8_flag_on($json);
            $result = eval { to_clownfish( $json_encoder->decode($json) ) };
        }
        else {
            $@ = "Invalid UTF-8";
        }
        if ( $@ or !$result ) {
            KinoSearch::Object::Err->set_error(
                KinoSearch::Object::Err->new( $@ || "Failed to decode JSON" )
            );
            return;
        }
        return $result;
    }

    sub spew_json {
        my ( undef, %args ) = @_;
        my $json = eval { $json_encoder->encode( $args{'dump'} ) };
        if ( !defined $json ) {
            KinoSearch::Object::Err->set_error(
                KinoSearch::Object::Err->new($@) );
            return 0;
        }
        my $outstream = $args{folder}->open_out( $args{path} );
        return 0 unless $outstream;
        eval {
            $outstream->print($json);
            $outstream->close;
        };
        if ($@) {
            my $error;
            if ( blessed($@) && $@->isa("KinoSearch::Object::Err") ) {
                $error = $@;
            }
            else {
                $error = KinoSearch::Object::Err->new($@);
            }
            KinoSearch::Object::Err->set_error($error);
            return 0;
        }
        return 1;
    }

    sub to_json {
        my ( undef, $dump ) = @_;
        return $json_encoder->encode($dump);
    }

    sub from_json {
        return to_clownfish( $json_encoder->decode( $_[1] ) );
    }

    sub set_tolerant { $json_encoder->allow_nonref( $_[1] ) }
}

{
    package KinoSearch::Object::Host;
    BEGIN {
        if ( !__PACKAGE__->isa('KinoSearch::Object::Obj') ) {
            push our @ISA, 'KinoSearch::Object::Obj';
        }
    }
}

1;

__END__