/[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 10 - (hide annotations)
Wed Jan 4 15:48:00 2006 UTC (18 years, 2 months ago) by dpavlin
Original Path: trunk/Estraier.pm
File size: 4679 byte(s)
demonstrate bug with 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     confess "attr_names return array, not scalar" if (! wantarray);
185     return $self->{dtexts};
186     }
187    
188 dpavlin 5 =head2 dump_draft
189    
190     print $doc->dump_draft;
191    
192     =cut
193    
194     sub dump_draft {
195 dpavlin 9 return 'FIXME';
196 dpavlin 5 }
197    
198 dpavlin 4 =head2 delete
199 dpavlin 2
200 dpavlin 4 Empty document object
201 dpavlin 2
202 dpavlin 4 $doc->delete;
203    
204     =cut
205    
206     sub delete {
207     my $self = shift;
208    
209 dpavlin 5 foreach my $data (qw/attrs dtexts stexts/) {
210     delete($self->{$data});
211     }
212 dpavlin 4
213 dpavlin 10 $self->{id} = -1;
214    
215 dpavlin 4 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 dpavlin 2 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