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;
|
---|