lib/CouchDB/Estraier.pm

package CouchDB::Estraier;

use strict;
use warnings;

our $VERSION = '0.01';

use Search::Estraier;
use Data::Dump qw/dump/;
use Getopt::Long;
use JSON;
#use IO::Handle;
use IO::File;

=head1 NAME

CouchDB::Estraier - Hyper Estraier full-text search for CouchDB

=head1 METHODS

=cut

our $c = {
        node_url => 'http://localhost:1978/node/',
        estuser => 'admin',
        estpasswd => 'admin',
        debug => 0,
};

my $log = $0;
$log =~ s{^.*/([^/]+)(\.\w+)$}{/tmp/$1.log} or die "can't generate log name from $0";

warn "$0 log $log\n";

GetOptions($c, qw/node_url=s debug+ estuser=s estpasswd=s dbuser=s dbpasswd=s/) or die $!;

#my $log = IO::Handle->new;
#my $log = IO::Handle->new_from_fd(\*STDERR, 'w');

$log = IO::File->new( "> $log" ) || die "can't open $log: $!";

$log->autoflush( 1 );
$log->print("c: ", dump($c), "\n" ); # if $c->{debug};

my $in = IO::Handle->new_from_fd(\*STDIN, 'r');
my $out = IO::Handle->new_from_fd(\*STDOUT, 'w');
$out->autoflush( 1 );

=head2 run_search

Process command line options and start helper

   CouchDB::Estraier->run;

=cut

sub run_search {
        while ( 1 ) {
                $log->print("search ready\n");
                my $json = $in->getline;
                die unless defined $json;
                $log->print( "run_search $json\n" );
                $out->print(
                        encode_json(
                                search( decode_json( $json ) )
                        ) ,"\n"
                );
        }
}

sub run_update {
        while ( 1 ) {
                $log->print("update ready\n");
                my $json = $in->getline;
                die unless defined $json;
                $log->print( "run_update $json\n" );
                update( decode_json( $json ) )
        }
}


=head2 update

  CouchDB::Estraier::update( { db => $database, type => $type } );

=cut

sub update {
        my $args = shift or die "no args";
        $log->print( "add ",dump( $args ),"\n" );

        my $ret = {
                code => 200,
                json => {
                        args => $args,
                },
        };

        return $ret;

        my $database = $args->{db} or die "no db in ",dump( $args );
        my $data = $args->{data} or die "no data in ",dump( $args );

        # create and configure node
        my $node = new Search::Estraier::Node(
                url => $c->{node_url} . $database,
                user => $c->{estuser},
                passwd => $c->{estpasswd},
                croak_on_error => 1,
                create => 1,
                debug => $c->{debug} >= 4 ? 1 : 0,
        );

        # create document
        my $doc = new Search::Estraier::Document;

        if (my $id = $data->{_id}) {
                $doc->add_attr('@uri', $id);
        } else {
                die "can't find pk_col column _id in results\n";
        }

        while (my ($col,$val) = each %{$data}) {

                if ( defined $val ) {
                        # add attributes (make column usable from attribute search)
                        $doc->add_attr($col, $val);

                        # add body text to document (make it searchable using full-text index)
                        $doc->add_text($val);
                }

        }

        $log->print("doc draft: ",$doc->dump_draft ) if ($c->{debug} >= 2);

        die "error: ", $node->status,"\n" unless (eval { $node->put_doc($doc) });

        return $ret;
}

=head2 search

Implementation specification: L<http://wiki.apache.org/couchdb/FullTextSearch>

  CouchDB::Estraier::search( $database, $query );

=cut

sub search {
        my $args = shift or die "no args";
        $log->print( "search ",dump( $args ),"\n" );
        my $database = $args->{db} or die "no db in ",dump( $args );
        my $query = $args->{query} or die "no query in ",dump( $args );

        # create and configure node
        my $node = new Search::Estraier::Node(
                url => $c->{node_url} . $database,
                user => $c->{estuser},
                passwd => $c->{estpasswd},
                croak_on_error => 1,
#               create => 1,
                debug => $c->{debug} >= 4 ? 1 : 0,
        );

        my $cond = new Search::Estraier::Condition;
        $cond->set_phrase( $query );
        my $nres = $node->search($cond, 0);

        if ( defined($nres) ) {

                $out->print( "ok\n" );
                for my $i ( 0 ... $nres->doc_num - 1 ) {
                        my $rdoc = $nres->get_doc($i);
                        print $rdoc->attr('@uri'),"\n",$i,"\n";
                }
                $out->print( "\n\n" );

        } else {
                $out->print( "error\n", $node->status, "\n" );
        }

}


1;
1	dpavlin	1	package CouchDB::Estraier;
2
3			use strict;
4			use warnings;
5
6	dpavlin	3	our $VERSION = '0.01';
7
8	dpavlin	1	use Search::Estraier;
9			use Data::Dump qw/dump/;
10	dpavlin	3	use Getopt::Long;
11			use JSON;
12	dpavlin	12	#use IO::Handle;
13			use IO::File;
14	dpavlin	1
15			=head1 NAME
16
17			CouchDB::Estraier - Hyper Estraier full-text search for CouchDB
18
19			=head1 METHODS
20
21			=cut
22
23			our $c = {
24			node_url => 'http://localhost:1978/node/',
25			estuser => 'admin',
26			estpasswd => 'admin',
27	dpavlin	12	debug => 0,
28	dpavlin	1	};
29
30	dpavlin	12	my $log = $0;
31			$log =~ s{^.*/([^/]+)(\.\w+)$}{/tmp/$1.log} or die "can't generate log name from $0";
32	dpavlin	1
33	dpavlin	12	warn "$0 log $log\n";
34
35			GetOptions($c, qw/node_url=s debug+ estuser=s estpasswd=s dbuser=s dbpasswd=s/) or die $!;
36
37			#my $log = IO::Handle->new;
38			#my $log = IO::Handle->new_from_fd(\*STDERR, 'w');
39
40			$log = IO::File->new( "> $log" ) \|\| die "can't open $log: $!";
41
42			$log->autoflush( 1 );
43			$log->print("c: ", dump($c), "\n" ); # if $c->{debug};
44
45			my $in = IO::Handle->new_from_fd(\*STDIN, 'r');
46			my $out = IO::Handle->new_from_fd(\*STDOUT, 'w');
47			$out->autoflush( 1 );
48
49	dpavlin	3	=head2 run_search
50	dpavlin	1
51			Process command line options and start helper
52
53			CouchDB::Estraier->run;
54
55			=cut
56
57	dpavlin	3	sub run_search {
58			while ( 1 ) {
59	dpavlin	12	$log->print("search ready\n");
60			my $json = $in->getline;
61			die unless defined $json;
62			$log->print( "run_search $json\n" );
63			$out->print(
64			encode_json(
65			search( decode_json( $json ) )
66			) ,"\n"
67			);
68	dpavlin	1	}
69			}
70
71	dpavlin	3	sub run_update {
72			while ( 1 ) {
73	dpavlin	12	$log->print("update ready\n");
74			my $json = $in->getline;
75			die unless defined $json;
76			$log->print( "run_update $json\n" );
77			update( decode_json( $json ) )
78	dpavlin	3	}
79			}
80	dpavlin	1
81	dpavlin	3
82	dpavlin	12	=head2 update
83	dpavlin	1
84	dpavlin	12	CouchDB::Estraier::update( { db => $database, type => $type } );
85	dpavlin	1
86			=cut
87
88	dpavlin	12	sub update {
89			my $args = shift or die "no args";
90			$log->print( "add ",dump( $args ),"\n" );
91	dpavlin	1
92	dpavlin	12	my $ret = {
93			code => 200,
94			json => {
95			args => $args,
96			},
97			};
98	dpavlin	3
99	dpavlin	12	return $ret;
100
101			my $database = $args->{db} or die "no db in ",dump( $args );
102			my $data = $args->{data} or die "no data in ",dump( $args );
103
104	dpavlin	1	# create and configure node
105			my $node = new Search::Estraier::Node(
106			url => $c->{node_url} . $database,
107			user => $c->{estuser},
108			passwd => $c->{estpasswd},
109			croak_on_error => 1,
110			create => 1,
111			debug => $c->{debug} >= 4 ? 1 : 0,
112			);
113
114			# create document
115			my $doc = new Search::Estraier::Document;
116
117			if (my $id = $data->{_id}) {
118			$doc->add_attr('@uri', $id);
119			} else {
120			die "can't find pk_col column _id in results\n";
121			}
122
123			while (my ($col,$val) = each %{$data}) {
124
125	dpavlin	12	if ( defined $val ) {
126	dpavlin	1	# add attributes (make column usable from attribute search)
127			$doc->add_attr($col, $val);
128
129			# add body text to document (make it searchable using full-text index)
130			$doc->add_text($val);
131			}
132
133			}
134
135	dpavlin	12	$log->print("doc draft: ",$doc->dump_draft ) if ($c->{debug} >= 2);
136	dpavlin	1
137			die "error: ", $node->status,"\n" unless (eval { $node->put_doc($doc) });
138
139	dpavlin	12	return $ret;
140	dpavlin	1	}
141
142			=head2 search
143
144			Implementation specification: L<http://wiki.apache.org/couchdb/FullTextSearch>
145
146	dpavlin	3	CouchDB::Estraier::search( $database, $query );
147	dpavlin	1
148			=cut
149
150			sub search {
151	dpavlin	12	my $args = shift or die "no args";
152			$log->print( "search ",dump( $args ),"\n" );
153			my $database = $args->{db} or die "no db in ",dump( $args );
154			my $query = $args->{query} or die "no query in ",dump( $args );
155	dpavlin	1
156			# create and configure node
157			my $node = new Search::Estraier::Node(
158			url => $c->{node_url} . $database,
159			user => $c->{estuser},
160			passwd => $c->{estpasswd},
161			croak_on_error => 1,
162	dpavlin	12	# create => 1,
163	dpavlin	1	debug => $c->{debug} >= 4 ? 1 : 0,
164			);
165
166			my $cond = new Search::Estraier::Condition;
167			$cond->set_phrase( $query );
168			my $nres = $node->search($cond, 0);
169
170			if ( defined($nres) ) {
171
172	dpavlin	12	$out->print( "ok\n" );
173	dpavlin	1	for my $i ( 0 ... $nres->doc_num - 1 ) {
174			my $rdoc = $nres->get_doc($i);
175			print $rdoc->attr('@uri'),"\n",$i,"\n";
176			}
177	dpavlin	12	$out->print( "\n\n" );
178	dpavlin	1
179			} else {
180	dpavlin	12	$out->print( "error\n", $node->status, "\n" );
181	dpavlin	1	}
182
183			}
184
185
186			1;