--- trunk/Estraier.pm 2006/02/19 17:13:57 108 +++ trunk/Estraier.pm 2006/05/09 12:42:39 135 @@ -4,7 +4,7 @@ use strict; use warnings; -our $VERSION = '0.04_2'; +our $VERSION = '0.06_1'; =head1 NAME @@ -599,6 +599,35 @@ } +=head2 set_skip + +Set number of skipped documents from beginning of results + + $cond->set_skip(42); + +Similar to C in RDBMS. + +=cut + +sub set_skip { + my $self = shift; + $self->{skip} = shift; +} + +=head2 skip + +Return skip for this condition. + + print $cond->skip; + +=cut + +sub skip { + my $self = shift; + return $self->{skip}; +} + + package Search::Estraier::ResultDocument; use Carp qw/croak/; @@ -843,6 +872,8 @@ my $node = new Search::HyperEstraier::Node( url => 'http://localhost:1978/node/test', + user => 'admin', + passwd => 'admin' debug => 1, croak_on_error => 1 ); @@ -855,6 +886,14 @@ URL to node +=item user + +specify username for node server authentication + +=item passwd + +password for authentication + =item debug dumps a B of debugging output @@ -874,26 +913,30 @@ my $self = { pxport => -1, timeout => 0, # this used to be -1 - dnum => -1, - wnum => -1, - size => -1.0, wwidth => 480, hwidth => 96, awidth => 96, status => -1, }; + bless($self, $class); if ($#_ == 0) { $self->{url} = shift; } else { - my $args = {@_}; - %$self = ( %$self, @_ ); + $self->set_auth( $self->{user}, $self->{passwd} ) if ($self->{user}); + warn "## Node debug on\n" if ($self->{debug}); } + $self->{inform} = { + dnum => -1, + wnum => -1, + size => -1.0, + }; + $self ? return $self : return undef; } @@ -1270,8 +1313,8 @@ sub name { my $self = shift; - $self->_set_info unless ($self->{name}); - return $self->{name}; + $self->_set_info unless ($self->{inform}->{name}); + return $self->{inform}->{name}; } @@ -1283,8 +1326,8 @@ sub label { my $self = shift; - $self->_set_info unless ($self->{label}); - return $self->{label}; + $self->_set_info unless ($self->{inform}->{label}); + return $self->{inform}->{label}; } @@ -1296,8 +1339,8 @@ sub doc_num { my $self = shift; - $self->_set_info if ($self->{dnum} < 0); - return $self->{dnum}; + $self->_set_info if ($self->{inform}->{dnum} < 0); + return $self->{inform}->{dnum}; } @@ -1309,8 +1352,8 @@ sub word_num { my $self = shift; - $self->_set_info if ($self->{wnum} < 0); - return $self->{wnum}; + $self->_set_info if ($self->{inform}->{wnum} < 0); + return $self->{inform}->{wnum}; } @@ -1322,8 +1365,8 @@ sub size { my $self = shift; - $self->_set_info if ($self->{size} < 0); - return $self->{size}; + $self->_set_info if ($self->{inform}->{size} < 0); + return $self->{inform}->{size}; } @@ -1356,88 +1399,32 @@ ); return if ($rv != 200); - my (@docs, $hints); - - my @lines = split(/\n/, $resbody); - return unless (@lines); - - my $border = $lines[0]; - my $isend = 0; - my $lnum = 1; - - while ( $lnum <= $#lines ) { - my $line = $lines[$lnum]; - $lnum++; - - #warn "## $line\n"; - if ($line && $line =~ m/^\Q$border\E(:END)*$/) { - $isend = $1; - last; - } - - if ($line =~ /\t/) { - my ($k,$v) = split(/\t/, $line, 2); - $hints->{$k} = $v; - } - } - - my $snum = $lnum; - - while( ! $isend && $lnum <= $#lines ) { - my $line = $lines[$lnum]; - #warn "# $lnum: $line\n"; - $lnum++; - - if ($line && $line =~ m/^\Q$border\E/) { - if ($lnum > $snum) { - my $rdattrs; - my $rdvector; - my $rdsnippet; - - my $rlnum = $snum; - while ($rlnum < $lnum - 1 ) { - #my $rdline = $self->_s($lines[$rlnum]); - my $rdline = $lines[$rlnum]; - $rlnum++; - last unless ($rdline); - if ($rdline =~ /^%/) { - $rdvector = $1 if ($rdline =~ /^%VECTOR\t(.+)$/); - } elsif($rdline =~ /=/) { - $rdattrs->{$1} = $2 if ($rdline =~ /^(.+)=(.+)$/); - } else { - confess "invalid format of response"; - } - } - while($rlnum < $lnum - 1) { - my $rdline = $lines[$rlnum]; - $rlnum++; - $rdsnippet .= "$rdline\n"; - } - #warn Dumper($rdvector, $rdattrs, $rdsnippet); - if (my $rduri = $rdattrs->{'@uri'}) { - push @docs, new Search::Estraier::ResultDocument( - uri => $rduri, - attrs => $rdattrs, - snippet => $rdsnippet, - keywords => $rdvector, - ); - } - } - $snum = $lnum; - #warn "### $line\n"; - $isend = 1 if ($line =~ /:END$/); - } - - } - - if (! $isend) { - warn "received result doesn't have :END\n$resbody"; - return; + my @records = split /--------\[.*?\]--------(?::END)?\r?\n/, $resbody; + my $hintsText = splice @records, 0, 2; # starts with empty record + my $hints = { $hintsText =~ m/^(.*?)\t(.*?)$/gsm }; + + # process records + my $docs = []; + foreach my $record (@records) + { + # split into keys and snippets + my ($keys, $snippet) = $record =~ m/^(.*?)\n\n(.*?)$/s; + + # create document hash + my $doc = { $keys =~ m/^(.*?)=(.*?)$/gsm }; + $doc->{'@keywords'} = $doc->{keywords}; + ($doc->{keywords}) = $keys =~ m/^%VECTOR\t(.*?)$/gm; + $doc->{snippet} = $snippet; + + push @$docs, new Search::Estraier::ResultDocument( + attrs => $doc, + uri => $doc->{'@uri'}, + snippet => $snippet, + keywords => $doc->{'keywords'}, + ); } - #warn Dumper(\@docs, $hints); - - return new Search::Estraier::NodeResult( docs => \@docs, hints => $hints ); + return new Search::Estraier::NodeResult( docs => $docs, hints => $hints ); } @@ -1486,6 +1473,7 @@ push @args, 'wwidth=' . $self->{wwidth}; push @args, 'hwidth=' . $self->{hwidth}; push @args, 'awidth=' . $self->{awidth}; + push @args, 'skip=' . $self->{skip} if ($self->{skip}); return join('&', @args); } @@ -1680,8 +1668,8 @@ sub admins { my $self = shift; - $self->_set_info unless ($self->{name}); - return $self->{admins}; + $self->_set_info unless ($self->{inform}->{name}); + return $self->{inform}->{admins}; } =head2 guests @@ -1694,8 +1682,8 @@ sub guests { my $self = shift; - $self->_set_info unless ($self->{name}); - return $self->{guests}; + $self->_set_info unless ($self->{inform}->{name}); + return $self->{inform}->{guests}; } =head2 links @@ -1708,10 +1696,138 @@ sub links { my $self = shift; - $self->_set_info unless ($self->{name}); - return $self->{links}; + $self->_set_info unless ($self->{inform}->{name}); + return $self->{inform}->{links}; } +=head2 master + +Set actions on Hyper Estraier node master (C process) + + $node->master( + action => 'sync' + ); + +All available actions are documented in +L + +=cut + +my $estmaster_rest = { + shutdown => { + status => 202, + }, + sync => { + status => 202, + }, + backup => { + status => 202, + }, + userlist => { + status => 200, + returns => [ qw/name passwd flags fname misc/ ], + }, + useradd => { + required => [ qw/name passwd flags/ ], + optional => [ qw/fname misc/ ], + status => 200, + }, + userdel => { + required => [ qw/name/ ], + status => 200, + }, + nodelist => { + status => 200, + returns => [ qw/name label doc_num word_num size/ ], + }, + nodeadd => { + required => [ qw/name/ ], + optional => [ qw/label/ ], + status => 200, + }, + nodedel => { + required => [ qw/name/ ], + status => 200, + }, + nodeclr => { + required => [ qw/name/ ], + status => 200, + }, + nodertt => { + status => 200, + }, +}; + +sub master { + my $self = shift; + + my $args = {@_}; + + # have action? + my $action = $args->{action} || croak "need action, available: ", + join(", ",keys %{ $estmaster_rest }); + + # check if action is valid + my $rest = $estmaster_rest->{$action}; + croak "action '$action' is not supported, available actions: ", + join(", ",keys %{ $estmaster_rest }) unless ($rest); + + croak "BUG: action '$action' needs return status" unless ($rest->{status}); + + my @args; + + if ($rest->{required} || $rest->{optional}) { + + map { + croak "need parametar '$_' for action '$action'" unless ($args->{$_}); + push @args, $_ . '=' . uri_escape( $args->{$_} ); + } ( keys %{ $rest->{required} } ); + + map { + push @args, $_ . '=' . uri_escape( $args->{$_} ) if ($args->{$_}); + } ( keys %{ $rest->{optional} } ); + + } + + my $uri = new URI( $self->{url} ); + + my $resbody; + + my $status = $self->shuttle_url( + 'http://' . $uri->host_port . '/master?action=' . $action , + 'application/x-www-form-urlencoded', + join('&', @args), + \$resbody, + 1, + ) or confess "shuttle_url failed"; + + if ($status == $rest->{status}) { + if ($rest->{returns} && wantarray) { + + my @results; + my $fields = $#{$rest->{returns}}; + + foreach my $line ( split(/[\r\n]/,$resbody) ) { + my @e = split(/\t/, $line, $fields + 1); + my $row; + foreach my $i ( 0 .. $fields) { + $row->{ $rest->{returns}->[$i] } = $e[ $i ]; + } + push @results, $row; + } + + return @results; + + } elsif ($resbody) { + return $resbody; + } else { + return 0E0; + } + } + + carp "expected status $rest->{status}, but got $status"; + return undef; +} =head1 PRIVATE METHODS @@ -1741,24 +1857,26 @@ return if ($rv != 200 || !$resbody); my @lines = split(/[\r\n]/,$resbody); - - ( $self->{name}, $self->{label}, $self->{dnum}, $self->{wnum}, $self->{size} ) = - split(/\t/, shift @lines, 5); + + $self->{inform} = {}; + + ( $self->{inform}->{name}, $self->{inform}->{label}, $self->{inform}->{dnum}, + $self->{inform}->{wnum}, $self->{inform}->{size} ) = split(/\t/, shift @lines, 5); return $resbody unless (@lines); shift @lines; while(my $admin = shift @lines) { - push @{$self->{admins}}, $admin; + push @{$self->{inform}->{admins}}, $admin; } - + while(my $guest = shift @lines) { - push @{$self->{guests}}, $guest; + push @{$self->{inform}->{guests}}, $guest; } while(my $link = shift @lines) { - push @{$self->{links}}, $link; + push @{$self->{inform}->{links}}, $link; } return $resbody; @@ -1781,6 +1899,7 @@ Dobrica Pavlinusic, Edpavlin@rot13.orgE +Robert Klep Erobert@klep.nameE contributed refactored search code =head1 COPYRIGHT AND LICENSE