WebPAC/Search/Estraier.pm

package WebPAC::Search::Estraier;

use warnings;
use strict;

use Search::Estraier;
use Text::Iconv;
use Data::Dumper;

=head1 NAME

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

=head1 VERSION

Version 0.06

=cut

our $VERSION = '0.06';

=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(
        masterurl => 'http://localhost:1978/',
        database => 'webpac2',
        user => 'admin',
        passwd => 'admin',
        encoding => 'iso-8859-2',
        log => $Log::Log4perl->log_object,
 );

Options are:

=over 4

=item maseterurl

URI to C<estmaster> node

=item database

name of 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.

=item log

L<Log::Log4perl> object or equivalent (C<< $c->log >> can be used in
L<Catalyst> and there is support for it).

=back

=cut

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

        my $log = $self->_get_logger;

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

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

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

        $self->{db} = Search::Estraier::Node->new;
        $self->{db}->set_url($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('UTF-8', $encoding) or
                $log->die("can't create conversion from UTF-8 to $encoding");

        $self ? return $self : return undef;
}


=head2 search

Locate items in index

  my @results = $est->search(
        phrase => 'name of book or novel',
        add_attr => [
                "filepath ISTRINC $q",
                "size NUMGT 100",
        ],
        get_attr => qw/PersonalName TitleProper/,
        order => 'NUMD',
        max => 100,
        options => $HyperEstraier::Condition::SURE,
        page => 42,
        depth => 0,
  );

Options are close match to Hyper Estraier API, except C<get_attr> which defines
attributes which will be returned in hash for each record.

Results are returned as hash array with keys named by attributes

Pages are numbered C< 1 ... hits/max >.

=cut

sub search {
        my $self = shift;

        my $args = {@_};

        my $log = $self->_get_logger;

        #$log->debug( 'search args: ' . Dumper($args) );

        $self->confess('need db in object') unless ($self->{db});
        $self->confess('need get_attr') unless ($args->{get_attr});

        $self->confess("need get_attr as array not " . ref($args->{get_attr}) ) unless (ref($args->{get_attr}) eq 'ARRAY');

        my $q = $args->{phrase};

        $log->debug("args: " . Dumper( $args ));

        my $cond = Search::Estraier::Condition->new();
        if ( ref($args->{add_attr}) eq 'ARRAY' ) {
                $log->debug("adding search attributes: " . join(", ", @{ $args->{add_attr} }) );
                map {
                        $cond->add_attr( $self->{iconv}->convert( $_ ) );
                        $log->debug(" + $_");
                } @{ $args->{add_attr} };
        };

        $cond->set_phrase( $self->{iconv}->convert($q) ) if ($q);
        $cond->set_options( $args->{options} ) if ($args->{options});
        $cond->set_order( $args->{order} ) if ($args->{order});

        my $max = $args->{max} || 7;
        my $page = $args->{page} || 1;
        if ($page < 1) {
                $log->warn("page number $page < 1");
                $page = 1;
        }

        $cond->set_max( $page * $max );

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

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

        my @results;

        for my $i ( (($page - 1) * $max) .. ( $hits - 1 ) ) {

                #$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 (@{ $args->{get_attr} }) {
                        my $val = $doc->attr( $attr );
                        #$log->debug("attr $attr = ", $val || 'undef');
                        $hash->{$attr} = $self->{iconv}->convert( $val ) if (defined($val));
                }

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

        }

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

        $self->confess("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('logconfess')) {
                        $log->logconfess(@_);
                } elsif ($log->can('fatal')) {
                        $log->fatal(@_);
                        die @_;
                } 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	dpavlin	343	use Search::Estraier;
7	dpavlin	80	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	dpavlin	343	Version 0.06
17	dpavlin	80
18			=cut
19
20	dpavlin	343	our $VERSION = '0.06';
21	dpavlin	80
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	dpavlin	211	masterurl => 'http://localhost:1978/',
35			database => 'webpac2',
36	dpavlin	80	user => 'admin',
37			passwd => 'admin',
38			encoding => 'iso-8859-2',
39	dpavlin	81	log => $Log::Log4perl->log_object,
40	dpavlin	80	);
41
42			Options are:
43
44			=over 4
45
46	dpavlin	211	=item maseterurl
47	dpavlin	80
48			URI to C<estmaster> node
49
50	dpavlin	211	=item database
51
52			name of C<estmaster> node
53
54	dpavlin	80	=item user
55
56			C<estmaster> user with read rights
57
58			=item passwd
59
60			password for user
61
62			=item encoding
63
64			character encoding of C<data_structure> if it's differenet than C<ISO-8859-2>
65			(and it probably is). This encoding will be converted to C<UTF-8> for
66			Hyper Estraier.
67
68	dpavlin	81	=item log
69
70			L<Log::Log4perl> object or equivalent (C<< $c->log >> can be used in
71			L<Catalyst> and there is support for it).
72
73	dpavlin	80	=back
74
75			=cut
76
77			sub new {
78			my $class = shift;
79			my $self = {@_};
80			bless($self, $class);
81
82			my $log = $self->_get_logger;
83
84	dpavlin	211	foreach my $p (qw/masterurl user passwd/) {
85	dpavlin	80	$log->logdie("need $p") unless ($self->{$p});
86			}
87
88	dpavlin	211	my $url = $self->{masterurl} . '/node/' . $self->{database};
89			$self->{url} = $url;
90
91	dpavlin	80	$log->info("opening Hyper Estraier index $self->{'url'} as $self->{'user'}");
92
93	dpavlin	343	$self->{db} = Search::Estraier::Node->new;
94			$self->{db}->set_url($self->{'url'});
95			$self->{db}->set_auth($self->{'user'}, $self->{'passwd'});
96	dpavlin	80
97			my $encoding = $self->{'encoding'} \|\| 'ISO-8859-2';
98			$log->info("using encoding $encoding");
99
100	dpavlin	81	$self->{'iconv'} = new Text::Iconv('UTF-8', $encoding) or
101			$log->die("can't create conversion from UTF-8 to $encoding");
102	dpavlin	80
103			$self ? return $self : return undef;
104			}
105
106
107			=head2 search
108
109			Locate items in index
110
111	dpavlin	81	my @results = $est->search(
112	dpavlin	122	phrase => 'name of book or novel',
113			add_attr => [
114			"filepath ISTRINC $q",
115			"size NUMGT 100",
116			],
117			get_attr => qw/PersonalName TitleProper/,
118			order => 'NUMD',
119			max => 100,
120			options => $HyperEstraier::Condition::SURE,
121	dpavlin	156	page => 42,
122	dpavlin	216	depth => 0,
123	dpavlin	80	);
124
125	dpavlin	122	Options are close match to Hyper Estraier API, except C<get_attr> which defines
126			attributes which will be returned in hash for each record.
127
128	dpavlin	81	Results are returned as hash array with keys named by attributes
129
130	dpavlin	156	Pages are numbered C< 1 ... hits/max >.
131
132	dpavlin	80	=cut
133
134			sub search {
135			my $self = shift;
136
137			my $args = {@_};
138
139			my $log = $self->_get_logger;
140
141	dpavlin	152	#$log->debug( 'search args: ' . Dumper($args) );
142
143	dpavlin	122	$self->confess('need db in object') unless ($self->{db});
144			$self->confess('need get_attr') unless ($args->{get_attr});
145	dpavlin	81
146	dpavlin	122	$self->confess("need get_attr as array not " . ref($args->{get_attr}) ) unless (ref($args->{get_attr}) eq 'ARRAY');
147	dpavlin	80
148	dpavlin	122	my $q = $args->{phrase};
149	dpavlin	86
150	dpavlin	123	$log->debug("args: " . Dumper( $args ));
151
152	dpavlin	343	my $cond = Search::Estraier::Condition->new();
153	dpavlin	122	if ( ref($args->{add_attr}) eq 'ARRAY' ) {
154			$log->debug("adding search attributes: " . join(", ", @{ $args->{add_attr} }) );
155			map {
156	dpavlin	123	$cond->add_attr( $self->{iconv}->convert( $_ ) );
157	dpavlin	122	$log->debug(" + $_");
158	dpavlin	123	} @{ $args->{add_attr} };
159			};
160	dpavlin	80
161	dpavlin	122	$cond->set_phrase( $self->{iconv}->convert($q) ) if ($q);
162			$cond->set_options( $args->{options} ) if ($args->{options});
163			$cond->set_order( $args->{order} ) if ($args->{order});
164	dpavlin	80
165	dpavlin	156	my $max = $args->{max} \|\| 7;
166			my $page = $args->{page} \|\| 1;
167	dpavlin	177	if ($page < 1) {
168			$log->warn("page number $page < 1");
169			$page = 1;
170			}
171	dpavlin	156
172			$cond->set_max( $page * $max );
173
174	dpavlin	216	my $result = $self->{db}->search($cond, ( $args->{depth} \|\| 0 )) \|\|
175	dpavlin	80	$log->die("can't search for ", sub { Dumper( $args ) });
176
177			my $hits = $result->doc_num;
178	dpavlin	86	$log->debug("found $hits hits for '$q'");
179	dpavlin	80
180			my @results;
181
182	dpavlin	156	for my $i ( (($page - 1) * $max) .. ( $hits - 1 ) ) {
183	dpavlin	80
184	dpavlin	86	#$log->debug("get_doc($i)");
185	dpavlin	80	my $doc = $result->get_doc( $i );
186			if (! $doc) {
187			$log->warn("can't find result $i");
188			next;
189			}
190
191			my $hash;
192
193	dpavlin	122	foreach my $attr (@{ $args->{get_attr} }) {
194	dpavlin	80	my $val = $doc->attr( $attr );
195	dpavlin	86	#$log->debug("attr $attr = ", $val \|\| 'undef');
196	dpavlin	122	$hash->{$attr} = $self->{iconv}->convert( $val ) if (defined($val));
197	dpavlin	80	}
198
199			if ($hash) {
200			push @results, $hash;
201			}
202
203			}
204
205	dpavlin	103	# $log->debug("results " . Dumper( \@results ));
206	dpavlin	80
207	dpavlin	87	$self->confess("expected to return array") unless (wantarray);
208	dpavlin	80
209			return @results;
210			}
211
212			=head2 confess
213
214			wrapper around L<Log::Log4perl> C<confess> or C<< $log->fatal >> or
215			C<< $log->error >> if they exists (like in L<Catalyst>), else plain
216			C<die>.
217
218			=cut
219
220			sub confess {
221			my $self = shift;
222			if (my $log = $self->{'log'}) {
223	dpavlin	87	if ($log->can('logconfess')) {
224			$log->logconfess(@_);
225	dpavlin	80	} elsif ($log->can('fatal')) {
226			$log->fatal(@_);
227	dpavlin	87	die @_;
228	dpavlin	80	} elsif ($log->can('error')) {
229			$log->error(@_);
230			} else {
231			die @_;
232			}
233			} else {
234			die @_;
235			}
236			}
237
238			=head2 _get_logger
239
240			For compatibility with same method from L<WebPAC::Common>, but without
241			need for it.
242
243			=cut
244
245			sub _get_logger {
246			my $self = shift;
247
248			return $self->{'log'} \|\| die "really need log!";
249			}
250
251			=head1 AUTHOR
252
253			Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
254
255			=head1 COPYRIGHT & LICENSE
256
257			Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
258
259			This program is free software; you can redistribute it and/or modify it
260			under the same terms as Perl itself.
261
262			=cut
263
264			1; # End of WebPAC::Search::Estraier