This is an automated email from the git hooks/post-receive script. js pushed a commit to annotated tag v0.01 in repository libcatmandu-store-lucy-perl.
commit fa9806ec8ff360aef49c8123f69dae0a6e13a37f Author: Nicolas Steenlant <[email protected]> Date: Mon May 7 09:50:48 2012 +0200 initial commit --- .gitignore | 9 +++ Build.PL | 26 +++++++++ Changes | 4 ++ README | 21 +++++++ lib/Catmandu/Store/Lucy.pm | 143 +++++++++++++++++++++++++++++++++++++++++++++ t/00-load.t | 15 +++++ 6 files changed, 218 insertions(+) diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..60fe9f0 --- /dev/null +++ b/.gitignore @@ -0,0 +1,9 @@ +!.gitignore +.DS_Store +*.swp +.build +_build +blib +Build +MANIFEST* +MYMETA.* diff --git a/Build.PL b/Build.PL new file mode 100644 index 0000000..ed9fd1f --- /dev/null +++ b/Build.PL @@ -0,0 +1,26 @@ +use strict; +use warnings; +use Module::Build; + +my $builder = Module::Build->new( + module_name => 'Catmandu::Store::Lucy', + license => 'perl', + dist_author => [ + 'Nicolas Steenlant <[email protected]>' + ], + dist_version_from => 'lib/Catmandu/Store/Lucy.pm', + build_requires => { + 'Software::License' => 0, + 'Test::Exception' => 0, + 'Test::More' => 0, + }, + requires => { + 'perl' => '5.10.0', + 'Catmandu' => '0.1', + 'Lucy' => '0.30', + 'Moo' => '0.009011', + }, + create_license => 1, +); + +$builder->create_build_script; diff --git a/Changes b/Changes new file mode 100644 index 0000000..d0badc6 --- /dev/null +++ b/Changes @@ -0,0 +1,4 @@ +Revision history for Catmandu-Store-MongoDB + +0.1 2012-05-04 + - initial release diff --git a/README b/README new file mode 100644 index 0000000..dd0289f --- /dev/null +++ b/README @@ -0,0 +1,21 @@ +Catmandu-Store-Lucy + +WARNING + +This module isn't finished and WILL NOT WORK! + +INSTALLATION + +To install this module, run the following commands: + + perl Build.PL + ./Build + ./Build test + ./Build install + +SUPPORT AND DOCUMENTATION + +After installing, you can find documentation for this module with the +perldoc command. + + perldoc Catmandu::Store::Lucy diff --git a/lib/Catmandu/Store/Lucy.pm b/lib/Catmandu/Store/Lucy.pm new file mode 100644 index 0000000..6e6e60a --- /dev/null +++ b/lib/Catmandu/Store/Lucy.pm @@ -0,0 +1,143 @@ +package Catmandu::Index::Lucy; +use Catmandu::Sane; +use Catmandu::Util qw(is_able check_id); +use Lucy::Plan::Schema; +use Lucy::Plan::FullTextType; +use Lucy::Analysis::PolyAnalyzer; +use Lucy::Index::Indexer; +use Lucy::Search::IndexSearcher; +use Catmandu::Hits; +use Catmandu::Object + path => 'r', + _analyzer => { default => '_build_analyzer' }, + _ft_field_type => { default => '_build_ft_field_type' }, + _schema => { default => '_build_schema' }, + _indexer => { default => '_build_indexer' }, + _searcher => { default => '_build_searcher' }; + +sub _build_analyzer { + Lucy::Analysis::PolyAnalyzer->new(language => 'en'); +} + +sub _build_ft_field_type { + my $self = $_[0]; + Lucy::Plan::FullTextType->new(analyzer => $self->_analyzer); +} + +sub _build_schema { + my $self = $_[0]; + my $schema = Lucy::Plan::Schema->new; + $schema->spec_field(name => '_id', type => Lucy::Plan::StringType->new); + $schema; +} + +sub _build_indexer { + my $self = $_[0]; + Lucy::Index::Indexer->new(schema => $self->_schema, index => $self->path, create => 1); +} + +sub _build_searcher { + my $self = $_[0]; + Lucy::Search::IndexSearcher->new(index => $self->path); +} + +sub _add { + my ($self, $obj) = @_; + check_id($obj); + my $type = $self->_ft_field_type; + my $schema = $self->_schema; + for my $name (keys %$obj) { + $schema->spec_field(name => $name, type => $type) if $name ne '_id'; + } + $self->_indexer->add_doc($obj); + $obj; +} + +sub add { + my ($self, $obj) = @_; + if (is_able $obj, 'each') { + $obj->each(sub { $self->_add($_[0]) }); + } else { + $self->_add($obj); + } +} + +sub search { + my ($self, $query, %opts) = @_; + + $opts{limit} ||= 50; + $opts{start} //= 0; + + if (ref $query eq 'HASH') { + $query = Lucy::Search::ANDQuery->new( + children => [ map { + Lucy::Search::TermQuery->new(field => $_, term => $query->{$_}); + } keys %$query ], + ); + } + + my $hits = $self->_searcher->hits( + query => $query, + num_wanted => $opts{limit}, + offset => $opts{start}, + ); + + my $objs = []; + + if (my $store = $opts{reify}) { + while (my $hit = $hits->next) { + push @$objs, $store->get($hit->{_id}); + } + } else { + while (my $hit = $hits->next) { + push @$objs, $hit->get_fields; + } + } + + Catmandu::Hits->new({ + limit => $opts{limit}, + start => $opts{start}, + total => $hits->total, + hits => $objs, + }); +} + +sub delete { + my ($self, $id) = @_; + $self->_indexer->delete_by_term(field => '_id', term => check_id($id)); + return; +} + +sub delete_where { + my ($self, $query) = @_; + + if (! ref $query) { + $query = Lucy::Search::QueryParser->new(schema => $self->_schema)->parse($query); + } elsif (ref $query eq 'HASH') { + my $terms = [ map { + Lucy::Search::TermQuery->new(field => $_, term => $query->{$_}); + } keys %$query ]; + $query = Lucy::Search::ANDQuery->new(children => $terms); + } + + $self->_indexer->delete_by_query($query); + return; +} + +sub delete_all { + my ($self) = @_; + $self->delete_where(Lucy::Search::MatchAllQuery->new); + return; +} + +sub commit { # TODO optimize + my ($self) = @_; + + if ($self->{_indexer}) { + $self->{_indexer}->commit; + delete $self->{_indexer}; + delete $self->{_searcher}; + } +} + +1; diff --git a/t/00-load.t b/t/00-load.t new file mode 100644 index 0000000..95c012d --- /dev/null +++ b/t/00-load.t @@ -0,0 +1,15 @@ +#!perl -T + +use strict; +use warnings; +use Test::More; + +my $pkg; +BEGIN { + $pkg = 'Catmandu::Store::Lucy'; + use_ok $pkg; +} + +require_ok $pkg; + +done_testing 2; -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcatmandu-store-lucy-perl.git _______________________________________________ Pkg-perl-cvs-commits mailing list [email protected] http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
