/[Search-Estraier]/trunk/lib/Search/Estraier.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/lib/Search/Estraier.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 81 by dpavlin, Tue Jan 17 00:03:45 2006 UTC revision 102 by dpavlin, Sat Jan 28 19:46:20 2006 UTC
# Line 17  Search::Estraier - pure perl module to u Line 17  Search::Estraier - pure perl module to u
17          use Search::Estraier;          use Search::Estraier;
18    
19          # create and configure node          # create and configure node
20          my $node = new Search::Estraier::Node;          my $node = new Search::Estraier::Node(
21          $node->set_url("http://localhost:1978/node/test");                  url => 'http://localhost:1978/node/test',
22          $node->set_auth("admin","admin");                  user => 'admin',
23                    passwd => 'admin'
24            );
25    
26          # create document          # create document
27          my $doc = new Search::Estraier::Document;          my $doc = new Search::Estraier::Document;
# Line 32  Search::Estraier - pure perl module to u Line 34  Search::Estraier - pure perl module to u
34          $doc->add_text("Somewhere over the rainbow.  Way up high.");          $doc->add_text("Somewhere over the rainbow.  Way up high.");
35          $doc->add_text("There's a land that I heard of once in a lullaby.");          $doc->add_text("There's a land that I heard of once in a lullaby.");
36    
37          die "error: ", $node->status,"\n" unless ($node->put_doc($doc));          die "error: ", $node->status,"\n" unless (eval { $node->put_doc($doc) });
38    
39  =head2 Simple searcher  =head2 Simple searcher
40    
41          use Search::Estraier;          use Search::Estraier;
42    
43          # create and configure node          # create and configure node
44          my $node = new Search::Estraier::Node;          my $node = new Search::Estraier::Node(
45          $node->set_url("http://localhost:1978/node/test");                  url => 'http://localhost:1978/node/test',
46          $node->set_auth("admin","admin");                  user => 'admin',
47                    passwd => 'admin',
48                    croak_on_error => 1,
49            );
50    
51          # create condition          # create condition
52          my $cond = new Search::Estraier::Condition;          my $cond = new Search::Estraier::Condition;
# Line 50  Search::Estraier - pure perl module to u Line 55  Search::Estraier - pure perl module to u
55          $cond->set_phrase("rainbow AND lullaby");          $cond->set_phrase("rainbow AND lullaby");
56    
57          my $nres = $node->search($cond, 0);          my $nres = $node->search($cond, 0);
58    
59          if (defined($nres)) {          if (defined($nres)) {
60                    print "Got ", $nres->hits, " results\n";
61    
62                  # for each document in results                  # for each document in results
63                  for my $i ( 0 ... $nres->doc_num - 1 ) {                  for my $i ( 0 ... $nres->doc_num - 1 ) {
64                          # get result document                          # get result document
# Line 92  Remove multiple whitespaces from string, Line 100  Remove multiple whitespaces from string,
100  =cut  =cut
101    
102  sub _s {  sub _s {
103          my $text = $_[1] || return;          my $text = $_[1];
104            return unless defined($text);
105          $text =~ s/\s\s+/ /gs;          $text =~ s/\s\s+/ /gs;
106          $text =~ s/^\s+//;          $text =~ s/^\s+//;
107          $text =~ s/\s+$//;          $text =~ s/\s+$//;
# Line 320  sub dump_draft { Line 329  sub dump_draft {
329          my $draft;          my $draft;
330    
331          foreach my $attr_name (sort keys %{ $self->{attrs} }) {          foreach my $attr_name (sort keys %{ $self->{attrs} }) {
332                  $draft .= $attr_name . '=' . $self->{attrs}->{$attr_name} . "\n";                  next unless defined(my $v = $self->{attrs}->{$attr_name});
333                    $draft .= $attr_name . '=' . $v . "\n";
334          }          }
335    
336          if ($self->{kwords}) {          if ($self->{kwords}) {
# Line 368  sub delete { Line 378  sub delete {
378    
379  package Search::Estraier::Condition;  package Search::Estraier::Condition;
380    
381  use Carp qw/confess croak/;  use Carp qw/carp confess croak/;
382    
383  use Search::Estraier;  use Search::Estraier;
384  our @ISA = qw/Search::Estraier/;  our @ISA = qw/Search::Estraier/;
# Line 446  sub set_max { Line 456  sub set_max {
456    
457  =head2 set_options  =head2 set_options
458    
459    $cond->set_options( SURE => 1 );    $cond->set_options( 'SURE' );
460    
461      $cond->set_options( qw/AGITO NOIDF SIMPLE/ );
462    
463    Possible options are:
464    
465    =over 8
466    
467    =item SURE
468    
469    check every N-gram
470    
471    =item USUAL
472    
473    check every second N-gram
474    
475    =item FAST
476    
477    check every third N-gram
478    
479    =item AGITO
480    
481    check every fourth N-gram
482    
483    =item NOIDF
484    
485    don't perform TF-IDF tuning
486    
487    =item SIMPLE
488    
489    use simplified query phrase
490    
491    =back
492    
493    Skipping N-grams will speed up search, but reduce accuracy. Every call to C<set_options> will reset previous
494    options;
495    
496    This option changed in version C<0.04> of this module. It's backwards compatibile.
497    
498  =cut  =cut
499    
500  my $options = {  my $options = {
         # check N-gram keys skipping by three  
501          SURE => 1 << 0,          SURE => 1 << 0,
         # check N-gram keys skipping by two  
502          USUAL => 1 << 1,          USUAL => 1 << 1,
         # without TF-IDF tuning  
503          FAST => 1 << 2,          FAST => 1 << 2,
         # with the simplified phrase  
504          AGITO => 1 << 3,          AGITO => 1 << 3,
         # check every N-gram key  
505          NOIDF => 1 << 4,          NOIDF => 1 << 4,
         # check N-gram keys skipping by one  
506          SIMPLE => 1 << 10,          SIMPLE => 1 << 10,
507  };  };
508    
509  sub set_options {  sub set_options {
510          my $self = shift;          my $self = shift;
511          my $option = shift;          my $opt = 0;
512          confess "unknown option" unless ($options->{$option});          foreach my $option (@_) {
513          $self->{options} ||= $options->{$option};                  my $mask;
514                    unless ($mask = $options->{$option}) {
515                            if ($option eq '1') {
516                                    next;
517                            } else {
518                                    croak "unknown option $option";
519                            }
520                    }
521                    $opt += $mask;
522            }
523            $self->{options} = $opt;
524  }  }
525    
526    
# Line 691  Return number of documents Line 742  Return number of documents
742    
743    print $res->doc_num;    print $res->doc_num;
744    
745    This will return real number of documents (limited by C<max>).
746    If you want to get total number of hits, see C<hits>.
747    
748  =cut  =cut
749    
750  sub doc_num {  sub doc_num {
# Line 722  sub get_doc { Line 776  sub get_doc {
776    
777  Return specific hint from results.  Return specific hint from results.
778    
779    print $rec->hint( 'VERSION' );    print $res->hint( 'VERSION' );
780    
781  Possible hints are: C<VERSION>, C<NODE>, C<HIT>, C<HINT#n>, C<DOCNUM>, C<WORDNUM>,  Possible hints are: C<VERSION>, C<NODE>, C<HIT>, C<HINT#n>, C<DOCNUM>, C<WORDNUM>,
782  C<TIME>, C<LINK#n>, C<VIEW>.  C<TIME>, C<LINK#n>, C<VIEW>.
# Line 735  sub hint { Line 789  sub hint {
789          return $self->{hints}->{$key};          return $self->{hints}->{$key};
790  }  }
791    
792    =head2 hits
793    
794    More perlish version of C<hint>. This one returns hash.
795    
796      my %hints = $res->hints;
797    
798    =cut
799    
800    sub hints {
801            my $self = shift;
802            return $self->{hints};
803    }
804    
805    =head2 hits
806    
807    Syntaxtic sugar for total number of hits for this query
808    
809      print $res->hits;
810    
811    It's same as
812    
813      print $res->hint('HIT');
814    
815    but shorter.
816    
817    =cut
818    
819    sub hits {
820            my $self = shift;
821            return $self->{hints}->{'HIT'} || 0;
822    }
823    
824  package Search::Estraier::Node;  package Search::Estraier::Node;
825    
Legend:
Removed from v.81  
changed lines
  Added in v.102
  ViewVC Help
Powered by ViewVC 1.1.26