1 | #!/usr/bin/perl
|
---|
2 |
|
---|
3 | # @note A request to the server must include the database to apply it to.
|
---|
4 | # Special commands, however, do not need a specific database to work.
|
---|
5 |
|
---|
6 | package TDBClient;
|
---|
7 |
|
---|
8 | # We're going to have to delve into locking (a little) to prevent multiple
|
---|
9 | # threads trying to launch the server at once
|
---|
10 | use Fcntl qw(:flock);
|
---|
11 |
|
---|
12 | # A simple multithreaded, socketed, server.
|
---|
13 | use SocketsSwimmingThreadPoolClient;
|
---|
14 |
|
---|
15 | my $debug = 0;
|
---|
16 |
|
---|
17 | sub new
|
---|
18 | {
|
---|
19 | my ($class, $server_lockfile_path, $infodb_file, $we_started_server) = @_;
|
---|
20 | my $self = {};
|
---|
21 |
|
---|
22 | if ($infodb_file =~ /archiveinf-doc/)
|
---|
23 | {
|
---|
24 | $self->{'database'} = 'd';
|
---|
25 | }
|
---|
26 | elsif ($infodb_file =~ /archiveinf-src/)
|
---|
27 | {
|
---|
28 | $self->{'database'} = 's';
|
---|
29 | }
|
---|
30 | else
|
---|
31 | {
|
---|
32 | $self->{'database'} = 'i';
|
---|
33 | }
|
---|
34 |
|
---|
35 | # - Now we wait until we can get a shared lock (after the exclusive
|
---|
36 | # lock above releases) and then read in the port number that connections
|
---|
37 | # to the server should be made on.
|
---|
38 | print " * Reading information from lockfile: " . $server_lockfile_path . "\n" if ($debug);
|
---|
39 | open(SLFH, "<" , $server_lockfile_path) or die("Error! Failed to open file for reading: " . $server_lockfile_path . "\nReason: " . $! . "\n");
|
---|
40 | flock(SLFH, LOCK_SH) or die("Error! Cannot lock file for reading: " . $server_lockfile_path . "\nReason: " . $! . "\n");
|
---|
41 | # read communications port
|
---|
42 | my $raw_information = <SLFH>;
|
---|
43 | if ($raw_information =~ /(.+):(\d+)/)
|
---|
44 | {
|
---|
45 | my $host = $1;
|
---|
46 | my $port = $2;
|
---|
47 | # We now create a client that can connect to the specified port
|
---|
48 | if ($debug)
|
---|
49 | {
|
---|
50 | print " * Creating Client and connecting to " . $host . ":" . $port . "...\n";
|
---|
51 | }
|
---|
52 | $self->{'tdb_client_handle'} = SocketsSwimmingThreadPoolClient->new(host=>$host, port=>$port, firstcaller=>$we_started_server);
|
---|
53 | }
|
---|
54 | else
|
---|
55 | {
|
---|
56 | die("Error! Failed to determine host and port number from lockfile: " . $raw_information);
|
---|
57 | }
|
---|
58 | # Done
|
---|
59 | flock(SLFH, LOCK_UN);
|
---|
60 | close(SLFH);
|
---|
61 |
|
---|
62 | return bless $self, $class;
|
---|
63 | }
|
---|
64 |
|
---|
65 | # @note command calls don't need a database to work
|
---|
66 | sub addListener
|
---|
67 | {
|
---|
68 | my ($self, $suffix) = @_;
|
---|
69 | my $command = '#a:' . $$;
|
---|
70 | if (defined $suffix)
|
---|
71 | {
|
---|
72 | $command .= $suffix;
|
---|
73 | }
|
---|
74 | print " * add listener: " . $command . "\n" if ($debug);
|
---|
75 | $self->{'tdb_client_handle'}->query($command);
|
---|
76 | return 1;
|
---|
77 | }
|
---|
78 |
|
---|
79 | # @note command calls don't need a database to work
|
---|
80 | sub removeListener
|
---|
81 | {
|
---|
82 | my ($self, $suffix) = @_;
|
---|
83 | my $command = '#r:' . $$;
|
---|
84 | if (defined $suffix)
|
---|
85 | {
|
---|
86 | $command .= $suffix;
|
---|
87 | }
|
---|
88 | print " * remove listener: " . $command . "\n" if ($debug);
|
---|
89 | $self->{'tdb_client_handle'}->query($command);
|
---|
90 | return 1;
|
---|
91 | }
|
---|
92 |
|
---|
93 | sub stopServer
|
---|
94 | {
|
---|
95 | my ($self, $suffix) = @_;
|
---|
96 | my $command = '#q:' . $$;
|
---|
97 | if (defined $suffix)
|
---|
98 | {
|
---|
99 | $command .= $suffix;
|
---|
100 | }
|
---|
101 | print " * stop server: " . $command . "\n" if ($debug);
|
---|
102 | $self->{'tdb_client_handle'}->query($command);
|
---|
103 | return 1;
|
---|
104 | }
|
---|
105 |
|
---|
106 | sub query
|
---|
107 | {
|
---|
108 | my ($self, $query) = @_;
|
---|
109 | # Append the indicator of the database to edit on the front
|
---|
110 | if ($query !~ /^#/)
|
---|
111 | {
|
---|
112 | $query = $self->{'database'} . ':' . $query;
|
---|
113 | }
|
---|
114 | print " * sending query [" . length($query) . " characters]\n" if ($debug);
|
---|
115 | return $self->{'tdb_client_handle'}->query($query);
|
---|
116 | }
|
---|
117 |
|
---|
118 | 1;
|
---|