--- trunk/Estraier.pm 2006/01/04 22:24:57 15 +++ trunk/Estraier.pm 2006/01/07 16:19:31 63 @@ -4,7 +4,7 @@ use strict; use warnings; -our $VERSION = '0.00'; +our $VERSION = '0.01'; =head1 NAME @@ -27,6 +27,10 @@ =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 @@ -56,6 +60,7 @@ This class implements Document which is collection of attributes (key=value), vectors (also key value) display text and hidden text. + =head2 new Create new document, empty or from draft. @@ -175,6 +180,7 @@ push @{ $self->{htexts} }, $self->_s($text); } + =head2 id Get the ID number of document. If the object has never been registred, C<-1> is returned. @@ -188,6 +194,7 @@ return $self->{id}; } + =head2 attr_names Returns array with attribute names from document object. @@ -198,7 +205,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 +222,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 +237,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 +252,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. @@ -272,12 +282,13 @@ $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,9 +317,88 @@ package Search::Estraier::Condition; +use Carp qw/confess croak/; + use Search::Estraier; our @ISA = qw/Search::Estraier/; +=head1 Search::Estraier::Condition + +=head2 new + + my $cond = new Search::HyperEstraier::Condition; + +=cut + +sub new { + my $class = shift; + my $self = {}; + bless($self, $class); + + $self->{max} = -1; + $self->{options} = 0; + + $self ? return $self : return undef; +} + + +=head2 set_phrase + + $cond->set_phrase('search phrase'); + +=cut + +sub set_phrase { + my $self = shift; + $self->{phrase} = $self->_s( shift ); +} + + +=head2 add_attr + + $cond->add_attr('@URI STRINC /~dpavlin/'); + +=cut + +sub add_attr { + my $self = shift; + my $attr = shift || return; + push @{ $self->{attrs} }, $self->_s( $attr ); +} + + +=head2 set_order + + $cond->set_order('@mdate NUMD'); + +=cut + +sub set_order { + my $self = shift; + $self->{order} = shift; +} + + +=head2 set_max + + $cond->set_max(42); + +=cut + +sub set_max { + my $self = shift; + my $max = shift; + croak "set_max needs number, not '$max'" unless ($max =~ m/^\d+$/); + $self->{max} = $max; +} + + +=head2 set_options + + $cond->set_options( SURE => 1 ); + +=cut + my $options = { # check N-gram keys skipping by three SURE => 1 << 0, @@ -324,59 +414,209 @@ SIMPLE => 1 << 10, }; -=head1 Search::Estraier::Condition +sub set_options { + my $self = shift; + my $option = shift; + confess "unknown option" unless ($options->{$option}); + $self->{options} ||= $options->{$option}; +} + + +=head2 phrase + +Return search phrase. + + print $cond->phrase; + +=cut + +sub phrase { + my $self = shift; + return $self->{phrase}; +} + + +=head2 order + +Return search result order. + + print $cond->order; + +=cut + +sub order { + my $self = shift; + return $self->{order}; +} + + +=head2 attrs + +Return search result attrs. + + my @cond_attrs = $cond->attrs; + +=cut + +sub attrs { + my $self = shift; + #croak "attrs return array, not scalar" if (! wantarray); + return @{ $self->{attrs} } if ($self->{attrs}); +} + + +=head2 max + +Return maximum number of results. + + print $cond->max; + +C<-1> is returned for unitialized value, C<0> is unlimited. + +=cut + +sub max { + my $self = shift; + return $self->{max}; +} + + +=head2 options + +Return options for this condition. + + print $cond->options; + +Options are returned in numerical form. + +=cut + +sub options { + my $self = shift; + return $self->{options}; +} + + +package Search::Estraier::ResultDocument; + +use Carp qw/croak/; + +#use Search::Estraier; +#our @ISA = qw/Search::Estraier/; + +=head1 Search::Estraier::ResultDocument =head2 new - my $cond = new Search::HyperEstraier::Condition; + my $rdoc = new Search::HyperEstraier::ResultDocument( + uri => 'http://localhost/document/uri/42', + attrs => { + foo => 1, + bar => 2, + }, + snippet => 'this is a text of snippet' + keywords => 'this\tare\tkeywords' + ); =cut sub new { my $class = shift; - my $self = {}; + my $self = {@_}; bless($self, $class); + croak "missing uri for ResultDocument" unless defined($self->{uri}); + $self ? return $self : return undef; } -package Search::Estraier::Master; +=head2 uri + +Return URI of result document -use Carp; + print $rdoc->uri; -=head1 Search::Estraier::Master +=cut + +sub uri { + my $self = shift; + return $self->{uri}; +} + + +=head2 attr_names -Controll node master. This requires user with administration priviledges. +Returns array with attribute names from result document object. + + my @attrs = $rdoc->attr_names; =cut -{ - package RequestAgent; - our @ISA = qw(LWP::UserAgent); +sub attr_names { + my $self = shift; + croak "attr_names return array, not scalar" if (! wantarray); + return sort keys %{ $self->{attrs} }; +} - sub new { - my $self = LWP::UserAgent::new(@_); - $self->agent("Search-Estraier/$Search::Estraer::VERSION"); - $self; - } - sub get_basic_credentials { - my($self, $realm, $uri) = @_; -# return ($user, $password); - } +=head2 attr + +Returns value of an attribute. + + my $value = $rdoc->attr( 'attribute' ); + +=cut + +sub attr { + my $self = shift; + my $name = shift || return; + return $self->{attrs}->{ $name }; } +=head2 snippet -=head2 new +Return snippet from result document + + print $rdoc->snippet; + +=cut + +sub snippet { + my $self = shift; + return $self->{snippet}; +} + + +=head2 keywords -Create new connection to node master. +Return keywords from result document - my $master = new Search::Estraier::Master( - url => 'http://localhost:1978', - user => 'admin', - passwd => 'admin', + print $rdoc->keywords; + +=cut + +sub keywords { + my $self = shift; + return $self->{keywords}; +} + + +package Search::Estraier::NodeResult; + +use Carp qw/croak/; + +#use Search::Estraier; +#our @ISA = qw/Search::Estraier/; + +=head1 Search::Estraier::NodeResult + +=head2 new + + my $res = new Search::HyperEstraier::NodeResult( + docs => @array_of_rdocs, + hits => %hash_with_hints, ); =cut @@ -386,14 +626,897 @@ my $self = {@_}; bless($self, $class); - foreach my $p (qw/url user passwd/) { - croak "need $p" unless ($self->{$p}); + foreach my $f (qw/docs hints/) { + croak "missing $f for ResultDocument" unless defined($self->{$f}); } $self ? return $self : return undef; } +=head2 doc_num + +Return number of documents + + print $res->doc_num; + +=cut + +sub doc_num { + my $self = shift; + return $#{$self->{docs}} + 1; +} + + +=head2 get_doc + +Return single document + + my $doc = $res->get_doc( 42 ); + +Returns undef if document doesn't exist. + +=cut + +sub get_doc { + my $self = shift; + my $num = shift; + 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' ); + +Possible hints are: C, C, C, C, C, C, +C