git.rot13.org Git - webpac2/blob - lib/WebPAC/Output/KinoSearch.pm

   1 package WebPAC::Output::KinoSearch;
   2
   3 use warnings;
   4 use strict;
   5
   6 use base qw/WebPAC::Common/;
   7
   8 use KinoSearch::InvIndexer;
   9 use KinoSearch::Analysis::PolyAnalyzer;
  10 use Encode qw/from_to/;
  11 use Data::Dumper;
  12 use Storable;
  13
  14 =head1 NAME
  15
  16 WebPAC::Output::KinoSearch - Create KinoSearch 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 KinoSearch index from data with
  29 type C<search>.
  30
  31 =head1 FUNCTIONS
  32
  33 =head2 new
  34
  35 Open KinoSearch index
  36
  37  my $est = new WebPAC::Output::KinoSearch(
  38         index_path => '/path/to/invindex',
  39         fields => qw/name of all filelds used/,
  40         database => 'demo',
  41         label => 'node label',
  42         encoding => 'iso-8859-2',
  43         clean => 1,
  44  );
  45
  46 Options are:
  47
  48 =over 4
  49
  50 =item index_path
  51
  52 path to KinoSearch index to use
  53
  54 =item fields
  55
  56 name of all fields used in this index
  57
  58 =item database
  59
  60 name of database from which data comes
  61
  62 =item label
  63
  64 label for node (optional)
  65
  66 =item encoding
  67
  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
  70 index.
  71
  72 =back
  73
  74 =cut
  75
  76 sub new {
  77         my $class = shift;
  78         my $self = {@_};
  79         bless($self, $class);
  80
  81         my $log = $self->_get_logger;
  82
  83         #$log->debug("self: ", sub { Dumper($self) });
  84
  85         foreach my $p (qw/index_path fields database/) {
  86                 $log->logdie("need $p") unless ($self->{$p});
  87         }
  88
  89         $log->logdie("fields is not ARRAY") unless (ref($self->{fields}) eq 'ARRAY');
  90
  91         $self->{encoding} ||= 'ISO-8859-2';
  92
  93         $self->{clean} = 1 if (! -e $self->{index_path} . '/segments');
  94
  95         $log->info("using", $self->{clean} ? ' new' : '', " index $self->{index_path} with encoding $self->{encoding}");
  96
  97         my $analyzer = KinoSearch::Analysis::PolyAnalyzer->new( language => 'en' );
  98
  99         $self->{invindex} = KinoSearch::InvIndexer->new(
 100                 invindex => $self->{index_path},
 101                 create   => $self->{clean},
 102                 analyzer => $analyzer,
 103         );
 104
 105         my $fields_path = $self->{index_path} . '/fields.storable';
 106         $fields_path =~ s#//#/#g;
 107         if (-e $fields_path) {
 108                 $self->{fields} = retrieve($fields_path) ||
 109                         $log->warn("can't open $fields_path: $!");
 110         } else {
 111                 $log->error("This will be dummy run since no fields statistics are found!");
 112                 $log->error("You will have to re-run indexing to get search results!");
 113                 $self->{dummy_run} = 1;
 114         }
 115         $self->{fields_path} = $fields_path;
 116
 117         foreach my $f (@{ $self->{fields} }) {
 118                 $self->{invindex}->spec_field(
 119                         name  => $f,
 120 #                       boost => 10,
 121                         stored => 1,
 122                         indexed => 1,
 123                         vectorized => 0,
 124                 );
 125         }
 126
 127         $self ? return $self : return undef;
 128 }
 129
 130
 131 =head2 add
 132
 133 Adds one entry to database.
 134
 135   $est->add(
 136         id => 42,
 137         ds => $ds,
 138         type => 'display',
 139         text => 'optional text from which snippet is created',
 140   );
 141
 142 This function will create  entries in index using following URI format:
 143
 144   C<file:///type/database%20name/000>
 145
 146 Each tag in C<data_structure> with specified C<type> will create one
 147 attribute and corresponding hidden text (used for search).
 148
 149 =cut
 150
 151 sub add {
 152         my $self = shift;
 153
 154         my $args = {@_};
 155
 156         my $log = $self->_get_logger;
 157
 158         my $database = $self->{'database'} || $log->logconfess('no database in $self');
 159         $log->logconfess('need invindex in object') unless ($self->{'invindex'});
 160
 161         foreach my $p (qw/id ds type/) {
 162                 $log->logdie("need $p") unless ($args->{$p});
 163         }
 164
 165         my $type = $args->{'type'};
 166         my $id = $args->{'id'};
 167
 168         my $uri = "file:///$type/$database/$id";
 169         $log->debug("creating $uri");
 170
 171         my $doc = $self->{invindex}->new_doc( $uri ) || $log->logdie("can't create new_doc( $uri )");
 172
 173         sub add_value($$$$$) {
 174                 my ($self,$log,$doc,$n,$v) = @_;
 175                 return unless ($v);
 176
 177                 $self->{value_usage}->{$n}++;
 178                 return if ($self->{dummy_run});
 179
 180                 eval { $doc->set_value($n, $self->convert($v) ) };
 181                 $log->warn("can't insert: $n = $v") if ($@);
 182         }
 183
 184         add_value($self,$log,$doc, 'uri', $uri);
 185
 186         $log->debug("ds = ", sub { Dumper($args->{'ds'}) } );
 187
 188         # filter all tags which have type defined
 189         my @tags = grep {
 190                 ref($args->{'ds'}->{$_}) eq 'HASH' && defined( $args->{'ds'}->{$_}->{$type} )
 191         } keys %{ $args->{'ds'} };
 192
 193         $log->debug("tags = ", join(",", @tags));
 194
 195         return unless (@tags);
 196
 197         foreach my $tag (@tags) {
 198
 199                 my $vals = join(" ", @{ $args->{'ds'}->{$tag}->{$type} });
 200
 201                 next if (! $vals);
 202
 203                 $vals = $self->convert( $vals ) or
 204                         $log->logdie("can't convert '$vals' to UTF-8");
 205
 206                 add_value($self, $log, $doc, $tag, $vals );
 207         }
 208
 209         if (my $text = $args->{'text'}) {
 210                 add_value($self, $log, $doc, 'bodytext', $text );
 211         }
 212
 213         #$log->debug("adding ", sub { $doc->dump_draft } );
 214         $self->{invindex}->add_doc($doc) || $log->warn("can't add document $uri");
 215
 216         return 1;
 217 }
 218
 219 =head2 finish
 220
 221 Close index
 222
 223  $index->finish;
 224
 225 =cut
 226
 227 sub finish {
 228         my $self = shift;
 229
 230         my $log = $self->_get_logger();
 231
 232         $log->info("finish index writing to disk");
 233         $self->{invindex}->finish;
 234
 235         $log->info("writing value usage file");
 236
 237         # add fields from last run
 238         map { $self->{value_usage}->{$_}++ } @{ $self->{fields} };
 239
 240         my @fields = keys %{ $self->{value_usage} };
 241         store \@fields, $self->{fields_path} ||
 242                 $log->warn("can't write $self->{fields_path}: $!");
 243
 244 }
 245
 246 =head2 convert
 247
 248  my $utf8_string = $self->convert('string in codepage');
 249
 250 =cut
 251
 252 sub convert {
 253         my $self = shift;
 254
 255         my $text = shift || return;
 256         from_to($text, $self->{encoding}, 'UTF-8');
 257         return $text;
 258 }
 259
 260 =head1 AUTHOR
 261
 262 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
 263
 264 =head1 COPYRIGHT & LICENSE
 265
 266 Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
 267
 268 This program is free software; you can redistribute it and/or modify it
 269 under the same terms as Perl itself.
 270
 271 =cut
 272
 273 1; # End of WebPAC::Output::Estraier