WebPAC/Output/Estraier.pm

package WebPAC::Output::Estraier;

use warnings;
use strict;

use base qw/WebPAC::Common/;

use Search::Estraier 0.06;
use Encode qw/from_to/;
use Data::Dump qw/dump/;
use LWP;
use URI::Escape;
use List::Util qw/first/;
use YAML;

=head1 NAME

WebPAC::Output::Estraier - Create Hyper Estraier full text index

=head1 VERSION

Version 0.12

=cut

our $VERSION = '0.12';

=head1 SYNOPSIS

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

=head1 FUNCTIONS

=head2 new

Connect to Hyper Estraier index using HTTP

 my $est = new WebPAC::Output::Estraier(
        masterurl => 'http://localhost:1978/',
        user => 'admin',
        passwd => 'admin',
        database => 'demo',
        label => 'node label',
        encoding => 'iso-8859-2',
        clean => 1,
 );

Options are:

=over 4

=item masterurl

URI to C<estmaster> node

=item user

C<estmaster> user with sufficient rights

=item passwd

password for user

=item database

name of database from which data comes

=item label

label for node (optional)

=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
Hyper Estraier.

=back

Name of database will be used to form URI of documents in index.

=cut

sub new {
        my $class = shift;
        my $self = {@_};
        bless($self, $class);

        my $log = $self->_get_logger;

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

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

        $self->{encoding} ||= 'ISO-8859-2';

        my $url = $self->{masterurl} . '/node/' . $self->{database};
        $self->{url} = $url;

        $self->{label} ||= "WebPAC $self->{database}";

        $self->{db} = Search::Estraier::Node->new(
                url => $url,
                user => $self->{user},
                passwd => $self->{passwd},
                debug => $self->{debug},
                create => 1,
                label => $self->convert( $self->{label} ),
        );

        $log->info("using ", $self->{clean} ? "new " : "", "index $self->{url} '$self->{label}' with encoding $self->{encoding}");

        if ($self->{clean}) {
                $log->debug("clean $self->{database}");
                $self->master( action => 'nodeclr', name => $self->{database} );
        } else {
                $log->debug("opening index $self->{url}");
        }

        $self->{stats} = {};

        $self ? return $self : return undef;
}


=head2 add

Adds one entry to database.

  $est->add(
        id => 42,
        ds => $ds,
        type => 'display',
        text => 'optional text from which snippet is created',
  );

This function will create  entries in index using following URI format:

  C<file:///type/database%20name/000>

Each tag in C<data_structure> with specified C<type> will create one
attribute and corresponding hidden text (used for search).

=cut

sub add {
        my $self = shift;

        my $args = {@_};

        my $log = $self->_get_logger;

        my $database = $self->{'database'} || $log->logconfess('no database in $self');
        $log->logconfess('need db in object') unless ($self->{'db'});

        foreach my $p (qw/id ds type/) {
                $log->logdie("need $p") unless ($args->{$p});
        }

        my $type = $args->{'type'};
        my $id = $args->{'id'};

        my $uri = "file:///$type/$database/$id";
        $log->debug("creating $uri");

        my $doc = Search::Estraier::Document->new;
        $doc->add_attr('@uri', $self->convert($uri) );

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

        # filter all tags which have type defined
        my @tags = grep {
                ref($args->{'ds'}->{$_}) eq 'HASH' && defined( $args->{'ds'}->{$_}->{$type} )
        } keys %{ $args->{'ds'} };

        $log->debug("tags = ", join(",", @tags));

        return unless (@tags);

        foreach my $tag (@tags) {

                my $vals = join(" ", @{ $args->{'ds'}->{$tag}->{$type} });

                next if (! $vals);

                $vals = $self->convert( $vals ) or
                        $log->logdie("can't convert '$vals' to UTF-8");

                $doc->add_attr( $tag, $vals );
                $doc->add_hidden_text( $vals );

                $self->{stats}->{attr}->{$tag}++;
        }

        my $text = $args->{'text'};
        if ( $text ) {
                $text = $self->convert( $text ) or
                        $log->logdie("can't convert '$text' to UTF-8");
                $doc->add_text( $text );
        }

        $log->debug("adding ", sub { $doc->dump_draft } );
        $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());

        return 1;
}

=head2 add_link

  $est->add_link(
        from => 'ps',
        to => 'webpac2',
        credit => 10000,
  );

=cut

sub add_link {
        my $self = shift;

        my $args = {@_};
        my $log = $self->_get_logger;

        foreach my $p (qw/from to credit/) {
                $log->logdie("need $p") unless ($args->{$p});
        }

        my $node = first { $_->{name} eq $args->{to} } $self->master( action => 'nodelist' );

        if (! $node) {
                $log->warn("can't find node $args->{to}, skipping link creaton");
                return;
        }

        my $label = $node->{label};

        if (! $label) {
                $log->warn("can't find label for $args->{to}, skipping link creaton");
                return;
        }

        $log->debug("using label $label for $args->{to}");

        return $self->{db}->set_link(
                $self->{masterurl} . '/node/' . $args->{to},
                $label,
                $args->{credit},
        );
}


=head2 master

Issue administrative commands to C<estmaster> process. See documentation for
C<master> in L<Search::Estraier>::Node.

  $self->master(
        action => 'nodeclr',
        name => 'foobar',
  );

=cut

sub master {
        my $self = shift;
        $self->{db}->master( @_ );
}


=head2 convert

 my $utf8_string = $self->convert('string in codepage');

=cut

sub convert {
        my $self = shift;

        my $text = shift || return;
        from_to($text, $self->{encoding}, 'UTF-8');
        return $text;
}

=head2 finish

Dump attributes used on disk

=cut

sub finish {
        my $self = shift;
        my $log = $self->_get_logger();

        my $path = 'var/estraier/' . $self->{database} . '.yaml';
        YAML::DumpFile( $path, $self->{stats} );
        $log->info("created  $path ", -s $path, " bytes");
        $log->debug( dump( $self->{stats} ) );
}

=head1 AUTHOR

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

=head1 COPYRIGHT & LICENSE

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