Changeset 25454

Show
Ignore:
Timestamp:
23.04.2012 10:37:28 (7 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

Files:
1 modified

Legend:

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

    r25453 r25454  
    7777# Globally available - but once set these are read-only - so locking isn't 
    7878# an issue 
     79my $use_harness = 0; 
    7980my $tdbexe = 'tdbcli'; 
    8081my $parent_pid = 0; 
    8182my $collection = ''; 
    8283my $no_daemon = 0; 
    83 my $debug = 0; 
     84my $debug = 1; 
    8485my $server; 
    8586my $server_host; 
     
    318319  my $tid = shift @_; 
    319320  my $result = "#ERROR#"; 
    320   # Synchronized debug log writing 
    321   if ($debug) 
    322   { 
    323     lock($debug_log); 
    324     $|++; 
    325     print "[" . time() . "|" . $tid . "|RECV] " . $data . "\n"; 
    326     $|--; 
    327   } 
     321  my $the_count = 0; 
     322  { 
     323    lock($msg_counter); 
     324    $msg_counter++; 
     325    $the_count = $msg_counter + 0; 
     326    # //unlock($msg_counter); 
     327  } 
     328  &debugPrint($the_count, $tid, 'RECV', $data); 
    328329  # process special commands first 
    329330  if ($data =~ /^#([arq]):(.*)$/) 
     
    403404  # form  <database>:<key>:<value> 
    404405  # where: database is [d]oc, [i]ndex, or [s]rc 
    405   elsif ($data =~ /^([dis]):(.+)$/s) 
     406  elsif ($data =~ /^([dis]):\[([^\]]+)\]([+?\-])(.+)$/s) 
    406407  { 
    407408    my $database = $1; 
    408     my $record = $2; 
     409    my $key = $2; 
     410    my $action = $3 
     411    my $payload = $4; 
    409412    # Build path to database file 
    410413    my $tdb_path = ''; 
     
    421424      $tdb_path = &util::filename_cat($ENV{'GSDLHOME'}, 'collect', $collection, 'building', 'text', $collection . '.tdb'); 
    422425    } 
    423     # Open harness to TDBCLI 
    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); 
    432     my $buffer_to_tdb = ''; 
    433     my $buffer_from_tdb = ''; 
    434     my $tdb_harness = start(\@tdb_command, \$buffer_to_tdb, \$buffer_from_tdb); 
    435     # Check the harness worked 
    436  
    437     if (!pumpable $tdb_harness) 
    438     { 
    439       die("Error! Harness to " . $tdbexe . " has gone away!"); 
    440     } 
    441     # - write the data to the TDBCLI 
    442     $buffer_to_tdb = $record . "\n"; 
    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"; 
    450     # - read any response from TDBCLI 
    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"; 
    458     # - not that this result doesn't include the [Server] prefix as it 
    459     #   may be parsed for data by the client 
    460     $result = $buffer_from_tdb; 
    461     chomp($result); 
    462     # Finished with harness 
    463     finish($tdb_harness); 
     426    # Harnesses seem like goodly magic - but unfortunately may be broken 
     427    # magic. Testing on Medusa randomly hangs on the finish() function. 
     428    if ($use_harness) 
     429    { 
     430      my $record = '[' . $key . ']' . $action . $payload; 
     431      # Open harness to TDBCLI 
     432      my @tdb_command = ($tdbexe, $tdb_path, '-mid ' . $the_count); 
     433      my $buffer_to_tdb = ''; 
     434      my $buffer_from_tdb = ''; 
     435      my $tdb_harness = start(\@tdb_command, \$buffer_to_tdb, \$buffer_from_tdb); 
     436      # Check the harness worked 
     437      if (!pumpable $tdb_harness) 
     438      { 
     439        die("Error! Harness to " . $tdbexe . " has gone away!"); 
     440      } 
     441      # - write the data to the TDBCLI 
     442      $buffer_to_tdb = $record . "\n"; 
     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"; 
     450      # - read any response from TDBCLI 
     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"; 
     458      # - not that this result doesn't include the [Server] prefix as it 
     459      #   may be parsed for data by the client 
     460      $result = $buffer_from_tdb; 
     461      chomp($result); 
     462      # Finished with harness 
     463      finish($tdb_harness); 
     464    } 
     465    # Use different TDB tools depending on arguments 
     466    # - lookups using TDBGET 
     467    elsif ($action eq '?') 
     468    { 
     469      my $command = 'tdbget "' . $tdb_path . '" "' . $key . '"'; 
     470      &debugPrint($the_count, $tid, 'TDBGET', 'Command: ' . $command); 
     471      my $result = `$command`; 
     472      &debugPrint($the_count, $tid, 'TDBGET', 'Result: ' . $result); 
     473      if ($result =~ /-{70}/) 
     474      { 
     475        $result .= "-"x70 . "\n"; 
     476      } 
     477    } 
     478    # - adds, updates and deletes using TXT2TDB 
     479    elsif ($action eq '+' || $action eq '-') 
     480    { 
     481      my $command = 'txt2tdb "' . $tdb_path . '" -append'; 
     482      &debugPrint($the_count, $tid, 'TXT2TDB', 'Command: ' . $command); 
     483      open(my $infodb_handle, '| ' . $command) or die("Error! Failed to open pipe to TXT2TDB\n"); 
     484      print $infodb_handle '[' . $key . ']'; 
     485      if ($action eq '-') 
     486      { 
     487        print $infodb_handle $action; 
     488      } 
     489      print $infodb_handle $payload; 
     490      close($infodb_handle); 
     491      $result = "-"x70 . "\n"; 
     492      &debugPrint($the_count, $tid, 'TXT2TDB', 'Result: ' . $result); 
     493    } 
     494    else 
     495    { 
     496      die("Error! Unknown action: " . $action . "\n"); 
     497    } 
    464498  } 
    465499  # Synchronized debug log writing 
     500  &debugPrint($the_count, $tid, 'SEND', $result); 
     501  return $result; 
     502} 
     503 
     504sub debugPrint 
     505{ 
     506  my ($the_count, $tid, $type, $msg) = @_; 
    466507  if ($debug) 
    467508  { 
    468509    lock($debug_log); 
    469510    $|++; 
    470     print "[" . time() . "|" . $tid . "|SEND] " . $result . "\n\n"; 
     511    print "[" . time() . "] #" . $the_count . ", tid:" . $tid . ", act:" . $type . "\n" . $msg . "\n\n"; 
    471512    $|--; 
    472513    # //unlock($debug_log); 
    473514  } 
    474   return $result; 
    475515} 
    476516