--- trunk/lib/WebPAC/Output/Estraier.pm 2005/12/14 18:55:38 238 +++ trunk/lib/WebPAC/Output/Estraier.pm 2005/12/19 21:26:04 301 @@ -17,11 +17,11 @@ =head1 VERSION -Version 0.03 +Version 0.07 =cut -our $VERSION = '0.03'; +our $VERSION = '0.07'; =head1 SYNOPSIS @@ -90,15 +90,15 @@ my $url = $self->{masterurl} . '/node/' . $self->{database}; $self->{url} = $url; - $log->info("opening Hyper Estraier index $self->{url}"); + $log->debug("opening index $self->{url}"); - my $nodes = $self->est_master( action => 'nodelist' ); + my $nodes = $self->master( action => 'nodelist' ); $log->debug("nodes found: $nodes"); if ($nodes !~ m/^$self->{database}\t/sm) { - $log->info("creating index $url"); - $self->est_master( + $log->warn("creating index $url"); + $self->master( action => 'nodeadd', name => $self->{database}, label => "WebPAC $self->{database}", @@ -109,7 +109,7 @@ $self->{'db'}->set_auth($self->{'user'}, $self->{passwd}); my $encoding = $self->{'encoding'} || 'ISO-8859-2'; - $log->info("using encoding $encoding"); + $log->info("using index $self->{url} with encoding $encoding"); $self->{'iconv'} = new Text::Iconv($encoding, 'UTF-8') or $log->logdie("can't create conversion from $encoding to UTF-8"); @@ -198,55 +198,133 @@ return 1; } -=head2 est_master +# +# 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 process and receive response as array of lines - my $nodelist = $self->est_master( action => nodelist ); + my $nodelist = $est->master( action => 'nodelist' ); =cut -my $estmaster_actions = { - userdel => [ qw/name/ ], - nodelist => [], - nodeadd => [ qw/name label/ ], - nodedel => [ qw/name/ ], -}; - -sub est_ua { +sub master { my $self = shift; - return $self->{_master_ua} if ($self->{_master_ua}); + my $args = {@_}; + my $log = $self->_get_logger; - $self->{_master_ua} = LWP::UserAgent->new( ) || sub { - my $log = $self->_get_logger; - $log->logdie("can't create LWP::UserAgent: $!"); - }; + my $action = $args->{action} || $log->logconfess("no action specified"); - $self->{_master_ua}->credentials('localhost:1978','Super User', $self->{user} => $self->{passwd}); + $log->logdie("action '$action' isn't supported") unless ($estraier_rest->{master}->{$action}); - return $self->{_master_ua}; + $log->debug("master action: $action"); + + return $self->estcall( + validate => 'master', + rest_url => $self->{masterurl} . '/master?action=' . $action , + action => $action, + %{ $args }, + ); } -sub est_master { +=head2 add_link + + $est->add_link( + from => 'ps', + to => 'webpac2', + credit => 10000, + ); + +=cut + +sub add_link { my $self = shift; + my $args = {@_}; my $log = $self->_get_logger; - $log->debug(Dumper($args)); + my @labels = $self->master( action => 'nodelist' ); - my $action = $args->{action} || $log->logconfess("no action specified"); + $log->debug("got labels: ", join("|", @labels)); - $log->logdie("action '$action' isn't supported") unless ($estmaster_actions->{$action}); + @labels = grep(/^$args->{to}/, @labels); - my $url = $self->{masterurl} . '/master?action=' . $action; + my (undef,$label) = split(/\t/, shift @labels); - foreach my $arg (@{ $estmaster_actions->{$action} }) { - $log->logdie("missing parametar $arg for action $action") unless ($args->{$arg}); - $url .= '&' . $arg . '=' . uri_escape( $args->{$arg} ); + if (! $label) { + $log->warn("can't find label for $args->{to}, skipping link creaton"); + return; } + $log->debug("using label $label for $args->{to}"); + + return $self->estcall( + validate => 'node', + action => '_set_link', + rest_url => $self->{masterurl} . '/node/' . $args->{from} . '/_set_link' , + url => $self->{masterurl} . '/node/' . $args->{to}, + label => $label, + credit => $args->{credit}, + ); +} + +=head2 estcall + +Workhourse which does actual calls to Hyper Estraier + + $self->estcall( + rest_url => '/master?action=' . $action, + validate => 'master', + # ... + ); + +C is relative URL to C and C is entry into +internal hash which will check if all parametars are available before +calling function. + +=cut + +sub estcall { + my $self = shift; + my $args = {@_}; + 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); @@ -254,7 +332,7 @@ if ($res->is_success) { #$log->debug( $res->content ); return split(/\n/, $res->content) if wantarray; - return $res->content; + return $res->content || 0E0; } else { $log->warn("unable to call $url: " . $res->status_line); return; @@ -262,6 +340,51 @@ } +=head2 est_ua + +This is helper function to create C 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}; +} + =head1 AUTHOR Dobrica Pavlinusic, C<< >>