source: gs2-extensions/parallel-building/trunk/src/perllib/GDBMClient.pm@ 27279

#!/usr/bin/perl

# @note Each client represents one database on the server. Whlie the server may
#       be managing multiple databases, this client references a specific one
#       using it's index number whenever GDBM queries are sent. Special
#       commands, however, do not need a database index to work.

package GDBMClient;

# 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) = @_;
  my $self = {};

  # - 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->{'gdbm_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) = @_;
  print " * add listener: " . $$ . $suffix . "\n" if ($debug);
  my $command = '!addlistener:' . $$;
  if (defined $suffix)
  {
    $command .= $suffix;
  }
  $self->{'gdbm_client_handle'}->query($command);
  return 1;
}

# @note command calls don't need a database to work
sub removeListener
{
  my ($self, $suffix) = @_;
  print " * remove listener: " . $$ . $suffix . "\n" if ($debug);
  my $command = '!removelistener:' . $$;
  if (defined $suffix)
  {
    $command .= $suffix;
  }
  $self->{'gdbm_client_handle'}->query($command);
  return 1;
}

sub query
{
  my ($self, $query) = @_;
  print " * sending query [" . length($query) . " characters]\n" if ($debug);
  return $self->{'gdbm_client_handle'}->query($query);
}

1;