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

Revision 26996, 12.0 KB (checked in by jmt12, 7 years ago)

Commenting out the bit that waits (adding a significant delay to test runs) for TDBServers to cleanly exit. If an exit somehow fails, the TDB lockfile will be left behind prevent other TDBServers from starting up. While this may cause a series of test to not run, it won't result in inconsistent results as I initially worried

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