lib/Search/Estraier.pm

package Search::Estraier;

use 5.008;
use strict;
use warnings;

our $VERSION = '0.00';

=head1 NAME

Search::Estraier - pure perl module to use Hyper Estraier search engine

=head1 SYNOPSIS

  use Search::Estraier;
  my $est = new Search::Estraier();

=head1 DESCRIPTION

This module is implementation of node API of Hyper Estraier. Since it's
perl-only module with dependencies only on standard perl modules, it will
run on all platforms on which perl runs. It doesn't require compilation
or Hyper Estraier development files on target machine.

It is implemented as multiple packages which closly resamble Ruby
implementation. It also includes methods to manage nodes.

=cut

=head2 _s

Remove multiple whitespaces from string, as well as whitespaces at beginning or end

 my $text = $self->_s(" this  is a text  ");
 $text = 'this is a text';

=cut

sub _s {
        my $text = $_[1] || return;
        $text =~ s/\s\s+/ /gs;
        $text =~ s/^\s+//;
        $text =~ s/\s+$//;
        return $text;
}

package Search::Estraier::Document;

use Carp qw/croak confess/;

use Search::Estraier;
our @ISA = qw/Search::Estraier/;

=head1 Search::Estraier::Document

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.

  my $doc = new Search::HyperEstraier::Document;
  my $doc2 = new Search::HyperEstraier::Document( $draft );

=cut

sub new {
        my $class = shift;
        my $self = {};
        bless($self, $class);

        $self->{id} = -1;

        my $draft = shift;

        if ($draft) {
                my $in_text = 0;
                foreach my $line (split(/\n/, $draft)) {

                        if ($in_text) {
                                if ($line =~ /^\t/) {
                                        push @{ $self->{htexts} }, substr($line, 1);
                                } else {
                                        push @{ $self->{dtexts} }, $line;
                                }
                                next;
                        }

                        if ($line =~ m/^%VECTOR\t(.+)$/) {
                                my @fields = split(/\t/, $1);
                                for my $i ( 0 .. ($#fields - 1) ) {
                                        $self->{kwords}->{ $fields[ $i ] } = $fields[ $i + 1 ];
                                        $i++;
                                }
                                next;
                        } elsif ($line =~ m/^%/) {
                                # What is this? comment?
                                #warn "$line\n";
                                next;
                        } elsif ($line =~ m/^$/) {
                                $in_text = 1;
                                next;
                        } elsif ($line =~ m/^(.+)=(.+)$/) {
                                $self->{attrs}->{ $1 } = $2;
                                next;
                        }

                        warn "draft ignored: $line\n";
                }
        }

        $self ? return $self : return undef;
}


=head2 add_attr

Add an attribute.

  $doc->add_attr( name => 'value' );

Delete attribute using

  $doc->add_attr( name => undef );

=cut

sub add_attr {
        my $self = shift;
        my $attrs = {@_};

        while (my ($name, $value) = each %{ $attrs }) {
                if (! defined($value)) {
                        delete( $self->{attrs}->{ $self->_s($name) } );
                } else {
                        $self->{attrs}->{ $self->_s($name) } = $self->_s($value);
                }
        }

        return 1;
}


=head2 add_text

Add a sentence of text.

  $doc->add_text('this is example text to display');

=cut

sub add_text {
        my $self = shift;
        my $text = shift;
        return unless defined($text);

        push @{ $self->{dtexts} }, $self->_s($text);
}


=head2 add_hidden_text

Add a hidden sentence.

  $doc->add_hidden_text('this is example text just for search');

=cut

sub add_hidden_text {
        my $self = shift;
        my $text = shift;
        return unless defined($text);

        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.

  print $doc->id;

=cut

sub id {
        my $self = shift;
        return $self->{id};
}

=head2 attr_names

Returns array with attribute names from document object.

  my @attrs = $doc->attr_names;

=cut

sub attr_names {
        my $self = shift;
        croak "attr_names return array, not scalar" if (! wantarray);
        return sort keys %{ $self->{attrs} };
}


=head2 attr

Returns value of an attribute.

  my $value = $doc->attr( 'attribute' );

=cut

sub attr {
        my $self = shift;
        my $name = shift;

        return $self->{'attrs'}->{ $name };
}


=head2 texts

Returns array with text sentences.

  my @texts = $doc->texts;

=cut

sub texts {
        my $self = shift;
        confess "texts return array, not scalar" if (! wantarray);
        return @{ $self->{dtexts} };
}

=head2 cat_texts

Return whole text as single scalar.

 my $text = $doc->cat_texts;

=cut

sub cat_texts {
        my $self = shift;
        return join(' ',@{ $self->{dtexts} });
}

=head2 dump_draft

Dump draft data from document object.

  print $doc->dump_draft;

=cut

sub dump_draft {
        my $self = shift;
        my $draft;

        foreach my $attr_name (sort keys %{ $self->{attrs} }) {
                $draft .= $attr_name . '=' . $self->{attrs}->{$attr_name} . "\n";
        }

        if ($self->{kwords}) {
                $draft .= '%%VECTOR';
                while (my ($key, $value) = each %{ $self->{kwords} }) {
                        $draft .= "\t$key\t$value";
                }
                $draft .= "\n";
        }

        $draft .= "\n";

        $draft .= join("\n", @{ $self->{dtexts} }) . "\n";
        $draft .= "\t" . join("\n\t", @{ $self->{htexts} }) . "\n";

        return $draft;
}

=head2 delete

Empty document object

  $doc->delete;

This function is addition to original Ruby API, and since it was included in C wrappers it's here as a
convinience. Document objects which go out of scope will be destroyed
automatically.

=cut

sub delete {
        my $self = shift;

        foreach my $data (qw/attrs dtexts stexts kwords/) {
                delete($self->{$data});
        }

        $self->{id} = -1;

        return 1;
}


package Search::Estraier::Condition;

use Search::Estraier;
our @ISA = qw/Search::Estraier/;

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,
};

=head1 Search::Estraier::Condition

=head2 new

  my $cond = new Search::HyperEstraier::Condition;

=cut

sub new {
        my $class = shift;
        my $self = {};
        bless($self, $class);

        $self ? return $self : return undef;
}


package Search::Estraier::Master;

use Carp;

=head1 Search::Estraier::Master

Controll node master. This requires user with administration priviledges.

=cut

{
        package RequestAgent;
        our @ISA = qw(LWP::UserAgent);

        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 new

Create new connection to node master.

  my $master = new Search::Estraier::Master(
        url => 'http://localhost:1978',
        user => 'admin',
        passwd => 'admin',
  );

=cut

sub new {
        my $class = shift;
        my $self = {@_};
        bless($self, $class);

        foreach my $p (qw/url user passwd/) {
                croak "need $p" unless ($self->{$p});
        }

        $self ? return $self : return undef;
}


###

=head1 EXPORT

Nothing.

=head1 SEE ALSO

L<http://hyperestraier.sourceforge.net/>

Hyper Estraier Ruby interface on which this module is based.

=head1 AUTHOR

Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>


=head1 COPYRIGHT AND LICENSE

Copyright (C) 2005-2006 by Dobrica Pavlinusic

This library is free software; you can redistribute it and/or modify
it under the GPL v2 or later.

=cut

1;
1	package Search::Estraier;
2
3	use 5.008;
4	use strict;
5	use warnings;
6
7	our $VERSION = '0.00';
8
9	=head1 NAME
10
11	Search::Estraier - pure perl module to use Hyper Estraier search engine
12
13	=head1 SYNOPSIS
14
15	use Search::Estraier;
16	my $est = new Search::Estraier();
17
18	=head1 DESCRIPTION
19
20	This module is implementation of node API of Hyper Estraier. Since it's
21	perl-only module with dependencies only on standard perl modules, it will
22	run on all platforms on which perl runs. It doesn't require compilation
23	or Hyper Estraier development files on target machine.
24
25	It is implemented as multiple packages which closly resamble Ruby
26	implementation. It also includes methods to manage nodes.
27
28	=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;
48
49	use Carp qw/croak confess/;
50
51	use Search::Estraier;
52	our @ISA = qw/Search::Estraier/;
53
54	=head1 Search::Estraier::Document
55
56	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
60
61	Create new document, empty or from draft.
62
63	my $doc = new Search::HyperEstraier::Document;
64	my $doc2 = new Search::HyperEstraier::Document( $draft );
65
66	=cut
67
68	sub new {
69	my $class = shift;
70	my $self = {};
71	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;
114	}
115
116
117	=head2 add_attr
118
119	Add an attribute.
120
121	$doc->add_attr( name => 'value' );
122
123	Delete attribute using
124
125	$doc->add_attr( name => undef );
126
127	=cut
128
129	sub add_attr {
130	my $self = shift;
131	my $attrs = {@_};
132
133	while (my ($name, $value) = each %{ $attrs }) {
134	if (! defined($value)) {
135	delete( $self->{attrs}->{ $self->_s($name) } );
136	} 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;
345
346	use Carp;
347
348	=head1 Search::Estraier::Master
349
350	Controll node master. This requires user with administration priviledges.
351
352	=cut
353
354	{
355	package RequestAgent;
356	our @ISA = qw(LWP::UserAgent);
357
358	sub new {
359	my $self = LWP::UserAgent::new(@_);
360	$self->agent("Search-Estraier/$Search::Estraer::VERSION");
361	$self;
362	}
363
364	sub get_basic_credentials {
365	my($self, $realm, $uri) = @_;
366	# return ($user, $password);
367	}
368	}
369
370
371
372	=head2 new
373
374	Create new connection to node master.
375
376	my $master = new Search::Estraier::Master(
377	url => 'http://localhost:1978',
378	user => 'admin',
379	passwd => 'admin',
380	);
381
382	=cut
383
384	sub new {
385	my $class = shift;
386	my $self = {@_};
387	bless($self, $class);
388
389	foreach my $p (qw/url user passwd/) {
390	croak "need $p" unless ($self->{$p});
391	}
392
393	$self ? return $self : return undef;
394	}
395
396
397
398	###
399
400	=head1 EXPORT
401
402	Nothing.
403
404	=head1 SEE ALSO
405
406	L<http://hyperestraier.sourceforge.net/>
407
408	Hyper Estraier Ruby interface on which this module is based.
409
410	=head1 AUTHOR
411
412	Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
413
414
415	=head1 COPYRIGHT AND LICENSE
416
417	Copyright (C) 2005-2006 by Dobrica Pavlinusic
418
419	This library is free software; you can redistribute it and/or modify
420	it under the GPL v2 or later.
421
422	=cut
423
424	1;