Index: gs2-extensions/tdb/trunk/perllib/SocketsSwimmingThreadPoolClient.pm
===================================================================
--- gs2-extensions/tdb/trunk/perllib/SocketsSwimmingThreadPoolClient.pm	(revision 30177)
+++ gs2-extensions/tdb/trunk/perllib/SocketsSwimmingThreadPoolClient.pm	(revision 30177)
@@ -0,0 +1,106 @@
+# @author Donnie Cameron (macnod)
+# @url    https://github.com/macnod/DcServer
+# @readme http://donnieknows.com/blog/perl-sockets-swimming-thread-pool
+
+package SocketsSwimmingThreadPoolClient;
+
+use IO::Socket;
+use Carp;
+use strict;
+use warnings;
+
+my $retry_limit = 300; # five minute
+my $retry_time = 1;
+
+sub new
+{
+  # Params: host, port
+  my ($proto, %param)= @_;
+  my $class= ref($proto) || $proto;
+  bless +{%param} => $class;
+}
+
+sub stop_server
+{
+  shift->query('$self->stop')
+}
+
+sub open_socket
+{
+  my $self = shift @_;
+  # There is, unfortunately, a complication when using TCP sockets - that being
+  # the amount of time sockets linger after being closed. This TIME_WAIT period
+  # is required to ensure the terminating ACKs (kernel level) are recieved (in
+  # a graceful disconnect) and to allow time for 'wandering duplicates' to
+  # finally arrive. While there are (platform/OS/hardware) methods for getting
+  # rid of / shortening this grace period they aren't recommended (for both
+  # stability and security reasons).
+  # Thus you have the issue that, very occasionally and somewhat based upon the
+  # current turnover rate of TCP connections, you may exhaust the available
+  # pool of TCP sockets (as the rest are stuck waiting on TIME_WAIT timeouts).
+  # While the 'reuse' flag might lead you to expect the ability to 'reuse' the
+  # socket - there is one glaring caveat: you can't reuse the port from the
+  # same origin address as this would be a major security flaw. So in reality
+  # the reuse flag does nothing for us (which is why I removed it).
+  # Instead I am forced to put the socket connection in a loop and, if the
+  # first attempt to create the socket fails, wait around for SO_LINGER time
+  # in the hope that the TCP socket pool will have finally purged a number of
+  # the stranded TIME_WAIT connections.
+  # One last kick in the daddy-bags - the *default* SO_LINGER is set to 2*MSL
+  # (Maximum Segment Lifetime - the 'Time To Live of TCP' packets). This means
+  # (according to RFC793) we may be waiting up to 4 minutes for TIME_WAITs to
+  # be reaped. Sigh. Still - ever an optimist - I'll retry the socket
+  # connection every seconds.
+  # References:
+  #   http://www.perlmonks.org/?node_id=771242
+  #   http://hea-www.harvard.edu/~fine/Tech/addrinuse.html
+  #   http://blog.port80software.com/2004/12/07/hurry-up-and-time_wait/
+  #   http://www.isi.edu/touch/pubs/infocomm99/infocomm99-web/
+  #   http://www.faqs.org/rfcs/rfc793.html
+  while($retry_limit > 0)
+  {
+    my $socket= new IO::Socket::INET(PeerAddr => $self->{host} || 'localhost',
+                                     PeerPort => $self->{port} || 8190,
+                                     Proto => 'tcp');
+    if ($socket)
+    {
+      return $socket;
+    }
+    # if we are the very first caller, and a socket didn't get created, then
+    # most likely the server is still starting up... wait a little longer
+    # before complaining
+    if ($self->{'firstcaller'})
+    {
+      print "* Still waiting...\n";
+    }
+    else
+    {
+      print "Failed to create client socket: $!\n";
+      print "=> Most likely cause - TCP ephemeral ports exhausted (stuck in TIME_WAITs)\n";
+      print "=> Retry in " . $retry_time . " seconds.\n";
+      sleep($retry_time);
+    }
+    $retry_limit--;
+  }
+  print "Error! Failed to create client socket within 5 minutes timeout.\n";
+}
+
+sub query
+{
+  my ($self, $query)= @_;
+  my $socket = $self->open_socket();
+  croak "Fatal Error! $!\nDetails: " . $self->{'host'} . ":" . $self->{'port'} . "\n" unless $socket;
+  binmode($socket, ":utf8");
+  print $socket $query . "\n.\n";
+  my $buffer = '';
+  my $reply = '';
+  while($buffer = <$socket>)
+  {
+    $reply.= $buffer;
+    last if $reply =~ s/\n\.\n$//;
+  }
+  close($socket);
+  return $reply;
+}
+
+1;
Index: gs2-extensions/tdb/trunk/perllib/SocketsSwimmingThreadPoolServer.pm
===================================================================
--- gs2-extensions/tdb/trunk/perllib/SocketsSwimmingThreadPoolServer.pm	(revision 30177)
+++ gs2-extensions/tdb/trunk/perllib/SocketsSwimmingThreadPoolServer.pm	(revision 30177)
@@ -0,0 +1,191 @@
+# @author Donnie Cameron (macnod)
+# @url    https://github.com/macnod/DcServer
+# @readme http://donnieknows.com/blog/perl-sockets-swimming-thread-pool
+
+# One lurking issue with the ThreadPoolServer is that several threads don't get
+# a chance to return before the server shuts down. In a perfect world they'd
+# all get a chance to notice the 'stop' flag has been set and thusly
+# stop. However, it is only by chance this happens as most will spend most of
+# their lives either blocked listening to a socket (accept_requests) or blocked
+# waiting to dequeue a message (request_handlers). Possible solutions, such as
+# interupts, have problems of their own - interrupting mid-read of a socket
+# could be bad.  Since this is non-fatal, and non-trivial to fix, I'm just
+# leaving it for now.
+
+package SocketsSwimmingThreadPoolServer;
+
+use lib '.';
+use threads;
+use threads::shared;
+use Thread::Queue;
+use IO::Socket;
+use Time::HiRes qw/sleep/;
+use strict;
+use warnings;
+
+my $stop :shared;
+my $accept_queue = Thread::Queue->new;
+my $closed_queue = Thread::Queue->new;
+
+sub new {
+  # Params: host, port, thread_count, eom_marker, main_yield, main_cb,
+  # done_cb, processor_cb
+  my ($proto, %param)= @_;
+  my $class= ref($proto) || $proto;
+  bless +{
+    socket_defaults => +{
+      LocalHost => $param{host} || 'localhost',
+      LocalPort => $param{port} || 8191},
+    thread_count => $param{thread_count} || 10,
+    main_yield => $param{main_yield} || 1,
+    main_cb => $param{main_cb} || sub {},
+    done_cb => $param{done_cb} || sub {},
+    processor_cb => $param{processor_cb} || \&processor,
+    eom_marker => $param{eom_marker} || "\\n\\.\\n",
+    thread_pool => undef,
+    listen_queue => 5
+  } => $class;
+}
+
+# This callback (for processor_cb) simply explains no other processor function
+# defined.
+sub processor
+{
+  my ($data, $ip, $tid, $fnstop)= @_;
+  return "[tid=$tid; ip=$ip] No function implemented";
+}
+
+sub start
+{
+  my $self= shift;
+
+  # Start a thread to dispatch incoming requests
+  threads->create(sub {$self->accept_requests})->detach;
+
+  # Start the thread pool to handle dispatched requests
+  for (1 .. $self->{thread_count})
+  {
+    threads->create(sub {$self->request_handler})->detach;
+  }
+
+  # Start a loop for performing tasks in the background, while
+  # handling requests
+  $self->main_loop;
+
+  $self->{done_cb}->();
+}
+
+sub stop
+{
+  my $self = shift;
+  $stop= 1;
+}
+
+sub main_loop
+{
+  my $self = shift;
+  my $counter = 1;
+  until($stop)
+  {
+    $self->{main_cb}->($counter++, sub {$self->stop});
+    sleep $self->{main_yield};
+  }
+}
+
+sub accept_requests
+{
+  my $self = shift;
+  my %socket;
+  # lsocket => listerner [sic] socket
+  my $lsocket;
+  while (!defined $lsocket || !$lsocket)
+  {
+    $lsocket = new IO::Socket::INET(%{$self->{socket_defaults}}, Proto => 'tcp', Listen => 1, Reuse => 1);
+    if (!defined $lsocket || !$lsocket)
+    {
+      print STDERR "Warning! Can't create listener socket so server can't start (trying again in 1 second).\n";
+      print STDERR "Error message: \"" . $! . "\"\n\n";
+      sleep(1);
+    }
+  }
+  until($stop)
+  {
+    # csocket => connected socket (for doing the actual communications)
+    my $csocket = $lsocket->accept;
+    my $n = fileno $csocket;
+    $socket{$n} = $csocket;
+    # add this to the queue that a virtual horde of request_handlers are
+    # waiting upon (much like vultures)
+    $accept_queue->enqueue($n . ' ' . inet_ntoa($csocket->peeraddr));
+    # we then go ahead and destroy any sockets that we are no longer using.
+    # Note the use on a non-blocking dequeue (so it returns straight away) and
+    # that $n may be undefined (if the queue is empty) skipping the while loop
+    # altogether
+    while($n = $closed_queue->dequeue_nb)
+    {
+      # note: 2 = finished both reading and writing to this socket
+      $socket{$n}->shutdown(2);
+      delete $socket{$n}
+    }
+  }
+  # note: 2 = finished both reading and writing to this socket
+  $lsocket->shutdown(2);
+}
+
+# @function request_handler()
+#
+# There are *thread_count* request_handler threads all sitting, waiting, to
+# process any incoming requests received via the socket. Note that the whole
+# 'race for data' issue is being handled by the Thread::Queue->dequeue command
+# which is, according to the documentation, thread safe. I presume the actual
+# dequeuing is somehow synchronized.
+sub request_handler
+{
+  my $self= shift;
+  my ($n, $ip, $data);
+  my ($receive_time, $process_time, $send_time);
+  until($stop)
+  {
+    # note: dequeue is blocking so this thread will wait here until something
+    # is enqueued
+    ($n, $ip)= split / /, $accept_queue->dequeue();
+    next unless $n;
+    # open socket for reading and writing... reading first of course
+    open my $socket, '+<&=' . $n or die $!;
+    # this will read in the payload from the socket until the end of message
+    # sentinel value is detected. Note that this is done in a loop, so the
+    # client side of the socket may send multiple requests. Eventually the
+    # client will close their end of the socket causing the data to be
+    # undefined (maybe - I don't quite understand the defining construct - see
+    # below) and breaking out of the loop.
+    if(defined($data = $self->receive_client_request($socket)))
+    {
+      # we then pass the payload to the registered processor function (provided
+      # by the caller) to do the actual legwork, the result of which is written
+      # back to the socket.
+      my $result = $self->{processor_cb}->($data, $ip, threads->tid, sub {$self->stop});
+      print $socket $result, "\n.\n";
+    }
+    # this is where the socket is closed... so why am I eventually hitting a
+    # "cannot assign address" problem?
+    close $socket;
+    # add this socket number to the list of sockets to be destroyed
+    $closed_queue->enqueue($n);
+  }
+}
+
+sub receive_client_request
+{
+  my ($self, $socket)= @_;
+  # how does this construct work? eom_marker is a scalar (a string) so how can
+  # it be assigned to an anonymous array?
+  my ($eom, $buffer, $data)= $self->{eom_marker};
+  while ($buffer = <$socket>)
+  {
+    $data .= $buffer;
+    last if $data =~ s/$eom$//;
+  }
+  return $data;
+}
+
+1;
Index: gs2-extensions/tdb/trunk/perllib/TDBClient.pm
===================================================================
--- gs2-extensions/tdb/trunk/perllib/TDBClient.pm	(revision 30177)
+++ gs2-extensions/tdb/trunk/perllib/TDBClient.pm	(revision 30177)
@@ -0,0 +1,118 @@
+#!/usr/bin/perl
+
+# @note A request to the server must include the database to apply it to.
+#       Special commands, however, do not need a specific database to work.
+
+package TDBClient;
+
+# 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);
+
+# A simple multithreaded, socketed, server.
+use SocketsSwimmingThreadPoolClient;
+
+my $debug = 0;
+
+sub new
+{
+  my ($class, $server_lockfile_path, $infodb_file, $we_started_server) = @_;
+  my $self = {};
+
+  if ($infodb_file =~ /archiveinf-doc/)
+  {
+    $self->{'database'} = 'd';
+  }
+  elsif ($infodb_file =~ /archiveinf-src/)
+  {
+    $self->{'database'} = 's';
+  }
+  else
+  {
+    $self->{'database'} = 'i';
+  }
+
+  # - Now we wait until we can get a shared lock (after the exclusive
+  #   lock above releases) and then read in the port number that connections
+  #   to the server should be made on.
+  print " * Reading information from lockfile: " . $server_lockfile_path . "\n" if ($debug);
+  open(SLFH, "<" , $server_lockfile_path) or die("Error! Failed to open file for reading: " . $server_lockfile_path . "\nReason: " . $! . "\n");
+  flock(SLFH, LOCK_SH) or die("Error! Cannot lock file for reading: " . $server_lockfile_path . "\nReason: " . $! . "\n");
+  # read communications port
+  my $raw_information = <SLFH>;
+  if ($raw_information =~ /(.+):(\d+)/)
+  {
+    my $host = $1;
+    my $port = $2;
+    # We now create a client that can connect to the specified port
+    if ($debug)
+    {
+      print " * Creating Client and connecting to " . $host . ":" . $port . "...\n";
+    }
+    $self->{'tdb_client_handle'} = SocketsSwimmingThreadPoolClient->new(host=>$host, port=>$port, firstcaller=>$we_started_server);
+  }
+  else
+  {
+    die("Error! Failed to determine host and port number from lockfile: " . $raw_information);
+  }
+  # Done
+  flock(SLFH, LOCK_UN);
+  close(SLFH);
+
+  return bless $self, $class;
+}
+
+# @note command calls don't need a database to work
+sub addListener
+{
+  my ($self, $suffix) = @_;
+  my $command = '#a:' . $$;
+  if (defined $suffix)
+  {
+    $command .= $suffix;
+  }
+  print " * add listener: " . $command . "\n" if ($debug);
+  $self->{'tdb_client_handle'}->query($command);
+  return 1;
+}
+
+# @note command calls don't need a database to work
+sub removeListener
+{
+  my ($self, $suffix) = @_;
+  my $command = '#r:' . $$;
+  if (defined $suffix)
+  {
+    $command .= $suffix;
+  }
+  print " * remove listener: " . $command . "\n" if ($debug);
+  $self->{'tdb_client_handle'}->query($command);
+  return 1;
+}
+
+sub stopServer
+{
+  my ($self, $suffix) = @_;
+  my $command = '#q:' . $$;
+  if (defined $suffix)
+  {
+    $command .= $suffix;
+  }
+  print " * stop server: " . $command . "\n" if ($debug);
+  $self->{'tdb_client_handle'}->query($command);
+  return 1;
+}
+
+sub query
+{
+  my ($self, $query) = @_;
+  # Append the indicator of the database to edit on the front
+  if ($query !~ /^#/)
+  {
+    $query = $self->{'database'} . ':' . $query;
+  }
+  print " * sending query [" . length($query) . " characters]\n" if ($debug);
+  return $self->{'tdb_client_handle'}->query($query);
+}
+
+1;
Index: gs2-extensions/tdb/trunk/perllib/dbutil.pm
===================================================================
--- gs2-extensions/tdb/trunk/perllib/dbutil.pm	(revision 30177)
+++ gs2-extensions/tdb/trunk/perllib/dbutil.pm	(revision 30177)
@@ -0,0 +1,392 @@
+###########################################################################
+#
+# dbutil.pm -- gateway to utilities for reading/writing to different databases
+#
+# Copyright (C) 2008 DL Consulting Ltd
+#
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the
+# University of Waikato, New Zealand.
+#
+# 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 dbutil;
+
+use strict;
+
+use Symbol qw<qualify>;
+use util;
+
+# /** Dynamic class loading - for use in DBUtils to load various database
+#  *  drivers, configured in the collect.cfg, at runtime.
+#  *  @param $class - The class name (including any path) to load
+#  *  @param rest - any function aliases you want exported
+#  */
+sub load_db_driver
+{
+  my $class = shift(@_);
+  (my $file = "$class.pm") =~ s|::|/|g;
+  # - ensure we haven't already loaded this class
+  unless( $INC{$file} )
+  {
+    # - require is fine being assigned at runtime - no need for evil eval
+    #eval
+    #{
+    require $file;
+    #};
+  }
+  # - this is the magic that actually instantiates the class (rubberstamp?)
+  # - we pass @_ to action any function aliases exports requested
+  eval
+  {
+    $class->import(@_);
+  };
+  # - by now the driver file should have been loaded
+  return (defined $INC{$file});
+}
+# /** load_db_driver() **/
+
+# /** Make a function call to a dynamically loaded database driver.
+#  *  @param $function_name
+#  *  @param $driver_name
+#  *  @param <rest> The parameters to be passed to the function called
+#  */
+sub call_dynamic_driver_function
+{
+  my $function_name = shift(@_);
+  my $driver_name = shift(@_);
+  my $package_name = 'dbutil::' . $driver_name;
+  # - try to load the requested infodb type
+  if (!&load_db_driver($package_name))
+  {
+    # - try loading the default GDBM driver
+    print STDERR 'Warning! Using default database driver (GDBM) as failed to load configured database driver: ' . $driver_name . "\n";
+    $package_name = 'dbutil::gdbm';
+    if (!&load_db_driver($package_name))
+    {
+      die("Fatal Error! Failed to load default database driver: dbutil::gdbm\n");
+    }
+  }
+  # - make call to the newly created package
+  no strict;
+  # - lets check that the function we are about to call
+  my $symbol = qualify($function_name, $package_name);
+  unless ( defined &{$symbol} )
+  {
+    die ('Error! Function not found: ' . $package_name . '::' . $function_name . "()\n");
+  }
+  return &{$symbol}(@_);
+}
+# /** call_dynamic_driver_function() **/
+
+
+## @function test_dynamic_driver_function()
+#
+# Checks to see if a function in a dynamically loaded driver exists
+#
+sub test_dynamic_driver_function
+{
+  my $function_name = shift(@_);
+  my $driver_name = shift(@_);
+  my $package_name = 'dbutil::' . $driver_name;
+  # - try to load the requested infodb type
+  if (!&load_db_driver($package_name))
+  {
+    # - try loading the default GDBM driver
+    print STDERR 'Warning! Using default database driver (GDBM) as failed to load configured database driver: ' . $driver_name . "\n";
+    $package_name = 'dbutil::gdbm';
+    if (!&load_db_driver($package_name))
+    {
+      die("Fatal Error! Failed to load default database driver: dbutil::gdbm\n");
+    }
+  }
+  # - make call to the newly created package
+  no strict;
+  # - lets check that the function we are about to call
+  my $symbol = qualify($function_name, $package_name);
+  return defined &{$symbol};
+}
+## test_dynamic_driver_function() ##
+
+
+## @function
+#
+sub open_infodb_write_handle
+{
+  my $infodb_type = shift(@_);
+  my $infodb_file_path = shift(@_);
+  # Make a call to the dynamically loaded driver to open the connection.
+  return &dbutil::call_dynamic_driver_function('open_infodb_write_handle', $infodb_type, $infodb_file_path, @_);
+}
+
+
+sub close_infodb_write_handle
+{
+  my $infodb_type = shift(@_);
+  my $infodb_handle = shift(@_);
+  # Dynamic database driver call
+  return &dbutil::call_dynamic_driver_function('close_infodb_write_handle', $infodb_type, $infodb_handle, @_);
+}
+
+
+sub get_default_infodb_type
+{
+  # The default is GDBM so everything works the same for existing collections
+  # To use something else, specify the "infodbtype" in the collection's collect.cfg file
+  return "gdbm";
+}
+
+# /** @function get_infodb_file_path()
+#  * Warning! Black magic follows. The first time get_infodb_file_path is
+#  * called (presumably from inexport::process_files()) for databases of type
+#  * server will actually the Server to be run complete with an initial dummy
+#  * listener. This is done so that, in parallel importing, the server will
+#  * persist until the top level import.pl (which will be the first that calls
+#  * this function) completes and removes the dummy listener. [jmt12]
+sub get_infodb_file_path
+{
+  my $infodb_type = shift(@_);
+  my $collection_name = shift(@_);
+  my $infodb_directory_path = shift(@_);
+
+  #=======================================MSSQL SUPPORT==============================================#
+  # Updated by Jeffrey (2008/08/25 Monday)
+  # After look into the run-time code, it seems we should still create a database file.
+  # Since the run-time code is always try to read a database file, the easiest way here is not
+  # to change the whole structure, but to give whatever the system is looking for.
+  #==================================================================================================#
+  # Added by Jeffrey (2008/08/15 Friday)
+  # No file path required for MS SQL, it is a server-client connection.
+  # At the moment the information is hard coded in dbutil::mssql::open_infodb_write_handle
+  # the this might need some tidy up sometime.
+  #==================================================================================================#
+
+  return &dbutil::call_dynamic_driver_function('get_infodb_file_path', $infodb_type, $collection_name, $infodb_directory_path, @_);
+}
+
+# This function, conceptually, would be better structured if it didn't
+# use return statements, as the database methods it calls do not
+# themselves return anything.
+# Note: if doing this, then the GDBM lines of code should be moved into
+# an 'else' clause
+sub read_infodb_file
+{
+  my $infodb_type = shift(@_);
+  my $infodb_file_path = shift(@_);
+  my $infodb_map = shift(@_);
+
+  return &dbutil::call_dynamic_driver_function('read_infodb_file', $infodb_type, $infodb_file_path, $infodb_map, @_);
+}
+
+sub read_infodb_keys
+{
+    my $infodb_type = shift(@_);
+    my $infodb_file_path = shift(@_);
+    my $infodb_map = shift(@_);
+
+    return &dbutil::call_dynamic_driver_function('read_infodb_keys', $infodb_type, $infodb_file_path, $infodb_map, @_);
+}
+
+
+## @function supportDatestamp
+#
+sub supportsDatestamp
+{
+  my $infodb_type = shift(@_);
+  return &dbutil::test_dynamic_driver_function('supportsDatestamp', $infodb_type);
+}
+## supportsDatestamp() ##
+
+
+## @function supportsMerge
+#
+sub supportsMerge
+{
+  my $infodb_type = shift(@_);
+  return &dbutil::test_dynamic_driver_function('merge_databases', $infodb_type);
+}
+## supportsMerge() ##
+
+
+## @function supportRSS
+#
+sub supportsRSS
+{
+  my $infodb_type = shift(@_);
+  return &dbutil::test_dynamic_driver_function('supportsRSS', $infodb_type);
+}
+## supportsRSS() ##
+
+
+sub write_infodb_entry
+{
+  my $infodb_type = shift(@_);
+  my $infodb_handle = shift(@_);
+  my $infodb_key = shift(@_);
+  my $infodb_map = shift(@_);
+
+  return &dbutil::call_dynamic_driver_function('write_infodb_entry', $infodb_type, $infodb_handle, $infodb_key, $infodb_map, @_);
+}
+
+
+sub write_infodb_rawentry
+{
+  my $infodb_type = shift(@_);
+  my $infodb_handle = shift(@_);
+  my $infodb_key = shift(@_);
+  my $infodb_val = shift(@_);
+
+  return &dbutil::call_dynamic_driver_function('write_infodb_rawentry', $infodb_type, $infodb_handle, $infodb_key, $infodb_val, @_);
+}
+
+
+sub set_infodb_entry
+{
+  my $infodb_type = shift(@_);
+  my $infodb_file_path = shift(@_);
+  my $infodb_key = shift(@_);
+  my $infodb_map = shift(@_);
+
+  return &dbutil::call_dynamic_driver_function('set_infodb_entry', $infodb_type, $infodb_file_path, $infodb_key, $infodb_map, @_);
+}
+
+
+
+sub delete_infodb_entry
+{
+  my $infodb_type = shift(@_);
+  my $infodb_handle = shift(@_);
+  my $infodb_key = shift(@_);
+
+  return &dbutil::call_dynamic_driver_function('delete_infodb_entry', $infodb_type, $infodb_handle, $infodb_key, @_);
+}
+
+sub read_infodb_rawentry
+{
+  my $infodb_type = shift(@_);
+  my $infodb_file_path = shift(@_);
+  my $infodb_key = shift(@_);
+
+  # !! TEMPORARY: Slow and naive implementation that just reads the entire file and picks out the one value
+  # !! This will one day be replaced with database-specific versions that will use dbget etc.
+  my $infodb_map = {};
+  &read_infodb_file($infodb_type, $infodb_file_path, $infodb_map);
+
+  return $infodb_map->{$infodb_key};
+}
+
+
+sub read_infodb_entry
+{
+  my $infodb_type = shift(@_);
+  my $infodb_file_path = shift(@_);
+  my $infodb_key = shift(@_);
+
+  if ($infodb_type eq "sqlite")
+  {
+    require dbutil::sqlite;
+    return &dbutil::sqlite::read_infodb_entry($infodb_file_path, $infodb_key, @_);
+  }
+#  elsif ($infodb_type eq "gdbm-txtgz")
+#  {
+#    require dbutil::gdbmtxtgz;
+#    return &dbutil::gdbmtxtgz::read_infodb_entry($infodb_file_path, $infodb_key, @_);
+#  }
+#  elsif ($infodb_type eq "jdbm")
+#  {
+#    require dbutil::jdbm;
+#    return &dbutil::jdbm::read_infodb_entry($infodb_file_path, $infodb_key, @_);
+#  }
+#  elsif ($infodb_type eq "mssql")
+#  {
+#    require dbutil::mssql;
+#    return &dbutil::mssql::read_infodb_entry($infodb_file_path, $infodb_key, @_);
+#  }
+  
+#  # Use GDBM if the infodb type is empty or not one of the values above
+#  require dbutil::gdbm;
+#  return &dbutil::gdbm::read_infodb_entry($infodb_file_path, $infodb_key, @_);
+  
+  
+  # rawentry above is currently naive implementation
+  my $raw_string = read_infodb_rawentry($infodb_type, $infodb_file_path, $infodb_key);
+  my $infodb_rec = &dbutil::convert_infodb_string_to_hash($raw_string); 
+  
+  return $infodb_rec;
+}
+
+
+## @function
+#
+sub merge_databases
+{
+  my $infodb_type = shift(@_);
+  # Make a call to the dynamically loaded driver to open the connection.
+  return &dbutil::call_dynamic_driver_function('merge_databases', $infodb_type, @_);
+}
+##
+
+
+# ---- GENERAL FUNCTIONS --------
+
+sub convert_infodb_hash_to_string
+{
+  my $infodb_map = shift(@_);
+
+  my $infodb_entry_value = "";
+  foreach my $infodb_value_key (keys(%$infodb_map))
+  {
+    foreach my $infodb_value (@{$infodb_map->{$infodb_value_key}})
+    {
+      $infodb_entry_value .= "<$infodb_value_key>" . $infodb_value . "\n";
+    }
+  }
+
+  return $infodb_entry_value;
+}
+
+
+sub convert_infodb_string_to_hash
+{
+  my $infodb_entry_value = shift(@_);
+  my $infodb_map = ();
+  
+  if (!defined $infodb_entry_value) {
+	print STDERR "Warning: No value to convert into a infodb hashtable\n";
+  }
+  else {
+    while ($infodb_entry_value =~ /^<(.*?)>(.*)$/mg)
+    {
+        my $infodb_value_key = $1;
+		my $infodb_value = $2;
+
+		if (!defined($infodb_map->{$infodb_value_key}))
+		{
+		  $infodb_map->{$infodb_value_key} = [ $infodb_value ];
+		}
+		else
+		{
+		  push(@{$infodb_map->{$infodb_value_key}}, $infodb_value);
+		}
+	}
+  }
+
+  return $infodb_map;
+}
+
+
+1;
Index: gs2-extensions/tdb/trunk/perllib/dbutil/tdb.pm
===================================================================
--- gs2-extensions/tdb/trunk/perllib/dbutil/tdb.pm	(revision 30177)
+++ gs2-extensions/tdb/trunk/perllib/dbutil/tdb.pm	(revision 30177)
@@ -0,0 +1,286 @@
+###########################################################################
+#
+# dbutil::tdb -- utility functions for writing to tdb databases. Should be
+#                hauntingly similar to GDBM utility functions.
+#
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 2011
+#
+# 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 dbutil::tdb;
+
+# Pragma
+use strict;
+
+# Libraries/Modules
+use Cwd;
+use dbutil::gdbmtxtgz;
+
+# -----------------------------------------------------------------------------
+#   TDB IMPLEMENTATION
+# -----------------------------------------------------------------------------
+
+our %handle_pool;
+
+END {
+  # Close any handles left open in the pool
+  foreach my $pool_key (keys %handle_pool)
+  {
+    my $infodb_file_handle = $handle_pool{$pool_key};
+    close_infodb_write_handle($infodb_file_handle, 1);
+  }
+}
+
+# /**
+#  */
+sub get_tdb_executable
+{
+  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() **/
+
+
+
+# /**
+#  */
+sub open_infodb_write_handle
+{
+  my $infodb_file_path = shift(@_);
+  my $opt_append = shift(@_);
+
+  my $txt2tdb_exe = &dbutil::tdb::get_tdb_executable('txt2tdb');
+
+  my $pool_key = $infodb_file_path;
+  #my $cmd = "taskset -c 5 \"$txt2tdb_exe\"";
+  my $cmd = "\"$txt2tdb_exe\"";
+  if ((defined $opt_append) && ($opt_append eq "append"))
+  {
+    $cmd .= " -append";
+    $pool_key .= '-append';
+  }
+  $cmd .= " \"$infodb_file_path\"";
+  #$cmd .= " -debug"; # Uncomment to enable debug timing
+
+  # we're going to pipe the key value pairs, in the appropriate format, from
+  # within the buildproc, so we create a piped handle here
+  my $infodb_file_handle = undef;
+  if (defined $handle_pool{$pool_key})
+  {
+    $infodb_file_handle = $handle_pool{$pool_key};
+  }
+  else
+  {
+    print STDERR "tdb::open_infodb_write_handle(" . $infodb_file_path . ")\n";
+    if(!open($infodb_file_handle, "| $cmd"))
+    {
+      print STDERR "Error: Failed to open pipe to $cmd\n";
+      print STDERR "       $!\n";
+      return undef;
+    }
+    binmode($infodb_file_handle,":utf8");
+    $handle_pool{$pool_key} = $infodb_file_handle;
+  }
+  return $infodb_file_handle;
+}
+# /** open_infodb_write_handle() **/
+
+# /**
+#  */
+sub close_infodb_write_handle
+{
+  my $infodb_handle = shift(@_);
+  my ($empty_pool) = @_;
+  if (defined $empty_pool && $empty_pool == 1)
+  {
+    print STDERR "tdb::close_infodb_write_handle()\n";
+    close($infodb_handle);
+  }
+}
+# /** close_infodb_write_handle() **/
+
+# /**
+#  */
+sub get_infodb_file_path
+{
+  my $collection_name = shift(@_);
+  my $infodb_directory_path = shift(@_);
+
+  my $infodb_file_extension = ".tdb";
+  my $infodb_file_name = &util::get_dirsep_tail($collection_name) . $infodb_file_extension;
+
+  return &util::filename_cat($infodb_directory_path, $infodb_file_name);
+}
+# /** get_infodb_file_path() **/
+
+# /**
+#  */
+sub read_infodb_file
+{
+  my $infodb_file_path = shift(@_);
+  my $infodb_map = shift(@_);
+
+  my $tdb2txt_exe = &dbutil::tdb::get_tdb_executable('tdb2txt');
+
+  if (!open (PIPEIN, "\"$tdb2txt_exe\" \"$infodb_file_path\" |"))
+  {
+    print STDERR 'Error: Failed to open pipe to ' . $tdb2txt_exe . "\n";
+    print STDERR "       $!\n";
+    return undef;
+  }
+
+  binmode(PIPEIN,":utf8");
+
+  my $infodb_line = "";
+  my $infodb_key = "";
+  my $infodb_value = "";
+  while (defined ($infodb_line = <PIPEIN>))
+  {
+    if ($infodb_line =~ /^\[([^\]]+)\]$/)
+    {
+      $infodb_key = $1;
+    }
+    elsif ($infodb_line =~ /^-{70}$/)
+    {
+      $infodb_map->{$infodb_key} = $infodb_value;
+      $infodb_key = "";
+      $infodb_value = "";
+    }
+    else
+    {
+      $infodb_value .= $infodb_line;
+    }
+  }
+
+  close (PIPEIN);
+}
+# /** read_infodb_file() **/
+
+# /**
+#  */
+sub read_infodb_keys
+{
+  my $infodb_file_path = shift(@_);
+  my $infodb_map = shift(@_);
+
+  my $tdbkeys_exe = &dbutil::tdb::get_tdb_executable('tdbkeys');
+
+  if (!open (PIPEIN, "\"tdbkeys_exe\" \"$infodb_file_path\" |"))
+  {
+    die "couldn't open pipe from gdbmkeys \$infodb_file_path\"\n$!\n";
+  }
+
+  binmode(PIPEIN,":utf8");
+
+  my $infodb_line = "";
+  my $infodb_key = "";
+  my $infodb_value = "";
+  while (defined ($infodb_line = <PIPEIN>))
+  {
+    # remove end of line
+    chomp $infodb_line;
+
+    $infodb_map->{$infodb_line} = 1;
+  }
+
+  close (PIPEIN);
+}
+# /** read_infodb_keys() **/
+
+# /**
+#  */
+sub write_infodb_entry
+{
+  # With infodb_handle already set up, works the same as gdbm and gdbm_txtgz
+  # versions
+  &dbutil::gdbmtxtgz::write_infodb_entry(@_);
+}
+# /** write_infodb_entry() **/
+
+# /**
+#  */
+sub write_infodb_rawentry
+{
+  # With infodb_handle already set up, works the same as gdbm and gdbm_txtgz
+  # versions
+  &dbutil::gdbmtxtgz::write_infodb_rawentry(@_);
+}
+# /** write_infodb_rawentry() **/
+
+# /**
+#  */
+sub set_infodb_entry
+{
+  my $infodb_file_path = shift(@_);
+  my $infodb_key = shift(@_);
+  my $infodb_map = shift(@_);
+
+  # Protect metadata values that go inside quotes for tdbset
+  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
+  my $serialized_infodb_map = &dbutil::convert_infodb_hash_to_string($infodb_map);
+  ## print STDERR "**** ser dr\n$serialized_infodb_map\n\n\n";
+
+  # Store it into GDBM
+  my $tdbset_exe = &dbutil::tdb::get_tdb_executable('tdbset');
+  my $cmd = "\"tdbset_exe\" \"$infodb_file_path\" \"$infodb_key\" \"$serialized_infodb_map\"";
+  my $status = system($cmd);
+
+  return $status;
+}
+# /** set_infodb_entry() **/
+
+# /**
+#  */
+sub delete_infodb_entry
+{
+  # With infodb_handle already set up, works the same as gdbm and gdbm_txtgz
+  # versions
+  &dbutil::gdbmtxtgz::delete_infodb_entry(@_);
+}
+# /** delete_infodb_entry() **/
+
+1;
Index: gs2-extensions/tdb/trunk/perllib/dbutil/tdbserver.pm
===================================================================
--- gs2-extensions/tdb/trunk/perllib/dbutil/tdbserver.pm	(revision 30177)
+++ gs2-extensions/tdb/trunk/perllib/dbutil/tdbserver.pm	(revision 30177)
@@ -0,0 +1,413 @@
+###########################################################################
+#
+# dbutil::tdbserver -- utility functions for writing to tdb 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) 2012
+#
+# 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 dbutil::tdbserver;
+
+# Pragma
+use strict;
+use warnings;
+
+# Modules
+# - 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);
+# - we'll also need to wait around for an indeterminate amount of time for the
+#   TDBServer to exit (detected by its lockfile disappearing)
+use Time::HiRes  qw( gettimeofday tv_interval usleep );
+
+# Greenstone modules
+use TDBClient;
+use util;
+
+my $hyphen70 = '-' x 70;
+my $debug = 0;
+
+# We have a global reference to all of the TDB Server lockfiles that this
+# instance has created (as we'll be responsible for closing them)
+my %created_server_lockfile_paths;
+# Keep track of the lockfiles for server we have added ourselves as listeners
+# to.
+my %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.
+my %registered_listeners;
+
+sub _spawnClient
+{
+  my ($infodb_file_path) = @_;
+  # 1. Check whether the server is already running by trying to locate the
+  #    server 'lock' file.
+
+  my ($collection) = $infodb_file_path =~ /collect[\\\/]([^\\\/]+)/i;
+  my ($infodb_file, $extension) = $infodb_file_path =~ /([^\\\/]+)\.(t?db)/i;
+
+  my $tmp_dir = &util::filename_cat($ENV{'GSDLHOME'},'tmp');
+  if (!-d $tmp_dir)
+  {
+    mkdir($tmp_dir, 0755);
+  }
+
+  my $we_started_server = 0;
+  my $server_lockfile_path =  &util::filename_cat($ENV{'GSDLHOME'},'collect',$collection,'tmp','tdbserver.lock');
+  print " * Searching for TDBServer lockfile...\n" if ($debug);
+  if (!-e $server_lockfile_path)
+  {
+    print "Not found.\n" if ($debug);
+    # We need to lock here to ensure only one thread enters the following code,
+    # sees a missing TDBServer, and launches it
+    my $tmp_lockfile_path = &util::filename_cat($ENV{'GSDLHOME'},'tmp','dbutil-tdbserver.lock');
+    open(TMPFH, '>', $tmp_lockfile_path) or die("Warning! 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 still doesn't exist...
+    if (!-e $server_lockfile_path)
+    {
+      $we_started_server = 1;
+      # ...start it!
+      my $launch_cmd = 'TDBServer.pl "' . $$ . '" "' . $collection . '"';
+      print "* Starting TDBServer for: " . $collection . " [" . $launch_cmd . "]...\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;
+      autoflush STDOUT 1;
+      print "* Waiting for TDBServer to start";
+      my $server_host = '';
+      my $server_port = '';
+      while ($line = <SERVERIN>)
+      {
+        print ".";
+        # - watch for the line indicating a lock file has been created and
+        #   populated with a sexy port number
+        if ($line =~ /Server now listening on ([^:]+):(\d+)/)
+        {
+          $server_host = $1;
+          $server_port = $2;
+          $server_lock_file_created = 1;
+        }
+        # - we could also watch for errors here
+        if ($debug)
+        {
+          if ($line !~ /\n/)
+          {
+            $line .= "\n";
+          }
+          $|++; # autoflush
+          print "[tdbserver] $line";
+          $|--; # disable autoflush
+        }
+      }
+      close(SERVERIN);
+      print "\n";
+      if (!$server_lock_file_created)
+      {
+        die("Error! TDBServer failed to create lock file. Check server logs.");
+      }
+      elsif ($debug)
+      {
+        print "* Server now running on " . $server_host . ":" . $server_port . "\n";
+      }
+      # record this for later
+      $created_server_lockfile_paths{$server_lockfile_path} = 1;
+    }
+    flock(TMPFH, LOCK_UN);
+    close($tmp_lockfile_path);
+    unlink($tmp_lockfile_path);
+  }
+  else
+  {
+    print "Found!\n" if ($debug);
+  }
+  # record this for later
+  $listener_server_lockfile_paths{$server_lockfile_path} = $infodb_file_path;
+  return TDBClient->new($server_lockfile_path, $infodb_file, $we_started_server);
+}
+
+END
+{
+  # 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 (%listener_server_lockfile_paths))
+  {
+    my $infodb_file_path = $listener_server_lockfile_paths{$server_lockfile_path};
+    my $tdb_client_handle = TDBClient->new($server_lockfile_path, '');
+    # Deregister all of our registered listeners
+    foreach my $listener_suffix (keys(%registered_listeners))
+    {
+      $tdb_client_handle->removeListener($listener_suffix);
+    }
+    # ask the servers we created to shut down (all other threads will have
+    # this request ignored)
+    if (defined $created_server_lockfile_paths{$infodb_file_path})
+    {
+      print "* Attempting to stop TDBServer for: " . $infodb_file_path . "\n";
+    }
+    $tdb_client_handle->stopServer();
+  }
+  # 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). (Subsequent testing shows it
+  # won't - a new Greenstone build can't start until the previous lockfile is
+  # removed - but I think, for ATOMic sake, I may as well make waiting a part
+  # of the Greenstone import/build time.
+  my $wait_for_exit = 1;
+  foreach my $server_lockfile_path (keys (%created_server_lockfile_paths))
+  {
+    my $shutdown_start;
+    my $shutdown_end;
+    if ($wait_for_exit)
+    {
+      # While the file exists, we should wait
+      autoflush STDOUT 1;
+      my $blurb = '';
+      if ($debug)
+      {
+        $blurb = '[' . $server_lockfile_path . ']';
+      }
+      print '* Waiting for TDBServer to exit... ';
+      $shutdown_start = [&gettimeofday()];
+      if (-e $server_lockfile_path)
+      {
+        while (-e $server_lockfile_path)
+        {
+          usleep(10000);
+        }
+      }
+      $shutdown_end = [&gettimeofday()];
+    }
+    else
+    {
+      print '* NOT Waiting for TDBServer to exit... ';
+    }
+    if (defined $shutdown_start)
+    {
+      my $duration = tv_interval($shutdown_start, $shutdown_end);
+      print sprintf(" Done (in %0.6f seconds)!\n", $duration);
+    }
+    else
+    {
+      print " Done!\n";
+    }
+  }
+}
+
+# -----------------------------------------------------------------------------
+#   TDB SERVER IMPLEMENTATION
+# -----------------------------------------------------------------------------
+sub open_infodb_write_handle
+{
+  my $infodb_file_path = shift(@_);
+  my $opt_append = shift(@_);
+  if (defined $opt_append && $opt_append ne "append")
+  {
+    print "Warning! Modes other than 'append' not supported for TDBServer.\n";
+  }
+  my $tdb_client_handle = &_spawnClient($infodb_file_path);
+  # Register this client on the server if necessary
+  $tdb_client_handle->addListener('w');
+  $registered_listeners{'w'} = 1;
+  # and pass the handle to client around
+  return $tdb_client_handle;
+}
+
+# /** Destructor or near enough.
+#  /*
+sub close_infodb_write_handle
+{
+  my $tdb_client_handle = shift(@_);
+  # @todo Is there meant to be something here?
+}
+# /** close_infodb_write_handle($infodb_handle) **/
+
+# /** @function get_info_db_file_path
+#  *  Exactly the same as vanilla TDB - as we are still using a TDB database
+#  *  just accessing it via a persistant server
+#  */
+sub get_infodb_file_path
+{
+  my $collection_name = shift(@_);
+  my $infodb_directory_path = shift(@_);
+  my $create_server = shift(@_);
+
+  my $infodb_file_extension = ".tdb";
+  my $infodb_file_name = &util::get_dirsep_tail($collection_name) . $infodb_file_extension;
+  my $infodb_file_path = &util::filename_cat($infodb_directory_path, $infodb_file_name);
+
+  # Special Case for TDBServer
+  if (defined $create_server && $create_server == 1)
+  {
+    my $tdb_client_handle = &_spawnClient($infodb_file_path);
+    # Register this client on the server if necessary
+    $tdb_client_handle->addListener('i');
+    $registered_listeners{'i'} = 1;
+  }
+
+  # Resuming our regular programming
+  return $infodb_file_path;
+}
+
+sub read_infodb_file
+{
+  my $infodb_file_path = shift(@_);
+  my $infodb_map = shift(@_);
+
+  my $tdb_client_handle = &_spawnClient($infodb_file_path);
+  $tdb_client_handle->addListener('r');
+  $registered_listeners{'r'} = 1;
+  # retrieves all the keys in the form:
+  # [key1]\n[key2]\n[key3]\n...[keyn]
+  my $raw_infodb_keys = $tdb_client_handle->query('[*]?');
+
+  my @infodb_keys = split(/\r?\n/, $raw_infodb_keys);
+  foreach my $infodb_key (@infodb_keys)
+  {
+    if ($infodb_key =~ /.+/ && $infodb_key !~ /-{70}/)
+    {
+      # lookup each key
+      my $infodb_value = $tdb_client_handle->query('[' . $infodb_key . ']?');
+      # store it
+      $infodb_map->{$infodb_key} = $infodb_value;
+    }
+  }
+}
+
+sub read_infodb_keys
+{
+  my $infodb_file_path = shift(@_);
+  my $infodb_map = shift(@_);
+
+  # spawn client (creating server as necessary)
+  my $tdb_client_handle = &_spawnClient($infodb_file_path);
+  # register ourself as listener
+  $tdb_client_handle->addListener('k');
+  $registered_listeners{'k'} = 1;
+  # retrieves all the keys in the form:
+  # [key1]\n[key2]\n[key3]\n...[keyn]
+  my $raw_infodb_keys = $tdb_client_handle->query('[*]?');
+  my @infodb_keys = split(/\r?\n/, $raw_infodb_keys);
+  foreach my $infodb_key (@infodb_keys)
+  {
+    if ($infodb_key =~ /.+/ && $infodb_key !~ /-{70}/)
+    {
+      $infodb_map->{$infodb_key} = 1;
+    }
+  }
+}
+
+sub write_infodb_entry
+{
+  my $tdb_client_handle = shift(@_);
+  my $infodb_key = shift(@_);
+  my $infodb_map = shift(@_);
+  # - build up the tdb command
+  my $tdb_command = "[" . $infodb_key . "]+\n";
+  foreach my $infodb_value_key (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;
+      }
+      $tdb_command .= "<" . $infodb_value_key . ">" . $infodb_value . "\n";
+    }
+  }
+  $tdb_command .= $hyphen70 . "\n";
+  # - ask the client to transmit the command to the server
+  $tdb_client_handle->query($tdb_command);
+}
+
+sub write_infodb_rawentry
+{
+  my $tdb_client_handle = shift(@_);
+  my $infodb_key = shift(@_);
+  my $infodb_val = shift(@_);
+  # - build up the tdb command
+  my $tdb_command = "[" . $infodb_key . "]\n";
+  $tdb_command .= $infodb_val . "\n";
+  $tdb_command .= $hyphen70 . "\n";
+  # - ask the client to transmit the command to the server
+  $tdb_client_handle->query($tdb_command);
+  return 1;
+}
+
+sub set_infodb_entry
+{
+  my $infodb_file_path = shift(@_);
+  my $infodb_key = shift(@_);
+  my $infodb_map = shift(@_);
+  # spawn client (creating server as necessary)
+  my $tdb_client_handle = &_spawnClient($infodb_file_path);
+  $tdb_client_handle->addListener('s');
+  $registered_listeners{'s'} = 1;
+  # Protect metadata values that go inside quotes for tdbset
+  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 (TDB command)
+  my $tdb_command = "[" . $infodb_key . "]\n";
+  $tdb_command .= &dbutil::convert_infodb_hash_to_string($infodb_map) . "\n";
+  $tdb_command .= $hyphen70 . "\n";
+  # Send command to server
+  $tdb_client_handle->query($tdb_command);
+}
+
+sub delete_infodb_entry
+{
+  my $tdb_client_handle = shift(@_);
+  my $infodb_key = shift(@_);
+  # - create command
+  my $tdb_command = "[" . $infodb_key . "]-\n";
+  # - and send
+  $tdb_client_handle->query($tdb_command);
+}
+
+
+
+1;
