/[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 12 by dpavlin, Sat Aug 9 16:10:05 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    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_search  =head2 run_search
50    
# Line 35  Process command line options and start h Line 54  Process command line options and start h
54    
55  =cut  =cut
56    
 GetOptions($c, qw/node_url=s debug+ quiet+ estuser=s estpasswd=s dbuser=s dbpasswd=s/) or die $!;  
 warn "# c: ", dump($c) if ($c->{debug});  
   
 open(my $log, '>', '/tmp/couchdb-estraier.log');  
   
57  sub run_search {  sub run_search {
58          while ( 1 ) {          while ( 1 ) {
59                  my $database = <STDIN>;                  $log->print("search 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_search $json\n" );
63                  chomp $query_string;                  $out->print(
64                  print $log "run_search $database\t$query_string\n";                          encode_json(
65                  search( $database, $query_string );                                  search( decode_json( $json ) )
66                            ) ,"\n"
67                    );
68          }          }
69  }  }
70    
71  sub run_update {  sub run_update {
72          while ( 1 ) {          while ( 1 ) {
73                  my $database = <STDIN>;                  $log->print("update ready\n");
74                  die unless defined $database;                  my $json = $in->getline;
75                  my $json = <STDIN>;                  die unless defined $json;
76                  chomp $database;                  $log->print( "run_update $json\n" );
77                  chomp $json;                  update( decode_json( $json ) )
                 print $log "run_update $database\t$json\n";  
                 add( $database, from_json( $json ) );  
78          }          }
79  }  }
80    
81    
82  =head2 add  =head2 update
83    
84    CouchDB::Estraier::add( $database, $data );    CouchDB::Estraier::update( { db => $database, type => $type } );
85    
86  =cut  =cut
87    
88  sub add {  sub update {
89          my ( $database, $data ) = @_;          my $args = shift or die "no args";
90            $log->print( "add ",dump( $args ),"\n" );
91    
92            my $ret = {
93                    code => 200,
94                    json => {
95                            args => $args,
96                    },
97            };
98    
99          print $log "add $database ",dump( $data ),"\n";          return $ret;
100          return;  
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          # create and configure node          # create and configure node
105          my $node = new Search::Estraier::Node(          my $node = new Search::Estraier::Node(
# Line 98  sub add { Line 122  sub add {
122    
123          while (my ($col,$val) = each %{$data}) {          while (my ($col,$val) = each %{$data}) {
124    
125                  if ($val) {                  if ( defined $val ) {
126                          # add attributes (make column usable from attribute search)                          # add attributes (make column usable from attribute search)
127                          $doc->add_attr($col, $val);                          $doc->add_attr($col, $val);
128    
# Line 108  sub add { Line 132  sub add {
132    
133          }          }
134    
135          warn "# doc draft: ",$doc->dump_draft, "\n" if ($c->{debug} >= 2);          $log->print("doc draft: ",$doc->dump_draft ) if ($c->{debug} >= 2);
136    
137          die "error: ", $node->status,"\n" unless (eval { $node->put_doc($doc) });          die "error: ", $node->status,"\n" unless (eval { $node->put_doc($doc) });
138    
139            return $ret;
140  }  }
141    
142  =head2 search  =head2 search
# Line 123  Implementation specification: L<http://w Line 148  Implementation specification: L<http://w
148  =cut  =cut
149    
150  sub search {  sub search {
151          my ( $database, $query ) = @_;          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    
156          # create and configure node          # create and configure node
157          my $node = new Search::Estraier::Node(          my $node = new Search::Estraier::Node(
# Line 131  sub search { Line 159  sub search {
159                  user => $c->{estuser},                  user => $c->{estuser},
160                  passwd => $c->{estpasswd},                  passwd => $c->{estpasswd},
161                  croak_on_error => 1,                  croak_on_error => 1,
162                  create => 1,  #               create => 1,
163                  debug => $c->{debug} >= 4 ? 1 : 0,                  debug => $c->{debug} >= 4 ? 1 : 0,
164          );          );
165    
# Line 141  sub search { Line 169  sub search {
169    
170          if ( defined($nres) ) {          if ( defined($nres) ) {
171    
172                  print "ok\n";                  $out->print( "ok\n" );
173                  for my $i ( 0 ... $nres->doc_num - 1 ) {                  for my $i ( 0 ... $nres->doc_num - 1 ) {
174                          my $rdoc = $nres->get_doc($i);                          my $rdoc = $nres->get_doc($i);
175                          print $rdoc->attr('@uri'),"\n",$i,"\n";                          print $rdoc->attr('@uri'),"\n",$i,"\n";
176                  }                  }
177                  print "\n\n";                  $out->print( "\n\n" );
178    
179          } else {          } else {
180                  print "error\n", $node->status, "\n";                  $out->print( "error\n", $node->status, "\n" );
181          }          }
182    
   
183  }  }
184    
185    

Legend:
Removed from v.3  
changed lines
  Added in v.12

  ViewVC Help
Powered by ViewVC 1.1.26