###########################################################################
#
# GDBMServer -- utility functions for writing to gdbm databases but
#               implemented as a server with a single, persistent
#               connection
#
# A component of the Greenstone digital library software
# from the New Zealand Digital Library Project at the
# University of Waikato, New Zealand.
#
# Copyright (c) 2015 New Zealand Digital Library Project
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
###########################################################################

package DBDrivers::GDBMSERVER;

# Pragma
use strict;
use warnings;

BEGIN
{
    if (!defined $ENV{'GSDLHOME'} || !defined $ENV{'GSDLOS'}) {
        die("Error! Environment not prepared. Have you sourced setup.bash?\n");
    }
}

# Libraries
# - We're going to have to delve into locking (a little) to prevent multiple
# threads trying to launch the server at once
use Fcntl qw(:flock);
use File::Temp;
use FileUtils;
use GDBMClient;
use ghtml;
use util;
use parent 'DBDrivers::BaseDBDriver';


## @function
#
sub new
{
    my $class = shift(@_);
    my $self = DBDrivers::BaseDBDriver->new(@_);
    $self->{'default_file_extension'} = 'gdb';
    # Optional Support
    $self->{'supports_set'} = 1;
    # Private variables
    # - We have a global reference to all of the GDBM Server lockfiles that
    # this instance has created (as we'll be responsible for closing them)
    $self->{'created_server_lockfile_paths'} = ();
    # - Keep track of the lockfiles for server we have added ourselves as
    # listeners to.
    $self->{'listener_server_lockfile_paths'} = ();
    # - We also have a global of all of the listeners we have assigned as we'll
    # be responsible for removing them.
    $self->{'registered_listeners'} = ();

    # Optional support
    $self->{'supports_persistentconnection'} = 1;
    $self->{'supports_set'} = 1;

    bless($self, $class);
    return $self;
}
## new(integer) => GDBMSERVER ##


## @function Destructor
#
sub DESTROY
{
    my $self = shift(@_);
    # we ask the server to shutdown but only the 'creator' thread will actually
    # be able to, and only once all listeners have deregistered.
    foreach my $server_lockfile_path (keys (%{$self->{'listener_server_lockfile_paths'}})) {
	my $infodb_file_path = $self->{'listener_server_lockfile_paths'}->{$server_lockfile_path};
	my $gdbm_client_handle = GDBMClient->new($server_lockfile_path);
	# Deregister all of our registered listeners
	foreach my $listener_suffix (keys(%{$self->{'registered_listeners'}})) {
	    $gdbm_client_handle->removeListener($listener_suffix);
	}
	# ask the servers we created to shut down (all other threads will have
	# this request ignored) - ownership determined by pid ($$)
	if (defined $self->{'created_server_lockfile_paths'}->{$infodb_file_path}) {
	    print "* Attempting to stop GDBMServer for: " . $infodb_file_path . "\n";
	}
	$gdbm_client_handle->query('!stop:' . $$);
    }
    # we should now wait until all of our server_lockfiles have actually been
    # removed (otherwise people could mistakenly run import/build again
    # immediately and things *might* go pearshaped).
    foreach my $server_lockfile_path (keys (%{$self->{'created_server_lockfile_paths'}})) {
	# While the file exists, we should wait
	print "* Waiting for GDBMServer [" . $server_lockfile_path . "] to exit...";
	if (&FileUtils::fileExists($server_lockfile_path)) {
	    while (&FileUtils::fileExists($server_lockfile_path)) {
		print ".";
		sleep(1);
	    }
	}
	print " Done!\n";
    }
}
## DESTROY(void) => void ##


## @function _spawnClient(string) => GDBMClient
#
sub _spawnClient
{
    my $self = shift(@_);
    my $infodb_file_path = shift(@_);

    my $tmp_dir = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'},'tmp');
    if (!&FileUtils::directoryExists($tmp_dir)) {
	&FileUtils::makeDirectory($tmp_dir, 1);
    }

    # 1. Check whether the server is already running by trying to locate the
    #    server 'lock' file.
    my ($infodb_file, $extension) = $infodb_file_path =~ /([^\\\/]+)\.(db|gdb)/i;
    my $server_lockfile_path = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'},'tmp','gdbmserver-' . $infodb_file . '.lock');
    #rint " * Searching for lockfile: " . $server_lockfile_path . "\n";
    # We need to lock here to ensure only one thread enters the following code,
    # sees a missing GDBMServer, and launches it
    my $tmp_lockfile_path = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'},'tmp','dbutil-gdbmserver.lock');
    open(TMPFH, '>', $tmp_lockfile_path) or die ("Error! Failed to open file for writing: " . $tmp_lockfile_path . "\nReason: " . $! . "\n");
    flock(TMPFH, LOCK_EX) or die("Error! Cannot lock file exclusively: " . $tmp_lockfile_path . "\nReason: " . $! . "\n");
    print TMPFH localtime();

    # - If the file doesn't exist...
    if (!&FileUtils::fileExists($server_lockfile_path)) {
	# ...start it!
	my $launch_cmd = 'GDBMServer.pl "' . $$ . '" "' . $infodb_file_path . '"';
	print "* Starting GDBMServer for: " . $infodb_file_path . "\n";
	# @note I once had the below pipe ending with 2>&1 |, but that then blocks
	#       indefinitely when looping and reading <SERVERIN>.
	open(SERVERIN, $launch_cmd . ' |') or die("Error! Failed to run launch command: " . $launch_cmd . "\nReason: " . $! . "\n");
	# read all the output from the server
	my $line = '';
	my $server_lock_file_created = 0;
	while ($line = <SERVERIN>) {
	    # - watch for the line indicating a lock file has been created and
	    #   populated with a sexy port number
	    if ($line =~ /Server now listening/) {
		$server_lock_file_created = 1;
	    }
	    # - we could also watch for errors here
	    if ($self->{'debug'}) {
		if ($line !~ /\n/) {
		    $line .= "\n";
		}
		$|++; # autoflush
		print "[gdbmserver] " . $line;
		$|--; # disable autoflush
	    }
	}
	close(SERVERIN);
	if (!$server_lock_file_created) {
	    die("Error! GDBMServer failed to create lock file. Check server logs.");
	}
	# record this for later
	$self->{'created_server_lockfile_paths'}->{$server_lockfile_path} = 1;
    }
    flock(TMPFH, LOCK_UN);
    close($tmp_lockfile_path);
    unlink($tmp_lockfile_path);
    # record this for later
    $self->{'listener_server_lockfile_paths'}->{$server_lockfile_path} = $infodb_file_path;
    my $client = GDBMClient->new($server_lockfile_path);
    return $client;
}
## _spawnServer(string) => GDBMClient ##


## @function _registerListener(GDBMClient, string) => void
#
# listener_types: i - init, w - writer, r - reader, k - keys, s - set
#
sub _registerListener
{
    my $self = shift(@_);
    my $client_handle = shift(@_);
    my $listener_type = shift(@_);
    # Register this client on the server
    $client_handle->addListener($listener_type);
    # we keep a count of the registered listeners, and only allow the client
    # to be closed when overall count is zero (no listeners left)
    if (defined $self->{'registered_listeners'}->{$listener_type}) {
	$self->{'registered_listeners'}->{$listener_type} += 1;
    }
    else {
	$self->{'registered_listeners'}->{$listener_type} = 1;
    }
}
## _registerListener(GDBMClient, string) => void ##


# -----------------------------------------------------------------------------
#   GDBM SERVER IMPLEMENTATION
# -----------------------------------------------------------------------------


## @function open_infodb_write_handle(string, string) => GDBMClient
#
sub open_infodb_write_handle
{
    my $self = shift(@_);
    my $infodb_file_path = shift(@_);
    my $opt_append = shift(@_);
    if (defined $opt_append && $opt_append ne "append") {
	print "Warning! GDBM modes other than 'append' not supported for GDBMServer.\n";
    }
    my $gdbm_client_handle = $self->_spawnClient($infodb_file_path);
    $self->_registerListener($gdbm_client_handle, 'w');
    # and pass the handle to client around
    return $gdbm_client_handle;
}
## open_infodb_write_handle(string, string) => GDBMClient ##


## @function
#
# Close does nothing. As client deregister as listeners, the system checks for
# zero listeners and then ends the connection.
#
sub close_infodb_write_handle
{
    my $self = shift(@_);
    my $gdbm_client_handle = shift(@_);
}
## close_infodb_write_handle(GDBMClient) => void ##


## @function get_info_db_file_path(string, string, integer) => string
#
# Starts of the same as vanilla GDBM - as we are still using a GDBM database
# just accessing it via a persistant server. We then allow a call to this
# function to spawn the clients... that way the top level call way back in
# inexport can be the parent of all persistent connections.
#
sub get_infodb_file_path
{
    my $self = shift(@_);
    my $collection_name = shift(@_);
    my $infodb_directory_path = shift(@_);
    my $create_server = shift(@_);
    # Leave it to parent
    my $infodb_file_path = $self->SUPER::get_infodb_file_path($collection_name, $infodb_directory_path);
    # But GDBMServer can start a server
    if (defined $create_server && $create_server == 1) {
	my $tmp_collect_dir = '';
	if (defined $ENV{'GSDLCOLLECTDIR'}) {
	    $tmp_collect_dir = &FileUtils::filenameConcatenate($ENV{'GSDLCOLLECTDIR'},'tmp');
	}
	else {
	    $tmp_collect_dir = File::Temp->newdir();
	}
	if (!&FileUtils::directoryExists($tmp_collect_dir)) {
	    &FileUtils::makeDirectory($tmp_collect_dir, 1);
	}

	my $gdbm_client_handle = $self->_spawnClient($infodb_file_path);
	# Register this client on the server if necessary
	$self->_registerListener($gdbm_client_handle, 'i');
    }
    # Resuming our regular programming
    return $infodb_file_path;
}
## get_infodb_file_path(string, string, integer) => string ##


## @function read_infodb_file(string, hashmap) => void
#
sub read_infodb_file
{
    my $self = shift(@_);
    my $infodb_file_path = shift(@_);
    my $infodb_map = shift(@_);
    my $gdbm_client_handle = $self->_spawnClient($infodb_file_path);
    $self->_registerListener($gdbm_client_handle, 'r');
    # retrieves all the keys in the form:
    # [key1]\n[key2]\n[key3]\n...[keyn]
    my $raw_infodb_keys = $gdbm_client_handle->query('[*]?');
    my @infodb_keys = split(/\r?\n/, $raw_infodb_keys);
    foreach my $infodb_key (@infodb_keys) {
	if ($infodb_key =~ /.+/ && $infodb_key !~ /$self->{'70hyphen'}/) {
	    # lookup each key
	    my $infodb_value = $gdbm_client_handle->query('[' . $infodb_key . ']?');
	    # store it
	    $infodb_map->{$infodb_key} = $infodb_value;
	}
    }
}
## read_infodb_file(string, hashmap) => void ##


## @function read_infodb_entry(GDBMClient, string) => hashmap
#
sub read_infodb_entry
{
    my $self = shift(@_);
    my $raw_infodb_value = $self->read_infodb_rawentry(@_);
    my $infodb_map = $self->convert_infodb_string_to_hash($raw_infodb_value);
    return $infodb_map;
}
## read_infodb_entry(GDBMClient, string) => hashmap ##


## @function read_infodb_keys(string, hashmap) => void
#
sub read_infodb_keys
{
    my $self = shift(@_);
    my $infodb_file_path = shift(@_);
    my $infodb_map = shift(@_);
    # spawn client (creating server as necessary)
    my $gdbm_client_handle = $self->_spawnClient($infodb_file_path);
    # register ourself as listener
    $self->_registerListener($gdbm_client_handle, 'k');
    # retrieves all the keys in the form:
    # [key1]\n[key2]\n[key3]\n...[keyn]
    my $raw_infodb_keys = $gdbm_client_handle->query('[*]?');
    my @infodb_keys = split(/\r?\n/, $raw_infodb_keys);
    foreach my $infodb_key (@infodb_keys) {
	if ($infodb_key =~ /.+/ && $infodb_key !~ /$self->{'70hyphen'}/) {
	    $infodb_map->{$infodb_key} = 1;
	}
    }
}
## read_infodb_keys(string, hashmap) => void ##


## @function read_infodb_rawentry(GDBMClient, string) => string
#
sub read_infodb_rawentry
{
    my $self = shift(@_);
    my $infodb_file_path = shift(@_);
    my $infodb_key = shift(@_);
    my $gdbm_client_handle = $self->_spawnClient($infodb_file_path);
    $self->_registerListener($gdbm_client_handle, 'r');
    my $gdbm_command = '[' . $infodb_key . ']?' . "\n";
    my $raw_infodb_value = $gdbm_client_handle->query($gdbm_command);
    return $raw_infodb_value;
}
## read_infodb_rawentry(GDBMClient, string) => hashmap ##


## @function write_infodb_entry(GDBMClient, string, hashmap) => void
#
sub write_infodb_entry
{
    my $self = shift(@_);
    my $gdbm_client_handle = shift(@_);
    my $infodb_key = shift(@_);
    my $infodb_map = shift(@_);
    # - build up the gdbm command
    my $gdbm_command = "[" . $infodb_key . "]+\n";
    foreach my $infodb_value_key (keys(%$infodb_map)) {
	foreach my $infodb_value (@{$infodb_map->{$infodb_value_key}}) {
	    if ($infodb_value =~ /$self->{'70hyphen'}/) {
		# if value contains 70 or more hyphens in a row we need to escape them
		# to prevent txt2db from treating them as a separator
		$infodb_value =~ s/-/&\#045;/gi;
	    }
	    $gdbm_command .= "<" . $infodb_value_key . ">" . $infodb_value . "\n";
	}
    }
    $gdbm_command .= $self->{'70hyphen'} . "\n";
    # - ask the client to transmit the command to the server
    $gdbm_client_handle->query($gdbm_command);
}
## write_infodb_entry(GDBMClient, string, hashmap) => void ##


## @function write_infodb_rawentry(GDBMClient, string, string) => void
#
sub write_infodb_rawentry
{
    my $self = shift(@_);
    my $gdbm_client_handle = shift(@_);
    my $infodb_key = shift(@_);
    my $infodb_val = shift(@_);
    # - build up the gdbm command
    my $gdbm_command = "[" . $infodb_key . "]\n";
    $gdbm_command .= $infodb_val . "\n";
    $gdbm_command .= $self->{'70hyphen'} . "\n";
    # - ask the client to transmit the command to the server
    $gdbm_client_handle->query($gdbm_command);
    return 1;
}
## write_infodb_rawentry(GDBMClient, string, string) => void ##


## @function set_infodb_entry(string, string, hashmap) => void
#
sub set_infodb_entry
{
    my $self = shift(@_);
    my $infodb_file_path = shift(@_);
    my $infodb_key = shift(@_);
    my $infodb_map = shift(@_);
    # spawn client (creating server as necessary)
    my $gdbm_client_handle = $self->_spawnClient($infodb_file_path);
    $self->_registerListener($gdbm_client_handle, 's');
    # Protect metadata values that go inside quotes for gdbmset
    foreach my $k (keys %$infodb_map) {
	my @escaped_v = ();
	foreach my $v (@{$infodb_map->{$k}}) {
	    if ($k eq "contains") {
		# protect quotes in ".2;".3 etc
		$v =~ s/\"/\\\"/g;
		push(@escaped_v, $v);
	    }
	    else {
		my $ev = &ghtml::unescape_html($v);
		$ev =~ s/\"/\\\"/g;
		push(@escaped_v, $ev);
	    }
	}
	$infodb_map->{$k} = \@escaped_v;
    }
    # Generate the record string (GDBM command)
    my $gdbm_command = "[" . $infodb_key . "]\n";
    $gdbm_command .= $self->convert_infodb_hash_to_string($infodb_map) . "\n";
    $gdbm_command .= $self->{'70hyphen'} . "\n";
    # Send command to server
    $gdbm_client_handle->query($gdbm_command);
}
## set_infodb_entry(string, string, hashmap) => void ##


## @function delete_infodb_entry(GDBMClient, string) => void
#
sub delete_infodb_entry
{
    my $self = shift(@_);
    my $gdbm_client_handle = shift(@_);
    my $infodb_key = shift(@_);
    # - create command
    my $gdbm_command = "[" . $infodb_key . "]-\n";
    # - and send
    $gdbm_client_handle->query($gdbm_command);
}
## delete_infodb_entry(GDBMClient, string) => void ##


1;