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 File::Path qw/mkpath/;
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';

        mkpath $path unless -e $path;

        $path .= '/' . $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	dpavlin	1	package WebPAC::Output::Estraier;
2
3			use warnings;
4			use strict;
5
6	dpavlin	74	use base qw/WebPAC::Common/;
7
8	dpavlin	458	use Search::Estraier 0.06;
9	dpavlin	401	use Encode qw/from_to/;
10	dpavlin	887	use Data::Dump qw/dump/;
11	dpavlin	211	use LWP;
12	dpavlin	210	use URI::Escape;
13	dpavlin	459	use List::Util qw/first/;
14	dpavlin	1148	use File::Path qw/mkpath/;
15	dpavlin	1131	use YAML;
16	dpavlin	74
17	dpavlin	1	=head1 NAME
18
19	dpavlin	74	WebPAC::Output::Estraier - Create Hyper Estraier full text index
20	dpavlin	1
21			=head1 VERSION
22
23	dpavlin	525	Version 0.12
24	dpavlin	1
25			=cut
26
27	dpavlin	525	our $VERSION = '0.12';
28	dpavlin	1
29			=head1 SYNOPSIS
30
31	dpavlin	74	Create full text index using Hyper Estraier index from data with
32			type C<search>.
33	dpavlin	1
34	dpavlin	74	=head1 FUNCTIONS
35	dpavlin	1
36	dpavlin	74	=head2 new
37	dpavlin	1
38	dpavlin	74	Connect to Hyper Estraier index using HTTP
39	dpavlin	1
40	dpavlin	74	my $est = new WebPAC::Output::Estraier(
41	dpavlin	210	masterurl => 'http://localhost:1978/',
42	dpavlin	74	user => 'admin',
43			passwd => 'admin',
44			database => 'demo',
45	dpavlin	401	label => 'node label',
46	dpavlin	74	encoding => 'iso-8859-2',
47	dpavlin	307	clean => 1,
48	dpavlin	74	);
49	dpavlin	1
50	dpavlin	74	Options are:
51	dpavlin	1
52	dpavlin	74	=over 4
53	dpavlin	1
54	dpavlin	210	=item masterurl
55	dpavlin	1
56	dpavlin	74	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	dpavlin	401	=item label
71
72			label for node (optional)
73
74	dpavlin	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	dpavlin	1	=cut
85
86	dpavlin	74	sub new {
87			my $class = shift;
88	dpavlin	343	my $self = {@_};
89			bless($self, $class);
90	dpavlin	74
91			my $log = $self->_get_logger;
92
93	dpavlin	887	#$log->debug("self: ", sub { dump($self) });
94	dpavlin	210
95			foreach my $p (qw/masterurl user passwd database/) {
96	dpavlin	74	$log->logdie("need $p") unless ($self->{$p});
97			}
98
99	dpavlin	401	$self->{encoding} \|\|= 'ISO-8859-2';
100
101	dpavlin	210	my $url = $self->{masterurl} . '/node/' . $self->{database};
102			$self->{url} = $url;
103	dpavlin	74
104	dpavlin	525	$self->{label} \|\|= "WebPAC $self->{database}";
105
106	dpavlin	458	$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	dpavlin	525	label => $self->convert( $self->{label} ),
113	dpavlin	458	);
114
115	dpavlin	525	$log->info("using ", $self->{clean} ? "new " : "", "index $self->{url} '$self->{label}' with encoding $self->{encoding}");
116	dpavlin	458
117	dpavlin	307	if ($self->{clean}) {
118	dpavlin	458	$log->debug("clean $self->{database}");
119			$self->master( action => 'nodeclr', name => $self->{database} );
120	dpavlin	307	} else {
121			$log->debug("opening index $self->{url}");
122			}
123	dpavlin	74
124	dpavlin	1131	$self->{stats} = {};
125
126	dpavlin	74	$self ? return $self : return undef;
127	dpavlin	1	}
128
129	dpavlin	75
130	dpavlin	74	=head2 add
131	dpavlin	1
132	dpavlin	74	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	dpavlin	212	C<file:///type/database%20name/000>
144	dpavlin	74
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	dpavlin	1	=cut
149
150	dpavlin	74	sub add {
151			my $self = shift;
152
153	dpavlin	456	my $args = {@_};
154	dpavlin	74
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	dpavlin	213	my $id = $args->{'id'};
166	dpavlin	74
167	dpavlin	213	my $uri = "file:///$type/$database/$id";
168	dpavlin	74	$log->debug("creating $uri");
169
170	dpavlin	343	my $doc = Search::Estraier::Document->new;
171	dpavlin	401	$doc->add_attr('@uri', $self->convert($uri) );
172	dpavlin	74
173	dpavlin	887	$log->debug("ds = ", sub { dump($args->{'ds'}) } );
174	dpavlin	74
175			# filter all tags which have type defined
176			my @tags = grep {
177	dpavlin	113	ref($args->{'ds'}->{$_}) eq 'HASH' && defined( $args->{'ds'}->{$_}->{$type} )
178	dpavlin	74	} 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	dpavlin	374	next if (! $vals);
189	dpavlin	74
190	dpavlin	401	$vals = $self->convert( $vals ) or
191	dpavlin	85	$log->logdie("can't convert '$vals' to UTF-8");
192	dpavlin	75
193			$doc->add_attr( $tag, $vals );
194			$doc->add_hidden_text( $vals );
195	dpavlin	1131
196			$self->{stats}->{attr}->{$tag}++;
197	dpavlin	74	}
198
199			my $text = $args->{'text'};
200	dpavlin	75	if ( $text ) {
201	dpavlin	401	$text = $self->convert( $text ) or
202	dpavlin	85	$log->logdie("can't convert '$text' to UTF-8");
203	dpavlin	75	$doc->add_text( $text );
204			}
205	dpavlin	74
206			$log->debug("adding ", sub { $doc->dump_draft } );
207	dpavlin	319	$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	dpavlin	74
209			return 1;
210	dpavlin	1	}
211
212	dpavlin	255	=head2 add_link
213
214			$est->add_link(
215			from => 'ps',
216			to => 'webpac2',
217			credit => 10000,
218			);
219
220	dpavlin	246	=cut
221
222	dpavlin	255	sub add_link {
223	dpavlin	238	my $self = shift;
224
225	dpavlin	255	my $args = {@_};
226			my $log = $self->_get_logger;
227	dpavlin	238
228	dpavlin	527	foreach my $p (qw/from to credit/) {
229			$log->logdie("need $p") unless ($args->{$p});
230			}
231
232	dpavlin	459	my $node = first { $_->{name} eq $args->{to} } $self->master( action => 'nodelist' );
233	dpavlin	238
234	dpavlin	459	if (! $node) {
235			$log->warn("can't find node $args->{to}, skipping link creaton");
236			return;
237			}
238	dpavlin	238
239	dpavlin	459	my $label = $node->{label};
240	dpavlin	255
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	dpavlin	459	return $self->{db}->set_link(
249			$self->{masterurl} . '/node/' . $args->{to},
250			$label,
251			$args->{credit},
252	dpavlin	255	);
253	dpavlin	238	}
254
255	dpavlin	255
256	dpavlin	458	=head2 master
257	dpavlin	255
258	dpavlin	458	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	dpavlin	255	);
265
266			=cut
267
268	dpavlin	458	sub master {
269	dpavlin	210	my $self = shift;
270	dpavlin	458	$self->{db}->master( @_ );
271	dpavlin	210	}
272
273	dpavlin	255
274	dpavlin	401	=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	dpavlin	1131	=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	dpavlin	1148	my $path = 'var/estraier';
299
300			mkpath $path unless -e $path;
301
302			$path .= '/' . $self->{database} . '.yaml';
303	dpavlin	1131	YAML::DumpFile( $path, $self->{stats} );
304			$log->info("created $path ", -s $path, " bytes");
305			$log->debug( dump( $self->{stats} ) );
306			}
307
308	dpavlin	1	=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