--- trunk/lib/WebPAC/Output/Estraier.pm 2005/12/18 23:34:24 291 +++ trunk/lib/WebPAC/Output/Estraier.pm 2006/05/10 14:08:15 458 @@ -5,8 +5,8 @@ use base qw/WebPAC::Common/; -use HyperEstraier; -use Text::Iconv; +use Search::Estraier 0.06; +use Encode qw/from_to/; use Data::Dumper; use LWP; use URI::Escape; @@ -17,11 +17,11 @@ =head1 VERSION -Version 0.07 +Version 0.11 =cut -our $VERSION = '0.07'; +our $VERSION = '0.11'; =head1 SYNOPSIS @@ -39,7 +39,9 @@ user => 'admin', passwd => 'admin', database => 'demo', + label => 'node label', encoding => 'iso-8859-2', + clean => 1, ); Options are: @@ -62,6 +64,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 @@ -76,8 +82,8 @@ sub new { my $class = shift; - my $self = {@_}; - bless($self, $class); + my $self = {@_}; + bless($self, $class); my $log = $self->_get_logger; @@ -87,33 +93,29 @@ $log->logdie("need $p") unless ($self->{$p}); } + $self->{encoding} ||= 'ISO-8859-2'; + my $url = $self->{masterurl} . '/node/' . $self->{database}; $self->{url} = $url; - $log->info("opening Hyper Estraier index $self->{url}"); - - 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 => "WebPAC $self->{database}", + ); - $log->debug("nodes found: $nodes"); + $log->info("using index $self->{url} with encoding $self->{encoding}"); - if ($nodes !~ m/^$self->{database}\t/sm) { - $log->info("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'} = 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"); - - $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; } @@ -141,7 +143,7 @@ sub add { my $self = shift; - my $args = {@_}; + my $args = {@_}; my $log = $self->_get_logger; @@ -158,8 +160,8 @@ my $uri = "file:///$type/$database/$id"; $log->debug("creating $uri"); - my $doc = HyperEstraier::Document->new; - $doc->add_attr('@uri', $self->{'iconv'}->convert($uri) ); + my $doc = Search::Estraier::Document->new; + $doc->add_attr('@uri', $self->convert($uri) ); $log->debug("ds = ", sub { Dumper($args->{'ds'}) } ); @@ -176,9 +178,9 @@ my $vals = join(" ", @{ $args->{'ds'}->{$tag}->{$type} }); - $log->logconfess("no values for $tag/$type") unless ($vals); + 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 ); @@ -187,62 +189,17 @@ 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 ); } $log->debug("adding ", sub { $doc->dump_draft } ); - $self->{'db'}->put_doc($doc) || $log->logdie("can't add document $uri to node " . $self->{url} . " status: " . $self->{db}->status()); + $self->{'db'}->put_doc($doc) || $log->warn("can't add document $uri with draft " . $doc->dump_draft . " 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( @@ -263,9 +220,9 @@ $log->debug("got labels: ", join("|", @labels)); - @labels = grep(/^$args->{to}/, @labels); - - my (undef,$label) = split(/\t/, shift @labels); + @labels = grep(/^$args->{to}\t/, @labels); + my $label = shift @labels; + (undef,$label) = split(/\t/, $label) if ($label); if (! $label) { $log->warn("can't find label for $args->{to}, skipping link creaton"); @@ -284,105 +241,37 @@ ); } -=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