package WebPAC::Output::Estraier;

use warnings;
use strict;

use base qw/WebPAC::Common/;

use Search::Estraier;
use Encode qw/from_to/;
use Data::Dumper;
use LWP;
use URI::Escape;

=head1 NAME

WebPAC::Output::Estraier - Create Hyper Estraier full text index

=head1 VERSION

Version 0.10

=cut

our $VERSION = '0.10';

=head1 SYNOPSIS

Create full text index using Hyper Estraier index from data with
type C<search>.

=head1 FUNCTIONS

=head2 new

Connect to Hyper Estraier index using HTTP

 my $est = new WebPAC::Output::Estraier(
 	masterurl => 'http://localhost:1978/',
	user => 'admin',
	passwd => 'admin',
	database => 'demo',
	label => 'node label',
	encoding => 'iso-8859-2',
	clean => 1,
 );

Options are:

=over 4

=item masterurl

URI to C<estmaster> node

=item user

C<estmaster> user with sufficient rights

=item passwd

password for user

=item database

name of database from which data comes

=item label

label for node (optional)

=item encoding

character encoding of C<data_structure> if it's differenet than C<ISO-8859-2>
(and it probably is). This encoding will be converted to C<UTF-8> for
Hyper Estraier.

=back

Name of database will be used to form URI of documents in index.

=cut

sub new {
	my $class = shift;
	my $self = {@_};
	bless($self, $class);

	my $log = $self->_get_logger;

	#$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};
	$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}");
	}

	my $nodes = $self->master( action => 'nodelist' );

	$log->debug("nodes found: $nodes");

	if ($nodes !~ m/^$self->{database}\t/sm) {
		my $label = $self->{label} || 'WebPAC ' . $self->{database};
		$log->warn("creating index $url ($label)");
		$self->master(
			action => 'nodeadd',
			name => $self->{database},
			label => $self->convert( $label ),
		) || $log->logdie("can't create Hyper Estraier node $self->{database}");
	}

	$self->{db} = Search::Estraier::Node->new( debug => $self->{debug} );
	$self->{db}->set_url($self->{url});
	$self->{db}->set_auth($self->{user}, $self->{passwd});

	$log->info("using index $self->{url} with encoding $self->{encoding}");

	$self ? return $self : return undef;
}


=head2 add

Adds one entry to database.

  $est->add(
  	id => 42,
	ds => $ds,
	type => 'display',
	text => 'optional text from which snippet is created',
  );

This function will create  entries in index using following URI format:

  C<file:///type/database%20name/000>

Each tag in C<data_structure> with specified C<type> will create one
attribute and corresponding hidden text (used for search).

=cut

sub add {
	my $self = shift;

        my $args = {@_};

	my $log = $self->_get_logger;

	my $database = $self->{'database'} || $log->logconfess('no database in $self');
	$log->logconfess('need db in object') unless ($self->{'db'});

	foreach my $p (qw/id ds type/) {
		$log->logdie("need $p") unless ($args->{$p});
	}

	my $type = $args->{'type'};
	my $id = $args->{'id'};

	my $uri = "file:///$type/$database/$id";
	$log->debug("creating $uri");

	my $doc = Search::Estraier::Document->new;
	$doc->add_attr('@uri', $self->convert($uri) );

	$log->debug("ds = ", sub { Dumper($args->{'ds'}) } );

	# filter all tags which have type defined
	my @tags = grep {
		ref($args->{'ds'}->{$_}) eq 'HASH' && defined( $args->{'ds'}->{$_}->{$type} )
	} keys %{ $args->{'ds'} };

	$log->debug("tags = ", join(",", @tags));

	return unless (@tags);

	foreach my $tag (@tags) {

		my $vals = join(" ", @{ $args->{'ds'}->{$tag}->{$type} });

		next if (! $vals);

		$vals = $self->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'};
	if ( $text ) {
		$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->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<estmaster> 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;
	(undef,$label) = split(/\t/, $label) 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<rest_url> is relative URL to C<estmaster> and C<validate> 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<LWP::UserAgent> 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};
}

=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

Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>

=head1 COPYRIGHT & LICENSE

Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1; # End of WebPAC::Output::Estraier
