/[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 8 - (show annotations)
Wed Jan 4 15:04:58 2006 UTC (18 years, 2 months ago) by dpavlin
File size: 4349 byte(s)
added $doc->attr('name'), fixed $doc->add_attr('name','value');
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/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 B<FIXME>: 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 $self->{attrs}->{_s($name)} = _s($value);
87 }
88
89 return 1;
90 }
91
92
93 =head2 add_text
94
95 Add a sentence of text.
96
97 $doc->add_text('this is example text to display');
98
99 =cut
100
101 sub add_text {
102 my $self = shift;
103 my $text = shift;
104 return unless defined($text);
105
106 push @{ $self->{dtexts} }, _s($text);
107 }
108
109
110 =head2 add_hidden_text
111
112 Add a hidden sentence.
113
114 $doc->add_hidden_text('this is example text just for search');
115
116 =cut
117
118 sub add_hidden_text {
119 my $self = shift;
120 my $text = shift;
121 return unless defined($text);
122
123 push @{ $self->{htexts} }, _s($text);
124 }
125
126 =head2 id
127
128 Get the ID number of document. If the object has never been registred, C<-1> is returned.
129
130 print $doc->id;
131
132 =cut
133
134 sub id {
135 my $self = shift;
136 return $self->{id};
137 }
138
139 =head2 attr_names
140
141 Get a list of attribute names of a document object.
142
143 my @attrs = $doc->attr_names;
144
145 =cut
146
147 sub attr_names {
148 my $self = shift;
149 confess "attr_names return array, not scalar" if (! wantarray);
150 return sort keys %{ $self->{attrs} };
151 }
152
153
154 =head2 attr
155
156 Get the value of an attribute.
157
158 my $value = $doc->attr( 'attribute' );
159
160 =cut
161
162 sub attr {
163 my $self = shift;
164 my $name = shift;
165
166 return $self->{'attrs'}->{ $name };
167 }
168
169 =head2 dump_draft
170
171 print $doc->dump_draft;
172
173 =cut
174
175 sub dump_draft {
176 }
177
178 =head2 delete
179
180 Empty document object
181
182 $doc->delete;
183
184 =cut
185
186 sub delete {
187 my $self = shift;
188
189 foreach my $data (qw/attrs dtexts stexts/) {
190 delete($self->{$data});
191 }
192
193 return 1;
194 }
195
196
197 =head2 _s
198
199 Remove multiple whitespaces from string, as well as whitespaces at beginning or end
200
201 my $text = _s(" this is a text ");
202 $text = 'this is a text';
203
204 =cut
205
206 sub _s {
207 my $text = shift || return;
208 $text =~ s/\s\s+/ /gs;
209 $text =~ s/^\s+//;
210 $text =~ s/\s+$//;
211 return $text;
212 }
213
214
215
216 package Search::Estraier::Master;
217
218 use Carp;
219
220 =head1 Search::Estraier::Master
221
222 Controll node master. This requires user with administration priviledges.
223
224 =cut
225
226 {
227 package RequestAgent;
228 @ISA = qw(LWP::UserAgent);
229
230 sub new {
231 my $self = LWP::UserAgent::new(@_);
232 $self->agent("Search-Estraier/$Search::Estraer::VERSION");
233 $self;
234 }
235
236 sub get_basic_credentials {
237 my($self, $realm, $uri) = @_;
238 # return ($user, $password);
239 }
240 }
241
242
243
244 =head2 new
245
246 Create new connection to node master.
247
248 my $master = new Search::Estraier::Master(
249 url => 'http://localhost:1978',
250 user => 'admin',
251 passwd => 'admin',
252 );
253
254 =cut
255
256 sub new {
257 my $class = shift;
258 my $self = {@_};
259 bless($self, $class);
260
261 foreach my $p (qw/url user passwd/) {
262 croak "need $p" unless ($self->{$p});
263 }
264
265 $self ? return $self : return undef;
266 }
267
268
269
270 ###
271
272 =head1 EXPORT
273
274 Nothing.
275
276 =head1 SEE ALSO
277
278 L<http://hyperestraier.sourceforge.net/>
279
280 Hyper Estraier Ruby interface on which this module is based.
281
282 =head1 AUTHOR
283
284 Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
285
286
287 =head1 COPYRIGHT AND LICENSE
288
289 Copyright (C) 2005 by Dobrica Pavlinusic
290
291 This library is free software; you can redistribute it and/or modify
292 it under the GPL v2 or later.
293
294 =cut
295
296 1;

  ViewVC Help
Powered by ViewVC 1.1.26