[libcatmandu-store-lucy-perl] 01/03: initial commit
Jonas Smedegaard
dr at jones.dk
Wed Aug 5 13:45:25 UTC 2015
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 <nicolas.steenlant at ugent.be>
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 <nicolas.steenlant at ugent.be>'
+ ],
+ 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
More information about the Pkg-perl-cvs-commits
mailing list