/[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

Contents of /trunk/Estraier.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 9 - (show annotations)
Wed Jan 4 15:28:39 2006 UTC (18 years, 2 months ago) by dpavlin
File size: 4659 byte(s)
added texts, fixed add_attr to delete atributes, tests now pass
1 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 use Carp qw/croak confess/;
47
48 =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 $self->{id} = -1;
64
65 $self ? return $self : return undef;
66 }
67
68
69 =head2 add_attr
70
71 Add an attribute.
72
73 $doc->add_attr( name => 'value' );
74
75 Delete attribute using
76
77 $doc->add_attr( name => undef );
78
79 =cut
80
81 sub add_attr {
82 my $self = shift;
83 my $attrs = {@_};
84
85 while (my ($name, $value) = each %{ $attrs }) {
86 if (! defined($value)) {
87 delete( $self->{attrs}->{_s($name)} );
88 } else {
89 $self->{attrs}->{_s($name)} = _s($value);
90 }
91 }
92
93 return 1;
94 }
95
96
97 =head2 add_text
98
99 Add a sentence of text.
100
101 $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 Add a hidden sentence.
117
118 $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 =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 =head2 attr_names
144
145 Returns array with attribute names from document object.
146
147 my @attrs = $doc->attr_names;
148
149 =cut
150
151 sub attr_names {
152 my $self = shift;
153 croak "attr_names return array, not scalar" if (! wantarray);
154 return sort keys %{ $self->{attrs} };
155 }
156
157
158 =head2 attr
159
160 Returns value of an attribute.
161
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
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 =head2 dump_draft
189
190 print $doc->dump_draft;
191
192 =cut
193
194 sub dump_draft {
195 return 'FIXME';
196 }
197
198 =head2 delete
199
200 Empty document object
201
202 $doc->delete;
203
204 =cut
205
206 sub delete {
207 my $self = shift;
208
209 foreach my $data (qw/attrs dtexts stexts/) {
210 delete($self->{$data});
211 }
212
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 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;

  ViewVC Help
Powered by ViewVC 1.1.26