Search-Estraier/trunk/Estraier.pm

package Search::Estraier;

use 5.008;
use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

our %EXPORT_TAGS = ( 'all' => [ qw(
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw( 
);

our $VERSION = '0.00';

use Carp;

=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

package Search::Estraier::Document;

use Carp qw/croak confess/;

=head1 Search::Estraier::Document

Document for HyperEstraier

=head2 new

  my $doc = new Search::HyperEstraier::Document;

=cut

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

        $self->{id} = -1;

        $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}->{_s($name)} );
                } else {
                        $self->{attrs}->{_s($name)} = _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} }, _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} }, _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;

=cut

sub delete {
        my $self = shift;

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

        $self->{id} = -1;

        return 1;
}


=head2 _s

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

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

=cut

sub _s {
        my $text = shift || return;
        $text =~ s/\s\s+/ /gs;
        $text =~ s/^\s+//;
        $text =~ s/\s+$//;
        return $text;
}


package Search::Estraier::Master;

use Carp;

=head1 Search::Estraier::Master

Controll node master. This requires user with administration priviledges.

=cut

{
        package RequestAgent;
        @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 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	dpavlin	2	package Search::Estraier;
2
3			use 5.008;
4			use strict;
5			use warnings;
6
7			require Exporter;
8
9			our @ISA = qw(Exporter);
10
11			our %EXPORT_TAGS = ( 'all' => [ qw(
12			) ] );
13
14			our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
15
16			our @EXPORT = qw(
17			);
18
19			our $VERSION = '0.00';
20
21			use Carp;
22
23			=head1 NAME
24
25			Search::Estraier - pure perl module to use Hyper Estraier search engine
26
27			=head1 SYNOPSIS
28
29			use Search::Estraier;
30			my $est = new Search::Estraier();
31
32			=head1 DESCRIPTION
33
34			This module is implementation of node API of Hyper Estraier. Since it's
35			perl-only module with dependencies only on standard perl modules, it will
36			run on all platforms on which perl runs. It doesn't require compilation
37			or Hyper Estraier development files on target machine.
38
39			It is implemented as multiple packages which closly resamble Ruby
40			implementation. It also includes methods to manage nodes.
41
42			=cut
43
44			package Search::Estraier::Document;
45
46	dpavlin	9	use Carp qw/croak confess/;
47	dpavlin	7
48	dpavlin	2	=head1 Search::Estraier::Document
49
50			Document for HyperEstraier
51
52			=head2 new
53
54			my $doc = new Search::HyperEstraier::Document;
55
56			=cut
57
58			sub new {
59			my $class = shift;
60			my $self = {@_};
61			bless($self, $class);
62
63	dpavlin	6	$self->{id} = -1;
64
65	dpavlin	2	$self ? return $self : return undef;
66			}
67
68	dpavlin	4
69	dpavlin	2	=head2 add_attr
70
71	dpavlin	6	Add an attribute.
72
73	dpavlin	2	$doc->add_attr( name => 'value' );
74
75	dpavlin	9	Delete attribute using
76	dpavlin	5
77			$doc->add_attr( name => undef );
78
79	dpavlin	2	=cut
80
81			sub add_attr {
82			my $self = shift;
83			my $attrs = {@_};
84
85			while (my ($name, $value) = each %{ $attrs }) {
86	dpavlin	9	if (! defined($value)) {
87			delete( $self->{attrs}->{_s($name)} );
88			} else {
89			$self->{attrs}->{_s($name)} = _s($value);
90			}
91	dpavlin	2	}
92	dpavlin	8
93			return 1;
94	dpavlin	2	}
95
96	dpavlin	5
97			=head2 add_text
98
99	dpavlin	6	Add a sentence of text.
100
101	dpavlin	5	$doc->add_text('this is example text to display');
102
103			=cut
104
105			sub add_text {
106			my $self = shift;
107			my $text = shift;
108			return unless defined($text);
109
110			push @{ $self->{dtexts} }, _s($text);
111			}
112
113
114			=head2 add_hidden_text
115
116	dpavlin	6	Add a hidden sentence.
117
118	dpavlin	5	$doc->add_hidden_text('this is example text just for search');
119
120			=cut
121
122			sub add_hidden_text {
123			my $self = shift;
124			my $text = shift;
125			return unless defined($text);
126
127			push @{ $self->{htexts} }, _s($text);
128			}
129
130	dpavlin	6	=head2 id
131
132			Get the ID number of document. If the object has never been registred, C<-1> is returned.
133
134			print $doc->id;
135
136			=cut
137
138			sub id {
139			my $self = shift;
140			return $self->{id};
141			}
142
143	dpavlin	7	=head2 attr_names
144
145	dpavlin	9	Returns array with attribute names from document object.
146	dpavlin	7
147			my @attrs = $doc->attr_names;
148
149			=cut
150
151			sub attr_names {
152			my $self = shift;
153	dpavlin	9	croak "attr_names return array, not scalar" if (! wantarray);
154	dpavlin	7	return sort keys %{ $self->{attrs} };
155			}
156
157	dpavlin	8
158			=head2 attr
159
160	dpavlin	9	Returns value of an attribute.
161	dpavlin	8
162			my $value = $doc->attr( 'attribute' );
163
164			=cut
165
166			sub attr {
167			my $self = shift;
168			my $name = shift;
169
170			return $self->{'attrs'}->{ $name };
171			}
172
173	dpavlin	9
174			=head2 texts
175
176			Returns array with text sentences.
177
178			my @texts = $doc->texts;
179
180			=cut
181
182			sub texts {
183			my $self = shift;
184	dpavlin	12	confess "texts return array, not scalar" if (! wantarray);
185	dpavlin	11	return @{ $self->{dtexts} };
186	dpavlin	9	}
187
188	dpavlin	12	=head2 cat_texts
189
190			Return whole text as single scalar.
191
192			my $text = $doc->cat_texts;
193
194			=cut
195
196			sub cat_texts {
197			my $self = shift;
198			return join(' ',@{ $self->{dtexts} });
199			}
200
201	dpavlin	5	=head2 dump_draft
202
203	dpavlin	13	Dump draft data from document object.
204
205	dpavlin	5	print $doc->dump_draft;
206
207			=cut
208
209			sub dump_draft {
210	dpavlin	13	my $self = shift;
211			my $draft;
212
213			foreach my $attr_name (sort keys %{ $self->{attrs} }) {
214			$draft .= $attr_name . '=' . $self->{attrs}->{$attr_name} . "\n";
215			}
216
217			if ($self->{kwords}) {
218			$draft .= '%%VECTOR';
219			while (my ($key, $value) = each %{ $self->{kwords} }) {
220			$draft .= "\t$key\t$value";
221			}
222			$draft .= "\n";
223			}
224
225			$draft .= "\n";
226
227			$draft .= join("\n", @{ $self->{dtexts} }) . "\n";
228			$draft .= "\t" . join("\n\t", @{ $self->{htexts} }) . "\n";
229
230			return $draft;
231	dpavlin	5	}
232
233	dpavlin	4	=head2 delete
234	dpavlin	2
235	dpavlin	4	Empty document object
236	dpavlin	2
237	dpavlin	4	$doc->delete;
238
239			=cut
240
241			sub delete {
242			my $self = shift;
243
244	dpavlin	5	foreach my $data (qw/attrs dtexts stexts/) {
245			delete($self->{$data});
246			}
247	dpavlin	4
248	dpavlin	10	$self->{id} = -1;
249
250	dpavlin	4	return 1;
251			}
252
253
254			=head2 _s
255
256			Remove multiple whitespaces from string, as well as whitespaces at beginning or end
257
258			my $text = _s(" this is a text ");
259			$text = 'this is a text';
260
261			=cut
262
263			sub _s {
264			my $text = shift \|\| return;
265			$text =~ s/\s\s+/ /gs;
266			$text =~ s/^\s+//;
267			$text =~ s/\s+$//;
268			return $text;
269			}
270
271
272
273	dpavlin	2	package Search::Estraier::Master;
274
275			use Carp;
276
277			=head1 Search::Estraier::Master
278
279			Controll node master. This requires user with administration priviledges.
280
281			=cut
282
283			{
284			package RequestAgent;
285			@ISA = qw(LWP::UserAgent);
286
287			sub new {
288			my $self = LWP::UserAgent::new(@_);
289			$self->agent("Search-Estraier/$Search::Estraer::VERSION");
290			$self;
291			}
292
293			sub get_basic_credentials {
294			my($self, $realm, $uri) = @_;
295			# return ($user, $password);
296			}
297			}
298
299
300
301			=head2 new
302
303			Create new connection to node master.
304
305			my $master = new Search::Estraier::Master(
306			url => 'http://localhost:1978',
307			user => 'admin',
308			passwd => 'admin',
309			);
310
311			=cut
312
313			sub new {
314			my $class = shift;
315			my $self = {@_};
316			bless($self, $class);
317
318			foreach my $p (qw/url user passwd/) {
319			croak "need $p" unless ($self->{$p});
320			}
321
322			$self ? return $self : return undef;
323			}
324
325
326
327			###
328
329			=head1 EXPORT
330
331			Nothing.
332
333			=head1 SEE ALSO
334
335			L<http://hyperestraier.sourceforge.net/>
336
337			Hyper Estraier Ruby interface on which this module is based.
338
339			=head1 AUTHOR
340
341			Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
342
343
344			=head1 COPYRIGHT AND LICENSE
345
346			Copyright (C) 2005 by Dobrica Pavlinusic
347
348			This library is free software; you can redistribute it and/or modify
349			it under the GPL v2 or later.
350
351			=cut
352
353			1;