/[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 8 - (hide 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 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 7 use Carp qw/confess/;
47    
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 5 B<FIXME>: delete attribute using
76    
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 8 $self->{attrs}->{_s($name)} = _s($value);
87 dpavlin 2 }
88 dpavlin 8
89     return 1;
90 dpavlin 2 }
91    
92 dpavlin 5
93     =head2 add_text
94    
95 dpavlin 6 Add a sentence of text.
96    
97 dpavlin 5 $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 dpavlin 6 Add a hidden sentence.
113    
114 dpavlin 5 $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 dpavlin 6 =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 dpavlin 7 =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 dpavlin 8
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 dpavlin 5 =head2 dump_draft
170    
171     print $doc->dump_draft;
172    
173     =cut
174    
175     sub dump_draft {
176     }
177    
178 dpavlin 4 =head2 delete
179 dpavlin 2
180 dpavlin 4 Empty document object
181 dpavlin 2
182 dpavlin 4 $doc->delete;
183    
184     =cut
185    
186     sub delete {
187     my $self = shift;
188    
189 dpavlin 5 foreach my $data (qw/attrs dtexts stexts/) {
190     delete($self->{$data});
191     }
192 dpavlin 4
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 dpavlin 2 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