/[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 13 - (show annotations)
Wed Jan 4 19:37:38 2006 UTC (18 years, 2 months ago) by dpavlin
File size: 5342 byte(s)
added implementation of dump_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 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 "texts return array, not scalar" if (! wantarray);
185 return @{ $self->{dtexts} };
186 }
187
188 =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 =head2 dump_draft
202
203 Dump draft data from document object.
204
205 print $doc->dump_draft;
206
207 =cut
208
209 sub dump_draft {
210 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 }
232
233 =head2 delete
234
235 Empty document object
236
237 $doc->delete;
238
239 =cut
240
241 sub delete {
242 my $self = shift;
243
244 foreach my $data (qw/attrs dtexts stexts/) {
245 delete($self->{$data});
246 }
247
248 $self->{id} = -1;
249
250 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 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;

  ViewVC Help
Powered by ViewVC 1.1.26