Index: /gs2-extensions/parallel-building/trunk/src/perllib/DBDrivers/GDBML.pm
===================================================================
--- /gs2-extensions/parallel-building/trunk/src/perllib/DBDrivers/GDBML.pm	(revision 30350)
+++ /gs2-extensions/parallel-building/trunk/src/perllib/DBDrivers/GDBML.pm	(revision 30350)
@@ -0,0 +1,92 @@
+###########################################################################
+#
+# GDBML.pm -- extends the dbutil::gdbm class by adding simple file
+# locking so as to allow for multiple readers/writers (albeit slow and not
+# supported over network filesystems)
+#
+# 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::GDBML;
+
+use strict;
+
+BEGIN
+{
+  @dbutil::gdbml::ISA = ('dbutil::gdbm');
+}
+
+# Libraries
+use util;
+use FileUtils;
+use parent 'DBDrivers::70HyphenFormat';
+
+## @function constructor
+#
+sub new
+{
+    my $class = shift(@_);
+    my $self = DBDrivers::70HyphenFormat->new(@_);
+    $self->{'default_file_extension'} = 'gdb';
+    # note: file separator agnostic
+    $self->{'executable_path'} = $ENV{'GSDLHOME'} . '/bin/' . $ENV{'GSDLOS'};
+    $self->{'read_executable'} = 'db2txtl';
+    $self->{'keyread_executable'} = 'gdbmkeys';
+    $self->{'write_executable'} = 'txt2dbl';
+    # Optional Support
+    $self->{'supports_set'} = 1;
+    bless($self, $class);
+    return $self;
+}
+## new(void) => GDBML ##
+
+# -----------------------------------------------------------------------------
+#   GDBML IMPLEMENTATION
+# -----------------------------------------------------------------------------
+
+# Handled by BaseDBDriver
+# sub get_infodb_file_path(string, string) => string
+
+# Handled by 70HyphenFormat
+# sub open_infodb_write_handle(string, string?) => filehandle
+# sub close_infodb_write_handle(filehandle) => void
+# sub delete_infodb_entry(filehandle, string) => void
+# sub read_infodb_entry(string, string) => hashmap
+# sub read_infodb_file(string, hashmap) => void
+# sub read_infodb_rawentry(string, string) => string
+# sub set_infodb_entry(string, string, hashmap) => integer
+# sub write_infodb_entry(filehandle, string, hashmap) => void
+# sub write_infodb_rawentry(filehandle, string, string) => void
+
+
+## @function
+#
+sub read_infodb_keys
+{
+    my $self = shift(@_);
+    print STDERR "Warning: read_infodb_keys() not available for GDBML, falling-back to GDBM\n";
+    $self->SUPER::read_infodb_keys(@_);
+}
+## read_infodb_keys(string, hashmap) => void ##
+
+
+1;
Index: /gs2-extensions/parallel-building/trunk/src/perllib/DBDrivers/GDBMSERVER.pm
===================================================================
--- /gs2-extensions/parallel-building/trunk/src/perllib/DBDrivers/GDBMSERVER.pm	(revision 30350)
+++ /gs2-extensions/parallel-building/trunk/src/perllib/DBDrivers/GDBMSERVER.pm	(revision 30350)
@@ -0,0 +1,465 @@
+###########################################################################
+#
+# 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;
Index: /gs2-extensions/parallel-building/trunk/src/perllib/DBDrivers/STDOUTXML.pm
===================================================================
--- /gs2-extensions/parallel-building/trunk/src/perllib/DBDrivers/STDOUTXML.pm	(revision 30350)
+++ /gs2-extensions/parallel-building/trunk/src/perllib/DBDrivers/STDOUTXML.pm	(revision 30350)
@@ -0,0 +1,232 @@
+###############################################################################
+#
+# STDOUTXML.pm -- A dbutil implementation that, hopefully unsurprisingly,
+# writes infodb stuff as XML to STDOUT. This will be used as part of the Hadoop
+# process - where this output will be passed through to the reduce phase to be
+# merged with other documents.
+#
+# 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::STDOUTXML;
+
+# Pragma
+use strict;
+
+# Libraries
+# - Perl built-in modules
+use Time::HiRes qw( gettimeofday );
+# - Greenstone modules
+use FileUtils;
+use parent 'DBDrivers::BaseDBDriver';
+
+## @function
+sub new
+{
+    my $class = shift(@_);
+    my $self = DBDrivers::BaseDBDriver->new(@_);
+    $self->{'default_file_extension'} = 'gdb';
+    $self->{'type'} = 'doc';
+    # Optional Support
+    $self->{'supports_datestamp'} = 1;
+    $self->{'supports_rss'} = 1;
+    $self->{'supports_set'} = 1;
+    $self->{'write_only'} = 1;
+    bless($self, $class);
+    return $self;
+}
+## new(integer) => STDOUTXML ##
+
+# -----------------------------------------------------------------------------
+#   STDOUT XML IMPLEMENTATION
+# -----------------------------------------------------------------------------
+
+
+## @function open_infodb_write_handle()
+#
+# Since we are writing to STDOUT we don't have to open a handle
+#
+sub open_infodb_write_handle
+{
+    my $self = shift(@_);
+    $self->debugPrintFunctionHeader(@_);
+    my $infodb_file_path = shift(@_);
+    my $opt_append = shift(@_);
+    # Store this for later
+    $self->{'type'} = $infodb_file_path;
+    return 1;
+}
+## open_infodb_write_handle() ##
+
+
+## @function
+#
+# In this function we not close the handle we didn't open :P
+#
+sub close_infodb_write_handle
+{
+    my $self = shift(@_);
+    $self->debugPrintFunctionHeader(@_);
+    my $infodb_handle = shift(@_);
+}
+## close_infodb_write_handle() ##
+
+
+## @function delete_infodb_entry()
+#
+sub delete_infodb_entry
+{
+    my $self = shift(@_);
+    $self->debugPrintFunctionHeader(@_);
+    my $infodb_handle = shift(@_);
+    my $infodb_key = shift(@_);
+    print STDERR "\@TODO: implement delete_infodb_entry()\n";
+}
+## delete_infodb_entry() ##
+
+
+## @function get_infodb_file_path()
+#
+sub get_infodb_file_path
+{
+    my $self = shift(@_);
+    $self->debugPrintFunctionHeader(@_);
+    my $collection_name = shift(@_);
+    my $infodb_directory_path = shift(@_);
+    my $infodb_type = 'error';
+    if ($collection_name =~ /(datestamp|doc|src|rss)/)
+    {
+	$infodb_type = $1;
+    }
+    return $infodb_type;
+}
+## get_infodb_file_path(string, string) => string ##
+
+
+## @function read_infodb_entry()
+#
+sub read_infodb_entry
+{
+    my $self = shift(@_);
+    $self->debugPrintFunctionHeader(@_);
+    my $infodb_file_path = shift(@_);
+    my $infodb_key = shift(@_);
+    print STDERR "\@TODO: implement read_infodb_entry()\n";
+}
+## read_infodb_file() ##
+
+
+## @function read_infodb_file()
+#
+sub read_infodb_file
+{
+    my $self = shift(@_);
+    $self->debugPrintFunctionHeader(@_);
+    my $infodb_file_path = shift(@_);
+    my $infodb_map = shift(@_);
+    print STDERR "\@TODO: implement read_infodb_file()\n";
+}
+## read_infodb_file() ##
+
+
+## @function read_infodb_keys()
+#
+sub read_infodb_keys
+{
+    my $self = shift(@_);
+    $self->debugPrintFunctionHeader(@_);
+    my $infodb_file_path = shift(@_);
+    my $infodb_map = shift(@_);
+    print "!implement read_infodb_keys()\n";
+}
+## read_infodb_keys() ##
+
+
+sub set_infodb_entry
+{
+    my $self = shift(@_);
+    $self->debugPrintFunctionHeader(@_);
+    my $infodb_file_path = shift(@_);
+    my $infodb_key = shift(@_);
+    my $infodb_map = shift(@_);
+    my $status = undef;
+    print STDERR "\@TODO: implement set_infodb_entry()\n";
+    return $status;
+}
+## set_infodb_entry() ##
+
+
+## @function write_infodb_entry()
+#
+sub write_infodb_entry
+{
+    my $self = shift(@_);
+    $self->debugPrintFunctionHeader(@_);
+    my $infodb_handle = shift(@_);
+    my $infodb_key = shift(@_);
+    my $infodb_map = shift(@_);
+    my @values;
+    foreach my $infodb_value_key (sort keys(%$infodb_map))
+    {
+	foreach my $infodb_value (@{$infodb_map->{$infodb_value_key}})
+	{
+	    if ($infodb_value =~ /-{70,}/)
+	    {
+		# 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;
+	    }
+	    push(@values, '<' . $infodb_value_key . '>' . $infodb_value);
+	}
+    }
+    my $values_str = join("\n", @values);
+    $values_str =~ s/&/&amp;/g;
+    $values_str =~ s/</&lt;/g;
+    $values_str =~ s/>/&gt;/g;
+    $values_str =~ s/"/&quot;/g;
+    $values_str =~ s/'/&apos;/g;
+    my ($seconds, $microseconds) = gettimeofday();
+    print '<InfoDBEntry type="' . $self->{'type'} . '" key="' . $infodb_key . '" mode="set" timestamp="' . $seconds . '.' . $microseconds . '">' . $values_str . '</InfoDBEntry>' . "\n";
+}
+## write_infodb_entry() ##
+
+
+## @function write_infodb_rawentry()
+#
+sub write_infodb_rawentry
+{
+    my $self = shift(@_);
+    $self->debugPrintFunctionHeader(@_);
+    my $infodb_handle = shift(@_);
+    my $infodb_key = shift(@_);
+    my $infodb_val = shift(@_);
+    $infodb_val =~ s/&/&amp;/g;
+    $infodb_val =~ s/</&lt;/g;
+    $infodb_val =~ s/>/&gt;/g;
+    $infodb_val =~ s/"/&quot;/g;
+    $infodb_val =~ s/'/&apos;/g;
+    my ($seconds, $microseconds) = gettimeofday();
+    print '<InfoDBEntry type="' . $self->{'type'} . '" key="' . $infodb_key . '" mode="set" timestamp="' . $seconds . '.' . $microseconds . '">' . $infodb_val . '</InfoDBEntry>' . "\n";
+}
+## write_infodb_rawentry(filehandle, string, string) => void ##
+
+
+1;
Index: /gs2-extensions/parallel-building/trunk/src/perllib/DBDrivers/TDBCLUSTER.pm
===================================================================
--- /gs2-extensions/parallel-building/trunk/src/perllib/DBDrivers/TDBCLUSTER.pm	(revision 30350)
+++ /gs2-extensions/parallel-building/trunk/src/perllib/DBDrivers/TDBCLUSTER.pm	(revision 30350)
@@ -0,0 +1,161 @@
+###########################################################################
+#
+# TDBCLUSTER -- utility functions for writing to TDB databases. Should be
+#               hauntingly similar to GDBM utility functions. However, allows
+#               TDB to be run on a cluster where the locking mechanism for
+#               multiple reader/writers only works on a per-computer node
+#               basis. Essentially, each compute node gets its own data-
+#               base to write to (possible with multiple writers) and then
+#               the top-level caller merges these individual databases back
+#               into a single database.
+#
+# 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::TDBCLUSTER;
+
+# Pragma
+use strict;
+
+sub BEGIN
+{
+    if (!defined $ENV{'GSDLHOME'} || !defined $ENV{'GSDLOS'}) {
+        die("Error! Environment not prepared. Have you sourced setup.bash?\n");
+    }
+    if (!defined $ENV{'GEXTTDBEDIT_INSTALLED'}) {
+        die("Error! Path to TDB binaries not found. Have you sourced setup.bash?\n");
+    }
+}
+
+# Libraries/Modules
+use Cwd;
+use dbutil::gdbmtxtgz;
+use dbutil::tdb;
+use parent 'DBDrivers::70HyphenFormat';
+
+##
+#
+sub new
+{
+    my $class = shift(@_);
+
+    my $self = DBDrivers::70HyphenFormat->new(@_);
+
+    # Default TDB file extension
+    $self->{'default_file_extension'} = 'tdb';
+    # Should the TDB used a specific affinity?
+    $self->{'forced_affinity'} = -1; # zero upwards indicates the affinity
+    # Ask TDB executables to display debugging information?
+    $self->{'tdb_debug'} = 0; # 1 to enable
+
+    # On a cluster, we need to know the hostname of the headnode
+    $self->{'headnode'} = 'medusa';
+
+    # note: file separator agnostic
+    $self->{'executable_path'} = $ENV{GEXTTDBEDIT_INSTALLED} . '/bin/';
+    $self->{'read_executable'} = 'tdb2txt';
+    $self->{'keyread_executable'} = 'tdbkeys';
+    $self->{'write_executable'} = 'txt2tdb';
+
+    # Optional Support
+    $self->{'supports_persistentconnection'} = 1;
+    $self->{'supports_set'} = 1;
+
+    bless($self, $class);
+    return $self;
+}
+
+# -----------------------------------------------------------------------------
+#   TDB IMPLEMENTATION
+# -----------------------------------------------------------------------------
+
+## @function get_tdb_executable(string)
+#
+sub get_tdb_executable
+{
+    my $self = shift(@_);
+    my $program = shift(@_);
+    my $program_exe = &util::filename_cat($program . &util::get_os_exe());
+    #if (!-x $program_exe) {
+    #  die('Fatal Error! File doesn\'t exist or isn\'t executable: ' . $program_exe);
+    #}
+    return $program_exe;
+}
+## get_tdb_executable(string) => string ##
+
+## @function
+#
+sub get_infodb_file_path
+{
+    my $self = shift(@_);
+    my $collection_name = shift(@_);
+    my $infodb_directory_path = shift(@_);
+#    my $perform_firsttime_initialization = shift(@_);
+    my $hostname = shift(@_);
+#    if (!defined $perform_firsttime_initialization) {
+#	$perform_firsttime_initialization = 0;
+#    }
+    if (!defined $hostname) {
+	$hostname = `hostname -s`;
+	$hostname =~ s/^\s*|\s*$//gi;
+	# Special case: look up the head node (top of list) from mpi.conf and do
+	# not add suffix if a match
+	if ($hostname eq $self->{'headnode'}) {
+	    $hostname = '';
+	}
+    }
+    my $infodb_file_extension = $self->{'default_file_extension'};
+    $self->debugPrint('DBDrivers::TDBCLUSTER::get_infodb_file_path("' . $collection_name . '","' . $infodb_directory_path . '","' . $hostname . '")' . "\n");
+    if ($hostname ne '') {
+	$infodb_file_extension = '.' . $hostname . '.' . $infodb_file_extension;
+    }
+    my $infodb_file_name = &util::get_dirsep_tail($collection_name) . $infodb_file_extension;
+    my $path = &util::filename_cat($infodb_directory_path, $infodb_file_name);
+    ###rint STDERR ' => ' . $path . "\n";
+    return $path;
+}
+## get_infodb_file_path() => string ##
+
+
+## @function mergeDatabases(string, string) => integer
+#
+sub mergeDatabases
+{
+    my $self = shift(@_);
+    my $source_infodb_file_path = shift(@_);
+    my $target_infodb_file_path = shift(@_);
+    # path specific filenames
+    my $tdb2txt_exe = &FileUtils::filenameConcatenate($self->{'executable_path'}, $self->{'read_executable'} . &util::get_os_exe());
+    my $txt2tdb_exe = &FileUtils::filenameConcatenate($self->{'executable_path'}, $self->{'write_executable'} . &util::get_os_exe());
+    my $cmd = $tdb2txt_exe . ' "' . $source_infodb_file_path . '" | ' . $txt2tdb_exe . ' -append "' . $target_infodb_file_path . '"';
+    ###rint STDERR "[DEBUG] cmd: " . $cmd . "\n";
+    my $status = system($cmd);
+    ###rint STDERR "[DEBUG] status: $status\n";
+    if ($status == 0) {
+	&FileUtils::removeFiles($source_infodb_file_path);
+    }
+    return $status;
+}
+## mergeDatabases(string, string) => integer ##
+
+
+1;
