Changeset 25453

Show
Ignore:
Timestamp:
23.04.2012 09:33:00 (8 years ago)
Author:
jmt12
Message:

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

Files:
1 modified

Legend:

Unmodified
Added
Removed
  • gs2-extensions/tdb-edit/trunk/src/bin/script/TDBServer.pl

    r25414 r25453  
    9191my $debug_log :shared = 0; 
    9292 
     93my $msg_counter :shared = 0; 
     94 
    9395print "===== TDB Server =====\n"; 
    9496print "Provides a server to allow multiple remote machines to simultaenously\n"; 
     
    218220                                                   port=>$server_port, 
    219221                                                   thread_count=>$server_threads, 
    220 #                                                   main_cb => \&exitCheck, 
     222                                                   main_cb => \&exitCheck, 
    221223                                                   processor_cb => \&process); 
    222224 
     
    279281{ 
    280282  my $counter = shift @_; 
    281   print "[DEBUG] Has parent process gone away? [" . $parent_pid . "]\n"; 
     283  #rint "[DEBUG] Has parent process gone away? [" . $parent_pid . "]\n"; 
    282284  # Parent PID not available or we aren't allowed to talk to it (debugging) 
    283285  if ($parent_pid == 0) 
     
    420422    } 
    421423    # Open harness to TDBCLI 
    422     my @tdb_command = ($tdbexe, $tdb_path); 
     424    my $the_count = 0; 
     425    { 
     426      lock($msg_counter); 
     427      $msg_counter++; 
     428      $the_count = $msg_counter + 0; 
     429      # //unlock($msg_counter); 
     430    } 
     431    my @tdb_command = ($tdbexe, $tdb_path, '-mid ' . $the_count); 
    423432    my $buffer_to_tdb = ''; 
    424433    my $buffer_from_tdb = ''; 
    425434    my $tdb_harness = start(\@tdb_command, \$buffer_to_tdb, \$buffer_from_tdb); 
    426435    # Check the harness worked 
     436 
    427437    if (!pumpable $tdb_harness) 
    428438    { 
     
    431441    # - write the data to the TDBCLI 
    432442    $buffer_to_tdb = $record . "\n"; 
    433     pump($tdb_harness) while (length($buffer_to_tdb)); 
     443    my $write_msg = '#' . $the_count . ' writing: |' . $record . '| => '; 
     444    while (length($buffer_to_tdb)) 
     445    { 
     446      $write_msg .='.'; 
     447      pump($tdb_harness); 
     448    } 
     449    print STDERR $write_msg . "\n"; 
    434450    # - read any response from TDBCLI 
    435     pump($tdb_harness) until ($buffer_from_tdb =~ /-{70}/); 
     451    my $read_msg = '#' . $the_count . ' reading: '; 
     452    while ($buffer_from_tdb !~ /-{70}/) 
     453    { 
     454      $read_msg .= '.'; 
     455      pump($tdb_harness); 
     456    } 
     457    print STDERR $read_msg . ' => |' . $buffer_from_tdb . "|\n"; 
    436458    # - not that this result doesn't include the [Server] prefix as it 
    437459    #   may be parsed for data by the client