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/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' );

B<FIXME>: delete attribute using

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

=cut

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

        while (my ($name, $value) = each %{ $attrs }) {
                push @{ $self->{attrs}->{_s($name)} }, _s($value);
        }
}


=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

Get a list of attribute names of a document object.

  my @attrs = $doc->attr_names;

=cut

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

=head2 dump_draft

  print $doc->dump_draft;

=cut

sub dump_draft {
}

=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	7	use Carp qw/confess/;
47
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	5	B<FIXME>: delete attribute using
76
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	5	push @{ $self->{attrs}->{_s($name)} }, _s($value);
87	dpavlin	2	}
88			}
89
90	dpavlin	5
91			=head2 add_text
92
93	dpavlin	6	Add a sentence of text.
94
95	dpavlin	5	$doc->add_text('this is example text to display');
96
97			=cut
98
99			sub add_text {
100			my $self = shift;
101			my $text = shift;
102			return unless defined($text);
103
104			push @{ $self->{dtexts} }, _s($text);
105			}
106
107
108			=head2 add_hidden_text
109
110	dpavlin	6	Add a hidden sentence.
111
112	dpavlin	5	$doc->add_hidden_text('this is example text just for search');
113
114			=cut
115
116			sub add_hidden_text {
117			my $self = shift;
118			my $text = shift;
119			return unless defined($text);
120
121			push @{ $self->{htexts} }, _s($text);
122			}
123
124	dpavlin	6	=head2 id
125
126			Get the ID number of document. If the object has never been registred, C<-1> is returned.
127
128			print $doc->id;
129
130			=cut
131
132			sub id {
133			my $self = shift;
134			return $self->{id};
135			}
136
137	dpavlin	7	=head2 attr_names
138
139			Get a list of attribute names of a document object.
140
141			my @attrs = $doc->attr_names;
142
143			=cut
144
145			sub attr_names {
146			my $self = shift;
147			confess "attr_names return array, not scalar" if (! wantarray);
148			return sort keys %{ $self->{attrs} };
149			}
150
151	dpavlin	5	=head2 dump_draft
152
153			print $doc->dump_draft;
154
155			=cut
156
157			sub dump_draft {
158			}
159
160	dpavlin	4	=head2 delete
161	dpavlin	2
162	dpavlin	4	Empty document object
163	dpavlin	2
164	dpavlin	4	$doc->delete;
165
166			=cut
167
168			sub delete {
169			my $self = shift;
170
171	dpavlin	5	foreach my $data (qw/attrs dtexts stexts/) {
172			delete($self->{$data});
173			}
174	dpavlin	4
175			return 1;
176			}
177
178
179			=head2 _s
180
181			Remove multiple whitespaces from string, as well as whitespaces at beginning or end
182
183			my $text = _s(" this is a text ");
184			$text = 'this is a text';
185
186			=cut
187
188			sub _s {
189			my $text = shift \|\| return;
190			$text =~ s/\s\s+/ /gs;
191			$text =~ s/^\s+//;
192			$text =~ s/\s+$//;
193			return $text;
194			}
195
196
197
198	dpavlin	2	package Search::Estraier::Master;
199
200			use Carp;
201
202			=head1 Search::Estraier::Master
203
204			Controll node master. This requires user with administration priviledges.
205
206			=cut
207
208			{
209			package RequestAgent;
210			@ISA = qw(LWP::UserAgent);
211
212			sub new {
213			my $self = LWP::UserAgent::new(@_);
214			$self->agent("Search-Estraier/$Search::Estraer::VERSION");
215			$self;
216			}
217
218			sub get_basic_credentials {
219			my($self, $realm, $uri) = @_;
220			# return ($user, $password);
221			}
222			}
223
224
225
226			=head2 new
227
228			Create new connection to node master.
229
230			my $master = new Search::Estraier::Master(
231			url => 'http://localhost:1978',
232			user => 'admin',
233			passwd => 'admin',
234			);
235
236			=cut
237
238			sub new {
239			my $class = shift;
240			my $self = {@_};
241			bless($self, $class);
242
243			foreach my $p (qw/url user passwd/) {
244			croak "need $p" unless ($self->{$p});
245			}
246
247			$self ? return $self : return undef;
248			}
249
250
251
252			###
253
254			=head1 EXPORT
255
256			Nothing.
257
258			=head1 SEE ALSO
259
260			L<http://hyperestraier.sourceforge.net/>
261
262			Hyper Estraier Ruby interface on which this module is based.
263
264			=head1 AUTHOR
265
266			Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
267
268
269			=head1 COPYRIGHT AND LICENSE
270
271			Copyright (C) 2005 by Dobrica Pavlinusic
272
273			This library is free software; you can redistribute it and/or modify
274			it under the GPL v2 or later.
275
276			=cut
277
278			1;