/[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!

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

Parent Directory | Revision Log | View Patch Patch

-revision 69 by dpavlin,
Sun Jan  8 16:49:53 2006 UTC
+revision 98 by dpavlin,
Sat Jan 28 19:18:13 2006 UTC
 Line 4 
 use 5.008;
  use strict;
  use warnings;
- our $VERSION = '0.03_1';
+ our $VERSION = '0.04_1';
  =head1 NAME
 Line 92 
 Remove multiple whitespaces from string,
  =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+$//;
-Line 157 
 sub new {
+Line 158 
 sub new {
                          } 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";
                  }
          }
-Line 320 
 sub dump_draft {
+Line 321 
 sub dump_draft {
          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}) {
-Line 368 
 sub delete {
+Line 370 
 sub delete {
  package Search::Estraier::Condition;
- use Carp qw/confess croak/;
+ use Carp qw/carp confess croak/;
  use Search::Estraier;
  our @ISA = qw/Search::Estraier/;
-Line 446 
 sub set_max {
+Line 448 
 sub set_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;
+         my $opt = 0;
-         confess "unknown option" unless ($options->{$option});
+         foreach my $option (@_) {
-         $self->{options} ||= $options->{$option};
+                 my $mask;
+                 unless ($mask = $options->{$option}) {
+                         if ($option eq '1') {
+                                 next;
+                         } else {
+                                 croak "unknown option $option";
+                         }
+                 }
+                 $opt += $mask;
+         }
+         $self->{options} = $opt;
  }
-Line 735 
 sub hint {
+Line 778 
 sub hint {
          return $self->{hints}->{$key};
  }
+ =head2 hints
+ More perlish version of C<hint>. This one returns hash.
+   my %hints = $rec->hints;
+ =cut
+ sub hints {
+         my $self = shift;
+         return $self->{hints};
+ }
  package Search::Estraier::Node;
-Line 754 
 or optionally with C<url> as parametar
+Line 809 
 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',
+         debug => 1,
+         croak_on_error => 1
+   );
+ with following arguments:
+ =over 4
+ =item url
+ URL to node
+ =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 {
-Line 776 
 sub new {
+Line 859 
 sub new {
          } else {
                  my $args = {@_};
-                 $self->{debug} = $args->{debug};
+                 %$self = ( %$self, @_ );
                  warn "## Node debug on\n" if ($self->{debug});
          }
-Line 1418 
 sub shuttle_url {
+Line 1502 
 sub shuttle_url {
          $req->headers->header( 'Host' => $url->host . ":" . $url->port );
          $req->headers->header( 'Connection', 'close' );
-         $req->headers->header( 'Authorization', 'Basic ' . $self->{auth} );
+         $req->headers->header( 'Authorization', 'Basic ' . $self->{auth} ) if ($self->{auth});
          $req->content_type( $content_type );
          warn $req->headers->as_string,"\n" if ($self->{debug});
-Line 1432 
 sub shuttle_url {
+Line 1516 
 sub shuttle_url {
          warn "## response status: ",$res->status_line,"\n" if ($self->{debug});
-         return -1 if (! $res->is_success);
          ($self->{status}, $self->{status_message}) = split(/\s+/, $res->status_line, 2);
+         if (! $res->is_success) {
+                 if ($self->{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});
-Line 1535 
 sub set_link {
+Line 1625 
 sub set_link {
          $reqbody .= '&credit=' . $credit if ($credit > 0);
          $self->shuttle_url( $self->{url} . '/_set_link',
-                 'text/plain',
+                 'application/x-www-form-urlencoded',
                  $reqbody,
                  undef
          ) == 200;

 Legend:



Removed from v.69
 


changed lines


 
Added in v.98
 Legend:



Removed from v.69
 


changed lines


 
Added in v.98
-Removed from v.69
+Added in v.98

	ViewVC Help
Powered by ViewVC 1.1.26