git.rot13.org Git - webpac2/blob - 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;
  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.03
  21
  22 =cut
  23
  24 our $VERSION = '0.03';
  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         $log->debug("nodes found: $nodes");
  99
 100         if ($nodes !~ m/^$self->{database}\t/sm) {
 101                 $log->info("creating index $url");
 102                 $self->est_master(
 103                         action => 'nodeadd',
 104                         name => $self->{database},
 105                         label => "WebPAC $self->{database}",
 106                 ) || $log->logdie("can't create Hyper Estraier node $self->{database}");
 107         }
 108
 109         $self->{'db'} = HyperEstraier::Node->new($self->{url});
 110         $self->{'db'}->set_auth($self->{'user'}, $self->{passwd});
 111
 112         my $encoding = $self->{'encoding'} || 'ISO-8859-2';
 113         $log->info("using encoding $encoding");
 114
 115         $self->{'iconv'} = new Text::Iconv($encoding, 'UTF-8') or
 116                 $log->logdie("can't create conversion from $encoding to UTF-8");
 117
 118         $self ? return $self : return undef;
 119 }
 120
 121
 122 =head2 add
 123
 124 Adds one entry to database.
 125
 126   $est->add(
 127         id => 42,
 128         ds => $ds,
 129         type => 'display',
 130         url_prefix => 'database name',
 131         text => 'optional text from which snippet is created',
 132   );
 133
 134 This function will create  entries in index using following URI format:
 135
 136   C<file:///database%20name/000>
 137
 138 Each tag in C<data_structure> with specified C<type> will create one
 139 attribute and corresponding hidden text (used for search).
 140
 141 =cut
 142
 143 sub add {
 144         my $self = shift;
 145
 146         my $args = {@_};
 147
 148         my $log = $self->_get_logger;
 149
 150         my $database = $self->{'database'} || $log->logconfess('no database in $self');
 151         $log->logconfess('need db in object') unless ($self->{'db'});
 152
 153         foreach my $p (qw/id ds type/) {
 154                 $log->logdie("need $p") unless ($args->{$p});
 155         }
 156
 157         my $type = $args->{'type'};
 158         my $mfn = $args->{'id'};
 159
 160         my $uri = "file:///$type/$database/$mfn";
 161         $log->debug("creating $uri");
 162
 163         my $doc = HyperEstraier::Document->new;
 164         $doc->add_attr('@uri', $self->{'iconv'}->convert($uri) );
 165
 166         $log->debug("ds = ", sub { Dumper($args->{'ds'}) } );
 167
 168         # filter all tags which have type defined
 169         my @tags = grep {
 170                 ref($args->{'ds'}->{$_}) eq 'HASH' && defined( $args->{'ds'}->{$_}->{$type} )
 171         } keys %{ $args->{'ds'} };
 172
 173         $log->debug("tags = ", join(",", @tags));
 174
 175         return unless (@tags);
 176
 177         foreach my $tag (@tags) {
 178
 179                 my $vals = join(" ", @{ $args->{'ds'}->{$tag}->{$type} });
 180
 181                 $log->logconfess("no values for $tag/$type") unless ($vals);
 182
 183                 $vals = $self->{'iconv'}->convert( $vals ) or
 184                         $log->logdie("can't convert '$vals' to UTF-8");
 185
 186                 $doc->add_attr( $tag, $vals );
 187                 $doc->add_hidden_text( $vals );
 188         }
 189
 190         my $text = $args->{'text'};
 191         if ( $text ) {
 192                 $text = $self->{'iconv'}->convert( $text ) or
 193                         $log->logdie("can't convert '$text' to UTF-8");
 194                 $doc->add_text( $text );
 195         }
 196
 197         $log->debug("adding ", sub { $doc->dump_draft } );
 198         $self->{'db'}->put_doc($doc) || $log->logdie("can't add document $uri to index");
 199
 200         return 1;
 201 }
 202
 203 =head2 est_master
 204
 205 Issue administrative commands to C<estmaster> process and receive response
 206 as array of lines
 207
 208   my $nodelist = $self->est_master( action => nodelist );
 209
 210 =cut
 211
 212 my $estmaster_actions = {
 213         userdel => [ qw/name/ ],
 214         nodelist => [],
 215         nodeadd => [ qw/name label/ ],
 216         nodedel => [ qw/name/ ],
 217 };
 218
 219 sub est_master {
 220         my $self = shift;
 221         my $args = {@_};
 222         my $log = $self->_get_logger;
 223
 224         $log->debug(Dumper($args));
 225
 226         my $action = $args->{action} || $log->logconfess("no action specified");
 227
 228         $log->logdie("action '$action' isn't supported") unless ($estmaster_actions->{$action});
 229
 230         my $url = $self->{masterurl} . '/master?action=' . $action;
 231
 232         foreach my $arg (@{ $estmaster_actions->{$action} }) {
 233                 $log->logdie("missing parametar $arg for action $action") unless ($args->{$arg});
 234                 $url .= '&' . $arg . '=' . uri_escape( $args->{$arg} );
 235         }
 236
 237         $log->debug("calling $url");
 238
 239         if (! $self->{_master_ua}) {
 240                 $self->{_master_ua} = LWP::UserAgent->new( ) || $log->logdie("can't create LWP::UserAgent: $!");
 241                 $self->{_master_ua}->credentials('localhost:1978','Super User', $self->{user} => $self->{passwd});
 242         }
 243
 244         my $res = $self->{_master_ua}->get($url);
 245
 246         if ($res->is_success) {
 247                 #$log->debug( $res->content );
 248                 return split(/\n/, $res->content) if wantarray;
 249                 return $res->content;
 250         } else {
 251                 $log->warn("unable to call $url: " . $res->status_line);
 252                 #$log->debug(Dumper($res, $self->{'_master_ua'}));
 253                 return;
 254         }
 255
 256 }
 257
 258 =head1 AUTHOR
 259
 260 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
 261
 262 =head1 COPYRIGHT & LICENSE
 263
 264 Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
 265
 266 This program is free software; you can redistribute it and/or modify it
 267 under the same terms as Perl itself.
 268
 269 =cut
 270
 271 1; # End of WebPAC::Output::Estraier