WebPAC/Output/Estraier.pm

package WebPAC::Output::Estraier;

use warnings;
use strict;

use base qw/WebPAC::Common/;

use HyperEstraier;
use Text::Iconv;
use Data::Dumper;
use LWP;
use URI::Escape;

=head1 NAME

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

=head1 VERSION

Version 0.03

=cut

our $VERSION = '0.03';

=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',
        encoding => 'iso-8859-2',
 );

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 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 { Dumper($self) });

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

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

        $log->info("opening Hyper Estraier index $self->{url}");

        my $nodes = $self->est_master( action => 'nodelist' );

        $log->debug("nodes found: $nodes");

        if ($nodes !~ m/^$self->{database}\t/sm) {
                $log->info("creating index $url");
                $self->est_master(
                        action => 'nodeadd',
                        name => $self->{database},
                        label => "WebPAC $self->{database}",
                ) || $log->logdie("can't create Hyper Estraier node $self->{database}");
        }

        $self->{'db'} = HyperEstraier::Node->new($self->{url});
        $self->{'db'}->set_auth($self->{'user'}, $self->{passwd});

        my $encoding = $self->{'encoding'} || 'ISO-8859-2';
        $log->info("using encoding $encoding");

        $self->{'iconv'} = new Text::Iconv($encoding, 'UTF-8') or
                $log->logdie("can't create conversion from $encoding to UTF-8");

        $self ? return $self : return undef;
}


=head2 add

Adds one entry to database.

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

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

  C<file:///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 $mfn = $args->{'id'};

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

        my $doc = HyperEstraier::Document->new;
        $doc->add_attr('@uri', $self->{'iconv'}->convert($uri) );

        $log->debug("ds = ", sub { Dumper($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} });

                $log->logconfess("no values for $tag/$type") unless ($vals);

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

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

        my $text = $args->{'text'};
        if ( $text ) {
                $text = $self->{'iconv'}->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->logdie("can't add document $uri to index");

        return 1;
}

=head2 est_master

Issue administrative commands to C<estmaster> process and receive response
as array of lines

  my $nodelist = $self->est_master( action => nodelist );

=cut

my $estmaster_actions = {
        userdel => [ qw/name/ ],
        nodelist => [],
        nodeadd => [ qw/name label/ ],
        nodedel => [ qw/name/ ],
};

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

        $log->debug(Dumper($args));

        my $action = $args->{action} || $log->logconfess("no action specified");

        $log->logdie("action '$action' isn't supported") unless ($estmaster_actions->{$action});

        my $url = $self->{masterurl} . '/master?action=' . $action;

        foreach my $arg (@{ $estmaster_actions->{$action} }) {
                $log->logdie("missing parametar $arg for action $action") unless ($args->{$arg});
                $url .= '&' . $arg . '=' . uri_escape( $args->{$arg} );
        }

        $log->debug("calling $url");

        if (! $self->{_master_ua}) {
                $self->{_master_ua} = LWP::UserAgent->new( ) || $log->logdie("can't create LWP::UserAgent: $!");
                $self->{_master_ua}->credentials('localhost:1978','Super User', $self->{user} => $self->{passwd});
        }

        my $res = $self->{_master_ua}->get($url);

        if ($res->is_success) {
                #$log->debug( $res->content );
                return split(/\n/, $res->content) if wantarray;
                return $res->content;
        } else {
                $log->warn("unable to call $url: " . $res->status_line);
                #$log->debug(Dumper($res, $self->{'_master_ua'}));
                return;
        }

}

=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			use HyperEstraier;
9			use Text::Iconv;
10			use Data::Dumper;
11	dpavlin	211	use LWP;
12	dpavlin	210	use URI::Escape;
13	dpavlin	74
14	dpavlin	1	=head1 NAME
15
16	dpavlin	74	WebPAC::Output::Estraier - Create Hyper Estraier full text index
17	dpavlin	1
18			=head1 VERSION
19
20	dpavlin	211	Version 0.03
21	dpavlin	1
22			=cut
23
24	dpavlin	211	our $VERSION = '0.03';
25	dpavlin	1
26			=head1 SYNOPSIS
27
28	dpavlin	74	Create full text index using Hyper Estraier index from data with
29			type C<search>.
30	dpavlin	1
31	dpavlin	74	=head1 FUNCTIONS
32	dpavlin	1
33	dpavlin	74	=head2 new
34	dpavlin	1
35	dpavlin	74	Connect to Hyper Estraier index using HTTP
36	dpavlin	1
37	dpavlin	74	my $est = new WebPAC::Output::Estraier(
38	dpavlin	210	masterurl => 'http://localhost:1978/',
39	dpavlin	74	user => 'admin',
40			passwd => 'admin',
41			database => 'demo',
42			encoding => 'iso-8859-2',
43			);
44	dpavlin	1
45	dpavlin	74	Options are:
46	dpavlin	1
47	dpavlin	74	=over 4
48	dpavlin	1
49	dpavlin	210	=item masterurl
50	dpavlin	1
51	dpavlin	74	URI to C<estmaster> node
52
53			=item user
54
55			C<estmaster> user with sufficient rights
56
57			=item passwd
58
59			password for user
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			Hyper Estraier.
70
71			=back
72
73			Name of database will be used to form URI of documents in index.
74
75	dpavlin	1	=cut
76
77	dpavlin	74	sub new {
78			my $class = shift;
79			my $self = {@_};
80			bless($self, $class);
81
82			my $log = $self->_get_logger;
83
84	dpavlin	211	#$log->debug("self: ", sub { Dumper($self) });
85	dpavlin	210
86			foreach my $p (qw/masterurl user passwd database/) {
87	dpavlin	74	$log->logdie("need $p") unless ($self->{$p});
88			}
89
90	dpavlin	210	my $url = $self->{masterurl} . '/node/' . $self->{database};
91			$url =~ s#//#/#g;
92			$self->{url} = $url;
93	dpavlin	74
94	dpavlin	210	$log->info("opening Hyper Estraier index $self->{url}");
95	dpavlin	74
96	dpavlin	211	my $nodes = $self->est_master( action => 'nodelist' );
97	dpavlin	210
98	dpavlin	211	$log->debug("nodes found: $nodes");
99
100			if ($nodes !~ m/^$self->{database}\t/sm) {
101	dpavlin	210	$log->info("creating index $url");
102			$self->est_master(
103			action => 'nodeadd',
104			name => $self->{database},
105			label => "WebPAC $self->{database}",
106			) \|\| $log->logdie("can't create Hyper Estraier node $self->{database}");
107			}
108
109			$self->{'db'} = HyperEstraier::Node->new($self->{url});
110			$self->{'db'}->set_auth($self->{'user'}, $self->{passwd});
111
112	dpavlin	74	my $encoding = $self->{'encoding'} \|\| 'ISO-8859-2';
113			$log->info("using encoding $encoding");
114
115	dpavlin	75	$self->{'iconv'} = new Text::Iconv($encoding, 'UTF-8') or
116	dpavlin	85	$log->logdie("can't create conversion from $encoding to UTF-8");
117	dpavlin	74
118			$self ? return $self : return undef;
119	dpavlin	1	}
120
121	dpavlin	75
122	dpavlin	74	=head2 add
123	dpavlin	1
124	dpavlin	74	Adds one entry to database.
125
126			$est->add(
127			id => 42,
128			ds => $ds,
129			type => 'display',
130			url_prefix => 'database name',
131			text => 'optional text from which snippet is created',
132			);
133
134			This function will create entries in index using following URI format:
135
136			C<file:///database%20name/000>
137
138			Each tag in C<data_structure> with specified C<type> will create one
139			attribute and corresponding hidden text (used for search).
140
141	dpavlin	1	=cut
142
143	dpavlin	74	sub add {
144			my $self = shift;
145
146			my $args = {@_};
147
148			my $log = $self->_get_logger;
149
150			my $database = $self->{'database'} \|\| $log->logconfess('no database in $self');
151			$log->logconfess('need db in object') unless ($self->{'db'});
152
153			foreach my $p (qw/id ds type/) {
154			$log->logdie("need $p") unless ($args->{$p});
155			}
156
157			my $type = $args->{'type'};
158			my $mfn = $args->{'id'};
159
160			my $uri = "file:///$type/$database/$mfn";
161			$log->debug("creating $uri");
162
163			my $doc = HyperEstraier::Document->new;
164	dpavlin	75	$doc->add_attr('@uri', $self->{'iconv'}->convert($uri) );
165	dpavlin	74
166			$log->debug("ds = ", sub { Dumper($args->{'ds'}) } );
167
168			# filter all tags which have type defined
169			my @tags = grep {
170	dpavlin	113	ref($args->{'ds'}->{$_}) eq 'HASH' && defined( $args->{'ds'}->{$_}->{$type} )
171	dpavlin	74	} keys %{ $args->{'ds'} };
172
173			$log->debug("tags = ", join(",", @tags));
174
175			return unless (@tags);
176
177			foreach my $tag (@tags) {
178
179			my $vals = join(" ", @{ $args->{'ds'}->{$tag}->{$type} });
180
181			$log->logconfess("no values for $tag/$type") unless ($vals);
182
183	dpavlin	75	$vals = $self->{'iconv'}->convert( $vals ) or
184	dpavlin	85	$log->logdie("can't convert '$vals' to UTF-8");
185	dpavlin	75
186			$doc->add_attr( $tag, $vals );
187			$doc->add_hidden_text( $vals );
188	dpavlin	74	}
189
190			my $text = $args->{'text'};
191	dpavlin	75	if ( $text ) {
192			$text = $self->{'iconv'}->convert( $text ) or
193	dpavlin	85	$log->logdie("can't convert '$text' to UTF-8");
194	dpavlin	75	$doc->add_text( $text );
195			}
196	dpavlin	74
197			$log->debug("adding ", sub { $doc->dump_draft } );
198	dpavlin	85	$self->{'db'}->put_doc($doc) \|\| $log->logdie("can't add document $uri to index");
199	dpavlin	74
200			return 1;
201	dpavlin	1	}
202
203	dpavlin	210	=head2 est_master
204
205			Issue administrative commands to C<estmaster> process and receive response
206			as array of lines
207
208			my $nodelist = $self->est_master( action => nodelist );
209
210			=cut
211
212			my $estmaster_actions = {
213			userdel => [ qw/name/ ],
214			nodelist => [],
215			nodeadd => [ qw/name label/ ],
216			nodedel => [ qw/name/ ],
217			};
218
219			sub est_master {
220			my $self = shift;
221			my $args = {@_};
222			my $log = $self->_get_logger;
223
224			$log->debug(Dumper($args));
225
226			my $action = $args->{action} \|\| $log->logconfess("no action specified");
227
228			$log->logdie("action '$action' isn't supported") unless ($estmaster_actions->{$action});
229
230			my $url = $self->{masterurl} . '/master?action=' . $action;
231
232			foreach my $arg (@{ $estmaster_actions->{$action} }) {
233			$log->logdie("missing parametar $arg for action $action") unless ($args->{$arg});
234			$url .= '&' . $arg . '=' . uri_escape( $args->{$arg} );
235			}
236
237			$log->debug("calling $url");
238
239	dpavlin	211	if (! $self->{_master_ua}) {
240			$self->{_master_ua} = LWP::UserAgent->new( ) \|\| $log->logdie("can't create LWP::UserAgent: $!");
241			$self->{_master_ua}->credentials('localhost:1978','Super User', $self->{user} => $self->{passwd});
242			}
243	dpavlin	210
244	dpavlin	211	my $res = $self->{_master_ua}->get($url);
245
246			if ($res->is_success) {
247			#$log->debug( $res->content );
248			return split(/\n/, $res->content) if wantarray;
249			return $res->content;
250			} else {
251			$log->warn("unable to call $url: " . $res->status_line);
252			#$log->debug(Dumper($res, $self->{'_master_ua'}));
253	dpavlin	210	return;
254			}
255
256			}
257
258	dpavlin	1	=head1 AUTHOR
259
260			Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
261
262			=head1 COPYRIGHT & LICENSE
263
264			Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
265
266			This program is free software; you can redistribute it and/or modify it
267			under the same terms as Perl itself.
268
269			=cut
270
271			1; # End of WebPAC::Output::Estraier