source: gs2-extensions/tdb-edit/trunk/src/perllib/TDBClient.pm@ 26992

#!/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 TDBClient and connecting to " . $host . ":" . $port . "...\n";
    $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;