root/gs2-extensions/parallel-building/trunk/src/perllib/dbutil/gdbmserver.pm @ 30305

Revision 30305, 11.6 KB (checked in by jmt12, 4 years ago)

replacing deprecated function calls to newer ones in FileUtils?

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