--- trunk/Estraier.pm 2006/01/06 01:51:28 47 +++ trunk/Estraier.pm 2006/01/06 13:19:50 51 @@ -692,6 +692,7 @@ use URI; use MIME::Base64; use IO::Socket::INET; +use URI::Escape qw/uri_escape/; =head1 Search::Estraier::Node @@ -866,7 +867,7 @@ return unless ($self->{url}); $self->shuttle_url( $self->{url} . '/out_doc', 'application/x-www-form-urlencoded', - "uri=$uri", + "uri=" . uri_escape($uri), undef ) == 200; } @@ -928,6 +929,40 @@ } +=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 @@ -936,7 +971,7 @@ =cut -sub erch_doc { +sub etch_doc { my $self = shift; my $id = shift || return; return $self->_fetch_doc( id => $id, etch => 1 ); @@ -987,6 +1022,10 @@ 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( @@ -1011,11 +1050,17 @@ croak "id must be numberm not '$a->{id}'" unless ($a->{id} =~ m/^\d+$/); $arg = 'id=' . $a->{id}; } elsif ($a->{uri}) { - $arg = 'uri=' . $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, @@ -1042,6 +1087,140 @@ } +=head2 name + + my $node_name = $node->name; + +=cut + +sub name { + my $self = shift; + $self->set_info unless ($self->{name}); + return $self->{name}; +} + + +=head2 label + + my $node_label = $node->label; + +=cut + +sub label { + my $self = shift; + $self->set_info unless ($self->{label}); + return $self->{label}; +} + + +=head2 doc_num + + my $documents_in_node = $node->doc_num; + +=cut + +sub doc_num { + my $self = shift; + $self->set_info if ($self->{dnum} < 0); + return $self->{dnum}; +} + + +=head2 word_num + + my $words_in_node = $node->word_num; + +=cut + +sub word_num { + my $self = shift; + $self->set_info if ($self->{wnum} < 0); + return $self->{wnum}; +} + + +=head2 size + + my $node_size = $node->size; + +=cut + +sub size { + my $self = shift; + $self->set_info if ($self->{size} < 0); + return $self->{size}; +} + + +=head2 search + +Search documents which match condition + + my $nres = $node->search( $cond, $depth ); + +C<$cond> is C object, while <$depth> specifies +depth for meta search. + +Function results C 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+$/); + + +} + + +=head2 cond_to_query + + my $args = $node->cond_to_query( $cond ); + +=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 @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 (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=' . $self->{depth} if ($self->{depth}); + push @args, 'wwidth=' . $self->{wwidth}; + push @args, 'hwidth=' . $self->{hwidth}; + push @args, 'awidth=' . $self->{awidth}; + + return join('&', @args); +} =head2 shuttle_url @@ -1155,6 +1334,37 @@ return $self->{status}; } + +=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); + + chomp($resbody); + + ( $self->{name}, $self->{label}, $self->{dnum}, $self->{wnum}, $self->{size} ) = + split(/\t/, $resbody, 5); + +} + ### =head1 EXPORT