/[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 14 - (show annotations)
Wed Jan 4 21:51:01 2006 UTC (18 years, 2 months ago) by dpavlin
File size: 6330 byte(s)
new Document now accepts draft.
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 This class implements Document which is collection of attributes
51 (key=value), vectors (also key value) display text and hidden text.
52
53 Document for HyperEstraier
54
55 =head2 new
56
57 Create new document, empty or from draft.
58
59 my $doc = new Search::HyperEstraier::Document;
60 my $doc2 = new Search::HyperEstraier::Document( $draft );
61
62 =cut
63
64 sub new {
65 my $class = shift;
66 my $self = {};
67 bless($self, $class);
68
69 $self->{id} = -1;
70
71 my $draft = shift;
72
73 if ($draft) {
74 my $in_text = 0;
75 foreach my $line (split(/\n/, $draft)) {
76
77 if ($in_text) {
78 if ($line =~ /^\t/) {
79 push @{ $self->{htexts} }, substr($line, 1);
80 } else {
81 push @{ $self->{dtexts} }, $line;
82 }
83 next;
84 }
85
86 if ($line =~ m/^%VECTOR\t(.+)$/) {
87 my @fields = split(/\t/, $1);
88 for my $i ( 0 .. ($#fields - 1) ) {
89 $self->{kwords}->{ $fields[ $i ] } = $fields[ $i + 1 ];
90 $i++;
91 }
92 next;
93 } elsif ($line =~ m/^%/) {
94 # What is this? comment?
95 #warn "$line\n";
96 next;
97 } elsif ($line =~ m/^$/) {
98 $in_text = 1;
99 next;
100 } elsif ($line =~ m/^(.+)=(.+)$/) {
101 $self->{attrs}->{ $1 } = $2;
102 next;
103 }
104
105 warn "draft ignored: $line\n";
106 }
107 }
108
109 $self ? return $self : return undef;
110 }
111
112
113 =head2 add_attr
114
115 Add an attribute.
116
117 $doc->add_attr( name => 'value' );
118
119 Delete attribute using
120
121 $doc->add_attr( name => undef );
122
123 =cut
124
125 sub add_attr {
126 my $self = shift;
127 my $attrs = {@_};
128
129 while (my ($name, $value) = each %{ $attrs }) {
130 if (! defined($value)) {
131 delete( $self->{attrs}->{_s($name)} );
132 } else {
133 $self->{attrs}->{_s($name)} = _s($value);
134 }
135 }
136
137 return 1;
138 }
139
140
141 =head2 add_text
142
143 Add a sentence of text.
144
145 $doc->add_text('this is example text to display');
146
147 =cut
148
149 sub add_text {
150 my $self = shift;
151 my $text = shift;
152 return unless defined($text);
153
154 push @{ $self->{dtexts} }, _s($text);
155 }
156
157
158 =head2 add_hidden_text
159
160 Add a hidden sentence.
161
162 $doc->add_hidden_text('this is example text just for search');
163
164 =cut
165
166 sub add_hidden_text {
167 my $self = shift;
168 my $text = shift;
169 return unless defined($text);
170
171 push @{ $self->{htexts} }, _s($text);
172 }
173
174 =head2 id
175
176 Get the ID number of document. If the object has never been registred, C<-1> is returned.
177
178 print $doc->id;
179
180 =cut
181
182 sub id {
183 my $self = shift;
184 return $self->{id};
185 }
186
187 =head2 attr_names
188
189 Returns array with attribute names from document object.
190
191 my @attrs = $doc->attr_names;
192
193 =cut
194
195 sub attr_names {
196 my $self = shift;
197 croak "attr_names return array, not scalar" if (! wantarray);
198 return sort keys %{ $self->{attrs} };
199 }
200
201
202 =head2 attr
203
204 Returns value of an attribute.
205
206 my $value = $doc->attr( 'attribute' );
207
208 =cut
209
210 sub attr {
211 my $self = shift;
212 my $name = shift;
213
214 return $self->{'attrs'}->{ $name };
215 }
216
217
218 =head2 texts
219
220 Returns array with text sentences.
221
222 my @texts = $doc->texts;
223
224 =cut
225
226 sub texts {
227 my $self = shift;
228 confess "texts return array, not scalar" if (! wantarray);
229 return @{ $self->{dtexts} };
230 }
231
232 =head2 cat_texts
233
234 Return whole text as single scalar.
235
236 my $text = $doc->cat_texts;
237
238 =cut
239
240 sub cat_texts {
241 my $self = shift;
242 return join(' ',@{ $self->{dtexts} });
243 }
244
245 =head2 dump_draft
246
247 Dump draft data from document object.
248
249 print $doc->dump_draft;
250
251 =cut
252
253 sub dump_draft {
254 my $self = shift;
255 my $draft;
256
257 foreach my $attr_name (sort keys %{ $self->{attrs} }) {
258 $draft .= $attr_name . '=' . $self->{attrs}->{$attr_name} . "\n";
259 }
260
261 if ($self->{kwords}) {
262 $draft .= '%%VECTOR';
263 while (my ($key, $value) = each %{ $self->{kwords} }) {
264 $draft .= "\t$key\t$value";
265 }
266 $draft .= "\n";
267 }
268
269 $draft .= "\n";
270
271 $draft .= join("\n", @{ $self->{dtexts} }) . "\n";
272 $draft .= "\t" . join("\n\t", @{ $self->{htexts} }) . "\n";
273
274 return $draft;
275 }
276
277 =head2 delete
278
279 Empty document object
280
281 $doc->delete;
282
283 =cut
284
285 sub delete {
286 my $self = shift;
287
288 foreach my $data (qw/attrs dtexts stexts kwords/) {
289 delete($self->{$data});
290 }
291
292 $self->{id} = -1;
293
294 return 1;
295 }
296
297
298 =head2 _s
299
300 Remove multiple whitespaces from string, as well as whitespaces at beginning or end
301
302 my $text = _s(" this is a text ");
303 $text = 'this is a text';
304
305 =cut
306
307 sub _s {
308 my $text = shift || return;
309 $text =~ s/\s\s+/ /gs;
310 $text =~ s/^\s+//;
311 $text =~ s/\s+$//;
312 return $text;
313 }
314
315
316
317 package Search::Estraier::Master;
318
319 use Carp;
320
321 =head1 Search::Estraier::Master
322
323 Controll node master. This requires user with administration priviledges.
324
325 =cut
326
327 {
328 package RequestAgent;
329 @ISA = qw(LWP::UserAgent);
330
331 sub new {
332 my $self = LWP::UserAgent::new(@_);
333 $self->agent("Search-Estraier/$Search::Estraer::VERSION");
334 $self;
335 }
336
337 sub get_basic_credentials {
338 my($self, $realm, $uri) = @_;
339 # return ($user, $password);
340 }
341 }
342
343
344
345 =head2 new
346
347 Create new connection to node master.
348
349 my $master = new Search::Estraier::Master(
350 url => 'http://localhost:1978',
351 user => 'admin',
352 passwd => 'admin',
353 );
354
355 =cut
356
357 sub new {
358 my $class = shift;
359 my $self = {@_};
360 bless($self, $class);
361
362 foreach my $p (qw/url user passwd/) {
363 croak "need $p" unless ($self->{$p});
364 }
365
366 $self ? return $self : return undef;
367 }
368
369
370
371 ###
372
373 =head1 EXPORT
374
375 Nothing.
376
377 =head1 SEE ALSO
378
379 L<http://hyperestraier.sourceforge.net/>
380
381 Hyper Estraier Ruby interface on which this module is based.
382
383 =head1 AUTHOR
384
385 Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
386
387
388 =head1 COPYRIGHT AND LICENSE
389
390 Copyright (C) 2005 by Dobrica Pavlinusic
391
392 This library is free software; you can redistribute it and/or modify
393 it under the GPL v2 or later.
394
395 =cut
396
397 1;

  ViewVC Help
Powered by ViewVC 1.1.26