5 |
|
|
6 |
use base qw/WebPAC::Common/; |
use base qw/WebPAC::Common/; |
7 |
|
|
8 |
use Search::Estraier; |
use Search::Estraier 0.06; |
9 |
use Encode qw/from_to/; |
use Encode qw/from_to/; |
10 |
use Data::Dumper; |
use Data::Dumper; |
11 |
use LWP; |
use LWP; |
17 |
|
|
18 |
=head1 VERSION |
=head1 VERSION |
19 |
|
|
20 |
Version 0.10 |
Version 0.11 |
21 |
|
|
22 |
=cut |
=cut |
23 |
|
|
24 |
our $VERSION = '0.10'; |
our $VERSION = '0.11'; |
25 |
|
|
26 |
=head1 SYNOPSIS |
=head1 SYNOPSIS |
27 |
|
|
98 |
my $url = $self->{masterurl} . '/node/' . $self->{database}; |
my $url = $self->{masterurl} . '/node/' . $self->{database}; |
99 |
$self->{url} = $url; |
$self->{url} = $url; |
100 |
|
|
101 |
|
$self->{db} = Search::Estraier::Node->new( |
102 |
|
url => $url, |
103 |
|
user => $self->{user}, |
104 |
|
passwd => $self->{passwd}, |
105 |
|
debug => $self->{debug}, |
106 |
|
create => 1, |
107 |
|
label => "WebPAC $self->{database}", |
108 |
|
); |
109 |
|
|
110 |
|
$log->info("using index $self->{url} with encoding $self->{encoding}"); |
111 |
|
|
112 |
if ($self->{clean}) { |
if ($self->{clean}) { |
113 |
$log->debug("nodedel $self->{database}"); |
$log->debug("clean $self->{database}"); |
114 |
$self->master( action => 'nodedel', name => $self->{database} ); |
$self->master( action => 'nodeclr', name => $self->{database} ); |
115 |
} else { |
} else { |
116 |
$log->debug("opening index $self->{url}"); |
$log->debug("opening index $self->{url}"); |
117 |
} |
} |
118 |
|
|
|
my $nodes = $self->master( action => 'nodelist' ); |
|
|
|
|
|
$log->debug("nodes found: $nodes"); |
|
|
|
|
|
if ($nodes !~ m/^$self->{database}\t/sm) { |
|
|
my $label = $self->{label} || 'WebPAC ' . $self->{database}; |
|
|
$log->warn("creating index $url ($label)"); |
|
|
$self->master( |
|
|
action => 'nodeadd', |
|
|
name => $self->{database}, |
|
|
label => $self->convert( $label ), |
|
|
) || $log->logdie("can't create Hyper Estraier node $self->{database}"); |
|
|
} |
|
|
|
|
|
$self->{db} = Search::Estraier::Node->new( debug => $self->{debug} ); |
|
|
$self->{db}->set_url($self->{url}); |
|
|
$self->{db}->set_auth($self->{user}, $self->{passwd}); |
|
|
|
|
|
$log->info("using index $self->{url} with encoding $self->{encoding}"); |
|
|
|
|
119 |
$self ? return $self : return undef; |
$self ? return $self : return undef; |
120 |
} |
} |
121 |
|
|
200 |
return 1; |
return 1; |
201 |
} |
} |
202 |
|
|
|
# |
|
|
# REST parametars validation data |
|
|
# |
|
|
|
|
|
my $estraier_rest = { |
|
|
master => { |
|
|
userdel => [ qw/name/ ], |
|
|
nodelist => [], |
|
|
nodeadd => [ qw/name label/ ], |
|
|
nodedel => [ qw/name/ ], |
|
|
}, |
|
|
node => { |
|
|
_set_link => [ qw/url label credit/ ], |
|
|
}, |
|
|
}; |
|
|
|
|
|
=head2 master |
|
|
|
|
|
Issue administrative commands to C<estmaster> process and receive response |
|
|
as array of lines |
|
|
|
|
|
my $nodelist = $est->master( action => 'nodelist' ); |
|
|
|
|
|
=cut |
|
|
|
|
|
sub master { |
|
|
my $self = shift; |
|
|
|
|
|
my $args = {@_}; |
|
|
my $log = $self->_get_logger; |
|
|
|
|
|
my $action = $args->{action} || $log->logconfess("no action specified"); |
|
|
|
|
|
$log->logdie("action '$action' isn't supported") unless ($estraier_rest->{master}->{$action}); |
|
|
|
|
|
$log->debug("master action: $action"); |
|
|
|
|
|
return $self->estcall( |
|
|
validate => 'master', |
|
|
rest_url => $self->{masterurl} . '/master?action=' . $action , |
|
|
action => $action, |
|
|
%{ $args }, |
|
|
); |
|
|
} |
|
|
|
|
203 |
=head2 add_link |
=head2 add_link |
204 |
|
|
205 |
$est->add_link( |
$est->add_link( |
241 |
); |
); |
242 |
} |
} |
243 |
|
|
|
=head2 estcall |
|
244 |
|
|
245 |
Workhourse which does actual calls to Hyper Estraier |
=head2 master |
246 |
|
|
247 |
$self->estcall( |
Issue administrative commands to C<estmaster> process. See documentation for |
248 |
rest_url => '/master?action=' . $action, |
C<master> in L<Search::Estraier>::Node. |
|
validate => 'master', |
|
|
# ... |
|
|
); |
|
249 |
|
|
250 |
C<rest_url> is relative URL to C<estmaster> and C<validate> is entry into |
$self->master( |
251 |
internal hash which will check if all parametars are available before |
action => 'nodeclr', |
252 |
calling function. |
name => 'foobar', |
253 |
|
); |
254 |
|
|
255 |
=cut |
=cut |
256 |
|
|
257 |
sub estcall { |
sub master { |
258 |
my $self = shift; |
my $self = shift; |
259 |
my $args = {@_}; |
$self->{db}->master( @_ ); |
|
my $log = $self->_get_logger; |
|
|
|
|
|
$log->debug("estcall: ",Dumper($args)); |
|
|
|
|
|
foreach my $p (qw/rest_url validate action/) { |
|
|
$log->die("ectcall needs $p parametar") unless ($args->{$p}); |
|
|
} |
|
|
|
|
|
my $url = $args->{rest_url}; |
|
|
my $del = '?'; |
|
|
$del = '&' if ($url =~ m#\?#); |
|
|
|
|
|
my $url_args; |
|
|
|
|
|
foreach my $arg (@{ $estraier_rest->{ $args->{validate} }->{ $args->{action} } }) { |
|
|
$log->logdie("missing parametar $arg for action $args->{action}") unless ($args->{$arg}); |
|
|
$url_args .= $del . $arg . '=' . uri_escape( $args->{$arg} ); |
|
|
$del = '&'; |
|
|
} |
|
|
|
|
|
$url .= $url_args if ($url_args); |
|
|
|
|
|
$log->debug("calling $url"); |
|
|
|
|
|
my $res = $self->est_ua()->get($url); |
|
|
|
|
|
if ($res->is_success) { |
|
|
#$log->debug( $res->content ); |
|
|
return split(/\n/, $res->content) if wantarray; |
|
|
return $res->content || 0E0; |
|
|
} else { |
|
|
$log->warn("unable to call $url: " . $res->status_line); |
|
|
return; |
|
|
} |
|
|
|
|
260 |
} |
} |
261 |
|
|
|
=head2 est_ua |
|
|
|
|
|
This is helper function to create C<LWP::UserAgent> object with Super User |
|
|
priviledges |
|
|
|
|
|
my $ua = $self->est_ua( user => 'admin', passwd => 'admin' ); |
|
|
|
|
|
=cut |
|
|
|
|
|
|
|
|
|
|
|
sub est_ua { |
|
|
my $self = shift; |
|
|
|
|
|
return $self->{_master_ua} if ($self->{_master_ua}); |
|
|
|
|
|
{ |
|
|
package AdminUserAgent; |
|
|
use base qw/LWP::UserAgent/; |
|
|
sub new { |
|
|
my $self = LWP::UserAgent::new(@_); |
|
|
$self->agent("webpac/$VERSION"); |
|
|
$self; |
|
|
} |
|
|
sub get_basic_credentials { |
|
|
my($self, $realm, $uri) = @_; |
|
|
return ($self->{user}, $self->{passwd}); |
|
|
} |
|
|
sub set_basic_credentials { |
|
|
my ($self, $user, $passwd) = @_; |
|
|
$self->{user} = $user; |
|
|
$self->{passwd} = $passwd; |
|
|
} |
|
|
}; |
|
|
|
|
|
$self->{_master_ua} = AdminUserAgent->new( ) || sub { |
|
|
my $log = $self->_get_logger; |
|
|
$log->logdie("can't create LWP::UserAgent: $!"); |
|
|
}; |
|
|
|
|
|
$self->{_master_ua}->set_basic_credentials($self->{user}, $self->{passwd}); |
|
|
|
|
|
return $self->{_master_ua}; |
|
|
} |
|
262 |
|
|
263 |
=head2 convert |
=head2 convert |
264 |
|
|