/[Search-Estraier]/trunk/lib/Search/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

Annotation of /trunk/lib/Search/Estraier.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 12 - (hide annotations)
Wed Jan 4 19:28:30 2006 UTC (18 years, 2 months ago) by dpavlin
Original Path: trunk/Estraier.pm
File size: 4848 byte(s)
added cat_texts
1 dpavlin 2 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 dpavlin 9 use Carp qw/croak confess/;
47 dpavlin 7
48 dpavlin 2 =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 dpavlin 6 $self->{id} = -1;
64    
65 dpavlin 2 $self ? return $self : return undef;
66     }
67    
68 dpavlin 4
69 dpavlin 2 =head2 add_attr
70    
71 dpavlin 6 Add an attribute.
72    
73 dpavlin 2 $doc->add_attr( name => 'value' );
74    
75 dpavlin 9 Delete attribute using
76 dpavlin 5
77     $doc->add_attr( name => undef );
78    
79 dpavlin 2 =cut
80    
81     sub add_attr {
82     my $self = shift;
83     my $attrs = {@_};
84    
85     while (my ($name, $value) = each %{ $attrs }) {
86 dpavlin 9 if (! defined($value)) {
87     delete( $self->{attrs}->{_s($name)} );
88     } else {
89     $self->{attrs}->{_s($name)} = _s($value);
90     }
91 dpavlin 2 }
92 dpavlin 8
93     return 1;
94 dpavlin 2 }
95    
96 dpavlin 5
97     =head2 add_text
98    
99 dpavlin 6 Add a sentence of text.
100    
101 dpavlin 5 $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 dpavlin 6 Add a hidden sentence.
117    
118 dpavlin 5 $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 dpavlin 6 =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 dpavlin 7 =head2 attr_names
144    
145 dpavlin 9 Returns array with attribute names from document object.
146 dpavlin 7
147     my @attrs = $doc->attr_names;
148    
149     =cut
150    
151     sub attr_names {
152     my $self = shift;
153 dpavlin 9 croak "attr_names return array, not scalar" if (! wantarray);
154 dpavlin 7 return sort keys %{ $self->{attrs} };
155     }
156    
157 dpavlin 8
158     =head2 attr
159    
160 dpavlin 9 Returns value of an attribute.
161 dpavlin 8
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 dpavlin 9
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 dpavlin 12 confess "texts return array, not scalar" if (! wantarray);
185 dpavlin 11 return @{ $self->{dtexts} };
186 dpavlin 9 }
187    
188 dpavlin 12 =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 dpavlin 5 =head2 dump_draft
202    
203     print $doc->dump_draft;
204    
205     =cut
206    
207     sub dump_draft {
208 dpavlin 9 return 'FIXME';
209 dpavlin 5 }
210    
211 dpavlin 4 =head2 delete
212 dpavlin 2
213 dpavlin 4 Empty document object
214 dpavlin 2
215 dpavlin 4 $doc->delete;
216    
217     =cut
218    
219     sub delete {
220     my $self = shift;
221    
222 dpavlin 5 foreach my $data (qw/attrs dtexts stexts/) {
223     delete($self->{$data});
224     }
225 dpavlin 4
226 dpavlin 10 $self->{id} = -1;
227    
228 dpavlin 4 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 dpavlin 2 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