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