--- trunk/Estraier.pm 2006/01/06 14:10:29 52 +++ trunk/Estraier.pm 2006/01/06 20:58:26 57 @@ -645,7 +645,7 @@ sub doc_num { my $self = shift; - return $#{$self->{docs}}; + return $#{$self->{docs}} + 1; } @@ -717,10 +717,10 @@ }; bless($self, $class); - if (@_) { - $self->{debug} = shift; - warn "## Node debug on\n"; - } + my $args = {@_}; + + $self->{debug} = $args->{debug}; + warn "## Node debug on\n" if ($self->{debug}); $self ? return $self : return undef; } @@ -1095,7 +1095,7 @@ sub name { my $self = shift; - $self->set_info unless ($self->{name}); + $self->_set_info unless ($self->{name}); return $self->{name}; } @@ -1108,7 +1108,7 @@ sub label { my $self = shift; - $self->set_info unless ($self->{label}); + $self->_set_info unless ($self->{label}); return $self->{label}; } @@ -1121,7 +1121,7 @@ sub doc_num { my $self = shift; - $self->set_info if ($self->{dnum} < 0); + $self->_set_info if ($self->{dnum} < 0); return $self->{dnum}; } @@ -1134,7 +1134,7 @@ sub word_num { my $self = shift; - $self->set_info if ($self->{wnum} < 0); + $self->_set_info if ($self->{wnum} < 0); return $self->{wnum}; } @@ -1147,7 +1147,7 @@ sub size { my $self = shift; - $self->set_info if ($self->{size} < 0); + $self->_set_info if ($self->{size} < 0); return $self->{size}; } @@ -1175,7 +1175,7 @@ my $resbody; my $rv = $self->shuttle_url( $self->{url} . '/search', - 'text/x-estraier-draft', + 'application/x-www-form-urlencoded', $self->cond_to_query( $cond ), \$resbody, ); @@ -1210,6 +1210,7 @@ while( ! $isend && $lnum <= $#lines ) { my $line = $lines[$lnum]; + #warn "# $lnum: $line\n"; $lnum++; if ($line && $line =~ m/^\Q$border\E/) { @@ -1226,8 +1227,10 @@ last unless ($rdline); if ($rdline =~ /^%/) { $rdvector = $1 if ($rdline =~ /^%VECTOR\t(.+)$/); + } elsif($rdline =~ /=/) { + $rdattrs->{$1} = $2 if ($rdline =~ /^(.+)=(.+)$/); } else { - $rdattrs->{$1} = {$2} if ($line =~ /^(.+)=(.+)$/); + confess "invalid format of response"; } } while($rlnum < $lnum - 1) { @@ -1235,6 +1238,7 @@ $rlnum++; $rdsnippet .= "$rdline\n"; } + #warn Dumper($rdvector, $rdattrs, $rdsnippet); if (my $rduri = $rdattrs->{'@uri'}) { push @docs, new Search::Estraier::ResultDocument( uri => $rduri, @@ -1249,17 +1253,14 @@ $isend = 1 if ($line =~ /:END$/); } - if (! $isend) { - warn "received result doesn't have :END\n$resbody"; - return; - } } if (! $isend) { warn "received result doesn't have :END\n$resbody"; return; } - + + #warn Dumper(\@docs, $hints); return new Search::Estraier::NodeResult( docs => \@docs, hints => $hints ); } @@ -1267,6 +1268,8 @@ =head2 cond_to_query +Return URI encoded string generated from Search::Estraier::Condition + my $args = $node->cond_to_query( $cond ); =cut @@ -1424,15 +1427,117 @@ } -=head2 set_info +=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', + 'text/plain', + '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); + + $self->shuttle_url( $self->{url} . '/_set_link', + 'text/plain', + $reqbody, + undef + ) == 200; +} + + +=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; + $node->_set_info; =cut -sub set_info { +sub _set_info { my $self = shift; $self->{status} = -1;