/[webpac2]/trunk/lib/WebPAC/Output/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/lib/WebPAC/Output/Estraier.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 525 - (show annotations)
Mon May 22 18:26:56 2006 UTC (18 years ago) by dpavlin
File size: 5599 byte(s)
 r697@llin:  dpavlin | 2006-05-22 20:30:05 +0200
 todo 2.17

1 package WebPAC::Output::Estraier;
2
3 use warnings;
4 use strict;
5
6 use base qw/WebPAC::Common/;
7
8 use Search::Estraier 0.06;
9 use Encode qw/from_to/;
10 use Data::Dumper;
11 use LWP;
12 use URI::Escape;
13 use List::Util qw/first/;
14
15 =head1 NAME
16
17 WebPAC::Output::Estraier - Create Hyper Estraier full text index
18
19 =head1 VERSION
20
21 Version 0.12
22
23 =cut
24
25 our $VERSION = '0.12';
26
27 =head1 SYNOPSIS
28
29 Create full text index using Hyper Estraier index from data with
30 type C<search>.
31
32 =head1 FUNCTIONS
33
34 =head2 new
35
36 Connect to Hyper Estraier index using HTTP
37
38 my $est = new WebPAC::Output::Estraier(
39 masterurl => 'http://localhost:1978/',
40 user => 'admin',
41 passwd => 'admin',
42 database => 'demo',
43 label => 'node label',
44 encoding => 'iso-8859-2',
45 clean => 1,
46 );
47
48 Options are:
49
50 =over 4
51
52 =item masterurl
53
54 URI to C<estmaster> node
55
56 =item user
57
58 C<estmaster> user with sufficient rights
59
60 =item passwd
61
62 password for user
63
64 =item database
65
66 name of database from which data comes
67
68 =item label
69
70 label for node (optional)
71
72 =item encoding
73
74 character encoding of C<data_structure> if it's differenet than C<ISO-8859-2>
75 (and it probably is). This encoding will be converted to C<UTF-8> for
76 Hyper Estraier.
77
78 =back
79
80 Name of database will be used to form URI of documents in index.
81
82 =cut
83
84 sub new {
85 my $class = shift;
86 my $self = {@_};
87 bless($self, $class);
88
89 my $log = $self->_get_logger;
90
91 #$log->debug("self: ", sub { Dumper($self) });
92
93 foreach my $p (qw/masterurl user passwd database/) {
94 $log->logdie("need $p") unless ($self->{$p});
95 }
96
97 $self->{encoding} ||= 'ISO-8859-2';
98
99 my $url = $self->{masterurl} . '/node/' . $self->{database};
100 $self->{url} = $url;
101
102 $self->{label} ||= "WebPAC $self->{database}";
103
104 $self->{db} = Search::Estraier::Node->new(
105 url => $url,
106 user => $self->{user},
107 passwd => $self->{passwd},
108 debug => $self->{debug},
109 create => 1,
110 label => $self->convert( $self->{label} ),
111 );
112
113 $log->info("using ", $self->{clean} ? "new " : "", "index $self->{url} '$self->{label}' with encoding $self->{encoding}");
114
115 if ($self->{clean}) {
116 $log->debug("clean $self->{database}");
117 $self->master( action => 'nodeclr', name => $self->{database} );
118 } else {
119 $log->debug("opening index $self->{url}");
120 }
121
122 $self ? return $self : return undef;
123 }
124
125
126 =head2 add
127
128 Adds one entry to database.
129
130 $est->add(
131 id => 42,
132 ds => $ds,
133 type => 'display',
134 text => 'optional text from which snippet is created',
135 );
136
137 This function will create entries in index using following URI format:
138
139 C<file:///type/database%20name/000>
140
141 Each tag in C<data_structure> with specified C<type> will create one
142 attribute and corresponding hidden text (used for search).
143
144 =cut
145
146 sub add {
147 my $self = shift;
148
149 my $args = {@_};
150
151 my $log = $self->_get_logger;
152
153 my $database = $self->{'database'} || $log->logconfess('no database in $self');
154 $log->logconfess('need db in object') unless ($self->{'db'});
155
156 foreach my $p (qw/id ds type/) {
157 $log->logdie("need $p") unless ($args->{$p});
158 }
159
160 my $type = $args->{'type'};
161 my $id = $args->{'id'};
162
163 my $uri = "file:///$type/$database/$id";
164 $log->debug("creating $uri");
165
166 my $doc = Search::Estraier::Document->new;
167 $doc->add_attr('@uri', $self->convert($uri) );
168
169 $log->debug("ds = ", sub { Dumper($args->{'ds'}) } );
170
171 # filter all tags which have type defined
172 my @tags = grep {
173 ref($args->{'ds'}->{$_}) eq 'HASH' && defined( $args->{'ds'}->{$_}->{$type} )
174 } keys %{ $args->{'ds'} };
175
176 $log->debug("tags = ", join(",", @tags));
177
178 return unless (@tags);
179
180 foreach my $tag (@tags) {
181
182 my $vals = join(" ", @{ $args->{'ds'}->{$tag}->{$type} });
183
184 next if (! $vals);
185
186 $vals = $self->convert( $vals ) or
187 $log->logdie("can't convert '$vals' to UTF-8");
188
189 $doc->add_attr( $tag, $vals );
190 $doc->add_hidden_text( $vals );
191 }
192
193 my $text = $args->{'text'};
194 if ( $text ) {
195 $text = $self->convert( $text ) or
196 $log->logdie("can't convert '$text' to UTF-8");
197 $doc->add_text( $text );
198 }
199
200 $log->debug("adding ", sub { $doc->dump_draft } );
201 $self->{'db'}->put_doc($doc) || $log->warn("can't add document $uri with draft " . $doc->dump_draft . " to node " . $self->{url} . " status: " . $self->{db}->status());
202
203 return 1;
204 }
205
206 =head2 add_link
207
208 $est->add_link(
209 from => 'ps',
210 to => 'webpac2',
211 credit => 10000,
212 );
213
214 =cut
215
216 sub add_link {
217 my $self = shift;
218
219 my $args = {@_};
220 my $log = $self->_get_logger;
221
222 my $node = first { $_->{name} eq $args->{to} } $self->master( action => 'nodelist' );
223
224 if (! $node) {
225 $log->warn("can't find node $args->{to}, skipping link creaton");
226 return;
227 }
228
229 my $label = $node->{label};
230
231 if (! $label) {
232 $log->warn("can't find label for $args->{to}, skipping link creaton");
233 return;
234 }
235
236 $log->debug("using label $label for $args->{to}");
237
238 return $self->{db}->set_link(
239 $self->{masterurl} . '/node/' . $args->{to},
240 $label,
241 $args->{credit},
242 );
243 }
244
245
246 =head2 master
247
248 Issue administrative commands to C<estmaster> process. See documentation for
249 C<master> in L<Search::Estraier>::Node.
250
251 $self->master(
252 action => 'nodeclr',
253 name => 'foobar',
254 );
255
256 =cut
257
258 sub master {
259 my $self = shift;
260 $self->{db}->master( @_ );
261 }
262
263
264 =head2 convert
265
266 my $utf8_string = $self->convert('string in codepage');
267
268 =cut
269
270 sub convert {
271 my $self = shift;
272
273 my $text = shift || return;
274 from_to($text, $self->{encoding}, 'UTF-8');
275 return $text;
276 }
277
278 =head1 AUTHOR
279
280 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
281
282 =head1 COPYRIGHT & LICENSE
283
284 Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
285
286 This program is free software; you can redistribute it and/or modify it
287 under the same terms as Perl itself.
288
289 =cut
290
291 1; # End of WebPAC::Output::Estraier

  ViewVC Help
Powered by ViewVC 1.1.26