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

  ViewVC Help
Powered by ViewVC 1.1.26