/[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

Annotation of /trunk/Estraier.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 14 - (hide annotations)
Wed Jan 4 21:51:01 2006 UTC (18 years, 2 months ago) by dpavlin
File size: 6330 byte(s)
new Document now accepts draft.
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 dpavlin 14 This class implements Document which is collection of attributes
51     (key=value), vectors (also key value) display text and hidden text.
52    
53 dpavlin 2 Document for HyperEstraier
54    
55     =head2 new
56    
57 dpavlin 14 Create new document, empty or from draft.
58    
59 dpavlin 2 my $doc = new Search::HyperEstraier::Document;
60 dpavlin 14 my $doc2 = new Search::HyperEstraier::Document( $draft );
61 dpavlin 2
62     =cut
63    
64     sub new {
65     my $class = shift;
66 dpavlin 14 my $self = {};
67 dpavlin 2 bless($self, $class);
68    
69 dpavlin 6 $self->{id} = -1;
70    
71 dpavlin 14 my $draft = shift;
72    
73     if ($draft) {
74     my $in_text = 0;
75     foreach my $line (split(/\n/, $draft)) {
76    
77     if ($in_text) {
78     if ($line =~ /^\t/) {
79     push @{ $self->{htexts} }, substr($line, 1);
80     } else {
81     push @{ $self->{dtexts} }, $line;
82     }
83     next;
84     }
85    
86     if ($line =~ m/^%VECTOR\t(.+)$/) {
87     my @fields = split(/\t/, $1);
88     for my $i ( 0 .. ($#fields - 1) ) {
89     $self->{kwords}->{ $fields[ $i ] } = $fields[ $i + 1 ];
90     $i++;
91     }
92     next;
93     } elsif ($line =~ m/^%/) {
94     # What is this? comment?
95     #warn "$line\n";
96     next;
97     } elsif ($line =~ m/^$/) {
98     $in_text = 1;
99     next;
100     } elsif ($line =~ m/^(.+)=(.+)$/) {
101     $self->{attrs}->{ $1 } = $2;
102     next;
103     }
104    
105     warn "draft ignored: $line\n";
106     }
107     }
108    
109 dpavlin 2 $self ? return $self : return undef;
110     }
111    
112 dpavlin 4
113 dpavlin 2 =head2 add_attr
114    
115 dpavlin 6 Add an attribute.
116    
117 dpavlin 2 $doc->add_attr( name => 'value' );
118    
119 dpavlin 9 Delete attribute using
120 dpavlin 5
121     $doc->add_attr( name => undef );
122    
123 dpavlin 2 =cut
124    
125     sub add_attr {
126     my $self = shift;
127     my $attrs = {@_};
128    
129     while (my ($name, $value) = each %{ $attrs }) {
130 dpavlin 9 if (! defined($value)) {
131     delete( $self->{attrs}->{_s($name)} );
132     } else {
133     $self->{attrs}->{_s($name)} = _s($value);
134     }
135 dpavlin 2 }
136 dpavlin 8
137     return 1;
138 dpavlin 2 }
139    
140 dpavlin 5
141     =head2 add_text
142    
143 dpavlin 6 Add a sentence of text.
144    
145 dpavlin 5 $doc->add_text('this is example text to display');
146    
147     =cut
148    
149     sub add_text {
150     my $self = shift;
151     my $text = shift;
152     return unless defined($text);
153    
154     push @{ $self->{dtexts} }, _s($text);
155     }
156    
157    
158     =head2 add_hidden_text
159    
160 dpavlin 6 Add a hidden sentence.
161    
162 dpavlin 5 $doc->add_hidden_text('this is example text just for search');
163    
164     =cut
165    
166     sub add_hidden_text {
167     my $self = shift;
168     my $text = shift;
169     return unless defined($text);
170    
171     push @{ $self->{htexts} }, _s($text);
172     }
173    
174 dpavlin 6 =head2 id
175    
176     Get the ID number of document. If the object has never been registred, C<-1> is returned.
177    
178     print $doc->id;
179    
180     =cut
181    
182     sub id {
183     my $self = shift;
184     return $self->{id};
185     }
186    
187 dpavlin 7 =head2 attr_names
188    
189 dpavlin 9 Returns array with attribute names from document object.
190 dpavlin 7
191     my @attrs = $doc->attr_names;
192    
193     =cut
194    
195     sub attr_names {
196     my $self = shift;
197 dpavlin 9 croak "attr_names return array, not scalar" if (! wantarray);
198 dpavlin 7 return sort keys %{ $self->{attrs} };
199     }
200    
201 dpavlin 8
202     =head2 attr
203    
204 dpavlin 9 Returns value of an attribute.
205 dpavlin 8
206     my $value = $doc->attr( 'attribute' );
207    
208     =cut
209    
210     sub attr {
211     my $self = shift;
212     my $name = shift;
213    
214     return $self->{'attrs'}->{ $name };
215     }
216    
217 dpavlin 9
218     =head2 texts
219    
220     Returns array with text sentences.
221    
222     my @texts = $doc->texts;
223    
224     =cut
225    
226     sub texts {
227     my $self = shift;
228 dpavlin 12 confess "texts return array, not scalar" if (! wantarray);
229 dpavlin 11 return @{ $self->{dtexts} };
230 dpavlin 9 }
231    
232 dpavlin 12 =head2 cat_texts
233    
234     Return whole text as single scalar.
235    
236     my $text = $doc->cat_texts;
237    
238     =cut
239    
240     sub cat_texts {
241     my $self = shift;
242     return join(' ',@{ $self->{dtexts} });
243     }
244    
245 dpavlin 5 =head2 dump_draft
246    
247 dpavlin 13 Dump draft data from document object.
248    
249 dpavlin 5 print $doc->dump_draft;
250    
251     =cut
252    
253     sub dump_draft {
254 dpavlin 13 my $self = shift;
255     my $draft;
256    
257     foreach my $attr_name (sort keys %{ $self->{attrs} }) {
258     $draft .= $attr_name . '=' . $self->{attrs}->{$attr_name} . "\n";
259     }
260    
261     if ($self->{kwords}) {
262     $draft .= '%%VECTOR';
263     while (my ($key, $value) = each %{ $self->{kwords} }) {
264     $draft .= "\t$key\t$value";
265     }
266     $draft .= "\n";
267     }
268    
269     $draft .= "\n";
270    
271     $draft .= join("\n", @{ $self->{dtexts} }) . "\n";
272     $draft .= "\t" . join("\n\t", @{ $self->{htexts} }) . "\n";
273    
274     return $draft;
275 dpavlin 5 }
276    
277 dpavlin 4 =head2 delete
278 dpavlin 2
279 dpavlin 4 Empty document object
280 dpavlin 2
281 dpavlin 4 $doc->delete;
282    
283     =cut
284    
285     sub delete {
286     my $self = shift;
287    
288 dpavlin 14 foreach my $data (qw/attrs dtexts stexts kwords/) {
289 dpavlin 5 delete($self->{$data});
290     }
291 dpavlin 4
292 dpavlin 10 $self->{id} = -1;
293    
294 dpavlin 4 return 1;
295     }
296    
297    
298     =head2 _s
299    
300     Remove multiple whitespaces from string, as well as whitespaces at beginning or end
301    
302     my $text = _s(" this is a text ");
303     $text = 'this is a text';
304    
305     =cut
306    
307     sub _s {
308     my $text = shift || return;
309     $text =~ s/\s\s+/ /gs;
310     $text =~ s/^\s+//;
311     $text =~ s/\s+$//;
312     return $text;
313     }
314    
315    
316    
317 dpavlin 2 package Search::Estraier::Master;
318    
319     use Carp;
320    
321     =head1 Search::Estraier::Master
322    
323     Controll node master. This requires user with administration priviledges.
324    
325     =cut
326    
327     {
328     package RequestAgent;
329     @ISA = qw(LWP::UserAgent);
330    
331     sub new {
332     my $self = LWP::UserAgent::new(@_);
333     $self->agent("Search-Estraier/$Search::Estraer::VERSION");
334     $self;
335     }
336    
337     sub get_basic_credentials {
338     my($self, $realm, $uri) = @_;
339     # return ($user, $password);
340     }
341     }
342    
343    
344    
345     =head2 new
346    
347     Create new connection to node master.
348    
349     my $master = new Search::Estraier::Master(
350     url => 'http://localhost:1978',
351     user => 'admin',
352     passwd => 'admin',
353     );
354    
355     =cut
356    
357     sub new {
358     my $class = shift;
359     my $self = {@_};
360     bless($self, $class);
361    
362     foreach my $p (qw/url user passwd/) {
363     croak "need $p" unless ($self->{$p});
364     }
365    
366     $self ? return $self : return undef;
367     }
368    
369    
370    
371     ###
372    
373     =head1 EXPORT
374    
375     Nothing.
376    
377     =head1 SEE ALSO
378    
379     L<http://hyperestraier.sourceforge.net/>
380    
381     Hyper Estraier Ruby interface on which this module is based.
382    
383     =head1 AUTHOR
384    
385     Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
386    
387    
388     =head1 COPYRIGHT AND LICENSE
389    
390     Copyright (C) 2005 by Dobrica Pavlinusic
391    
392     This library is free software; you can redistribute it and/or modify
393     it under the GPL v2 or later.
394    
395     =cut
396    
397     1;

  ViewVC Help
Powered by ViewVC 1.1.26