/[couchdb]/lib/CouchDB/Estraier.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /lib/CouchDB/Estraier.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 13 - (hide annotations)
Sat Aug 9 23:40:19 2008 UTC (15 years, 7 months ago) by dpavlin
File size: 4368 byte(s)
implemented view server
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 dpavlin 13 $log = IO::File->new( ">> $log" ) || die "can't open $log: $!";
41 dpavlin 12
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 13 =head2 run_query
50 dpavlin 1
51     Process command line options and start helper
52    
53     CouchDB::Estraier->run;
54    
55     =cut
56    
57 dpavlin 13 sub run_query {
58 dpavlin 3 while ( 1 ) {
59 dpavlin 13 # $log->print("query ready\n");
60 dpavlin 12 my $json = $in->getline;
61     die unless defined $json;
62 dpavlin 13 $log->print( "run_query $json\n" );
63     query( decode_json( $json ) )
64 dpavlin 1 }
65     }
66    
67 dpavlin 3 sub run_update {
68     while ( 1 ) {
69 dpavlin 13 # $log->print("update ready\n");
70 dpavlin 12 my $json = $in->getline;
71     die unless defined $json;
72     $log->print( "run_update $json\n" );
73     update( decode_json( $json ) )
74 dpavlin 3 }
75     }
76 dpavlin 1
77 dpavlin 3
78 dpavlin 12 =head2 update
79 dpavlin 1
80 dpavlin 12 CouchDB::Estraier::update( { db => $database, type => $type } );
81 dpavlin 1
82     =cut
83    
84 dpavlin 12 sub update {
85     my $args = shift or die "no args";
86 dpavlin 13 $log->print( "update ",dump( $args ),"\n" );
87 dpavlin 1
88 dpavlin 12 my $ret = {
89     code => 200,
90     json => {
91     args => $args,
92     },
93     };
94 dpavlin 3
95 dpavlin 12 return $ret;
96    
97     my $database = $args->{db} or die "no db in ",dump( $args );
98     my $data = $args->{data} or die "no data in ",dump( $args );
99    
100 dpavlin 1 # create and configure node
101     my $node = new Search::Estraier::Node(
102     url => $c->{node_url} . $database,
103     user => $c->{estuser},
104     passwd => $c->{estpasswd},
105     croak_on_error => 1,
106     create => 1,
107     debug => $c->{debug} >= 4 ? 1 : 0,
108     );
109    
110     # create document
111     my $doc = new Search::Estraier::Document;
112    
113     if (my $id = $data->{_id}) {
114     $doc->add_attr('@uri', $id);
115     } else {
116     die "can't find pk_col column _id in results\n";
117     }
118    
119     while (my ($col,$val) = each %{$data}) {
120    
121 dpavlin 12 if ( defined $val ) {
122 dpavlin 1 # add attributes (make column usable from attribute search)
123     $doc->add_attr($col, $val);
124    
125     # add body text to document (make it searchable using full-text index)
126     $doc->add_text($val);
127     }
128    
129     }
130    
131 dpavlin 12 $log->print("doc draft: ",$doc->dump_draft ) if ($c->{debug} >= 2);
132 dpavlin 1
133     die "error: ", $node->status,"\n" unless (eval { $node->put_doc($doc) });
134    
135 dpavlin 12 return $ret;
136 dpavlin 1 }
137    
138 dpavlin 13 =head2 query
139    
140     Implementation spec: L<http://wiki.apache.org/couchdb/ViewServer>
141    
142     =cut
143    
144     sub query {
145     my $args = shift or die "no args";
146     # $log->print( "query ",dump( $args ),"\n" );
147    
148     sub _json {
149     $out->print( encode_json( shift @_ ),"\n" );
150     }
151    
152     my ( $op, $doc ) = @$args;
153    
154     if ( $op eq 'add_fun' ) {
155     $out->print( "true\n" );
156     _json({ log => "$op $doc" });
157     } elsif ( $op eq 'reset' ) {
158     $out->print( "true\n" );
159     } elsif ( $op eq 'map_doc' ) {
160     $out->print( encode_json( [[[ $doc->{_id}, 'indexed' ]]] ),"\n" );
161     # _log( dump( $args ) );
162     } else {
163     $log->print("ERROR ",dump( $op, $doc ) );
164     _json({ error => $op, reason => dump( $doc ) });
165     }
166     }
167    
168 dpavlin 1 =head2 search
169    
170     Implementation specification: L<http://wiki.apache.org/couchdb/FullTextSearch>
171    
172 dpavlin 3 CouchDB::Estraier::search( $database, $query );
173 dpavlin 1
174     =cut
175    
176     sub search {
177 dpavlin 12 my $args = shift or die "no args";
178     $log->print( "search ",dump( $args ),"\n" );
179 dpavlin 13
180 dpavlin 12 my $database = $args->{db} or die "no db in ",dump( $args );
181     my $query = $args->{query} or die "no query in ",dump( $args );
182 dpavlin 1
183     # create and configure node
184     my $node = new Search::Estraier::Node(
185     url => $c->{node_url} . $database,
186     user => $c->{estuser},
187     passwd => $c->{estpasswd},
188     croak_on_error => 1,
189 dpavlin 12 # create => 1,
190 dpavlin 1 debug => $c->{debug} >= 4 ? 1 : 0,
191     );
192    
193     my $cond = new Search::Estraier::Condition;
194     $cond->set_phrase( $query );
195     my $nres = $node->search($cond, 0);
196    
197     if ( defined($nres) ) {
198    
199 dpavlin 12 $out->print( "ok\n" );
200 dpavlin 1 for my $i ( 0 ... $nres->doc_num - 1 ) {
201     my $rdoc = $nres->get_doc($i);
202     print $rdoc->attr('@uri'),"\n",$i,"\n";
203     }
204 dpavlin 12 $out->print( "\n\n" );
205 dpavlin 1
206     } else {
207 dpavlin 12 $out->print( "error\n", $node->status, "\n" );
208 dpavlin 1 }
209    
210     }
211    
212    
213     1;

  ViewVC Help
Powered by ViewVC 1.1.26