#!/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 = ; 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;