[libcatmandu-store-lucy-perl] 01/03: initial commit

[Jonas Smedegaard]

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