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