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

  ViewVC Help
Powered by ViewVC 1.1.26