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

Revision 25410, 11.4 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###########################################################################
2#
3# dbutil::tdbserver -- utility functions for writing to tdb databases but
4#                      implemented as a server with a single, persistent
5#                      connection
6#
7# A component of the Greenstone digital library software
8# from the New Zealand Digital Library Project at the
9# University of Waikato, New Zealand.
10#
11# Copyright (C) 2012
12#
13# This program is free software; you can redistribute it and/or modify
14# it under the terms of the GNU General Public License as published by
15# the Free Software Foundation; either version 2 of the License, or
16# (at your option) any later version.
17#
18# This program is distributed in the hope that it will be useful,
19# but WITHOUT ANY WARRANTY; without even the implied warranty of
20# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
21# GNU General Public License for more details.
22#
23# You should have received a copy of the GNU General Public License
24# along with this program; if not, write to the Free Software
25# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
26#
27###########################################################################
28
29package dbutil::tdbserver;
30
31use strict;
32use warnings;
33
34# We're going to have to delve into locking (a little) to prevent multiple
35# threads trying to launch the server at once
36use Fcntl qw(:flock);
37
38use TDBClient;
39use util;
40
41my $hyphen70 = '-' x 70;
42my $debug = 0;
43
44# We have a global reference to all of the TDB Server lockfiles that this
45# instance has created (as we'll be responsible for closing them)
46my %created_server_lockfile_paths;
47# Keep track of the lockfiles for server we have added ourselves as listeners
48# to.
49my %listener_server_lockfile_paths;
50# We also have a global of all of the listeners we have assigned as we'll
51# be responsible for removing them.
52my %registered_listeners;
53
54sub _spawnClient
55{
56  my ($infodb_file_path) = @_;
57  # 1. Check whether the server is already running by trying to locate the
58  #    server 'lock' file.
59
60  my ($collection) = $infodb_file_path =~ /collect[\\\/]([^\\\/]+)/i;
61  my ($infodb_file, $extension) = $infodb_file_path =~ /([^\\\/]+)\.(t?db)/i;
62
63  my $tmp_dir = &util::filename_cat($ENV{'GSDLHOME'},'tmp');
64  if (!-d $tmp_dir)
65  {
66    mkdir($tmp_dir, 0755);
67  }
68
69  my $server_lockfile_path =  &util::filename_cat($ENV{'GSDLHOME'},'collect',$collection,'tmp','tdbserver.lock');
70  #rint " * Searching for lockfile: " . $server_lockfile_path . "\n";
71  # We need to lock here to ensure only one thread enters the following code,
72  # sees a missing TDBServer, and launches it
73  my $tmp_lockfile_path = &util::filename_cat($ENV{'GSDLHOME'},'tmp','dbutil-tdbserver.lock');
74  open(TMPFH, '>', $tmp_lockfile_path) or die ("Error! Failed to open file for writing: " . $tmp_lockfile_path . "\nReason: " . $! . "\n");
75  flock(TMPFH, LOCK_EX) or die("Error! Cannot lock file exclusively: " . $tmp_lockfile_path . "\nReason: " . $! . "\n");
76  print TMPFH localtime();
77  # - If the file doesn't exist...
78  if (!-e $server_lockfile_path)
79  {
80    # ...start it!
81    my $launch_cmd = 'TDBServer.pl "' . $$ . '" "' . $collection . '"';
82    print "* Starting TDBServer for: " . $collection . " [" . $launch_cmd . "]\n";
83    # @note I once had the below pipe ending with 2>&1 |, but that then blocks
84    #       indefinitely when looping and reading <SERVERIN>.
85    open(SERVERIN, $launch_cmd . ' |') or die("Error! Failed to run launch command: " . $launch_cmd . "\nReason: " . $! . "\n");
86    # read all the output from the server
87    my $line = '';
88    my $server_lock_file_created = 0;
89    while ($line = <SERVERIN>)
90    {
91      # - watch for the line indicating a lock file has been created and
92      #   populated with a sexy port number
93      if ($line =~ /Server now listening/)
94      {
95        $server_lock_file_created = 1;
96      }
97      # - we could also watch for errors here
98      if ($debug)
99      {
100        if ($line !~ /\n/)
101        {
102          $line .= "\n";
103        }
104        $|++; # autoflush
105        print "[tdbserver] $line";
106        $|--; # disable autoflush
107      }
108    }
109    close(SERVERIN);
110    if (!$server_lock_file_created)
111    {
112      die("Error! TDBServer failed to create lock file. Check server logs.");
113    }
114    # record this for later
115    $created_server_lockfile_paths{$server_lockfile_path} = 1;
116  }
117  flock(TMPFH, LOCK_UN);
118  close($tmp_lockfile_path);
119  unlink($tmp_lockfile_path);
120  # record this for later
121  $listener_server_lockfile_paths{$server_lockfile_path} = $infodb_file_path;
122  return TDBClient->new($server_lockfile_path, $infodb_file);
123}
124
125END
126{
127  # we ask the server to shutdown, but only the 'creator' thread will actually
128  # be able to, and only once all listeners have deregistered.
129  foreach my $server_lockfile_path (keys (%listener_server_lockfile_paths))
130  {
131    my $infodb_file_path = $listener_server_lockfile_paths{$server_lockfile_path};
132    my $tdb_client_handle = TDBClient->new($server_lockfile_path, '');
133    # Deregister all of our registered listeners
134    foreach my $listener_suffix (keys(%registered_listeners))
135    {
136      $tdb_client_handle->removeListener($listener_suffix);
137    }
138    # ask the servers we created to shut down (all other threads will have
139    # this request ignored)
140    if (defined $created_server_lockfile_paths{$infodb_file_path})
141    {
142      print "* Attempting to stop TDBServer for: " . $infodb_file_path . "\n";
143    }
144    $tdb_client_handle->stopServer();
145  }
146  # we should now wait until all of our server_lockfiles have actually been
147  # removed (otherwise people could mistakenly run import/build again
148  # immediately and things *might* go pearshaped).
149  foreach my $server_lockfile_path (keys (%created_server_lockfile_paths))
150  {
151    # While the file exists, we should wait
152    print "* Waiting for TDBServer [" . $server_lockfile_path . "] to exit...";
153    if (-e $server_lockfile_path)
154    {
155      while (-e $server_lockfile_path)
156      {
157        print ".";
158        sleep(1);
159      }
160    }
161    print " Done!\n";
162  }
163}
164
165# -----------------------------------------------------------------------------
166#   TDB SERVER IMPLEMENTATION
167# -----------------------------------------------------------------------------
168sub open_infodb_write_handle
169{
170  my $infodb_file_path = shift(@_);
171  my $opt_append = shift(@_);
172  if (defined $opt_append && $opt_append ne "append")
173  {
174    print "Warning! Modes other than 'append' not supported for TDBServer.\n";
175  }
176  my $tdb_client_handle = &_spawnClient($infodb_file_path);
177  # Register this client on the server if necessary
178  $tdb_client_handle->addListener('w');
179  $registered_listeners{'w'} = 1;
180  # and pass the handle to client around
181  return $tdb_client_handle;
182}
183
184# /** Destructor or near enough.
185#  /*
186sub close_infodb_write_handle
187{
188  my $tdb_client_handle = shift(@_);
189  # @todo Is there meant to be something here?
190}
191# /** close_infodb_write_handle($infodb_handle) **/
192
193# /** @function get_info_db_file_path
194#  *  Exactly the same as vanilla TDB - as we are still using a TDB database
195#  *  just accessing it via a persistant server
196#  */
197sub get_infodb_file_path
198{
199  my $collection_name = shift(@_);
200  my $infodb_directory_path = shift(@_);
201  my $create_server = shift(@_);
202
203  my $infodb_file_extension = ".tdb";
204  my $infodb_file_name = &util::get_dirsep_tail($collection_name) . $infodb_file_extension;
205  my $infodb_file_path = &util::filename_cat($infodb_directory_path, $infodb_file_name);
206
207  # Special Case for TDBServer
208  if (defined $create_server && $create_server == 1)
209  {
210    my $tdb_client_handle = &_spawnClient($infodb_file_path);
211    # Register this client on the server if necessary
212    $tdb_client_handle->addListener('i');
213    $registered_listeners{'i'} = 1;
214  }
215
216  # Resuming our regular programming
217  return $infodb_file_path;
218}
219
220sub read_infodb_file
221{
222  my $infodb_file_path = shift(@_);
223  my $infodb_map = shift(@_);
224
225  my $tdb_client_handle = &_spawnClient($infodb_file_path);
226  $tdb_client_handle->addListener('r');
227  $registered_listeners{'r'} = 1;
228  # retrieves all the keys in the form:
229  # [key1]\n[key2]\n[key3]\n...[keyn]
230  my $raw_infodb_keys = $tdb_client_handle->query('[*]?');
231
232  my @infodb_keys = split(/\r?\n/, $raw_infodb_keys);
233  foreach my $infodb_key (@infodb_keys)
234  {
235    if ($infodb_key =~ /.+/ && $infodb_key !~ /-{70}/)
236    {
237      # lookup each key
238      my $infodb_value = $tdb_client_handle->query('[' . $infodb_key . ']?');
239      # store it
240      $infodb_map->{$infodb_key} = $infodb_value;
241    }
242  }
243}
244
245sub read_infodb_keys
246{
247  my $infodb_file_path = shift(@_);
248  my $infodb_map = shift(@_);
249
250  # spawn client (creating server as necessary)
251  my $tdb_client_handle = &_spawnClient($infodb_file_path);
252  # register ourself as listener
253  $tdb_client_handle->addListener('k');
254  $registered_listeners{'k'} = 1;
255  # retrieves all the keys in the form:
256  # [key1]\n[key2]\n[key3]\n...[keyn]
257  my $raw_infodb_keys = $tdb_client_handle->query('[*]?');
258  my @infodb_keys = split(/\r?\n/, $raw_infodb_keys);
259  foreach my $infodb_key (@infodb_keys)
260  {
261    if ($infodb_key =~ /.+/ && $infodb_key !~ /-{70}/)
262    {
263      $infodb_map->{$infodb_key} = 1;
264    }
265  }
266}
267
268sub write_infodb_entry
269{
270  my $tdb_client_handle = shift(@_);
271  my $infodb_key = shift(@_);
272  my $infodb_map = shift(@_);
273  # - build up the tdb command
274  my $tdb_command = "[" . $infodb_key . "]+\n";
275  foreach my $infodb_value_key (keys(%$infodb_map))
276  {
277    foreach my $infodb_value (@{$infodb_map->{$infodb_value_key}})
278    {
279      if ($infodb_value =~ /-{70,}/)
280      {
281        # if value contains 70 or more hyphens in a row we need to escape them
282        # to prevent txt2db from treating them as a separator
283        $infodb_value =~ s/-/&\#045;/gi;
284      }
285      $tdb_command .= "<" . $infodb_value_key . ">" . $infodb_value . "\n";
286    }
287  }
288  $tdb_command .= $hyphen70 . "\n";
289  # - ask the client to transmit the command to the server
290  $tdb_client_handle->query($tdb_command);
291}
292
293sub write_infodb_rawentry
294{
295  my $tdb_client_handle = shift(@_);
296  my $infodb_key = shift(@_);
297  my $infodb_val = shift(@_);
298  # - build up the tdb command
299  my $tdb_command = "[" . $infodb_key . "]\n";
300  $tdb_command .= $infodb_val . "\n";
301  $tdb_command .= $hyphen70 . "\n";
302  # - ask the client to transmit the command to the server
303  $tdb_client_handle->query($tdb_command);
304  return 1;
305}
306
307sub set_infodb_entry
308{
309  my $infodb_file_path = shift(@_);
310  my $infodb_key = shift(@_);
311  my $infodb_map = shift(@_);
312  # spawn client (creating server as necessary)
313  my $tdb_client_handle = &_spawnClient($infodb_file_path);
314  $tdb_client_handle->addListener('s');
315  $registered_listeners{'s'} = 1;
316  # Protect metadata values that go inside quotes for tdbset
317  foreach my $k (keys %$infodb_map)
318  {
319    my @escaped_v = ();
320    foreach my $v (@{$infodb_map->{$k}})
321    {
322      if ($k eq "contains")
323      {
324        # protect quotes in ".2;".3 etc
325        $v =~ s/\"/\\\"/g;
326        push(@escaped_v, $v);
327      }
328      else
329      {
330        my $ev = &ghtml::unescape_html($v);
331        $ev =~ s/\"/\\\"/g;
332        push(@escaped_v, $ev);
333      }
334    }
335    $infodb_map->{$k} = \@escaped_v;
336  }
337  # Generate the record string (TDB command)
338  my $tdb_command = "[" . $infodb_key . "]\n";
339  $tdb_command .= &dbutil::convert_infodb_hash_to_string($infodb_map) . "\n";
340  $tdb_command .= $hyphen70 . "\n";
341  # Send command to server
342  $tdb_client_handle->query($tdb_command);
343}
344
345sub delete_infodb_entry
346{
347  my $tdb_client_handle = shift(@_);
348  my $infodb_key = shift(@_);
349  # - create command
350  my $tdb_command = "[" . $infodb_key . "]-\n";
351  # - and send
352  $tdb_client_handle->query($tdb_command);
353}
354
355
356
3571;
Note: See TracBrowser for help on using the browser.