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 "attr_names return array, not scalar" if (! wantarray);
        return $self->{dtexts};
}

=head2 dump_draft

  print $doc->dump_draft;

=cut

sub dump_draft {
        return 'FIXME';
}

=head2 delete

Empty document object

  $doc->delete;

=cut

sub delete {
        my $self = shift;

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

        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			confess "attr_names return array, not scalar" if (! wantarray);
185			return $self->{dtexts};
186			}
187
188	dpavlin	5	=head2 dump_draft
189
190			print $doc->dump_draft;
191
192			=cut
193
194			sub dump_draft {
195	dpavlin	9	return 'FIXME';
196	dpavlin	5	}
197
198	dpavlin	4	=head2 delete
199	dpavlin	2
200	dpavlin	4	Empty document object
201	dpavlin	2
202	dpavlin	4	$doc->delete;
203
204			=cut
205
206			sub delete {
207			my $self = shift;
208
209	dpavlin	5	foreach my $data (qw/attrs dtexts stexts/) {
210			delete($self->{$data});
211			}
212	dpavlin	4
213			return 1;
214			}
215
216
217			=head2 _s
218
219			Remove multiple whitespaces from string, as well as whitespaces at beginning or end
220
221			my $text = _s(" this is a text ");
222			$text = 'this is a text';
223
224			=cut
225
226			sub _s {
227			my $text = shift \|\| return;
228			$text =~ s/\s\s+/ /gs;
229			$text =~ s/^\s+//;
230			$text =~ s/\s+$//;
231			return $text;
232			}
233
234
235
236	dpavlin	2	package Search::Estraier::Master;
237
238			use Carp;
239
240			=head1 Search::Estraier::Master
241
242			Controll node master. This requires user with administration priviledges.
243
244			=cut
245
246			{
247			package RequestAgent;
248			@ISA = qw(LWP::UserAgent);
249
250			sub new {
251			my $self = LWP::UserAgent::new(@_);
252			$self->agent("Search-Estraier/$Search::Estraer::VERSION");
253			$self;
254			}
255
256			sub get_basic_credentials {
257			my($self, $realm, $uri) = @_;
258			# return ($user, $password);
259			}
260			}
261
262
263
264			=head2 new
265
266			Create new connection to node master.
267
268			my $master = new Search::Estraier::Master(
269			url => 'http://localhost:1978',
270			user => 'admin',
271			passwd => 'admin',
272			);
273
274			=cut
275
276			sub new {
277			my $class = shift;
278			my $self = {@_};
279			bless($self, $class);
280
281			foreach my $p (qw/url user passwd/) {
282			croak "need $p" unless ($self->{$p});
283			}
284
285			$self ? return $self : return undef;
286			}
287
288
289
290			###
291
292			=head1 EXPORT
293
294			Nothing.
295
296			=head1 SEE ALSO
297
298			L<http://hyperestraier.sourceforge.net/>
299
300			Hyper Estraier Ruby interface on which this module is based.
301
302			=head1 AUTHOR
303
304			Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
305
306
307			=head1 COPYRIGHT AND LICENSE
308
309			Copyright (C) 2005 by Dobrica Pavlinusic
310
311			This library is free software; you can redistribute it and/or modify
312			it under the GPL v2 or later.
313
314			=cut
315
316			1;