--- trunk/lib/WebPAC/Output/Estraier.pm 2006/01/08 22:21:19 374 +++ trunk/lib/WebPAC/Output/Estraier.pm 2006/05/22 18:26:56 525 @@ -5,11 +5,12 @@ use base qw/WebPAC::Common/; -use Search::Estraier; -use Text::Iconv; +use Search::Estraier 0.06; +use Encode qw/from_to/; use Data::Dumper; use LWP; use URI::Escape; +use List::Util qw/first/; =head1 NAME @@ -17,11 +18,11 @@ =head1 VERSION -Version 0.09 +Version 0.12 =cut -our $VERSION = '0.09'; +our $VERSION = '0.12'; =head1 SYNOPSIS @@ -39,6 +40,7 @@ user => 'admin', passwd => 'admin', database => 'demo', + label => 'node label', encoding => 'iso-8859-2', clean => 1, ); @@ -63,6 +65,10 @@ name of database from which data comes +=item label + +label for node (optional) + =item encoding character encoding of C if it's differenet than C @@ -88,39 +94,31 @@ $log->logdie("need $p") unless ($self->{$p}); } + $self->{encoding} ||= 'ISO-8859-2'; + my $url = $self->{masterurl} . '/node/' . $self->{database}; $self->{url} = $url; - if ($self->{clean}) { - $log->debug("nodedel $self->{database}"); - $self->master( action => 'nodedel', name => $self->{database} ); - } else { - $log->debug("opening index $self->{url}"); - } + $self->{label} ||= "WebPAC $self->{database}"; - my $nodes = $self->master( action => 'nodelist' ); + $self->{db} = Search::Estraier::Node->new( + url => $url, + user => $self->{user}, + passwd => $self->{passwd}, + debug => $self->{debug}, + create => 1, + label => $self->convert( $self->{label} ), + ); - $log->debug("nodes found: $nodes"); + $log->info("using ", $self->{clean} ? "new " : "", "index $self->{url} '$self->{label}' with encoding $self->{encoding}"); - 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}"); + if ($self->{clean}) { + $log->debug("clean $self->{database}"); + $self->master( action => 'nodeclr', name => $self->{database} ); + } else { + $log->debug("opening index $self->{url}"); } - $self->{db} = Search::Estraier::Node->new( debug => $self->{debug} ); - $self->{db}->set_url($self->{url}); - $self->{db}->set_auth($self->{user}, $self->{passwd}); - - my $encoding = $self->{encoding} || 'ISO-8859-2'; - $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"); - $self ? return $self : return undef; } @@ -148,7 +146,7 @@ sub add { my $self = shift; - my $args = {@_}; + my $args = {@_}; my $log = $self->_get_logger; @@ -166,7 +164,7 @@ $log->debug("creating $uri"); my $doc = Search::Estraier::Document->new; - $doc->add_attr('@uri', $self->{'iconv'}->convert($uri) ); + $doc->add_attr('@uri', $self->convert($uri) ); $log->debug("ds = ", sub { Dumper($args->{'ds'}) } ); @@ -185,7 +183,7 @@ next if (! $vals); - $vals = $self->{'iconv'}->convert( $vals ) or + $vals = $self->convert( $vals ) or $log->logdie("can't convert '$vals' to UTF-8"); $doc->add_attr( $tag, $vals ); @@ -194,7 +192,7 @@ my $text = $args->{'text'}; if ( $text ) { - $text = $self->{'iconv'}->convert( $text ) or + $text = $self->convert( $text ) or $log->logdie("can't convert '$text' to UTF-8"); $doc->add_text( $text ); } @@ -205,51 +203,6 @@ 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( @@ -266,13 +219,14 @@ my $args = {@_}; my $log = $self->_get_logger; - my @labels = $self->master( action => 'nodelist' ); + my $node = first { $_->{name} eq $args->{to} } $self->master( action => 'nodelist' ); - $log->debug("got labels: ", join("|", @labels)); + if (! $node) { + $log->warn("can't find node $args->{to}, skipping link creaton"); + return; + } - @labels = grep(/^$args->{to}\t/, @labels); - my $label = shift @labels; - (undef,$label) = split(/\t/, $label) if ($label); + my $label = $node->{label}; if (! $label) { $log->warn("can't find label for $args->{to}, skipping link creaton"); @@ -281,115 +235,44 @@ $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}, + return $self->{db}->set_link( + $self->{masterurl} . '/node/' . $args->{to}, + $label, + $args->{credit}, ); } -=head2 estcall -Workhourse which does actual calls to Hyper Estraier +=head2 master - $self->estcall( - rest_url => '/master?action=' . $action, - validate => 'master', - # ... - ); +Issue administrative commands to C process. See documentation for +C in L::Node. -C is relative URL to C and C is entry into -internal hash which will check if all parametars are available before -calling function. + $self->master( + action => 'nodeclr', + name => 'foobar', + ); =cut -sub estcall { +sub master { 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; - } - + $self->{db}->master( @_ ); } -=head2 est_ua -This is helper function to create C object with Super User -priviledges +=head2 convert - my $ua = $self->est_ua( user => 'admin', passwd => 'admin' ); + my $utf8_string = $self->convert('string in codepage'); =cut - - -sub est_ua { +sub convert { 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}; + my $text = shift || return; + from_to($text, $self->{encoding}, 'UTF-8'); + return $text; } =head1 AUTHOR