Changeset 25454 for gs2-extensions

Timestamp:

2012-04-23T10:37:28+12:00 (12 years ago)

Author:

jmt12

Message:

Replacing potentially problematic harness code with calls to individual TDB utilities (although still using a pipe to TXT2TDB - so we'll see how that goes

File:

• gs2-extensions/tdb-edit/trunk/src/bin/script/TDBServer.pl (modified) (4 diffs)

gs2-extensions/tdb-edit/trunk/src/bin/script/TDBServer.pl

@@ -77 +77 @@
 # Globally available - but once set these are read-only - so locking isn't
 # an issue
+my $use_harness = 0;
 my $tdbexe = 'tdbcli';
 my $parent_pid = 0;
 my $collection = '';
 my $no_daemon = 0;
-my $debug = 0;
+my $debug = 1;
 my $server;
 my $server_host;
@@ -318 +319 @@
   my $tid = shift @_;
   my $result = "#ERROR#";
-  # Synchronized debug log writing
-  if ($debug)
-  {
-    lock($debug_log);
-    $|++;
-    print "[" . time() . "|" . $tid . "|RECV] " . $data . "\n";
-    $|--;
-  }
+  my $the_count = 0;
+  {
+    lock($msg_counter);
+    $msg_counter++;
+    $the_count = $msg_counter + 0;
+    # //unlock($msg_counter);
+  }
+  &debugPrint($the_count, $tid, 'RECV', $data);
   # process special commands first
   if ($data =~ /^#([arq]):(.*)$/)
@@ -403 +404 @@
   # form  <database>:<key>:<value>
   # where: database is [d]oc, [i]ndex, or [s]rc
-  elsif ($data =~ /^([dis]):(.+)$/s)
+  elsif ($data =~ /^([dis]):\[([^\]]+)\]([+?\-])(.+)$/s)
   {
     my $database = $1;
-    my $record = $2;
+    my $key = $2;
+    my $action = $3
+    my $payload = $4;
     # Build path to database file
     my $tdb_path = '';
@@ -421 +424 @@
       $tdb_path = &util::filename_cat($ENV{'GSDLHOME'}, 'collect', $collection, 'building', 'text', $collection . '.tdb');
     }
-    # Open harness to TDBCLI
-    my $the_count = 0;
-    {
-      lock($msg_counter);
-      $msg_counter++;
-      $the_count = $msg_counter + 0;
-      # //unlock($msg_counter);
-    }
-    my @tdb_command = ($tdbexe, $tdb_path, '-mid ' . $the_count);
-    my $buffer_to_tdb = '';
-    my $buffer_from_tdb = '';
-    my $tdb_harness = start(\@tdb_command, \$buffer_to_tdb, \$buffer_from_tdb);
-    # Check the harness worked
-
-    if (!pumpable $tdb_harness)
-    {
-      die("Error! Harness to " . $tdbexe . " has gone away!");
-    }
-    # - write the data to the TDBCLI
-    $buffer_to_tdb = $record . "\n";
-    my $write_msg = '#' . $the_count . ' writing: |' . $record . '| => ';
-    while (length($buffer_to_tdb))
-    {
-      $write_msg .='.';
-      pump($tdb_harness);
-    }
-    print STDERR $write_msg . "\n";
-    # - read any response from TDBCLI
-    my $read_msg = '#' . $the_count . ' reading: ';
-    while ($buffer_from_tdb !~ /-{70}/)
-    {
-      $read_msg .= '.';
-      pump($tdb_harness);
-    }
-    print STDERR $read_msg . ' => |' . $buffer_from_tdb . "|\n";
-    # - not that this result doesn't include the [Server] prefix as it
-    #   may be parsed for data by the client
-    $result = $buffer_from_tdb;
-    chomp($result);
-    # Finished with harness
-    finish($tdb_harness);
+    # Harnesses seem like goodly magic - but unfortunately may be broken
+    # magic. Testing on Medusa randomly hangs on the finish() function.
+    if ($use_harness)
+    {
+      my $record = '[' . $key . ']' . $action . $payload;
+      # Open harness to TDBCLI
+      my @tdb_command = ($tdbexe, $tdb_path, '-mid ' . $the_count);
+      my $buffer_to_tdb = '';
+      my $buffer_from_tdb = '';
+      my $tdb_harness = start(\@tdb_command, \$buffer_to_tdb, \$buffer_from_tdb);
+      # Check the harness worked
+      if (!pumpable $tdb_harness)
+      {
+        die("Error! Harness to " . $tdbexe . " has gone away!");
+      }
+      # - write the data to the TDBCLI
+      $buffer_to_tdb = $record . "\n";
+      my $write_msg = '#' . $the_count . ' writing: |' . $record . '| => ';
+      while (length($buffer_to_tdb))
+      {
+        $write_msg .='.';
+        pump($tdb_harness);
+      }
+      print STDERR $write_msg . "\n";
+      # - read any response from TDBCLI
+      my $read_msg = '#' . $the_count . ' reading: ';
+      while ($buffer_from_tdb !~ /-{70}/)
+      {
+        $read_msg .= '.';
+        pump($tdb_harness);
+      }
+      print STDERR $read_msg . ' => |' . $buffer_from_tdb . "|\n";
+      # - not that this result doesn't include the [Server] prefix as it
+      #   may be parsed for data by the client
+      $result = $buffer_from_tdb;
+      chomp($result);
+      # Finished with harness
+      finish($tdb_harness);
+    }
+    # Use different TDB tools depending on arguments
+    # - lookups using TDBGET
+    elsif ($action eq '?')
+    {
+      my $command = 'tdbget "' . $tdb_path . '" "' . $key . '"';
+      &debugPrint($the_count, $tid, 'TDBGET', 'Command: ' . $command);
+      my $result = `$command`;
+      &debugPrint($the_count, $tid, 'TDBGET', 'Result: ' . $result);
+      if ($result =~ /-{70}/)
+      {
+        $result .= "-"x70 . "\n";
+      }
+    }
+    # - adds, updates and deletes using TXT2TDB
+    elsif ($action eq '+' || $action eq '-')
+    {
+      my $command = 'txt2tdb "' . $tdb_path . '" -append';
+      &debugPrint($the_count, $tid, 'TXT2TDB', 'Command: ' . $command);
+      open(my $infodb_handle, '| ' . $command) or die("Error! Failed to open pipe to TXT2TDB\n");
+      print $infodb_handle '[' . $key . ']';
+      if ($action eq '-')
+      {
+        print $infodb_handle $action;
+      }
+      print $infodb_handle $payload;
+      close($infodb_handle);
+      $result = "-"x70 . "\n";
+      &debugPrint($the_count, $tid, 'TXT2TDB', 'Result: ' . $result);
+    }
+    else
+    {
+      die("Error! Unknown action: " . $action . "\n");
+    }
   }
   # Synchronized debug log writing
+  &debugPrint($the_count, $tid, 'SEND', $result);
+  return $result;
+}
+
+sub debugPrint
+{
+  my ($the_count, $tid, $type, $msg) = @_;
   if ($debug)
   {
     lock($debug_log);
     $|++;
-    print "[" . time() . "|" . $tid . "|SEND] " . $result . "\n\n";
+    print "[" . time() . "] #" . $the_count . ", tid:" . $tid . ", act:" . $type . "\n" . $msg . "\n\n";
     $|--;
     # //unlock($debug_log);
   }
-  return $result;
 }