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	dpavlin	80	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