root/gs2-extensions/tdb-edit/trunk/src/perllib/TDBClient.pm @ 25410

Revision 25410, 3.0 KB (checked in by jmt12, 8 years ago)

Adding a new infodbtype, tdbserver, to allow Greenstone to interact with a centralized TDBServer instance on systems that don't support multiple writers over NFS

Line 
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
6package 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
10use Fcntl qw(:flock);
11
12# A simple multithreaded, socketed, server.
13use SocketsSwimmingThreadPoolClient;
14
15my $debug = 0;
16
17sub new
18{
19  my ($class, $server_lockfile_path, $infodb_file) = @_;
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    print " * Creating Client and connecting to " . $host . ":" . $port . "...\n" if ($debug);
49    $self->{'tdb_client_handle'} = SocketsSwimmingThreadPoolClient->new(host=>$host,port=>$port);
50  }
51  else
52  {
53    die("Error! Failed to determine host and port number from lockfile: " . $raw_information);
54  }
55  # Done
56  flock(SLFH, LOCK_UN);
57  close(SLFH);
58
59  return bless $self, $class;
60}
61
62# @note command calls don't need a database to work
63sub addListener
64{
65  my ($self, $suffix) = @_;
66  my $command = '#a:' . $$;
67  if (defined $suffix)
68  {
69    $command .= $suffix;
70  }
71  print " * add listener: " . $command . "\n" if ($debug);
72  $self->{'tdb_client_handle'}->query($command);
73  return 1;
74}
75
76# @note command calls don't need a database to work
77sub removeListener
78{
79  my ($self, $suffix) = @_;
80  my $command = '#r:' . $$;
81  if (defined $suffix)
82  {
83    $command .= $suffix;
84  }
85  print " * remove listener: " . $command . "\n" if ($debug);
86  $self->{'tdb_client_handle'}->query($command);
87  return 1;
88}
89
90sub stopServer
91{
92  my ($self, $suffix) = @_;
93  my $command = '#q:' . $$;
94  if (defined $suffix)
95  {
96    $command .= $suffix;
97  }
98  print " * stop server: " . $command . "\n" if ($debug);
99  $self->{'tdb_client_handle'}->query($command);
100  return 1;
101}
102
103sub query
104{
105  my ($self, $query) = @_;
106  # Append the indicator of the database to edit on the front
107  if ($query !~ /^#/)
108  {
109    $query = $self->{'database'} . ':' . $query;
110  }
111  print " * sending query [" . length($query) . " characters]\n" if ($debug);
112  return $self->{'tdb_client_handle'}->query($query);
113}
114
1151;
Note: See TracBrowser for help on using the browser.