WebPAC/Search/Estraier.pm

package WebPAC::Search::Estraier;

use warnings;
use strict;

use HyperEstraier;
use Text::Iconv;
use Data::Dumper;

=head1 NAME

WebPAC::Search::Estraier - search Hyper Estraier full text index

=head1 VERSION

Version 0.01

=cut

our $VERSION = '0.01';

=head1 SYNOPSIS

Search WebPAC data using Hyper Estraier full text index created with
L<WebPAC::Output::Estraier>.

=head1 FUNCTIONS

=head2 new

Connect to Hyper Estraier index using HTTP

 my $est = new WebPAC::Search::Estraier(
        url => 'http://localhost:1978/node/webpac2',
        user => 'admin',
        passwd => 'admin',
        encoding => 'iso-8859-2',
        log => $Log::Log4Perl->log_object,
 );

Options are:

=over 4

=item url

URI to C<estmaster> node

=item user

C<estmaster> user with read rights

=item passwd

password for user

=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

=cut

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

        my $log = $self->_get_logger;

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

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

        $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->die("can't create conversion from $encoding to UTF-8");

        $self ? return $self : return undef;
}


=head2 search

Locate items in index

  $est->search(
        query => 'name of book or novel',
        attr => [ qw/PersonalName Title/ ],
  );

=cut

sub search {
        my $self = shift;

        my $args = {@_};

        my $log = $self->_get_logger;

        $log->logconfess('need db in object') unless ($self->{'db'});
        $log->logconfess('need attr') unless ($args->{'attr'});
        $log->logconfess("need attr as array not " . ref($args->{'attr'}) ) unless (ref($args->{'attr'}) eq 'ARRAY');

#       my $database = $self->{'database'} || $log->logconfess('no database in $self');
#       foreach my $p (qw/id ds type/) {
#               $log->logconfess("need $p") unless ($args->{$p});
#       }

        my $cond = HyperEstraier::Condition->new();
#       $cond->add_attr("filepath ISTRINC $q");

        $cond->set_phrase( $args->{'query'} ) if ($args->{'query'});
        $cond->set_max( $args->{'max'} ) if ($args->{'max'});
#       $cond->set_options( $HyperEstraier::Condition::SURE );
#       $cond->set_order( 'NUMD' );

        my $result = $self->{'db'}->search($cond, 0) ||
                $log->die("can't search for ", sub { Dumper( $args ) });

        my $hits = $result->doc_num;
        $log->debug("found $hits hits");

        my @attrs = $args->{'attr'} || $self->confess("need attr");

        my @results;

        for my $i ( 0 .. $hits ) {

                $log->debug("get_doc($i)");
                my $doc = $result->get_doc( $i );
                if (! $doc) {
                        $log->warn("can't find result $i");
                        next;
                }

                my $hash;

                foreach my $attr (@attrs) {
                        my $val = $doc->attr( $attr );
                        $log->debug("attr $attr = ", $val || 'undef');
                        $hash->{$attr} = $val if (defined($val));
                }

                if ($hash) {
                        push @results, $hash;
                }

        }

        $log->debug("results " . Dumper( \@results ));

        $log->logconfess("expected to return array") unless (wantarray);

        return @results;
}

=head2 confess

wrapper around L<Log::Log4perl> C<confess> or C<< $log->fatal >> or
C<< $log->error >> if they exists (like in L<Catalyst>), else plain
C<die>.

=cut

sub confess {
        my $self = shift;
        if (my $log = $self->{'log'}) {
                if ($log->can('confess')) {
                        $log->confess(@_);
                } elsif ($log->can('fatal')) {
                        $log->fatal(@_);
                } elsif ($log->can('error')) {
                        $log->error(@_);
                } else {
                        die @_;
                }
        } else {
                die @_;
        }
}

=head2 _get_logger

For compatibility with same method from L<WebPAC::Common>, but without
need for it.

=cut

sub _get_logger {
        my $self = shift;

        return $self->{'log'} || die "really need log!";
}

=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::Search::Estraier
1	package WebPAC::Search::Estraier;
2
3	use warnings;
4	use strict;
5
6	use HyperEstraier;
7	use Text::Iconv;
8	use Data::Dumper;
9
10	=head1 NAME
11
12	WebPAC::Search::Estraier - search Hyper Estraier full text index
13
14	=head1 VERSION
15
16	Version 0.01
17
18	=cut
19
20	our $VERSION = '0.01';
21
22	=head1 SYNOPSIS
23
24	Search WebPAC data using Hyper Estraier full text index created with
25	L<WebPAC::Output::Estraier>.
26
27	=head1 FUNCTIONS
28
29	=head2 new
30
31	Connect to Hyper Estraier index using HTTP
32
33	my $est = new WebPAC::Search::Estraier(
34	url => 'http://localhost:1978/node/webpac2',
35	user => 'admin',
36	passwd => 'admin',
37	encoding => 'iso-8859-2',
38	log => $Log::Log4Perl->log_object,
39	);
40
41	Options are:
42
43	=over 4
44
45	=item url
46
47	URI to C<estmaster> node
48
49	=item user
50
51	C<estmaster> user with read rights
52
53	=item passwd
54
55	password for user
56
57	=item encoding
58
59	character encoding of C<data_structure> if it's differenet than C<ISO-8859-2>
60	(and it probably is). This encoding will be converted to C<UTF-8> for
61	Hyper Estraier.
62
63	=back
64
65	=cut
66
67	sub new {
68	my $class = shift;
69	my $self = {@_};
70	bless($self, $class);
71
72	my $log = $self->_get_logger;
73
74	foreach my $p (qw/url user passwd/) {
75	$log->logdie("need $p") unless ($self->{$p});
76	}
77
78	$log->info("opening Hyper Estraier index $self->{'url'} as $self->{'user'}");
79
80	$self->{'db'} = HyperEstraier::Node->new($self->{'url'});
81	$self->{'db'}->set_auth($self->{'user'}, $self->{'passwd'});
82
83	my $encoding = $self->{'encoding'} \|\| 'ISO-8859-2';
84	$log->info("using encoding $encoding");
85
86	$self->{'iconv'} = new Text::Iconv($encoding, 'UTF-8') or
87	$log->die("can't create conversion from $encoding to UTF-8");
88
89	$self ? return $self : return undef;
90	}
91
92
93	=head2 search
94
95	Locate items in index
96
97	$est->search(
98	query => 'name of book or novel',
99	attr => [ qw/PersonalName Title/ ],
100	);
101
102	=cut
103
104	sub search {
105	my $self = shift;
106
107	my $args = {@_};
108
109	my $log = $self->_get_logger;
110
111	$log->logconfess('need db in object') unless ($self->{'db'});
112	$log->logconfess('need attr') unless ($args->{'attr'});
113	$log->logconfess("need attr as array not " . ref($args->{'attr'}) ) unless (ref($args->{'attr'}) eq 'ARRAY');
114
115	# my $database = $self->{'database'} \|\| $log->logconfess('no database in $self');
116	# foreach my $p (qw/id ds type/) {
117	# $log->logconfess("need $p") unless ($args->{$p});
118	# }
119
120	my $cond = HyperEstraier::Condition->new();
121	# $cond->add_attr("filepath ISTRINC $q");
122
123	$cond->set_phrase( $args->{'query'} ) if ($args->{'query'});
124	$cond->set_max( $args->{'max'} ) if ($args->{'max'});
125	# $cond->set_options( $HyperEstraier::Condition::SURE );
126	# $cond->set_order( 'NUMD' );
127
128	my $result = $self->{'db'}->search($cond, 0) \|\|
129	$log->die("can't search for ", sub { Dumper( $args ) });
130
131	my $hits = $result->doc_num;
132	$log->debug("found $hits hits");
133
134	my @attrs = $args->{'attr'} \|\| $self->confess("need attr");
135
136	my @results;
137
138	for my $i ( 0 .. $hits ) {
139
140	$log->debug("get_doc($i)");
141	my $doc = $result->get_doc( $i );
142	if (! $doc) {
143	$log->warn("can't find result $i");
144	next;
145	}
146
147	my $hash;
148
149	foreach my $attr (@attrs) {
150	my $val = $doc->attr( $attr );
151	$log->debug("attr $attr = ", $val \|\| 'undef');
152	$hash->{$attr} = $val if (defined($val));
153	}
154
155	if ($hash) {
156	push @results, $hash;
157	}
158
159	}
160
161	$log->debug("results " . Dumper( \@results ));
162
163	$log->logconfess("expected to return array") unless (wantarray);
164
165	return @results;
166	}
167
168	=head2 confess
169
170	wrapper around L<Log::Log4perl> C<confess> or C<< $log->fatal >> or
171	C<< $log->error >> if they exists (like in L<Catalyst>), else plain
172	C<die>.
173
174	=cut
175
176	sub confess {
177	my $self = shift;
178	if (my $log = $self->{'log'}) {
179	if ($log->can('confess')) {
180	$log->confess(@_);
181	} elsif ($log->can('fatal')) {
182	$log->fatal(@_);
183	} elsif ($log->can('error')) {
184	$log->error(@_);
185	} else {
186	die @_;
187	}
188	} else {
189	die @_;
190	}
191	}
192
193	=head2 _get_logger
194
195	For compatibility with same method from L<WebPAC::Common>, but without
196	need for it.
197
198	=cut
199
200	sub _get_logger {
201	my $self = shift;
202
203	return $self->{'log'} \|\| die "really need log!";
204	}
205
206	=head1 AUTHOR
207
208	Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
209
210	=head1 COPYRIGHT & LICENSE
211
212	Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
213
214	This program is free software; you can redistribute it and/or modify it
215	under the same terms as Perl itself.
216
217	=cut
218
219	1; # End of WebPAC::Search::Estraier