--- trunk/lib/WebPAC/Output/Estraier.pm 2005/11/20 20:13:39 74 +++ trunk/lib/WebPAC/Output/Estraier.pm 2005/12/19 23:29:25 303 @@ -8,6 +8,8 @@ use HyperEstraier; use Text::Iconv; use Data::Dumper; +use LWP; +use URI::Escape; =head1 NAME @@ -15,11 +17,11 @@ =head1 VERSION -Version 0.01 +Version 0.07 =cut -our $VERSION = '0.01'; +our $VERSION = '0.07'; =head1 SYNOPSIS @@ -33,7 +35,7 @@ Connect to Hyper Estraier index using HTTP my $est = new WebPAC::Output::Estraier( - url => 'http://localhost:1978/node/webpac2', + masterurl => 'http://localhost:1978/', user => 'admin', passwd => 'admin', database => 'demo', @@ -44,7 +46,7 @@ =over 4 -=item url +=item masterurl URI to C node @@ -79,23 +81,43 @@ my $log = $self->_get_logger; - foreach my $p (qw/url user passwd/) { + #$log->debug("self: ", sub { Dumper($self) }); + + foreach my $p (qw/masterurl user passwd database/) { $log->logdie("need $p") unless ($self->{$p}); } - $log->info("opening Hyper Estraier index $self->{'url'}"); + my $url = $self->{masterurl} . '/node/' . $self->{database}; + $self->{url} = $url; + + $log->debug("opening index $self->{url}"); + + my $nodes = $self->master( action => 'nodelist' ); + + $log->debug("nodes found: $nodes"); + + if ($nodes !~ m/^$self->{database}\t/sm) { + $log->warn("creating index $url"); + $self->master( + action => 'nodeadd', + name => $self->{database}, + label => "WebPAC $self->{database}", + ) || $log->logdie("can't create Hyper Estraier node $self->{database}"); + } - $self->{'db'} = HyperEstraier::Node->new($self->{'url'}); - $self->{'db'}->set_auth($self->{'user'}, $self->{'passwd'}); + $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"); + $log->info("using index $self->{url} with encoding $encoding"); - my $iconv = new Text::Iconv('iso-8859-2', 'utf-8'); + $self->{'iconv'} = new Text::Iconv($encoding, 'UTF-8') or + $log->logdie("can't create conversion from $encoding to UTF-8"); $self ? return $self : return undef; } + =head2 add Adds one entry to database. @@ -104,13 +126,12 @@ id => 42, ds => $ds, type => 'display', - url_prefix => 'database name', text => 'optional text from which snippet is created', ); This function will create entries in index using following URI format: - C + C Each tag in C with specified C will create one attribute and corresponding hidden text (used for search). @@ -132,19 +153,19 @@ } my $type = $args->{'type'}; - my $mfn = $args->{'id'}; + my $id = $args->{'id'}; - my $uri = "file:///$type/$database/$mfn"; + my $uri = "file:///$type/$database/$id"; $log->debug("creating $uri"); my $doc = HyperEstraier::Document->new; - $doc->add_attr('@uri', $uri); + $doc->add_attr('@uri', $self->{'iconv'}->convert($uri) ); $log->debug("ds = ", sub { Dumper($args->{'ds'}) } ); # filter all tags which have type defined my @tags = grep { - defined( $args->{'ds'}->{$_}->{$type} ) + ref($args->{'ds'}->{$_}) eq 'HASH' && defined( $args->{'ds'}->{$_}->{$type} ) } keys %{ $args->{'ds'} }; $log->debug("tags = ", join(",", @tags)); @@ -157,19 +178,213 @@ $log->logconfess("no values for $tag/$type") unless ($vals); - $doc->add_attr($tag, $vals); - $doc->add_hidden_text($vals); + $vals = $self->{'iconv'}->convert( $vals ) or + $log->logdie("can't convert '$vals' to UTF-8"); + + $doc->add_attr( $tag, $vals ); + $doc->add_hidden_text( $vals ); } my $text = $args->{'text'}; - $doc->add_text( $text ) if ( $text ); + if ( $text ) { + $text = $self->{'iconv'}->convert( $text ) or + $log->logdie("can't convert '$text' to UTF-8"); + $doc->add_text( $text ); + } $log->debug("adding ", sub { $doc->dump_draft } ); - $self->{'db'}->put_doc($doc) || $log->die("can't add document $uri to index"); + $self->{'db'}->put_doc($doc) || $log->logdie("can't add document $uri to node " . $self->{url} . " status: " . $self->{db}->status()); return 1; } +# +# 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 = $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 }, + ); +} + +=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; + + my @labels = $self->master( action => 'nodelist' ); + + $log->debug("got labels: ", join("|", @labels)); + + @labels = grep(/^$args->{to}\t/, @labels); + my $label = shift @labels; + $label = split(/\t/, $label)->[1] if ($label); + + 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); + + 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; + } + +} + +=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<< >>