package WebPAC::Output::EstraierNative;

use warnings;
use strict;

use base qw/WebPAC::Common/;

use Estraier;
use Encode qw/from_to/;
use Data::Dump qw/dump/;
use LWP;
use URI::Escape;
use List::Util qw/first/;
use File::Path;

$Estraier::DEBUG = 1;


=head1 NAME

WebPAC::Output::EstraierNative - Create Hyper Estraier full text index using native bindings

=head1 VERSION

Version 0.2

=cut

our $VERSION = '0.2';

=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(
 	path => 'casket/',
	database => 'demo',
	label => 'node label',
	encoding => 'iso-8859-2',
	clean => 1,
 );

Options are:

=over 4

=item path

full or relative path to Hyper Estraier database

=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 { dump($self) });

	foreach my $p (qw/path database/) {
		$log->logdie("need $p") unless ($self->{$p});
	}

	$self->{encoding} ||= 'ISO-8859-2';

	$self->{label} ||= "WebPAC $self->{database}";

	my $path = 'casket';
	$path =~ s!/+$!!;

	$path .= '/' . $self->{database};

	$self->{path} = $path;

	$path .= '.tmp';
	if (-e $path) {
		rmtree($path) || $log->logdie("can't remove old temporary directory $path: $!");
	}
	mkpath($path) || $log->logdie("can't create new temporary directory $path: $!");

	my $db = new Database();
	unless($db->open($path, Database::DBWRITER | Database::DBCREAT)) {
		$log->logdie("can't open $path: ", $db->err_msg($db->error()) );
	}

	$self->{db} = $db;

	$log->info("using ", $self->{clean} ? "new " : "", "index $self->{path} '$self->{label}' 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 = new Document();
	$doc->add_attr('@uri', $self->convert($uri) );

	# store type and database name
	$doc->add_attr('_database', $database );
	$doc->add_hidden_text('_database:' . $database);
	$doc->add_attr('_type', $type );

	$log->debug("ds = ", sub { dump($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) {

		$log->debug("$tag :: $type == ",dump( $args->{'ds'}->{$tag}->{$type} ) );

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

		next if (! $vals);

		$vals = join(" ") if (ref($vals) eq 'ARRAY');

		$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, Database::PDCLEAN) || $log->warn("can't add document $uri with draft " . $doc->dump_draft . " to node " . $self->{path} . " status: " . $self->{db}->error());

	return 1;
}

=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;

	$log->warn("add_link is not implemented");
	return;

	foreach my $p (qw/from to credit/) {
		$log->logdie("need $p") unless ($args->{$p});
	}

	my $node = first { $_->{name} eq $args->{to} } $self->master( action => 'nodelist' );

	if (! $node) {
		$log->warn("can't find node $args->{to}, skipping link creaton");
		return;
	}

	my $label = $node->{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->{db}->set_link(
		$self->{masterurl} . '/node/' . $args->{to},
		$label,
		$args->{credit},
	);
}


=head2 finish

Close index and rename of to final path

	$est->finish;

=cut

sub finish {
	my $self = shift;

	my $log = $self->_get_logger;
	$log->info("closing Hyper Estraier index make it current...");

	$self->{db}->close || $log->logdie("can't close index");

	my $path = $self->{path} || $log->logdie("no path?");

	if (-e $path) {
		$log->warn("removing old $path");
		rmtree($path) || $log->logdie("can't remove old temporary directory $path: $!");
	}

	rename $path . '.tmp', $path || $log->logdie("can't rename ${path}.tmp -> $path: $!");

}


=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
