/[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

Diff of /lib/CouchDB/Estraier.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 3 by dpavlin, Tue Aug 5 13:34:06 2008 UTC revision 13 by dpavlin, Sat Aug 9 23:40:19 2008 UTC
# Line 9  use Search::Estraier; Line 9  use Search::Estraier;
9  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
10  use Getopt::Long;  use Getopt::Long;
11  use JSON;  use JSON;
12    #use IO::Handle;
13    use IO::File;
14    
15  =head1 NAME  =head1 NAME
16    
# Line 20  CouchDB::Estraier - Hyper Estraier full- Line 22  CouchDB::Estraier - Hyper Estraier full-
22    
23  our $c = {  our $c = {
24          node_url => 'http://localhost:1978/node/',          node_url => 'http://localhost:1978/node/',
         debug => 0,  
25          estuser => 'admin',          estuser => 'admin',
26          estpasswd => 'admin',          estpasswd => 'admin',
27          quiet => 0,          debug => 0,
28  };  };
29    
30    my $log = $0;
31    $log =~ s{^.*/([^/]+)(\.\w+)$}{/tmp/$1.log} or die "can't generate log name from $0";
32    
33    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  =head2 run_search  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    =head2 run_query
50    
51  Process command line options and start helper  Process command line options and start helper
52    
# Line 35  Process command line options and start h Line 54  Process command line options and start h
54    
55  =cut  =cut
56    
57  GetOptions($c, qw/node_url=s debug+ quiet+ estuser=s estpasswd=s dbuser=s dbpasswd=s/) or die $!;  sub run_query {
 warn "# c: ", dump($c) if ($c->{debug});  
   
 open(my $log, '>', '/tmp/couchdb-estraier.log');  
   
 sub run_search {  
58          while ( 1 ) {          while ( 1 ) {
59                  my $database = <STDIN>;  #               $log->print("query ready\n");
60                  die unless defined $database;                  my $json = $in->getline;
61                  my $query_string = <STDIN>;                  die unless defined $json;
62                  chomp $database;                  $log->print( "run_query $json\n" );
63                  chomp $query_string;                  query( decode_json( $json ) )
                 print $log "run_search $database\t$query_string\n";  
                 search( $database, $query_string );  
64          }          }
65  }  }
66    
67  sub run_update {  sub run_update {
68          while ( 1 ) {          while ( 1 ) {
69                  my $database = <STDIN>;  #               $log->print("update ready\n");
70                  die unless defined $database;                  my $json = $in->getline;
71                  my $json = <STDIN>;                  die unless defined $json;
72                  chomp $database;                  $log->print( "run_update $json\n" );
73                  chomp $json;                  update( decode_json( $json ) )
                 print $log "run_update $database\t$json\n";  
                 add( $database, from_json( $json ) );  
74          }          }
75  }  }
76    
77    
78  =head2 add  =head2 update
79    
80    CouchDB::Estraier::add( $database, $data );    CouchDB::Estraier::update( { db => $database, type => $type } );
81    
82  =cut  =cut
83    
84  sub add {  sub update {
85          my ( $database, $data ) = @_;          my $args = shift or die "no args";
86            $log->print( "update ",dump( $args ),"\n" );
87    
88            my $ret = {
89                    code => 200,
90                    json => {
91                            args => $args,
92                    },
93            };
94    
95          print $log "add $database ",dump( $data ),"\n";          return $ret;
96          return;  
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          # create and configure node          # create and configure node
101          my $node = new Search::Estraier::Node(          my $node = new Search::Estraier::Node(
# Line 98  sub add { Line 118  sub add {
118    
119          while (my ($col,$val) = each %{$data}) {          while (my ($col,$val) = each %{$data}) {
120    
121                  if ($val) {                  if ( defined $val ) {
122                          # add attributes (make column usable from attribute search)                          # add attributes (make column usable from attribute search)
123                          $doc->add_attr($col, $val);                          $doc->add_attr($col, $val);
124    
# Line 108  sub add { Line 128  sub add {
128    
129          }          }
130    
131          warn "# doc draft: ",$doc->dump_draft, "\n" if ($c->{debug} >= 2);          $log->print("doc draft: ",$doc->dump_draft ) if ($c->{debug} >= 2);
132    
133          die "error: ", $node->status,"\n" unless (eval { $node->put_doc($doc) });          die "error: ", $node->status,"\n" unless (eval { $node->put_doc($doc) });
134    
135            return $ret;
136    }
137    
138    =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  =head2 search  =head2 search
# Line 123  Implementation specification: L<http://w Line 174  Implementation specification: L<http://w
174  =cut  =cut
175    
176  sub search {  sub search {
177          my ( $database, $query ) = @_;          my $args = shift or die "no args";
178            $log->print( "search ",dump( $args ),"\n" );
179    
180            my $database = $args->{db} or die "no db in ",dump( $args );
181            my $query = $args->{query} or die "no query in ",dump( $args );
182    
183          # create and configure node          # create and configure node
184          my $node = new Search::Estraier::Node(          my $node = new Search::Estraier::Node(
# Line 131  sub search { Line 186  sub search {
186                  user => $c->{estuser},                  user => $c->{estuser},
187                  passwd => $c->{estpasswd},                  passwd => $c->{estpasswd},
188                  croak_on_error => 1,                  croak_on_error => 1,
189                  create => 1,  #               create => 1,
190                  debug => $c->{debug} >= 4 ? 1 : 0,                  debug => $c->{debug} >= 4 ? 1 : 0,
191          );          );
192    
# Line 141  sub search { Line 196  sub search {
196    
197          if ( defined($nres) ) {          if ( defined($nres) ) {
198    
199                  print "ok\n";                  $out->print( "ok\n" );
200                  for my $i ( 0 ... $nres->doc_num - 1 ) {                  for my $i ( 0 ... $nres->doc_num - 1 ) {
201                          my $rdoc = $nres->get_doc($i);                          my $rdoc = $nres->get_doc($i);
202                          print $rdoc->attr('@uri'),"\n",$i,"\n";                          print $rdoc->attr('@uri'),"\n",$i,"\n";
203                  }                  }
204                  print "\n\n";                  $out->print( "\n\n" );
205    
206          } else {          } else {
207                  print "error\n", $node->status, "\n";                  $out->print( "error\n", $node->status, "\n" );
208          }          }
209    
   
210  }  }
211    
212    
Legend:
Removed from v.3  
changed lines
  Added in v.13
  ViewVC Help
Powered by ViewVC 1.1.26