/[Search-Estraier]/trunk/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/Estraier.pm

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

revision 2 by dpavlin, Wed Jan 4 13:11:43 2006 UTC revision 15 by dpavlin, Wed Jan 4 22:24:57 2006 UTC
# Line 4  use 5.008; Line 4  use 5.008;
4  use strict;  use strict;
5  use warnings;  use warnings;
6    
 require Exporter;  
   
 our @ISA = qw(Exporter);  
   
 our %EXPORT_TAGS = ( 'all' => [ qw(  
 ) ] );  
   
 our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );  
   
 our @EXPORT = qw(  
 );  
   
7  our $VERSION = '0.00';  our $VERSION = '0.00';
8    
 use Carp;  
   
9  =head1 NAME  =head1 NAME
10    
11  Search::Estraier - pure perl module to use Hyper Estraier search engine  Search::Estraier - pure perl module to use Hyper Estraier search engine
# Line 41  implementation. It also includes methods Line 27  implementation. It also includes methods
27    
28  =cut  =cut
29    
30    =head2 _s
31    
32    Remove multiple whitespaces from string, as well as whitespaces at beginning or end
33    
34     my $text = $self->_s(" this  is a text  ");
35     $text = 'this is a text';
36    
37    =cut
38    
39    sub _s {
40            my $text = $_[1] || return;
41            $text =~ s/\s\s+/ /gs;
42            $text =~ s/^\s+//;
43            $text =~ s/\s+$//;
44            return $text;
45    }
46    
47  package Search::Estraier::Document;  package Search::Estraier::Document;
48    
49    use Carp qw/croak confess/;
50    
51    use Search::Estraier;
52    our @ISA = qw/Search::Estraier/;
53    
54  =head1 Search::Estraier::Document  =head1 Search::Estraier::Document
55    
56  Document for HyperEstraier  This class implements Document which is collection of attributes
57    (key=value), vectors (also key value) display text and hidden text.
58    
59  =head2 new  =head2 new
60    
61    Create new document, empty or from draft.
62    
63    my $doc = new Search::HyperEstraier::Document;    my $doc = new Search::HyperEstraier::Document;
64      my $doc2 = new Search::HyperEstraier::Document( $draft );
65    
66  =cut  =cut
67    
68  sub new {  sub new {
69          my $class = shift;          my $class = shift;
70          my $self = {@_};          my $self = {};
71          bless($self, $class);          bless($self, $class);
72    
73            $self->{id} = -1;
74    
75            my $draft = shift;
76    
77            if ($draft) {
78                    my $in_text = 0;
79                    foreach my $line (split(/\n/, $draft)) {
80    
81                            if ($in_text) {
82                                    if ($line =~ /^\t/) {
83                                            push @{ $self->{htexts} }, substr($line, 1);
84                                    } else {
85                                            push @{ $self->{dtexts} }, $line;
86                                    }
87                                    next;
88                            }
89    
90                            if ($line =~ m/^%VECTOR\t(.+)$/) {
91                                    my @fields = split(/\t/, $1);
92                                    for my $i ( 0 .. ($#fields - 1) ) {
93                                            $self->{kwords}->{ $fields[ $i ] } = $fields[ $i + 1 ];
94                                            $i++;
95                                    }
96                                    next;
97                            } elsif ($line =~ m/^%/) {
98                                    # What is this? comment?
99                                    #warn "$line\n";
100                                    next;
101                            } elsif ($line =~ m/^$/) {
102                                    $in_text = 1;
103                                    next;
104                            } elsif ($line =~ m/^(.+)=(.+)$/) {
105                                    $self->{attrs}->{ $1 } = $2;
106                                    next;
107                            }
108    
109                            warn "draft ignored: $line\n";
110                    }
111            }
112    
113          $self ? return $self : return undef;          $self ? return $self : return undef;
114  }  }
115    
116    
117  =head2 add_attr  =head2 add_attr
118    
119    Add an attribute.
120    
121    $doc->add_attr( name => 'value' );    $doc->add_attr( name => 'value' );
122    
123    Delete attribute using
124    
125      $doc->add_attr( name => undef );
126    
127  =cut  =cut
128    
129  sub add_attr {  sub add_attr {
# Line 72  sub add_attr { Line 131  sub add_attr {
131          my $attrs = {@_};          my $attrs = {@_};
132    
133          while (my ($name, $value) = each %{ $attrs }) {          while (my ($name, $value) = each %{ $attrs }) {
134                  $name =~ s/\s\s+/ /gs;                  if (! defined($value)) {
135                  $value =~ s/\s\s+/ /gs;                          delete( $self->{attrs}->{ $self->_s($name) } );
136                  push @{$self->{$name}}, $value;                  } else {
137                            $self->{attrs}->{ $self->_s($name) } = $self->_s($value);
138                    }
139            }
140    
141            return 1;
142    }
143    
144    
145    =head2 add_text
146    
147    Add a sentence of text.
148    
149      $doc->add_text('this is example text to display');
150    
151    =cut
152    
153    sub add_text {
154            my $self = shift;
155            my $text = shift;
156            return unless defined($text);
157    
158            push @{ $self->{dtexts} }, $self->_s($text);
159    }
160    
161    
162    =head2 add_hidden_text
163    
164    Add a hidden sentence.
165    
166      $doc->add_hidden_text('this is example text just for search');
167    
168    =cut
169    
170    sub add_hidden_text {
171            my $self = shift;
172            my $text = shift;
173            return unless defined($text);
174    
175            push @{ $self->{htexts} }, $self->_s($text);
176    }
177    
178    =head2 id
179    
180    Get the ID number of document. If the object has never been registred, C<-1> is returned.
181    
182      print $doc->id;
183    
184    =cut
185    
186    sub id {
187            my $self = shift;
188            return $self->{id};
189    }
190    
191    =head2 attr_names
192    
193    Returns array with attribute names from document object.
194    
195      my @attrs = $doc->attr_names;
196    
197    =cut
198    
199    sub attr_names {
200            my $self = shift;
201            croak "attr_names return array, not scalar" if (! wantarray);
202            return sort keys %{ $self->{attrs} };
203    }
204    
205    
206    =head2 attr
207    
208    Returns value of an attribute.
209    
210      my $value = $doc->attr( 'attribute' );
211    
212    =cut
213    
214    sub attr {
215            my $self = shift;
216            my $name = shift;
217    
218            return $self->{'attrs'}->{ $name };
219    }
220    
221    
222    =head2 texts
223    
224    Returns array with text sentences.
225    
226      my @texts = $doc->texts;
227    
228    =cut
229    
230    sub texts {
231            my $self = shift;
232            confess "texts return array, not scalar" if (! wantarray);
233            return @{ $self->{dtexts} };
234    }
235    
236    =head2 cat_texts
237    
238    Return whole text as single scalar.
239    
240     my $text = $doc->cat_texts;
241    
242    =cut
243    
244    sub cat_texts {
245            my $self = shift;
246            return join(' ',@{ $self->{dtexts} });
247    }
248    
249    =head2 dump_draft
250    
251    Dump draft data from document object.
252    
253      print $doc->dump_draft;
254    
255    =cut
256    
257    sub dump_draft {
258            my $self = shift;
259            my $draft;
260    
261            foreach my $attr_name (sort keys %{ $self->{attrs} }) {
262                    $draft .= $attr_name . '=' . $self->{attrs}->{$attr_name} . "\n";
263            }
264    
265            if ($self->{kwords}) {
266                    $draft .= '%%VECTOR';
267                    while (my ($key, $value) = each %{ $self->{kwords} }) {
268                            $draft .= "\t$key\t$value";
269                    }
270                    $draft .= "\n";
271          }          }
272    
273            $draft .= "\n";
274    
275            $draft .= join("\n", @{ $self->{dtexts} }) . "\n";
276            $draft .= "\t" . join("\n\t", @{ $self->{htexts} }) . "\n";
277    
278            return $draft;
279    }
280    
281    =head2 delete
282    
283    Empty document object
284    
285      $doc->delete;
286    
287    This function is addition to original Ruby API, and since it was included in C wrappers it's here as a
288    convinience. Document objects which go out of scope will be destroyed
289    automatically.
290    
291    =cut
292    
293    sub delete {
294            my $self = shift;
295    
296            foreach my $data (qw/attrs dtexts stexts kwords/) {
297                    delete($self->{$data});
298            }
299    
300            $self->{id} = -1;
301    
302            return 1;
303  }  }
304    
305    
306    
307    package Search::Estraier::Condition;
308    
309    use Search::Estraier;
310    our @ISA = qw/Search::Estraier/;
311    
312    my $options = {
313            # check N-gram keys skipping by three
314            SURE => 1 << 0,
315            # check N-gram keys skipping by two
316            USUAL => 1 << 1,
317            # without TF-IDF tuning
318            FAST => 1 << 2,
319            # with the simplified phrase
320            AGITO => 1 << 3,
321            # check every N-gram key
322            NOIDF => 1 << 4,
323            # check N-gram keys skipping by one
324            SIMPLE => 1 << 10,
325    };
326    
327    =head1 Search::Estraier::Condition
328    
329    =head2 new
330    
331      my $cond = new Search::HyperEstraier::Condition;
332    
333    =cut
334    
335    sub new {
336            my $class = shift;
337            my $self = {};
338            bless($self, $class);
339    
340            $self ? return $self : return undef;
341    }
342    
343    
344  package Search::Estraier::Master;  package Search::Estraier::Master;
345    
346  use Carp;  use Carp;
# Line 92  Controll node master. This requires user Line 353  Controll node master. This requires user
353    
354  {  {
355          package RequestAgent;          package RequestAgent;
356          @ISA = qw(LWP::UserAgent);          our @ISA = qw(LWP::UserAgent);
357    
358          sub new {          sub new {
359                  my $self = LWP::UserAgent::new(@_);                  my $self = LWP::UserAgent::new(@_);
# Line 153  Dobrica Pavlinusic, E<lt>dpavlin@rot13.o Line 414  Dobrica Pavlinusic, E<lt>dpavlin@rot13.o
414    
415  =head1 COPYRIGHT AND LICENSE  =head1 COPYRIGHT AND LICENSE
416    
417  Copyright (C) 2005 by Dobrica Pavlinusic  Copyright (C) 2005-2006 by Dobrica Pavlinusic
418    
419  This library is free software; you can redistribute it and/or modify  This library is free software; you can redistribute it and/or modify
420  it under the GPL v2 or later.  it under the GPL v2 or later.
Legend:
Removed from v.2  
changed lines
  Added in v.15
  ViewVC Help
Powered by ViewVC 1.1.26