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

Timestamp:

2012-04-23T09:33:00+12:00 (12 years ago)

Author:

jmt12

Message:

Instrumenting in order to try and track down race condition/hang during GS import

File:

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

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

@@ -91 +91 @@
 my $debug_log :shared = 0;
 
+my $msg_counter :shared = 0;
+
 print "===== TDB Server =====\n";
 print "Provides a server to allow multiple remote machines to simultaenously\n";
@@ -218 +220 @@
                                                    port=>$server_port,
                                                    thread_count=>$server_threads,
-#                                                   main_cb => \&exitCheck,
+                                                   main_cb => \&exitCheck,
                                                    processor_cb => \&process);
 
@@ -279 +281 @@
 {
   my $counter = shift @_;
-  print "[DEBUG] Has parent process gone away? [" . $parent_pid . "]\n";
+  #rint "[DEBUG] Has parent process gone away? [" . $parent_pid . "]\n";
   # Parent PID not available or we aren't allowed to talk to it (debugging)
   if ($parent_pid == 0)
@@ -420 +422 @@
     }
     # Open harness to TDBCLI
-    my @tdb_command = ($tdbexe, $tdb_path);
+    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)
     {
@@ -431 +441 @@
     # - write the data to the TDBCLI
     $buffer_to_tdb = $record . "\n";
-    pump($tdb_harness) while (length($buffer_to_tdb));
+    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
-    pump($tdb_harness) until ($buffer_from_tdb =~ /-{70}/);
+    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