WebPAC/Output/KinoSearch.pm

package WebPAC::Output::KinoSearch;

use warnings;
use strict;

use base qw/WebPAC::Common WebPAC::Output Class::Accessor/;
__PACKAGE__->mk_accessors(qw(
        path
        database
        input
        encoding
        clean

        index
));

use KinoSearch::Simple;
use File::Path;
use Encode qw/decode/;
use Data::Dump qw/dump/;
use Storable;

=head1 NAME

WebPAC::Output::KinoSearch - Create KinoSearch full text index

=head1 VERSION

Version 0.05

=cut

our $VERSION = '0.05';

=head1 SYNOPSIS

Create full text index using KinoSearch index from data with
type C<search>.

=head1 FUNCTIONS

=head2 new

Open KinoSearch index

 my $out = new WebPAC::Output::KinoSearch({
        path => '/path/to/invindex',
        database => 'demo',
        encoding => 'iso-8859-2',
        clean => 1,
 });

Options are:

=over 4

=item path

path to KinoSearch index to use

=item database

name of database from which data comes

=item encoding

character encoding of C<data_structure> if it's differenet than C<ISO-8859-2>
(and it probably is). This encoding will be converted to C<UTF-8> for
index.

=back

=head2 init

  $out->init;

=cut

sub init {
        my $self = shift;

        my $log = $self->_get_logger;

        #$log->debug("self: ", sub { dump($self) });

        foreach my $p (qw/path database/) {
                $log->logdie("need $p") unless ($self->$p);
        }

#       $log->logdie("fields is not ARRAY") unless (ref($self->{fields}) eq 'ARRAY');

        $self->encoding( 'ISO-8859-2' ) unless $self->encoding;

        ## FIXME we shouldn't re-create whole KinoSearch index every time!
        $self->clean( 1 );

        if ( ! -e $self->path ) {
                mkpath $self->path || $log->logdie("can't create ", $self->path,": $!");
                $log->info("created ", $self->path);
        } elsif ( $self->clean ) {
                $log->info("removing existing ", $self->path);
                rmtree $self->path || $log->logdie("can't remove ", $self->path,": $!");
                mkpath $self->path || $log->logdie("can't create ", $self->path,": $!");
        }

        my $path = $self->path . '/' . $self->database;

        $log->info("using index $path with encoding ", $self->encoding);

        my $index = KinoSearch::Simple->new(
                path => $path,
                language => 'en',
        );

        $log->logdie("can't open $path: $!") unless $index;

        $self->index( $index );

}


=head2 add

Adds one entry

  $out->add( 42, $ds );

=cut

sub add {
        my $self = shift;

        my ( $id, $ds ) = @_;

        my $log = $self->_get_logger;
        $log->logdie("need id") unless defined $id;
        $log->logdie("need ds") unless $ds;

        $log->debug("id: $id ds = ", sub { dump($ds) });

        my $hash = $self->ds_to_hash( $ds, 'search' ) || return;

        $hash->{id}       ||= $id;
        $hash->{database} ||= $self->database;
        $hash->{input}    ||= $self->input;

        foreach my $f ( keys %$hash ) {
                if ( ref($hash->{$f}) eq 'ARRAY' ) {
                        $hash->{$f} = join(' <*> ', @{ $hash->{$f} });
                }
#               $hash->{$f} = decode( $self->encoding, $hash->{$f} );
        }

        $log->debug("add( $id, ", sub { dump($ds) }," ) => ", sub { dump( $hash ) });

        $self->index->add_doc( $hash );

        $self->{count}++;

        return 1;
}

=head2 finish

Close index

 $out->finish;

=cut

sub finish {
        my $self = shift;

        my $log = $self->_get_logger();

        $log->info("indexed ", $self->{count}, " records");

}

=head1 AUTHOR

Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>

=head1 COPYRIGHT & LICENSE

Copyright 2005-2007 Dobrica Pavlinusic, All Rights Reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1; # End of WebPAC::Output::Estraier
1	package WebPAC::Output::KinoSearch;
2
3	use warnings;
4	use strict;
5
6	use base qw/WebPAC::Common WebPAC::Output Class::Accessor/;
7	__PACKAGE__->mk_accessors(qw(
8	path
9	database
10	input
11	encoding
12	clean
13
14	index
15	));
16
17	use KinoSearch::Simple;
18	use File::Path;
19	use Encode qw/decode/;
20	use Data::Dump qw/dump/;
21	use Storable;
22
23	=head1 NAME
24
25	WebPAC::Output::KinoSearch - Create KinoSearch full text index
26
27	=head1 VERSION
28
29	Version 0.05
30
31	=cut
32
33	our $VERSION = '0.05';
34
35	=head1 SYNOPSIS
36
37	Create full text index using KinoSearch index from data with
38	type C<search>.
39
40	=head1 FUNCTIONS
41
42	=head2 new
43
44	Open KinoSearch index
45
46	my $out = new WebPAC::Output::KinoSearch({
47	path => '/path/to/invindex',
48	database => 'demo',
49	encoding => 'iso-8859-2',
50	clean => 1,
51	});
52
53	Options are:
54
55	=over 4
56
57	=item path
58
59	path to KinoSearch index to use
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	index.
70
71	=back
72
73	=head2 init
74
75	$out->init;
76
77	=cut
78
79	sub init {
80	my $self = shift;
81
82	my $log = $self->_get_logger;
83
84	#$log->debug("self: ", sub { dump($self) });
85
86	foreach my $p (qw/path database/) {
87	$log->logdie("need $p") unless ($self->$p);
88	}
89
90	# $log->logdie("fields is not ARRAY") unless (ref($self->{fields}) eq 'ARRAY');
91
92	$self->encoding( 'ISO-8859-2' ) unless $self->encoding;
93
94	## FIXME we shouldn't re-create whole KinoSearch index every time!
95	$self->clean( 1 );
96
97	if ( ! -e $self->path ) {
98	mkpath $self->path \|\| $log->logdie("can't create ", $self->path,": $!");
99	$log->info("created ", $self->path);
100	} elsif ( $self->clean ) {
101	$log->info("removing existing ", $self->path);
102	rmtree $self->path \|\| $log->logdie("can't remove ", $self->path,": $!");
103	mkpath $self->path \|\| $log->logdie("can't create ", $self->path,": $!");
104	}
105
106	my $path = $self->path . '/' . $self->database;
107
108	$log->info("using index $path with encoding ", $self->encoding);
109
110	my $index = KinoSearch::Simple->new(
111	path => $path,
112	language => 'en',
113	);
114
115	$log->logdie("can't open $path: $!") unless $index;
116
117	$self->index( $index );
118
119	}
120
121
122	=head2 add
123
124	Adds one entry
125
126	$out->add( 42, $ds );
127
128	=cut
129
130	sub add {
131	my $self = shift;
132
133	my ( $id, $ds ) = @_;
134
135	my $log = $self->_get_logger;
136	$log->logdie("need id") unless defined $id;
137	$log->logdie("need ds") unless $ds;
138
139	$log->debug("id: $id ds = ", sub { dump($ds) });
140
141	my $hash = $self->ds_to_hash( $ds, 'search' ) \|\| return;
142
143	$hash->{id} \|\|= $id;
144	$hash->{database} \|\|= $self->database;
145	$hash->{input} \|\|= $self->input;
146
147	foreach my $f ( keys %$hash ) {
148	if ( ref($hash->{$f}) eq 'ARRAY' ) {
149	$hash->{$f} = join(' <*> ', @{ $hash->{$f} });
150	}
151	# $hash->{$f} = decode( $self->encoding, $hash->{$f} );
152	}
153
154	$log->debug("add( $id, ", sub { dump($ds) }," ) => ", sub { dump( $hash ) });
155
156	$self->index->add_doc( $hash );
157
158	$self->{count}++;
159
160	return 1;
161	}
162
163	=head2 finish
164
165	Close index
166
167	$out->finish;
168
169	=cut
170
171	sub finish {
172	my $self = shift;
173
174	my $log = $self->_get_logger();
175
176	$log->info("indexed ", $self->{count}, " records");
177
178	}
179
180	=head1 AUTHOR
181
182	Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
183
184	=head1 COPYRIGHT & LICENSE
185
186	Copyright 2005-2007 Dobrica Pavlinusic, All Rights Reserved.
187
188	This program is free software; you can redistribute it and/or modify it
189	under the same terms as Perl itself.
190
191	=cut
192
193	1; # End of WebPAC::Output::Estraier