[24670] | 1 | #!/usr/bin/perl
|
---|
| 2 |
|
---|
| 3 | # @note Each client represents one database on the server. Whlie the server may
|
---|
| 4 | # be managing multiple databases, this client references a specific one
|
---|
| 5 | # using it's index number whenever GDBM queries are sent. Special
|
---|
| 6 | # commands, however, do not need a database index to work.
|
---|
| 7 |
|
---|
| 8 | package GDBMClient;
|
---|
| 9 |
|
---|
| 10 | # We're going to have to delve into locking (a little) to prevent multiple
|
---|
| 11 | # threads trying to launch the server at once
|
---|
| 12 | use Fcntl qw(:flock);
|
---|
| 13 |
|
---|
| 14 | # A simple multithreaded, socketed, server.
|
---|
| 15 | use SocketsSwimmingThreadPoolClient;
|
---|
| 16 |
|
---|
| 17 | my $debug = 0;
|
---|
| 18 |
|
---|
| 19 | sub new
|
---|
| 20 | {
|
---|
| 21 | my ($class, $server_lockfile_path) = @_;
|
---|
| 22 | my $self = {};
|
---|
| 23 |
|
---|
| 24 | # - Now we wait until we can get a shared lock (after the exclusive
|
---|
| 25 | # lock above releases) and then read in the port number that connections
|
---|
| 26 | # to the server should be made on.
|
---|
| 27 | print " * Reading information from lockfile: " . $server_lockfile_path . "\n" if ($debug);
|
---|
| 28 | open(SLFH, "<" , $server_lockfile_path) or die("Error! Failed to open file for reading: " . $server_lockfile_path . "\nReason: " . $! . "\n");
|
---|
| 29 | flock(SLFH, LOCK_SH) or die("Error! Cannot lock file for reading: " . $server_lockfile_path . "\nReason: " . $! . "\n");
|
---|
| 30 | # read communications port
|
---|
| 31 | my $raw_information = <SLFH>;
|
---|
| 32 | if ($raw_information =~ /(.+):(\d+)/)
|
---|
| 33 | {
|
---|
| 34 | my $host = $1;
|
---|
| 35 | my $port = $2;
|
---|
| 36 | # We now create a client that can connect to the specified port
|
---|
| 37 | print " * Creating Client and connecting to " . $host . ":" . $port . "...\n" if ($debug);
|
---|
| 38 | $self->{'gdbm_client_handle'} = SocketsSwimmingThreadPoolClient->new(host=>$host,port=>$port);
|
---|
| 39 | }
|
---|
| 40 | else
|
---|
| 41 | {
|
---|
| 42 | die("Error! Failed to determine host and port number from lockfile: " . $raw_information);
|
---|
| 43 | }
|
---|
| 44 | # Done
|
---|
| 45 | flock(SLFH, LOCK_UN);
|
---|
| 46 | close(SLFH);
|
---|
| 47 |
|
---|
| 48 | return bless $self, $class;
|
---|
| 49 | }
|
---|
| 50 |
|
---|
| 51 | # @note command calls don't need a database to work
|
---|
| 52 | sub addListener
|
---|
| 53 | {
|
---|
| 54 | my ($self, $suffix) = @_;
|
---|
| 55 | print " * add listener: " . $$ . $suffix . "\n" if ($debug);
|
---|
| 56 | my $command = '!addlistener:' . $$;
|
---|
| 57 | if (defined $suffix)
|
---|
| 58 | {
|
---|
| 59 | $command .= $suffix;
|
---|
| 60 | }
|
---|
| 61 | $self->{'gdbm_client_handle'}->query($command);
|
---|
| 62 | return 1;
|
---|
| 63 | }
|
---|
| 64 |
|
---|
| 65 | # @note command calls don't need a database to work
|
---|
| 66 | sub removeListener
|
---|
| 67 | {
|
---|
| 68 | my ($self, $suffix) = @_;
|
---|
| 69 | print " * remove listener: " . $$ . $suffix . "\n" if ($debug);
|
---|
| 70 | my $command = '!removelistener:' . $$;
|
---|
| 71 | if (defined $suffix)
|
---|
| 72 | {
|
---|
| 73 | $command .= $suffix;
|
---|
| 74 | }
|
---|
| 75 | $self->{'gdbm_client_handle'}->query($command);
|
---|
| 76 | return 1;
|
---|
| 77 | }
|
---|
| 78 |
|
---|
| 79 | sub query
|
---|
| 80 | {
|
---|
| 81 | my ($self, $query) = @_;
|
---|
| 82 | print " * sending query [" . length($query) . " characters]\n" if ($debug);
|
---|
| 83 | return $self->{'gdbm_client_handle'}->query($query);
|
---|
| 84 | }
|
---|
| 85 |
|
---|
| 86 | 1;
|
---|