--- trunk/lib/WebPAC/Output/Estraier.pm 2005/12/05 17:47:04 210 +++ trunk/lib/WebPAC/Output/Estraier.pm 2006/05/22 18:26:56 525 @@ -5,11 +5,12 @@ 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::Simple; +use LWP; use URI::Escape; +use List::Util qw/first/; =head1 NAME @@ -17,11 +18,11 @@ =head1 VERSION -Version 0.02 +Version 0.12 =cut -our $VERSION = '0.02'; +our $VERSION = '0.12'; =head1 SYNOPSIS @@ -39,7 +40,9 @@ user => 'admin', passwd => 'admin', database => 'demo', + label => 'node label', encoding => 'iso-8859-2', + clean => 1, ); Options are: @@ -62,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 @@ -76,43 +83,42 @@ sub new { my $class = shift; - my $self = {@_}; - bless($self, $class); + my $self = {@_}; + bless($self, $class); my $log = $self->_get_logger; - $log->debug("self: ", sub { Dumper($self) }); + #$log->debug("self: ", sub { Dumper($self) }); foreach my $p (qw/masterurl user passwd database/) { $log->logdie("need $p") unless ($self->{$p}); } + $self->{encoding} ||= 'ISO-8859-2'; + my $url = $self->{masterurl} . '/node/' . $self->{database}; - $url =~ s#//#/#g; $self->{url} = $url; - $log->info("opening Hyper Estraier index $self->{url}"); + $self->{label} ||= "WebPAC $self->{database}"; - my @nodes = $self->est_master( action => 'nodelist' ); - - if (! grep(/$self->{database}/, @nodes)) { - $log->info("creating index $url"); - $self->est_master( - action => 'nodeadd', - name => $self->{database}, - label => "WebPAC $self->{database}", - ) || $log->logdie("can't create Hyper Estraier node $self->{database}"); + $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->info("using ", $self->{clean} ? "new " : "", "index $self->{url} '$self->{label}' with encoding $self->{encoding}"); + + 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; } @@ -125,13 +131,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). @@ -141,7 +146,7 @@ sub add { my $self = shift; - my $args = {@_}; + my $args = {@_}; my $log = $self->_get_logger; @@ -153,13 +158,13 @@ } 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', $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 +181,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,61 +192,87 @@ 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 index"); + $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; } -=head2 est_master - -Issue administrative commands to C process and receive response -as array of lines +=head2 add_link - my $nodelist = $self->est_master( action => nodelist ); + $est->add_link( + from => 'ps', + to => 'webpac2', + credit => 10000, + ); =cut -my $estmaster_actions = { - userdel => [ qw/name/ ], - nodelist => [], - nodeadd => [ qw/name label/ ], - nodedel => [ qw/name/ ], -}; - -sub est_master { +sub add_link { my $self = shift; + my $args = {@_}; my $log = $self->_get_logger; - $log->debug(Dumper($args)); + my $node = first { $_->{name} eq $args->{to} } $self->master( action => 'nodelist' ); - my $action = $args->{action} || $log->logconfess("no action specified"); - - $log->logdie("action '$action' isn't supported") unless ($estmaster_actions->{$action}); + if (! $node) { + $log->warn("can't find node $args->{to}, skipping link creaton"); + return; + } - my $url = $self->{masterurl} . '/master?action=' . $action; + my $label = $node->{label}; - 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("calling $url"); + $log->debug("using label $label for $args->{to}"); - my $tsv = get($url); + return $self->{db}->set_link( + $self->{masterurl} . '/node/' . $args->{to}, + $label, + $args->{credit}, + ); +} - if (! $tsv) { - $log->warn("unable to call $url"); - return; - } - return split(/\n/, $tsv); +=head2 master + +Issue administrative commands to C process. See documentation for +C in L::Node. + + $self->master( + action => 'nodeclr', + name => 'foobar', + ); + +=cut + +sub master { + my $self = shift; + $self->{db}->master( @_ ); +} + + +=head2 convert + + my $utf8_string = $self->convert('string in codepage'); + +=cut + +sub convert { + my $self = shift; + + my $text = shift || return; + from_to($text, $self->{encoding}, 'UTF-8'); + return $text; } =head1 AUTHOR