Index: gs2-extensions/tdb-edit/trunk/src/perllib/SocketsSwimmingThreadPoolClient.pm
===================================================================
--- gs2-extensions/tdb-edit/trunk/src/perllib/SocketsSwimmingThreadPoolClient.pm	(revision 25410)
+++ gs2-extensions/tdb-edit/trunk/src/perllib/SocketsSwimmingThreadPoolClient.pm	(revision 25410)
@@ -0,0 +1,92 @@
+# @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_time = 30;
+
+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 30 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(1)
+  {
+    my $socket= new IO::Socket::INET(PeerAddr => $self->{host} || 'localhost',
+                                     PeerPort => $self->{port} || 8190,
+                                     Proto => 'tcp');
+    if ($socket)
+    {
+      return $socket;
+    }
+    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";
+  }
+}
+
+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-edit/trunk/src/perllib/SocketsSwimmingThreadPoolServer.pm
===================================================================
--- gs2-extensions/tdb-edit/trunk/src/perllib/SocketsSwimmingThreadPoolServer.pm	(revision 25410)
+++ gs2-extensions/tdb-edit/trunk/src/perllib/SocketsSwimmingThreadPoolServer.pm	(revision 25410)
@@ -0,0 +1,172 @@
+# @author Donnie Cameron (macnod)
+# @url    https://github.com/macnod/DcServer
+# @readme http://donnieknows.com/blog/perl-sockets-swimming-thread-pool
+
+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} || 5,
+    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 = new IO::Socket::INET(%{$self->{socket_defaults}}, Proto => 'tcp', Listen => 1, Reuse => 1);
+  die "Can't create listerner socket. Server can't start. $!." unless $lsocket;
+  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 reqeuests 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-edit/trunk/src/perllib/TDBClient.pm
===================================================================
--- gs2-extensions/tdb-edit/trunk/src/perllib/TDBClient.pm	(revision 25410)
+++ gs2-extensions/tdb-edit/trunk/src/perllib/TDBClient.pm	(revision 25410)
@@ -0,0 +1,115 @@
+#!/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) = @_;
+  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
+    print " * Creating Client and connecting to " . $host . ":" . $port . "...\n" if ($debug);
+    $self->{'tdb_client_handle'} = SocketsSwimmingThreadPoolClient->new(host=>$host,port=>$port);
+  }
+  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-edit/trunk/src/perllib/dbutil/tdbserver.pm
===================================================================
--- gs2-extensions/tdb-edit/trunk/src/perllib/dbutil/tdbserver.pm	(revision 25410)
+++ gs2-extensions/tdb-edit/trunk/src/perllib/dbutil/tdbserver.pm	(revision 25410)
@@ -0,0 +1,357 @@
+###########################################################################
+#
+# 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;
+
+use strict;
+use warnings;
+
+# 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 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 $server_lockfile_path =  &util::filename_cat($ENV{'GSDLHOME'},'collect',$collection,'tmp','tdbserver.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 TDBServer, and launches it
+  my $tmp_lockfile_path = &util::filename_cat($ENV{'GSDLHOME'},'tmp','dbutil-tdbserver.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 (!-e $server_lockfile_path)
+  {
+    # ...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;
+    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 ($debug)
+      {
+        if ($line !~ /\n/)
+        {
+          $line .= "\n";
+        }
+        $|++; # autoflush
+        print "[tdbserver] $line";
+        $|--; # disable autoflush
+      }
+    }
+    close(SERVERIN);
+    if (!$server_lock_file_created)
+    {
+      die("Error! TDBServer failed to create lock file. Check server logs.");
+    }
+    # record this for later
+    $created_server_lockfile_paths{$server_lockfile_path} = 1;
+  }
+  flock(TMPFH, LOCK_UN);
+  close($tmp_lockfile_path);
+  unlink($tmp_lockfile_path);
+  # record this for later
+  $listener_server_lockfile_paths{$server_lockfile_path} = $infodb_file_path;
+  return TDBClient->new($server_lockfile_path, $infodb_file);
+}
+
+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).
+  foreach my $server_lockfile_path (keys (%created_server_lockfile_paths))
+  {
+    # While the file exists, we should wait
+    print "* Waiting for TDBServer [" . $server_lockfile_path . "] to exit...";
+    if (-e $server_lockfile_path)
+    {
+      while (-e $server_lockfile_path)
+      {
+        print ".";
+        sleep(1);
+      }
+    }
+    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;
