1 package WebPAC::Output::EstraierNative;
6 use base qw/WebPAC::Common/;
9 use Encode qw/from_to/;
13 use List::Util qw/first/;
21 WebPAC::Output::EstraierNative - Create Hyper Estraier full text index using native bindings
33 Create full text index using Hyper Estraier index from data with
40 Connect to Hyper Estraier index using HTTP
42 my $est = new WebPAC::Output::Estraier(
45 label => 'node label',
46 encoding => 'iso-8859-2',
56 full or relative path to Hyper Estraier database
60 name of database from which data comes
64 label for node (optional)
68 character encoding of C<data_structure> if it's differenet than C<ISO-8859-2>
69 (and it probably is). This encoding will be converted to C<UTF-8> for
74 Name of database will be used to form URI of documents in index.
83 my $log = $self->_get_logger;
85 #$log->debug("self: ", sub { Dumper($self) });
87 foreach my $p (qw/path database/) {
88 $log->logdie("need $p") unless ($self->{$p});
91 $self->{encoding} ||= 'ISO-8859-2';
93 $self->{label} ||= "WebPAC $self->{database}";
98 $path .= '/' . $self->{database};
100 $self->{path} = $path;
104 rmtree($path) || $log->logdie("can't remove old temporary directory $path: $!");
106 mkpath($path) || $log->logdie("can't create new temporary directory $path: $!");
108 my $db = new Database();
109 unless($db->open($path, Database::DBWRITER | Database::DBCREAT)) {
110 $log->logdie("can't open $path: ", $db->err_msg($db->error()) );
115 $log->info("using ", $self->{clean} ? "new " : "", "index $self->{path} '$self->{label}' with encoding $self->{encoding}");
117 $self ? return $self : return undef;
123 Adds one entry to database.
129 text => 'optional text from which snippet is created',
132 This function will create entries in index using following URI format:
134 C<file:///type/database%20name/000>
136 Each tag in C<data_structure> with specified C<type> will create one
137 attribute and corresponding hidden text (used for search).
146 my $log = $self->_get_logger;
148 my $database = $self->{'database'} || $log->logconfess('no database in $self');
149 $log->logconfess('need db in object') unless ($self->{'db'});
151 foreach my $p (qw/id ds type/) {
152 $log->logdie("need $p") unless ($args->{$p});
155 my $type = $args->{'type'};
156 my $id = $args->{'id'};
158 my $uri = "file:///$type/$database/$id";
159 $log->debug("creating $uri");
161 my $doc = new Document();
162 $doc->add_attr('@uri', $self->convert($uri) );
164 # store type and database name
165 $doc->add_attr('_database', $database );
166 $doc->add_hidden_text('_database:' . $database);
167 $doc->add_attr('_type', $type );
169 $log->debug("ds = ", sub { Dumper($args->{'ds'}) } );
171 # filter all tags which have type defined
173 ref($args->{'ds'}->{$_}) eq 'HASH' && defined( $args->{'ds'}->{$_}->{$type} )
174 } keys %{ $args->{'ds'} };
176 $log->debug("tags = ", join(",", @tags));
178 return unless (@tags);
180 foreach my $tag (@tags) {
182 $log->debug("$tag :: $type == ",Dumper( $args->{'ds'}->{$tag}->{$type} ) );
184 my $vals = join(" ", @{ $args->{'ds'}->{$tag}->{$type} });
188 $vals = join(" ") if (ref($vals) eq 'ARRAY');
190 $vals = $self->convert( $vals ) or
191 $log->logdie("can't convert '$vals' to UTF-8");
193 $doc->add_attr( $tag, $vals );
194 $doc->add_hidden_text( $vals );
197 my $text = $args->{'text'};
199 $text = $self->convert( $text ) or
200 $log->logdie("can't convert '$text' to UTF-8");
201 $doc->add_text( $text );
204 $log->debug("adding ", sub { $doc->dump_draft } );
205 $self->{'db'}->put_doc($doc, Database::PDCLEAN) || $log->warn("can't add document $uri with draft " . $doc->dump_draft . " to node " . $self->{path} . " status: " . $self->{db}->error());
224 my $log = $self->_get_logger;
226 $log->warn("add_link is not implemented");
229 foreach my $p (qw/from to credit/) {
230 $log->logdie("need $p") unless ($args->{$p});
233 my $node = first { $_->{name} eq $args->{to} } $self->master( action => 'nodelist' );
236 $log->warn("can't find node $args->{to}, skipping link creaton");
240 my $label = $node->{label};
243 $log->warn("can't find label for $args->{to}, skipping link creaton");
247 $log->debug("using label $label for $args->{to}");
249 return $self->{db}->set_link(
250 $self->{masterurl} . '/node/' . $args->{to},
259 Close index and rename of to final path
268 my $log = $self->_get_logger;
269 $log->info("closing Hyper Estraier index make it current...");
271 $self->{db}->close || $log->logdie("can't close index");
273 my $path = $self->{path} || $log->logdie("no path?");
276 $log->warn("removing old $path");
277 rmtree($path) || $log->logdie("can't remove old temporary directory $path: $!");
280 rename $path . '.tmp', $path || $log->logdie("can't rename ${path}.tmp -> $path: $!");
287 my $utf8_string = $self->convert('string in codepage');
294 my $text = shift || return;
295 from_to($text, $self->{encoding}, 'UTF-8');
301 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
303 =head1 COPYRIGHT & LICENSE
305 Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
307 This program is free software; you can redistribute it and/or modify it
308 under the same terms as Perl itself.
312 1; # End of WebPAC::Output::Estraier