--- trunk/Estraier.pm	2006/01/05 15:33:48	30
+++ trunk/lib/Search/Estraier.pm	2008/01/20 16:51:47	199
@@ -4,7 +4,7 @@
 use strict;
 use warnings;
 
-our $VERSION = '0.00';
+our $VERSION = '0.09';
 
 =head1 NAME
 
@@ -12,8 +12,68 @@
 
 =head1 SYNOPSIS
 
-  use Search::Estraier;
-  my $est = new Search::Estraier();
+=head2 Simple indexer
+
+	use Search::Estraier;
+
+	# create and configure node
+	my $node = new Search::Estraier::Node(
+		url => 'http://localhost:1978/node/test',
+		user => 'admin',
+		passwd => 'admin',
+		create => 1,
+		label => 'Label for node',
+		croak_on_error => 1,
+	);
+
+	# create document
+	my $doc = new Search::Estraier::Document;
+
+	# add attributes
+	$doc->add_attr('@uri', "http://estraier.gov/example.txt");
+	$doc->add_attr('@title', "Over the Rainbow");
+
+	# add body text to document
+	$doc->add_text("Somewhere over the rainbow.  Way up high.");
+	$doc->add_text("There's a land that I heard of once in a lullaby.");
+
+	die "error: ", $node->status,"\n" unless (eval { $node->put_doc($doc) });
+
+=head2 Simple searcher
+
+	use Search::Estraier;
+
+	# create and configure node
+	my $node = new Search::Estraier::Node(
+		url => 'http://localhost:1978/node/test',
+		user => 'admin',
+		passwd => 'admin',
+		croak_on_error => 1,
+	);
+
+	# create condition
+	my $cond = new Search::Estraier::Condition;
+
+	# set search phrase
+	$cond->set_phrase("rainbow AND lullaby");
+
+	my $nres = $node->search($cond, 0);
+
+	if (defined($nres)) {
+		print "Got ", $nres->hits, " results\n";
+
+		# for each document in results
+		for my $i ( 0 ... $nres->doc_num - 1 ) {
+			# get result document
+			my $rdoc = $nres->get_doc($i);
+			# display attribte
+			print "URI: ", $rdoc->attr('@uri'),"\n";
+			print "Title: ", $rdoc->attr('@title'),"\n";
+			print $rdoc->snippet,"\n";
+		}
+	} else {
+		die "error: ", $node->status,"\n";
+	}
 
 =head1 DESCRIPTION
 
@@ -25,8 +85,14 @@
 It is implemented as multiple packages which closly resamble Ruby
 implementation. It also includes methods to manage nodes.
 
+There are few examples in C<scripts> directory of this distribution.
+
 =cut
 
+=head1 Inheritable common methods
+
+This methods should really move somewhere else.
+
 =head2 _s
 
 Remove multiple whitespaces from string, as well as whitespaces at beginning or end
@@ -37,7 +103,8 @@
 =cut
 
 sub _s {
-	my $text = $_[1] || return;
+	my $text = $_[1];
+	return unless defined($text);
 	$text =~ s/\s\s+/ /gs;
 	$text =~ s/^\s+//;
 	$text =~ s/\s+$//;
@@ -53,8 +120,34 @@
 
 =head1 Search::Estraier::Document
 
-This class implements Document which is collection of attributes
-(key=value), vectors (also key value) display text and hidden text.
+This class implements Document which is single item in Hyper Estraier.
+
+It's is collection of:
+
+=over 4
+
+=item attributes
+
+C<< 'key' => 'value' >> pairs which can later be used for filtering of results
+
+You can add common filters to C<attrindex> in estmaster's C<_conf>
+file for better performance. See C<attrindex> in
+L<Hyper Estraier P2P Guide|http://hyperestraier.sourceforge.net/nguide-en.html>.
+
+=item vectors
+
+also C<< 'key' => 'value' >> pairs
+
+=item display text
+
+Text which will be used to create searchable corpus of your index and
+included in snippet output.
+
+=item hidden text
+
+Text which will be searchable, but will not be included in snippet.
+
+=back
 
 =head2 new
 
@@ -89,11 +182,15 @@
 
 			if ($line =~ m/^%VECTOR\t(.+)$/) {
 				my @fields = split(/\t/, $1);
-				for my $i ( 0 .. ($#fields - 1) ) {
-					$self->{kwords}->{ $fields[ $i ] } = $fields[ $i + 1 ];
-					$i++;
+				if ($#fields % 2 == 1) {
+					$self->{kwords} = { @fields };
+				} else {
+					warn "can't decode $line\n";
 				}
 				next;
+			} elsif ($line =~ m/^%SCORE\t(.+)$/) {
+			    $self->{score} = $1;
+			    next;
 			} elsif ($line =~ m/^%/) {
 				# What is this? comment?
 				#warn "$line\n";
@@ -101,12 +198,12 @@
 			} elsif ($line =~ m/^$/) {
 				$in_text = 1;
 				next;
-			} elsif ($line =~ m/^(.+)=(.+)$/) {
+			} elsif ($line =~ m/^(.+)=(.*)$/) {
 				$self->{attrs}->{ $1 } = $2;
 				next;
 			}
 
-			warn "draft ignored: $line\n";
+			warn "draft ignored: '$line'\n";
 		}
 	}
 
@@ -175,6 +272,54 @@
 	push @{ $self->{htexts} }, $self->_s($text);
 }
 
+=head2 add_vectors
+
+Add a vectors
+
+  $doc->add_vector(
+  	'vector_name' => 42,
+	'another' => 12345,
+  );
+
+=cut
+
+sub add_vectors {
+	my $self = shift;
+	return unless (@_);
+
+	# this is ugly, but works
+	die "add_vector needs HASH as argument" unless ($#_ % 2 == 1);
+
+	$self->{kwords} = {@_};
+}
+
+=head2 set_score
+
+Set the substitute score
+
+  $doc->set_score(12345);
+
+=cut
+
+sub set_score {
+    my $self = shift;
+    my $score = shift;
+    return unless (defined($score));
+    $self->{score} = $score;
+}
+
+=head2 score
+
+Get the substitute score
+
+=cut
+
+sub score {
+    my $self = shift;
+    return -1 unless (defined($self->{score}));
+    return $self->{score};
+}
+
 =head2 id
 
 Get the ID number of document. If the object has never been registred, C<-1> is returned.
@@ -188,6 +333,7 @@
 	return $self->{id};
 }
 
+
 =head2 attr_names
 
 Returns array with attribute names from document object.
@@ -198,7 +344,8 @@
 
 sub attr_names {
 	my $self = shift;
-	croak "attr_names return array, not scalar" if (! wantarray);
+	return unless ($self->{attrs});
+	#croak "attr_names return array, not scalar" if (! wantarray);
 	return sort keys %{ $self->{attrs} };
 }
 
@@ -214,8 +361,8 @@
 sub attr {
 	my $self = shift;
 	my $name = shift;
-
-	return $self->{'attrs'}->{ $name };
+	return unless (defined($name) && $self->{attrs});
+	return $self->{attrs}->{ $name };
 }
 
 
@@ -229,10 +376,11 @@
 
 sub texts {
 	my $self = shift;
-	confess "texts return array, not scalar" if (! wantarray);
-	return @{ $self->{dtexts} };
+	#confess "texts return array, not scalar" if (! wantarray);
+	return @{ $self->{dtexts} } if ($self->{dtexts});
 }
 
+
 =head2 cat_texts
 
 Return whole text as single scalar.
@@ -243,9 +391,10 @@
 
 sub cat_texts {
 	my $self = shift;
-	return join(' ',@{ $self->{dtexts} });
+	return join(' ',@{ $self->{dtexts} }) if ($self->{dtexts});
 }
 
+
 =head2 dump_draft
 
 Dump draft data from document object.
@@ -259,25 +408,31 @@
 	my $draft;
 
 	foreach my $attr_name (sort keys %{ $self->{attrs} }) {
-		$draft .= $attr_name . '=' . $self->{attrs}->{$attr_name} . "\n";
+		next unless defined(my $v = $self->{attrs}->{$attr_name});
+		$draft .= $attr_name . '=' . $v . "\n";
 	}
 
 	if ($self->{kwords}) {
-		$draft .= '%%VECTOR';
+		$draft .= '%VECTOR';
 		while (my ($key, $value) = each %{ $self->{kwords} }) {
 			$draft .= "\t$key\t$value";
 		}
 		$draft .= "\n";
 	}
 
+	if (defined($self->{score}) && $self->{score} >= 0) {
+	    $draft .= "%SCORE\t" . $self->{score} . "\n";
+	}
+
 	$draft .= "\n";
 
-	$draft .= join("\n", @{ $self->{dtexts} }) . "\n";
-	$draft .= "\t" . join("\n\t", @{ $self->{htexts} }) . "\n";
+	$draft .= join("\n", @{ $self->{dtexts} }) . "\n" if ($self->{dtexts});
+	$draft .= "\t" . join("\n\t", @{ $self->{htexts} }) . "\n" if ($self->{htexts});
 
 	return $draft;
 }
 
+
 =head2 delete
 
 Empty document object
@@ -306,7 +461,7 @@
 
 package Search::Estraier::Condition;
 
-use Carp qw/confess croak/;
+use Carp qw/carp confess croak/;
 
 use Search::Estraier;
 our @ISA = qw/Search::Estraier/;
@@ -330,6 +485,7 @@
 	$self ? return $self : return undef;
 }
 
+
 =head2 set_phrase
 
   $cond->set_phrase('search phrase');
@@ -341,6 +497,7 @@
 	$self->{phrase} = $self->_s( shift );
 }
 
+
 =head2 add_attr
 
   $cond->add_attr('@URI STRINC /~dpavlin/');
@@ -353,6 +510,7 @@
 	push @{ $self->{attrs} }, $self->_s( $attr );
 }
 
+
 =head2 set_order
 
   $cond->set_order('@mdate NUMD');
@@ -364,6 +522,7 @@
 	$self->{order} = shift;
 }
 
+
 =head2 set_max
 
   $cond->set_max(42);
@@ -373,38 +532,81 @@
 sub set_max {
 	my $self = shift;
 	my $max = shift;
-	croak "set_max needs number" unless ($max =~ m/^\d+$/);
+	croak "set_max needs number, not '$max'" unless ($max =~ m/^\d+$/);
 	$self->{max} = $max;
 }
 
+
 =head2 set_options
 
-  $cond->set_options( SURE => 1 );
+  $cond->set_options( 'SURE' );
+
+  $cond->set_options( qw/AGITO NOIDF SIMPLE/ );
+
+Possible options are:
+
+=over 8
+
+=item SURE
+
+check every N-gram
+
+=item USUAL
+
+check every second N-gram
+
+=item FAST
+
+check every third N-gram
+
+=item AGITO
+
+check every fourth N-gram
+
+=item NOIDF
+
+don't perform TF-IDF tuning
+
+=item SIMPLE
+
+use simplified query phrase
+
+=back
+
+Skipping N-grams will speed up search, but reduce accuracy. Every call to C<set_options> will reset previous
+options;
+
+This option changed in version C<0.04> of this module. It's backwards compatibile.
 
 =cut
 
 my $options = {
-	# check N-gram keys skipping by three
 	SURE => 1 << 0,
-	# check N-gram keys skipping by two
 	USUAL => 1 << 1,
-	# without TF-IDF tuning
 	FAST => 1 << 2,
-	# with the simplified phrase
 	AGITO => 1 << 3,
-	# check every N-gram key
 	NOIDF => 1 << 4,
-	# check N-gram keys skipping by one
 	SIMPLE => 1 << 10,
 };
 
 sub set_options {
 	my $self = shift;
-	my $option = shift;
-	confess "unknown option" unless ($options->{$option});
-	$self->{options} ||= $options->{$option};
+	my $opt = 0;
+	foreach my $option (@_) {
+		my $mask;
+		unless ($mask = $options->{$option}) {
+			if ($option eq '1') {
+				next;
+			} else {
+				croak "unknown option $option";
+			}
+		}
+		$opt += $mask;
+	}
+	$self->{options} = $opt;
 }
 
+
 =head2 phrase
 
 Return search phrase.
@@ -418,6 +620,7 @@
 	return $self->{phrase};
 }
 
+
 =head2 order
 
 Return search result order.
@@ -431,6 +634,7 @@
 	return $self->{order};
 }
 
+
 =head2 attrs
 
 Return search result attrs.
@@ -442,9 +646,10 @@
 sub attrs {
 	my $self = shift;
 	#croak "attrs return array, not scalar" if (! wantarray);
-	return @{ $self->{attrs} };
+	return @{ $self->{attrs} } if ($self->{attrs});
 }
 
+
 =head2 max
 
 Return maximum number of results.
@@ -460,6 +665,7 @@
 	return $self->{max};
 }
 
+
 =head2 options
 
 Return options for this condition.
@@ -476,6 +682,76 @@
 }
 
 
+=head2 set_skip
+
+Set number of skipped documents from beginning of results
+
+  $cond->set_skip(42);
+
+Similar to C<offset> 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};
+}
+
+
+=head2 set_distinct
+
+  $cond->set_distinct('@author');
+
+=cut
+
+sub set_distinct {
+	my $self = shift;
+	$self->{distinct} = shift;
+}
+
+=head2 distinct
+
+Return distinct attribute
+
+  print $cond->distinct;
+
+=cut
+
+sub distinct {
+	my $self = shift;
+	return $self->{distinct};
+}
+
+=head2 set_mask
+
+Filter out some links when searching.
+
+Argument array of link numbers, starting with 0 (current node).
+
+  $cond->set_mask(qw/0 1 4/);
+
+=cut
+
+sub set_mask {
+	my $self = shift;
+	return unless (@_);
+	$self->{mask} = \@_;
+}
+
+
 package Search::Estraier::ResultDocument;
 
 use Carp qw/croak/;
@@ -504,13 +780,12 @@
 	my $self = {@_};
 	bless($self, $class);
 
-	foreach my $f (qw/uri attrs snippet keywords/) {
-		croak "missing $f for ResultDocument" unless defined($self->{$f});
-	}
+	croak "missing uri for ResultDocument" unless defined($self->{uri});
 
 	$self ? return $self : return undef;
 }
 
+
 =head2 uri
 
 Return URI of result document
@@ -539,6 +814,7 @@
 	return sort keys %{ $self->{attrs} };
 }
 
+
 =head2 attr
 
 Returns value of an attribute.
@@ -553,6 +829,7 @@
 	return $self->{attrs}->{ $name };
 }
 
+
 =head2 snippet
 
 Return snippet from result document
@@ -566,6 +843,7 @@
 	return $self->{snippet};
 }
 
+
 =head2 keywords
 
 Return keywords from result document
@@ -610,19 +888,24 @@
 	$self ? return $self : return undef;
 }
 
+
 =head2 doc_num
 
 Return number of documents
 
   print $res->doc_num;
 
+This will return real number of documents (limited by C<max>).
+If you want to get total number of hits, see C<hits>.
+
 =cut
 
 sub doc_num {
 	my $self = shift;
-	return $#{$self->{docs}};
+	return $#{$self->{docs}} + 1;
 }
 
+
 =head2 get_doc
 
 Return single document
@@ -636,16 +919,17 @@
 sub get_doc {
 	my $self = shift;
 	my $num = shift;
-	croak "expect number as argument" unless ($num =~ m/^\d+$/);
+	croak "expect number as argument, not '$num'" unless ($num =~ m/^\d+$/);
 	return undef if ($num < 0 || $num > $self->{docs});
 	return $self->{docs}->[$num];
 }
 
+
 =head2 hint
 
 Return specific hint from results.
 
-  print $rec->hint( 'VERSION' );
+  print $res->hint( 'VERSION' );
 
 Possible hints are: C<VERSION>, C<NODE>, C<HIT>, C<HINT#n>, C<DOCNUM>, C<WORDNUM>,
 C<TIME>, C<LINK#n>, C<VIEW>.
@@ -658,10 +942,45 @@
 	return $self->{hints}->{$key};
 }
 
+=head2 hints
+
+More perlish version of C<hint>. This one returns hash.
+
+  my %hints = $res->hints;
+
+=cut
+
+sub hints {
+	my $self = shift;
+	return $self->{hints};
+}
+
+=head2 hits
+
+Syntaxtic sugar for total number of hits for this query
+
+  print $res->hits;
+
+It's same as
+
+  print $res->hint('HIT');
+
+but shorter.
+
+=cut
+
+sub hits {
+	my $self = shift;
+	return $self->{hints}->{'HIT'} || 0;
+}
 
 package Search::Estraier::Node;
 
-use Carp qw/croak/;
+use Carp qw/carp croak confess/;
+use URI;
+use MIME::Base64;
+use IO::Socket::INET;
+use URI::Escape qw/uri_escape/;
 
 =head1 Search::Estraier::Node
 
@@ -669,26 +988,106 @@
 
   my $node = new Search::HyperEstraier::Node;
 
+or optionally with C<url> as parametar
+
+  my $node = new Search::HyperEstraier::Node( 'http://localhost:1978/node/test' );
+
+or in more verbose form
+
+  my $node = new Search::HyperEstraier::Node(
+  	url => 'http://localhost:1978/node/test',
+	user => 'admin',
+	passwd => 'admin'
+	create => 1,
+	label => 'optional node label',
+	debug => 1,
+	croak_on_error => 1
+  );
+
+with following arguments:
+
+=over 4
+
+=item url
+
+URL to node
+
+=item user
+
+specify username for node server authentication
+
+=item passwd
+
+password for authentication
+
+=item create
+
+create node if it doesn't exists
+
+=item label
+
+optional label for new node if C<create> is used
+
+=item debug
+
+dumps a B<lot> of debugging output
+
+=item croak_on_error
+
+very helpful during development. It will croak on all errors instead of
+silently returning C<-1> (which is convention of Hyper Estraier API in other
+languages).
+
+=back
+
 =cut
 
 sub new {
 	my $class = shift;
 	my $self = {
 		pxport => -1,
-		timeout => -1,
-		dnum => -1,
-		wnum => -1,
-		size => -1.0,
+		timeout => 0,	# this used to be -1
 		wwidth => 480,
 		hwidth => 96,
 		awidth => 96,
 		status => -1,
 	};
+
 	bless($self, $class);
 
+	if ($#_ == 0) {
+		$self->{url} = shift;
+	} else {
+		%$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,
+	};
+
+	if ($self->{create}) {
+		if (! eval { $self->name } || $@) {
+			my $name = $1 if ($self->{url} =~ m#/node/([^/]+)/*#);
+			croak "can't find node name in '$self->{url}'" unless ($name);
+			my $label = $self->{label} || $name;
+			$self->master(
+				action => 'nodeadd',
+				name => $name,
+				label => $label,
+			) || croak "can't create node $name ($label)";
+		}
+	}
+
 	$self ? return $self : return undef;
 }
 
+
 =head2 set_url
 
 Specify URL to node server
@@ -702,6 +1101,7 @@
 	$self->{url} = shift;
 }
 
+
 =head2 set_proxy
 
 Specify proxy server to connect to node server
@@ -713,11 +1113,12 @@
 sub set_proxy {
 	my $self = shift;
 	my ($host,$port) = @_;
-	croak "proxy port must be number" unless ($port =~ m/^\d+$/);
+	croak "proxy port must be number, not '$port'" unless ($port =~ m/^\d+$/);
 	$self->{pxhost} = $host;
 	$self->{pxport} = $port;
 }
 
+
 =head2 set_timeout
 
 Specify timeout of connection in seconds
@@ -729,63 +1130,982 @@
 sub set_timeout {
 	my $self = shift;
 	my $sec = shift;
-	croak "timeout must be number" unless ($sec =~ m/^\d+$/);
+	croak "timeout must be number, not '$sec'" unless ($sec =~ m/^\d+$/);
 	$self->{timeout} = $sec;
 }
 
-package Search::Estraier::Master;
 
-use Carp;
+=head2 set_auth
+
+Specify name and password for authentication to node server.
+
+  $node->set_auth('clint','eastwood');
+
+=cut
+
+sub set_auth {
+	my $self = shift;
+	my ($login,$passwd) = @_;
+	my $basic_auth = encode_base64( "$login:$passwd" );
+	chomp($basic_auth);
+	$self->{auth} = $basic_auth;
+}
+
+
+=head2 status
 
-=head1 Search::Estraier::Master
+Return status code of last request.
 
-Controll node master. This requires user with administration priviledges.
+  print $node->status;
+
+C<-1> means connection failure.
 
 =cut
 
-{
-	package RequestAgent;
-	our @ISA = qw(LWP::UserAgent);
+sub status {
+	my $self = shift;
+	return $self->{status};
+}
+
+
+=head2 put_doc
+
+Add a document
+
+  $node->put_doc( $document_draft ) or die "can't add document";
 
-	sub new { 
-		my $self = LWP::UserAgent::new(@_);
-		$self->agent("Search-Estraier/$Search::Estraer::VERSION");
-		$self;
+Return true on success or false on failure.
+
+=cut
+
+sub put_doc {
+	my $self = shift;
+	my $doc = shift || return;
+	return unless ($self->{url} && $doc->isa('Search::Estraier::Document'));
+	if ($self->shuttle_url( $self->{url} . '/put_doc',
+		'text/x-estraier-draft',
+		$doc->dump_draft,
+		undef
+	) == 200) {
+		$self->_clear_info;
+		return 1;
 	}
+	return undef;
+}
+
+
+=head2 out_doc
+
+Remove a document
+
+  $node->out_doc( document_id ) or "can't remove document";
+
+Return true on success or false on failture.
 
-	sub get_basic_credentials {
-		my($self, $realm, $uri) = @_;
-#		return ($user, $password);
+=cut
+
+sub out_doc {
+	my $self = shift;
+	my $id = shift || return;
+	return unless ($self->{url});
+	croak "id must be number, not '$id'" unless ($id =~ m/^\d+$/);
+	if ($self->shuttle_url( $self->{url} . '/out_doc',
+		'application/x-www-form-urlencoded',
+		"id=$id",
+		undef
+	) == 200) {
+		$self->_clear_info;
+		return 1;
 	}
+	return undef;
 }
 
 
+=head2 out_doc_by_uri
 
-=head2 new
+Remove a registrated document using it's uri
 
-Create new connection to node master.
+  $node->out_doc_by_uri( 'file:///document/uri/42' ) or "can't remove document";
 
-  my $master = new Search::Estraier::Master(
-	url => 'http://localhost:1978',
-	user => 'admin',
-	passwd => 'admin',
+Return true on success or false on failture.
+
+=cut
+
+sub out_doc_by_uri {
+	my $self = shift;
+	my $uri = shift || return;
+	return unless ($self->{url});
+	if ($self->shuttle_url( $self->{url} . '/out_doc',
+		'application/x-www-form-urlencoded',
+		"uri=" . uri_escape($uri),
+		undef
+	) == 200) {
+		$self->_clear_info;
+		return 1;
+	}
+	return undef;
+}
+
+
+=head2 edit_doc
+
+Edit attributes of a document
+
+  $node->edit_doc( $document_draft ) or die "can't edit document";
+
+Return true on success or false on failture.
+
+=cut
+
+sub edit_doc {
+	my $self = shift;
+	my $doc = shift || return;
+	return unless ($self->{url} && $doc->isa('Search::Estraier::Document'));
+	if ($self->shuttle_url( $self->{url} . '/edit_doc',
+		'text/x-estraier-draft',
+		$doc->dump_draft,
+		undef
+	) == 200) {
+		$self->_clear_info;
+		return 1;
+	}
+	return undef;
+}
+
+
+=head2 get_doc
+
+Retreive document
+
+  my $doc = $node->get_doc( document_id ) or die "can't get document";
+
+Return true on success or false on failture.
+
+=cut
+
+sub get_doc {
+	my $self = shift;
+	my $id = shift || return;
+	return $self->_fetch_doc( id => $id );
+}
+
+
+=head2 get_doc_by_uri
+
+Retreive document
+
+  my $doc = $node->get_doc_by_uri( 'file:///document/uri/42' ) or die "can't get document";
+
+Return true on success or false on failture.
+
+=cut
+
+sub get_doc_by_uri {
+	my $self = shift;
+	my $uri = shift || return;
+	return $self->_fetch_doc( uri => $uri );
+}
+
+
+=head2 get_doc_attr
+
+Retrieve the value of an atribute from object
+
+  my $val = $node->get_doc_attr( document_id, 'attribute_name' ) or
+  	die "can't get document attribute";
+
+=cut
+
+sub get_doc_attr {
+	my $self = shift;
+	my ($id,$name) = @_;
+	return unless ($id && $name);
+	return $self->_fetch_doc( id => $id, attr => $name );
+}
+
+
+=head2 get_doc_attr_by_uri
+
+Retrieve the value of an atribute from object
+
+  my $val = $node->get_doc_attr_by_uri( document_id, 'attribute_name' ) or
+  	die "can't get document attribute";
+
+=cut
+
+sub get_doc_attr_by_uri {
+	my $self = shift;
+	my ($uri,$name) = @_;
+	return unless ($uri && $name);
+	return $self->_fetch_doc( uri => $uri, attr => $name );
+}
+
+
+=head2 etch_doc
+
+Exctract document keywords
+
+  my $keywords = $node->etch_doc( document_id ) or die "can't etch document";
+
+=cut
+
+sub etch_doc {
+	my $self = shift;
+	my $id = shift || return;
+	return $self->_fetch_doc( id => $id, etch => 1 );
+}
+
+=head2 etch_doc_by_uri
+
+Retreive document
+
+  my $keywords = $node->etch_doc_by_uri( 'file:///document/uri/42' ) or die "can't etch document";
+
+Return true on success or false on failture.
+
+=cut
+
+sub etch_doc_by_uri {
+	my $self = shift;
+	my $uri = shift || return;
+	return $self->_fetch_doc( uri => $uri, etch => 1 );
+}
+
+
+=head2 uri_to_id
+
+Get ID of document specified by URI
+
+  my $id = $node->uri_to_id( 'file:///document/uri/42' );
+
+This method won't croak, even if using C<croak_on_error>.
+
+=cut
+
+sub uri_to_id {
+	my $self = shift;
+	my $uri = shift || return;
+	return $self->_fetch_doc( uri => $uri, path => '/uri_to_id', chomp_resbody => 1, croak_on_error => 0 );
+}
+
+
+=head2 _fetch_doc
+
+Private function used for implementing of C<get_doc>, C<get_doc_by_uri>,
+C<etch_doc>, C<etch_doc_by_uri>.
+
+ # this will decode received draft into Search::Estraier::Document object
+ my $doc = $node->_fetch_doc( id => 42 );
+ my $doc = $node->_fetch_doc( uri => 'file:///document/uri/42' );
+
+ # to extract keywords, add etch
+ my $doc = $node->_fetch_doc( id => 42, etch => 1 );
+ my $doc = $node->_fetch_doc( uri => 'file:///document/uri/42', etch => 1 );
+
+ # to get document attrubute add attr
+ my $doc = $node->_fetch_doc( id => 42, attr => '@mdate' );
+ my $doc = $node->_fetch_doc( uri => 'file:///document/uri/42', attr => '@mdate' );
+
+ # more general form which allows implementation of
+ # uri_to_id
+ my $id = $node->_fetch_doc(
+ 	uri => 'file:///document/uri/42',
+	path => '/uri_to_id',
+	chomp_resbody => 1
+ );
+
+=cut
+
+sub _fetch_doc {
+	my $self = shift;
+	my $a = {@_};
+	return unless ( ($a->{id} || $a->{uri}) && $self->{url} );
+
+	my ($arg, $resbody);
+
+	my $path = $a->{path} || '/get_doc';
+	$path = '/etch_doc' if ($a->{etch});
+
+	if ($a->{id}) {
+		croak "id must be number not '$a->{id}'" unless ($a->{id} =~ m/^\d+$/);
+		$arg = 'id=' . $a->{id};
+	} elsif ($a->{uri}) {
+		$arg = 'uri=' . uri_escape($a->{uri});
+	} else {
+		confess "unhandled argument. Need id or uri.";
+	}
+
+	if ($a->{attr}) {
+		$path = '/get_doc_attr';
+		$arg .= '&attr=' . uri_escape($a->{attr});
+		$a->{chomp_resbody} = 1;
+	}
+
+	my $rv = $self->shuttle_url( $self->{url} . $path,
+		'application/x-www-form-urlencoded',
+		$arg,
+		\$resbody,
+		$a->{croak_on_error},
+	);
+
+	return if ($rv != 200);
+
+	if ($a->{etch}) {
+		$self->{kwords} = {};
+		return +{} unless ($resbody);
+		foreach my $l (split(/\n/, $resbody)) {
+			my ($k,$v) = split(/\t/, $l, 2);
+			$self->{kwords}->{$k} = $v if ($v);
+		}
+		return $self->{kwords};
+	} elsif ($a->{chomp_resbody}) {
+		return unless (defined($resbody));
+		chomp($resbody);
+		return $resbody;
+	} else {
+		return new Search::Estraier::Document($resbody);
+	}
+}
+
+
+=head2 name
+
+  my $node_name = $node->name;
+
+=cut
+
+sub name {
+	my $self = shift;
+	$self->_set_info unless ($self->{inform}->{name});
+	return $self->{inform}->{name};
+}
+
+
+=head2 label
+
+  my $node_label = $node->label;
+
+=cut
+
+sub label {
+	my $self = shift;
+	$self->_set_info unless ($self->{inform}->{label});
+	return $self->{inform}->{label};
+}
+
+
+=head2 doc_num
+
+  my $documents_in_node = $node->doc_num;
+
+=cut
+
+sub doc_num {
+	my $self = shift;
+	$self->_set_info if ($self->{inform}->{dnum} < 0);
+	return $self->{inform}->{dnum};
+}
+
+
+=head2 word_num
+
+  my $words_in_node = $node->word_num;
+
+=cut
+
+sub word_num {
+	my $self = shift;
+	$self->_set_info if ($self->{inform}->{wnum} < 0);
+	return $self->{inform}->{wnum};
+}
+
+
+=head2 size
+
+  my $node_size = $node->size;
+
+=cut
+
+sub size {
+	my $self = shift;
+	$self->_set_info if ($self->{inform}->{size} < 0);
+	return $self->{inform}->{size};
+}
+
+
+=head2 search
+
+Search documents which match condition
+
+  my $nres = $node->search( $cond, $depth );
+
+C<$cond> is C<Search::Estraier::Condition> object, while <$depth> specifies
+depth for meta search.
+
+Function results C<Search::Estraier::NodeResult> object.
+
+=cut
+
+sub search {
+	my $self = shift;
+	my ($cond, $depth) = @_;
+	return unless ($cond && defined($depth) && $self->{url});
+	croak "cond mush be Search::Estraier::Condition, not '$cond->isa'" unless ($cond->isa('Search::Estraier::Condition'));
+	croak "depth needs number, not '$depth'" unless ($depth =~ m/^\d+$/);
+
+	my $resbody;
+
+	my $rv = $self->shuttle_url( $self->{url} . '/search',
+		'application/x-www-form-urlencoded',
+		$self->cond_to_query( $cond, $depth ),
+		\$resbody,
+	);
+	return if ($rv != 200);
+
+	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'},
+		);
+	}
+
+	return new Search::Estraier::NodeResult( docs => $docs, hints => $hints );
+}
+
+
+=head2 cond_to_query
+
+Return URI encoded string generated from Search::Estraier::Condition
+
+  my $args = $node->cond_to_query( $cond, $depth );
+
+=cut
+
+sub cond_to_query {
+	my $self = shift;
+
+	my $cond = shift || return;
+	croak "condition must be Search::Estraier::Condition, not '$cond->isa'" unless ($cond->isa('Search::Estraier::Condition'));
+	my $depth = shift;
+
+	my @args;
+
+	if (my $phrase = $cond->phrase) {
+		push @args, 'phrase=' . uri_escape($phrase);
+	}
+
+	if (my @attrs = $cond->attrs) {
+		for my $i ( 0 .. $#attrs ) {
+			push @args,'attr' . ($i+1) . '=' . uri_escape( $attrs[$i] ) if ($attrs[$i]);
+		}
+	}
+
+	if (my $order = $cond->order) {
+		push @args, 'order=' . uri_escape($order);
+	}
+		
+	if (my $max = $cond->max) {
+		push @args, 'max=' . $max;
+	} else {
+		push @args, 'max=' . (1 << 30);
+	}
+
+	if (my $options = $cond->options) {
+		push @args, 'options=' . $options;
+	}
+
+	push @args, 'depth=' . $depth if ($depth);
+	push @args, 'wwidth=' . $self->{wwidth};
+	push @args, 'hwidth=' . $self->{hwidth};
+	push @args, 'awidth=' . $self->{awidth};
+	push @args, 'skip=' . $cond->{skip} if ($cond->{skip});
+
+	if (my $distinct = $cond->distinct) {
+		push @args, 'distinct=' . uri_escape($distinct);
+	}
+
+	if ($cond->{mask}) {
+		my $mask = 0;
+		map { $mask += ( 2 ** $_ ) } @{ $cond->{mask} };
+
+		push @args, 'mask=' . $mask if ($mask);
+	}
+
+	return join('&', @args);
+}
+
+
+=head2 shuttle_url
+
+This is method which uses C<LWP::UserAgent> to communicate with Hyper Estraier node
+master.
+
+  my $rv = shuttle_url( $url, $content_type, $req_body, \$resbody );
+
+C<$resheads> and C<$resbody> booleans controll if response headers and/or response
+body will be saved within object.
+
+=cut
+
+use LWP::UserAgent;
+
+sub shuttle_url {
+	my $self = shift;
+
+	my ($url, $content_type, $reqbody, $resbody, $croak_on_error) = @_;
+
+	$croak_on_error = $self->{croak_on_error} unless defined($croak_on_error);
+
+	$self->{status} = -1;
+
+	warn "## $url\n" if ($self->{debug});
+
+	$url = new URI($url);
+	if (
+			!$url || !$url->scheme || !$url->scheme eq 'http' ||
+			!$url->host || !$url->port || $url->port < 1
+		) {
+		carp "can't parse $url\n";
+		return -1;
+	}
+
+	my $ua = LWP::UserAgent->new;
+	$ua->agent( "Search-Estraier/$Search::Estraier::VERSION" );
+
+	my $req;
+	if ($reqbody) {
+		$req = HTTP::Request->new(POST => $url);
+	} else {
+		$req = HTTP::Request->new(GET => $url);
+	}
+
+	$req->headers->header( 'Host' => $url->host . ":" . $url->port );
+	$req->headers->header( 'Connection', 'close' );
+	$req->headers->header( 'Authorization', 'Basic ' . $self->{auth} ) if ($self->{auth});
+	$req->content_type( $content_type );
+
+	warn $req->headers->as_string,"\n" if ($self->{debug});
+
+	if ($reqbody) {
+		warn "$reqbody\n" if ($self->{debug});
+		$req->content( $reqbody );
+	}
+
+	my $res = $ua->request($req) || croak "can't make request to $url: $!";
+
+	warn "## response status: ",$res->status_line,"\n" if ($self->{debug});
+
+	($self->{status}, $self->{status_message}) = split(/\s+/, $res->status_line, 2);
+
+	if (! $res->is_success) {
+		if ($croak_on_error) {
+			croak("can't get $url: ",$res->status_line);
+		} else {
+			return -1;
+		}
+	}
+
+	$$resbody .= $res->content;
+
+	warn "## response body:\n$$resbody\n" if ($resbody && $self->{debug});
+
+	return $self->{status};
+}
+
+
+=head2 set_snippet_width
+
+Set width of snippets in results
+
+  $node->set_snippet_width( $wwidth, $hwidth, $awidth );
+
+C<$wwidth> specifies whole width of snippet. It's C<480> by default. If it's C<0> snippet
+is not sent with results. If it is negative, whole document text is sent instead of snippet.
+
+C<$hwidth> specified width of strings from beginning of string. Default
+value is C<96>. Negative or zero value keep previous value.
+
+C<$awidth> specifies width of strings around each highlighted word. It's C<96> by default.
+If negative of zero value is provided previous value is kept unchanged.
+
+=cut
+
+sub set_snippet_width {
+	my $self = shift;
+
+	my ($wwidth, $hwidth, $awidth) = @_;
+	$self->{wwidth} = $wwidth;
+	$self->{hwidth} = $hwidth if ($hwidth >= 0);
+	$self->{awidth} = $awidth if ($awidth >= 0);
+}
+
+
+=head2 set_user
+
+Manage users of node
+
+  $node->set_user( 'name', $mode );
+
+C<$mode> can be one of:
+
+=over 4
+
+=item 0
+
+delete account
+
+=item 1
+
+set administrative right for user
+
+=item 2
+
+set user account as guest
+
+=back
+
+Return true on success, otherwise false.
+
+=cut
+
+sub set_user {
+	my $self = shift;
+	my ($name, $mode) = @_;
+
+	return unless ($self->{url});
+	croak "mode must be number, not '$mode'" unless ($mode =~ m/^\d+$/);
+
+	$self->shuttle_url( $self->{url} . '/_set_user',
+		'application/x-www-form-urlencoded',
+		'name=' . uri_escape($name) . '&mode=' . $mode,
+		undef
+	) == 200;
+}
+
+
+=head2 set_link
+
+Manage node links
+
+  $node->set_link('http://localhost:1978/node/another', 'another node label', $credit);
+
+If C<$credit> is negative, link is removed.
+
+=cut
+
+sub set_link {
+	my $self = shift;
+	my ($url, $label, $credit) = @_;
+
+	return unless ($self->{url});
+	croak "mode credit be number, not '$credit'" unless ($credit =~ m/^\d+$/);
+
+	my $reqbody = 'url=' . uri_escape($url) . '&label=' . uri_escape($label);
+	$reqbody .= '&credit=' . $credit if ($credit > 0);
+
+	if ($self->shuttle_url( $self->{url} . '/_set_link',
+		'application/x-www-form-urlencoded',
+		$reqbody,
+		undef
+	) == 200) {
+		# refresh node info after adding link
+		$self->_clear_info;
+		return 1;
+	}
+	return undef;
+}
+
+=head2 admins
+
+ my @admins = @{ $node->admins };
+
+Return array of users with admin rights on node
+
+=cut
+
+sub admins {
+	my $self = shift;
+	$self->_set_info unless ($self->{inform}->{name});
+	return $self->{inform}->{admins};
+}
+
+=head2 guests
+
+ my @guests = @{ $node->guests };
+
+Return array of users with guest rights on node
+
+=cut
+
+sub guests {
+	my $self = shift;
+	$self->_set_info unless ($self->{inform}->{name});
+	return $self->{inform}->{guests};
+}
+
+=head2 links
+
+ my $links = @{ $node->links };
+
+Return array of links for this node
+
+=cut
+
+sub links {
+	my $self = shift;
+	$self->_set_info unless ($self->{inform}->{name});
+	return $self->{inform}->{links};
+}
+
+=head2 cacheusage
+
+Return cache usage for a node
+
+  my $cache = $node->cacheusage;
+
+=cut
+
+sub cacheusage {
+	my $self = shift;
+
+	return unless ($self->{url});
+
+	my $resbody;
+	my $rv = $self->shuttle_url( $self->{url} . '/cacheusage',
+		'text/plain',
+		undef,
+		\$resbody,
+	);
+
+	return if ($rv != 200 || !$resbody);
+
+	return $resbody;
+}
+
+=head2 master
+
+Set actions on Hyper Estraier node master (C<estmaster> process)
+
+  $node->master(
+  	action => 'sync'
   );
 
+All available actions are documented in
+L<http://hyperestraier.sourceforge.net/nguide-en.html#protocol>
+
 =cut
 
-sub new {
-	my $class = shift;
-	my $self = {@_};
-	bless($self, $class);
+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->{$_} );
+		} ( @{ $rest->{required} } );
+
+		map {
+			push @args, $_ . '=' . uri_escape( $args->{$_} ) if ($args->{$_});
+		} ( @{ $rest->{optional} } );
 
-	foreach my $p (qw/url user passwd/) {
-		croak "need $p" unless ($self->{$p});
 	}
 
-	$self ? return $self : return undef;
+	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}) {
+
+		# refresh node info after sync
+		$self->_clear_info if ($action eq 'sync' || $action =~ m/^node(?:add|del|clr)$/);
+
+		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) {
+			chomp $resbody;
+			return $resbody;
+		} else {
+			return 0E0;
+		}
+	}
+
+	carp "expected status $rest->{status}, but got $status";
+	return undef;
 }
 
+=head1 PRIVATE METHODS
+
+You could call those directly, but you don't have to. I hope.
+
+=head2 _set_info
+
+Set information for node
+
+  $node->_set_info;
+
+=cut
+
+sub _set_info {
+	my $self = shift;
+
+	$self->{status} = -1;
+	return unless ($self->{url});
+
+	my $resbody;
+	my $rv = $self->shuttle_url( $self->{url} . '/inform',
+		'text/plain',
+		undef,
+		\$resbody,
+	);
+
+	return if ($rv != 200 || !$resbody);
+
+	my @lines = split(/[\r\n]/,$resbody);
+
+	$self->_clear_info;
 
+	( $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->{inform}->{admins}}, $admin;
+	}
+
+	while(my $guest = shift @lines) {
+		push @{$self->{inform}->{guests}}, $guest;
+	}
+
+	while(my $link = shift @lines) {
+		push @{$self->{inform}->{links}}, $link;
+	}
+
+	return $resbody;
+
+}
+
+=head2 _clear_info
+
+Clear information for node
+
+  $node->_clear_info;
+
+On next call to C<name>, C<label>, C<doc_num>, C<word_num> or C<size> node
+info will be fetch again from Hyper Estraier.
+
+=cut
+sub _clear_info {
+	my $self = shift;
+	$self->{inform} = {
+		dnum => -1,
+		wnum => -1,
+		size => -1.0,
+	};
+}
 
 ###
 
@@ -799,10 +2119,15 @@
 
 Hyper Estraier Ruby interface on which this module is based.
 
+Hyper Estraier now also has pure-perl binding included in distribution. It's
+a faster way to access databases directly if you are not running
+C<estmaster> P2P server.
+
 =head1 AUTHOR
 
 Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
 
+Robert Klep E<lt>robert@klep.nameE<gt> contributed refactored search code
 
 =head1 COPYRIGHT AND LICENSE