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

Revision 27399, 12.4 KB (checked in by jmt12, 6 years ago)

Try to make waiting messages a little more meaningful. Also pass a flag through to the first client to let it know it is first and the server may still be starting up

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 $we_started_server = 0;
70  my $server_lockfile_path =  &util::filename_cat($ENV{'GSDLHOME'},'collect',$collection,'tmp','tdbserver.lock');
71  print " * Searching for TDBServer lockfile...\n";
72  if (!-e $server_lockfile_path)
73  {
74    print "Not found.\n";
75    # We need to lock here to ensure only one thread enters the following code,
76    # sees a missing TDBServer, and launches it
77    my $tmp_lockfile_path = &util::filename_cat($ENV{'GSDLHOME'},'tmp','dbutil-tdbserver.lock');
78    open(TMPFH, '>', $tmp_lockfile_path) or die("Warning! Failed to open file for writing: " . $tmp_lockfile_path . "\nReason: " . $! . "\n");
79    flock(TMPFH, LOCK_EX) or die("Error! Cannot lock file exclusively: " . $tmp_lockfile_path . "\nReason: " . $! . "\n");
80    print TMPFH localtime();
81    # - If the file still doesn't exist...
82    if (!-e $server_lockfile_path)
83    {
84      $we_started_server = 1;
85      # ...start it!
86      my $launch_cmd = 'TDBServer.pl "' . $$ . '" "' . $collection . '"';
87      print "* Starting TDBServer for: " . $collection . " [" . $launch_cmd . "]... ";
88      # @note I once had the below pipe ending with 2>&1 |, but that then blocks
89      #       indefinitely when looping and reading <SERVERIN>.
90      open(SERVERIN, $launch_cmd . ' |') or die("Error! Failed to run launch command: " . $launch_cmd . "\nReason: " . $! . "\n");
91      # read all the output from the server
92      my $line = '';
93      my $server_lock_file_created = 0;
94      autoflush STDOUT 1;
95      print "* Waiting for TDBServer to start";
96      my $server_host = '';
97      my $server_port = '';
98      while ($line = <SERVERIN>)
99      {
100        print ".";
101        # - watch for the line indicating a lock file has been created and
102        #   populated with a sexy port number
103        if ($line =~ /Server now listening on ([^:]+):(\d+)/)
104        {
105          $server_host = $1;
106          $server_port = $2;
107          $server_lock_file_created = 1;
108        }
109        # - we could also watch for errors here
110        if ($debug)
111        {
112          if ($line !~ /\n/)
113          {
114            $line .= "\n";
115          }
116          $|++; # autoflush
117          print "[tdbserver] $line";
118          $|--; # disable autoflush
119        }
120      }
121      close(SERVERIN);
122      print "\n";
123      if (!$server_lock_file_created)
124      {
125        die("Error! TDBServer failed to create lock file. Check server logs.");
126      }
127      else
128      {
129        print "Running on " . $server_host . ":" . $server_port . "\n";
130      }
131      # record this for later
132      $created_server_lockfile_paths{$server_lockfile_path} = 1;
133    }
134    flock(TMPFH, LOCK_UN);
135    close($tmp_lockfile_path);
136    unlink($tmp_lockfile_path);
137  }
138  else
139  {
140    print "Found!\n";
141  }
142  # record this for later
143  $listener_server_lockfile_paths{$server_lockfile_path} = $infodb_file_path;
144  return TDBClient->new($server_lockfile_path, $infodb_file, $we_started_server);
145}
146
147END
148{
149  # we ask the server to shutdown, but only the 'creator' thread will actually
150  # be able to, and only once all listeners have deregistered.
151  foreach my $server_lockfile_path (keys (%listener_server_lockfile_paths))
152  {
153    my $infodb_file_path = $listener_server_lockfile_paths{$server_lockfile_path};
154    my $tdb_client_handle = TDBClient->new($server_lockfile_path, '');
155    # Deregister all of our registered listeners
156    foreach my $listener_suffix (keys(%registered_listeners))
157    {
158      $tdb_client_handle->removeListener($listener_suffix);
159    }
160    # ask the servers we created to shut down (all other threads will have
161    # this request ignored)
162    if (defined $created_server_lockfile_paths{$infodb_file_path})
163    {
164      print "* Attempting to stop TDBServer for: " . $infodb_file_path . "\n";
165    }
166    $tdb_client_handle->stopServer();
167  }
168  # we should now wait until all of our server_lockfiles have actually been
169  # removed (otherwise people could mistakenly run import/build again
170  # immediately and things *might* go pearshaped). (Subsequent testing shows it
171  # won't - a new Greenstone build can't start until the previous lockfile is
172  # removed - but I think, for ATOMic sake, I may as well make waiting a part
173  # of the Greenstone import/build time.
174  my $wait_for_exit = 1;
175  foreach my $server_lockfile_path (keys (%created_server_lockfile_paths))
176  {
177    if ($wait_for_exit)
178    {
179      # While the file exists, we should wait
180      autoflush STDOUT 1;
181      print "* Waiting for TDBServer to exit [" . $server_lockfile_path . "]";
182      if (-e $server_lockfile_path)
183      {
184        while (-e $server_lockfile_path)
185        {
186          print ".";
187          sleep(1);
188        }
189      }
190    }
191    else
192    {
193      print "* NOT Waiting for TDBServer to exit... ";
194    }
195    print " Done!\n";
196  }
197}
198
199# -----------------------------------------------------------------------------
200#   TDB SERVER IMPLEMENTATION
201# -----------------------------------------------------------------------------
202sub open_infodb_write_handle
203{
204  my $infodb_file_path = shift(@_);
205  my $opt_append = shift(@_);
206  if (defined $opt_append && $opt_append ne "append")
207  {
208    print "Warning! Modes other than 'append' not supported for TDBServer.\n";
209  }
210  my $tdb_client_handle = &_spawnClient($infodb_file_path);
211  # Register this client on the server if necessary
212  $tdb_client_handle->addListener('w');
213  $registered_listeners{'w'} = 1;
214  # and pass the handle to client around
215  return $tdb_client_handle;
216}
217
218# /** Destructor or near enough.
219#  /*
220sub close_infodb_write_handle
221{
222  my $tdb_client_handle = shift(@_);
223  # @todo Is there meant to be something here?
224}
225# /** close_infodb_write_handle($infodb_handle) **/
226
227# /** @function get_info_db_file_path
228#  *  Exactly the same as vanilla TDB - as we are still using a TDB database
229#  *  just accessing it via a persistant server
230#  */
231sub get_infodb_file_path
232{
233  my $collection_name = shift(@_);
234  my $infodb_directory_path = shift(@_);
235  my $create_server = shift(@_);
236
237  my $infodb_file_extension = ".tdb";
238  my $infodb_file_name = &util::get_dirsep_tail($collection_name) . $infodb_file_extension;
239  my $infodb_file_path = &util::filename_cat($infodb_directory_path, $infodb_file_name);
240
241  # Special Case for TDBServer
242  if (defined $create_server && $create_server == 1)
243  {
244    my $tdb_client_handle = &_spawnClient($infodb_file_path);
245    # Register this client on the server if necessary
246    $tdb_client_handle->addListener('i');
247    $registered_listeners{'i'} = 1;
248  }
249
250  # Resuming our regular programming
251  return $infodb_file_path;
252}
253
254sub read_infodb_file
255{
256  my $infodb_file_path = shift(@_);
257  my $infodb_map = shift(@_);
258
259  my $tdb_client_handle = &_spawnClient($infodb_file_path);
260  $tdb_client_handle->addListener('r');
261  $registered_listeners{'r'} = 1;
262  # retrieves all the keys in the form:
263  # [key1]\n[key2]\n[key3]\n...[keyn]
264  my $raw_infodb_keys = $tdb_client_handle->query('[*]?');
265
266  my @infodb_keys = split(/\r?\n/, $raw_infodb_keys);
267  foreach my $infodb_key (@infodb_keys)
268  {
269    if ($infodb_key =~ /.+/ && $infodb_key !~ /-{70}/)
270    {
271      # lookup each key
272      my $infodb_value = $tdb_client_handle->query('[' . $infodb_key . ']?');
273      # store it
274      $infodb_map->{$infodb_key} = $infodb_value;
275    }
276  }
277}
278
279sub read_infodb_keys
280{
281  my $infodb_file_path = shift(@_);
282  my $infodb_map = shift(@_);
283
284  # spawn client (creating server as necessary)
285  my $tdb_client_handle = &_spawnClient($infodb_file_path);
286  # register ourself as listener
287  $tdb_client_handle->addListener('k');
288  $registered_listeners{'k'} = 1;
289  # retrieves all the keys in the form:
290  # [key1]\n[key2]\n[key3]\n...[keyn]
291  my $raw_infodb_keys = $tdb_client_handle->query('[*]?');
292  my @infodb_keys = split(/\r?\n/, $raw_infodb_keys);
293  foreach my $infodb_key (@infodb_keys)
294  {
295    if ($infodb_key =~ /.+/ && $infodb_key !~ /-{70}/)
296    {
297      $infodb_map->{$infodb_key} = 1;
298    }
299  }
300}
301
302sub write_infodb_entry
303{
304  my $tdb_client_handle = shift(@_);
305  my $infodb_key = shift(@_);
306  my $infodb_map = shift(@_);
307  # - build up the tdb command
308  my $tdb_command = "[" . $infodb_key . "]+\n";
309  foreach my $infodb_value_key (keys(%$infodb_map))
310  {
311    foreach my $infodb_value (@{$infodb_map->{$infodb_value_key}})
312    {
313      if ($infodb_value =~ /-{70,}/)
314      {
315        # if value contains 70 or more hyphens in a row we need to escape them
316        # to prevent txt2db from treating them as a separator
317        $infodb_value =~ s/-/&\#045;/gi;
318      }
319      $tdb_command .= "<" . $infodb_value_key . ">" . $infodb_value . "\n";
320    }
321  }
322  $tdb_command .= $hyphen70 . "\n";
323  # - ask the client to transmit the command to the server
324  $tdb_client_handle->query($tdb_command);
325}
326
327sub write_infodb_rawentry
328{
329  my $tdb_client_handle = shift(@_);
330  my $infodb_key = shift(@_);
331  my $infodb_val = shift(@_);
332  # - build up the tdb command
333  my $tdb_command = "[" . $infodb_key . "]\n";
334  $tdb_command .= $infodb_val . "\n";
335  $tdb_command .= $hyphen70 . "\n";
336  # - ask the client to transmit the command to the server
337  $tdb_client_handle->query($tdb_command);
338  return 1;
339}
340
341sub set_infodb_entry
342{
343  my $infodb_file_path = shift(@_);
344  my $infodb_key = shift(@_);
345  my $infodb_map = shift(@_);
346  # spawn client (creating server as necessary)
347  my $tdb_client_handle = &_spawnClient($infodb_file_path);
348  $tdb_client_handle->addListener('s');
349  $registered_listeners{'s'} = 1;
350  # Protect metadata values that go inside quotes for tdbset
351  foreach my $k (keys %$infodb_map)
352  {
353    my @escaped_v = ();
354    foreach my $v (@{$infodb_map->{$k}})
355    {
356      if ($k eq "contains")
357      {
358        # protect quotes in ".2;".3 etc
359        $v =~ s/\"/\\\"/g;
360        push(@escaped_v, $v);
361      }
362      else
363      {
364        my $ev = &ghtml::unescape_html($v);
365        $ev =~ s/\"/\\\"/g;
366        push(@escaped_v, $ev);
367      }
368    }
369    $infodb_map->{$k} = \@escaped_v;
370  }
371  # Generate the record string (TDB command)
372  my $tdb_command = "[" . $infodb_key . "]\n";
373  $tdb_command .= &dbutil::convert_infodb_hash_to_string($infodb_map) . "\n";
374  $tdb_command .= $hyphen70 . "\n";
375  # Send command to server
376  $tdb_client_handle->query($tdb_command);
377}
378
379sub delete_infodb_entry
380{
381  my $tdb_client_handle = shift(@_);
382  my $infodb_key = shift(@_);
383  # - create command
384  my $tdb_command = "[" . $infodb_key . "]-\n";
385  # - and send
386  $tdb_client_handle->query($tdb_command);
387}
388
389
390
3911;
Note: See TracBrowser for help on using the browser.