#! /usr/local/bin/perl
################################################################################
##  mersearch - simple Merlin searches
##       Similarity search - find N most similar
##       Substructure search - find N most similar superstructures
##       SMARTS search - find N smallest (SMILES) matches
##       String search - find stringsearch matches in column specified
##       
##  Author: Jeremy Yang
##     Rev: 11 Sept 1996
################################################################################

use DayPerl;
$| = 1;
$N = 10;  ## Number of hits to show

%cols = ( );

#$INVALID_STR = dt_stringvalue(NULL_OB);
#$INVALID_STR = dt_stringvalue(dt_alloc_string(\000));
#$INVALID_STR = "\x00";
$INVALID_STR = \x00;
#$INVALID_STR = 0;

print "DEBUG: \$INVALID_STR = \"$INVALID_STR\"\n";

for ($i = 0; $i <= $#ARGV; ++$i) {
  if ($ARGV[$i] eq "-n")    { $N = $ARGV[++$i]; }
}

&INITIALIZE();
print &TIME."\n";
print $hello;
&SCAN4POOLS(@pools);

database: {
  for ($i = 0; $pool = <@pools>; ++$i) { printf("%2d. %s\n", $i, $pool); }
  print ($i ? "Enter # (or full pool name): " : "Enter pool: ");
  chop($db = <STDIN>);
  ($db eq "") && goto quit; 
  if ($db =~ /^\w?[0-9]+\w?$/) { $db = @pools[$db]; }
  &PARSE_DB($db);
  $mservice = $service;
  ## &DEBUG;

  ##########################################################
  ## Connect to Merlinserver, open pool.
  ##########################################################
  $poolname =  "$dbname\%$dbpw\@$host:$service:$user\%$userpw";
  if (NULL_OB ==
      ($mserver = dt_mer_server($host, $service, $user, $userpw, $isnew))) {
    print "Can't connect to server: \"$host:$service:$user\%$userpw\"\n";
    print "May be due to invalid server password.\n";
    goto database;
  } elsif (!dt_isopen($mserver, $dbname)) {
    print "Pool not loaded: \"$poolname\"\n";
    goto database;
  } elsif (NULL_OB ==
            ($pool = dt_open($mserver, $dbname, "r", $dbpw, $isnew))) {
    print "Can't open pool: \"$poolname\"\n";
    print "May be due to invalid database password.\n";
    goto database;
  } else {
    print "Pool opened: \"$poolname\"\n";
  }

  ##########################################################
  ## Allocate columns and hitlist.
  ##########################################################
  $ftype_sim   = &GET_FTYPE($pool,"SIMILARITY");
  $cols{"SIMILARITY"} = dt_mer_alloc_column($pool, $ftype_sim, DX_FUNC_FIRST);
  $ftype_smi   = &GET_FTYPE($pool,"\$SMI");
  $cols{"\$SMI"} = dt_mer_alloc_column($pool, $ftype_smi, DX_FUNC_FIRST);
  if ((NULL_OB == $ftype_sim) || (NULL_OB == $ftype_smi))
    { dt_dealloc($mserver); goto database; }
  $ftype   = &GET_FTYPE($pool,"\$NAM");
  $cols{"\$NAM"} = dt_mer_alloc_column($pool, $ftype, DX_FUNC_FIRST);
  $hitlist = dt_mer_alloc_hitlist($pool);
  dt_mer_reset($hitlist);
  $nrows = dt_mer_length($hitlist);
  print "Pool contains $nrows rows.\n"
}

prompt: {
  print "Current database: \"$dbname\@$host\".\n";
  print $prompt;
  ($ans = substr(<STDIN>, 0, 1)) =~ y/A-Z/a-z/;
  if ($ans eq "a") { goto simsearch; }
  if ($ans eq "b") { goto smisearch; }
  if ($ans eq "c") { goto smasearch; }
  if ($ans eq "d") { dt_dealloc($mserver); goto database; }
  if ($ans eq "e") { &POOLINFO($pool); goto prompt; }
  if ($ans eq "s") { goto strsearch; }
  goto quit;
}

simsearch: {
  ##########################################################
  ##  Enter SMILES; do search.
  ##########################################################
  print "Enter SMILES: "; chop($smi = <STDIN>);
  
  if (!&CHECKSMI($smi)) { goto simsearch; }
  print "Computing similarity... ";
  dt_mer_clear($hitlist);
  $ndone = dt_mer_similar($hitlist, $cols{"SIMILARITY"}, DX_SIMILAR_TANIMOTO,
                            DX_ACTION_ADD_HITS, -1, $status, $smi, 0.0);

  &PROGRESS($mserver) if ($status == DX_STATUS_IN_PROGRESS); 
  if ($status == DX_STATUS_NOT_FOUND) { 
    print "Target not found.\n";
  } elsif ($status == DX_STATUS_ERROR) { 
    print "Similarity search error.\n";
    &DU_PRINTERRORS;
  } else {
  
    ##########################################################
    ##  Sort hitlist.
    ##########################################################
    print "Sorting by similarity... ";
    $dsort = dt_mer_defaultsort($cols{"SIMILARITY"});
    $ndone = dt_mer_sort($hitlist, $cols{"SIMILARITY"}, $dsort, 0, $status);            
    &PROGRESS($mserver);
  
    ##########################################################
    ##  Print output.
    ##########################################################
    print "Top $N from similarity search:\n";
    for ($i = 0; $i < $N; $i++) {
      $smi = dt_mer_cellvalue($cols{"\$SMI"}, $hitlist, $i);
      $sim = dt_mer_cellvalue($cols{"SIMILARITY"}, $hitlist, $i);
      $nam = dt_mer_cellvalue($cols{"\$NAM"}, $hitlist, $i);
      printf("%-20s %-40s %-10s\n", $nam, $smi, $sim);
    }
    print "\n";
    &WRITETDTS;
  }
  goto prompt;
}

smisearch: {
  ##########################################################
  ##  Enter SMILES; do search.
  ##########################################################
  print "Enter SMILES: "; chop($smi = <STDIN>);

  if (!&CHECKSMI($smi)) { goto smisearch; }
  print "Finding superstructures... ";
  dt_mer_clear($hitlist);
  $ndone = dt_mer_superselect($hitlist, $cols{"\$SMI"}, DX_SUPER_SMILES,
                              DX_ACTION_ADD_HITS, -1, $status, $smi);
  &PROGRESS($mserver) if ($status == DX_STATUS_IN_PROGRESS); 
  if ($status == DX_STATUS_NOT_FOUND) {
    print "Target not found.\n";
  } elsif ($status == DX_STATUS_ERROR) {
    print  "Substructure search error.\n";
    &DU_PRINTERRORS;
  } else {
 
    ##########################################################
    ##  Sort hitlist.
    ##########################################################
    print "Computing similarity... ";
    $ndone = dt_mer_similar($hitlist, $cols{"SIMILARITY"}, DX_SIMILAR_TANIMOTO,
                              DX_ACTION_DEL_NONHITS, -1, $status, $smi, 0.0);
    &PROGRESS($mserver);
    print "Sorting by similarity... ";
    $dsort = dt_mer_defaultsort($cols{"SIMILARITY"});
    $ndone = dt_mer_sort($hitlist, $cols{"SIMILARITY"}, $dsort, 0, $status);
    &PROGRESS($mserver);
 
    ##########################################################
    ##  Print output.
    ##########################################################
    $nhits = dt_mer_length($hitlist);
    print "$nhits / $nrows hit...\n";
    print "Top $N by similarity from substructure search:\n";
    print "Search SMILES = \"$smi\"\n";
    for ($i = 0; $i < $N && $i < $nhits; $i++) {
      $smi = dt_mer_cellvalue($cols{"\$SMI"}, $hitlist, $i);
      $sim = dt_mer_cellvalue($cols{"SIMILARITY"}, $hitlist, $i);
      $nam = dt_mer_cellvalue($cols{"\$NAM"}, $hitlist, $i);
      printf("%-30s %-40s %-10s\n", $nam, $smi, $sim);
    }
    print "\n";
    &WRITETDTS;
  }
  goto prompt;
}

smasearch: {
  ##########################################################
  ##  Enter SMARTS; do search.
  ##########################################################
  print "Enter SMARTS: "; chop($sma = <STDIN>);

  if (!&CHECKSMA($sma)) { goto smasearch; }
  print "Finding SMARTS matches... ";
  dt_mer_clear($hitlist);
  $ndone = dt_mer_superselect($hitlist, $cols{"\$SMI"}, DX_SUPER_SMARTS,
                              DX_ACTION_ADD_HITS, -1, $status, $sma);

  &PROGRESS($mserver) if ($status == DX_STATUS_IN_PROGRESS); 
  if ($status == DX_STATUS_NOT_FOUND) { 
    print "Target not found.\n";
  } elsif ($status == DX_STATUS_ERROR) { 
    print "SMARTS search error.\n";
    &DU_PRINTERRORS;
  } else {
 
    ##########################################################
    ##  Sort hitlist.
    ##########################################################
    print "Sorting by SMILES length... ";
    $ndone = dt_mer_sort($hitlist, $cols{"\$SMI"}, DX_SORT_LEN, 0, $status);
    &PROGRESS($mserver);
    dt_mer_reverse($hitlist);

    ##########################################################
    ##  Print output.
    ##########################################################
    $nhits = dt_mer_length($hitlist);
    print "$nhits / $nrows hit...\n";
    print "Top $N by smi-length from SMARTS search:\n";
    print "Search SMARTS = \"$sma\"\n";
    for ($i = 0; $i < $N && $i < $nhits; $i++) {
      $smi = dt_mer_cellvalue($cols{"\$SMI"}, $hitlist, $i);
      $nam = dt_mer_cellvalue($cols{"\$NAM"}, $hitlist, $i);
      printf("%-30s %-40s\n", $nam, $smi);
    }
    print "\n";
    &WRITETDTS;
  }
  goto prompt;
}

strsearch: {
  ##########################################################
  ##  Select column
  ##########################################################
  print "Searchable columns:\n";
  @tags = ( );
  $dtypes = dt_stream($pool, TYP_DATATYPE);
  for ($i = 0; NULL_OB != ($dtype = dt_next($dtypes)); ) {
    $ftypes = dt_stream($dtype, TYP_FIELDTYPE);
    $ftype = dt_next($ftypes);
    dt_dealloc($ftypes);
    if (0 < dt_mer_getnitems($pool, $dtype)) {
      ++$i;
      $tags[$i] = dt_tag($dtype);
      printf("%3d. %-6s (%s)\n",$i, $tags[$i], dt_name($ftype));
    }
  }
  do { print "Select a column by number: "; chop($j = <STDIN>); }
  until (0 < $j && $j <= $i);
  $tag = $tags[$j];
  if (!exists($cols{$tag})) {
    $ftype   = &GET_FTYPE($pool,$tag);
    $cols{$tag} = dt_mer_alloc_column($pool, $ftype, DX_FUNC_FIRST);
  }
  print "Search string: "; chop($str = <STDIN>);
  print "Finding string matches... ";
  dt_mer_clear($hitlist);

  $ndone = dt_mer_strsearch($hitlist, $cols{$tag}, DX_STRING_NCPW,
                DX_ACTION_ADD_HITS, -1, $status, $str, $INVALID_STR);


  &PROGRESS($mserver) if ($status == DX_STATUS_IN_PROGRESS); 
  if ($status == DX_STATUS_NOT_FOUND) { 
    print "Target not found.\n";
  } elsif ($status == DX_STATUS_ERROR) {
    print "String search error.\n";
    &DU_PRINTERRORS;
  } else {
    ##########################################################
    ##  Print output.
    ##########################################################
    $nhits = dt_mer_length($hitlist);
    print "$nhits / $nrows hit...\n";
    print "Search string = \"$str\"\n";
    for ($i = 0; $i < $N && $i < $nhits; $i++) {
      $smi = dt_mer_cellvalue($cols{"\$SMI"}, $hitlist, $i);
      $data = dt_mer_cellvalue($cols{$tag}, $hitlist, $i);
      $nam = dt_mer_cellvalue($cols{"\$NAM"}, $hitlist, $i);
      printf("%-20s %-20s %s\n", $nam, $data, $smi);
    }
    print "\n";
    &WRITETDTS;
  }
  goto prompt;
}


quit:
  dt_dealloc($pool);
  print "Adios!\n";
  exit 0;


################################################################################
##    PARSE_DB($db)
##                                                    
##    where db = dbname[%dbpw]                        (1)
##    or    db = dbname[%dbpw]@host                   (2)
##    or    db = dbname[%dbpw]@host                   (3)
##    or    db = dbname[%dbpw]@host:service           (4)
##    or    db = dbname[%dbpw]@host:service:user      (5)
##    or    db = dbname[%dbpw]@host:service:user%pw   (6)
################################################################################

sub PARSE_DB {
  local($db) = @_;
 
  ########################################################
  ### Default values
  ########################################################
  $dbname = $dbpw = $userpw = "";
  chop($hostname = `hostname`);
  chop($whoami = `whoami`);
  $host = $hostname || (gethostent())[0];
  $user = $ENV{'USER'} || getlogin || (getpwuid($<))[0] || $whoami;
  $service = "merlin";

  $a = index($db, "\@", 0);    ### 1st '@'
  $p1 = index($db, "%", 0);    ### 1st '%'
  $c1 = index($db, ":", 0);    ### 1st ':'
  if ($c1 >= 0) { $c2 = index($db, ":", $c1 + 1); } else { $c2 = -1; }
  if ($p1 >= 0) { $p2 = index($db, "%", $p1 + 1); } else { $p2 = -1; }
  if ($a > 0 && $p1 > $a) { $p2 = $p1; $p1 = -1; }
 
  ########################################################
  ### case 1: db = dbname[%dbpw]
  ########################################################
  if ($a < 0) {
    if ($p1 < 0) { $dbname = $db; }
    else {
      $dbname = substr($db, 0, $p1);
      $dbpw = substr($db, $p1 + 1);
    }

  ########################################################
  ### case 2: db = dbname[%dbpw]@host
  ########################################################
  } else {
    if ($p1 < 0) {
      $dbname = substr($db, 0, $a);

    ########################################################
    ### case 3: db = dbname%dbpw@host
    ########################################################
    } else {
      $dbpw = substr($db, $p1 + 1, $a - $p1 -1);
      $dbname = substr($db, 0, $p1);
    }
    if ($c1 < 0) { $host = substr($db, $a + 1);

    ########################################################
    ### case 4: db = dbname[%dbpw]@host:service
    ########################################################
    } else {
      if ($c1 - $a > 1) { $host = substr($db, $a + 1, $c1 - $a -1); }
      if ($c2 < 0) {
        $service = substr($db, $c1 + 1);
   
      ########################################################
      ### case 5: db = dbname[%dbpw]@host:service:user
      ########################################################
      } else {
        if ($c2 - $c1 > 1)
          { $service = substr($db, $c1 + 1, $c2 - $c1 - 1); }
        if ($p2 < 0) {
          $user = substr($db, $c2 + 1);
        
        ########################################################
        ### case 6: db = dbname[%dbpw]@host:service:user%pw   
        ########################################################
        } else {
          $user = substr($db, $c2 + 1, $p2 - $c2 - 1);
          $userpw = substr($db, $p2 + 1);
        }
      }
    }
  }
 
  ########################################################
  ###  Check for errors.                             
  ########################################################
  if ((0 <= index($dbname, "%")) || (0 <= index($host, ":"))) {
    return (0);
  }
  return (1);
}

########################################################
###  GET_FTYPE($pool, $tag) get first fieldtype matching given tag
########################################################

sub GET_FTYPE {

  local($pool, $tag) = @_;
 
  $dtype  = dt_getdatatype($pool, $tag);
  $ftypes = dt_stream($dtype, TYP_FIELDTYPE);
  if (NULL_OB == ($ftype  = dt_next($ftypes))) {
    print "Can't get 1st field for \"$tag\" datatype.\n";
    &DU_PRINTERRORS;
    return (NULL_OB);
  }
  dt_dealloc($ftypes);
 
  return ($ftype);
}
 
########################################################
### PROGRESS($server) - report Merlin progress
###   Note that $progress is a global variable.
########################################################

sub PROGRESS {

  local($server) = @_;

  $old_percent_done = 0;
  $done_when = dt_done_when($server);
  while (DX_STATUS_IN_PROGRESS == $status) {
    $percent_done = int((100 * $ndone)/$done_when);
    if ($percent_done != $old_percent_done) { printf("%d%% ", $percent_done); }
    $old_percent_done = $percent_done;
    $ndone = dt_continue($server, $status);
  }
  print "done.\n";
}

########################################################
## SCAN4POOLS(@pools) - get pool list
########################################################

sub SCAN4POOLS {
  local($server, $i) = ("",  0);
 
  if (!exists($ENV{'DY_ROOT'})) {
    print STDERR "ERROR (mersearch): DY_ROOT undefined.\n";
    exit (1);
  } else { $DY_ROOT = $ENV{'DY_ROOT'}; }
  if (!exists($ENV{'DY_MERLIN_SERVER_LIST'})) {
    @MERLIN_SERVER_LIST = ($host);
  } else {
    @MERLIN_SERVER_LIST = split(/\s?,\s?/, $ENV{'DY_MERLIN_SERVER_LIST'});
  }
  print "Scanning for loaded pools...\n";
  foreach $server (@MERLIN_SERVER_LIST) {
    foreach $pool (split(/\W+/, `$DY_ROOT/bin/merlinls -SECURE_PASSWORDS FALSE $server:merlin:thorinfo\%`)) {
      if ($pool ne "") { @pools[$i++] = $pool."\@".$server };
    }
  }
}

########################################################
## INITIALIZE() - assign long strings
########################################################

sub INITIALIZE {

  chop($hello = <<'EOHello');
****************************************************
*  MerSearch - Simple Merlin searches              *
*    mersearch [-n N]  show N hits after searches  *
****************************************************

EOHello

  chop($prompt = <<'EOPrompt');
MerSearch action:
  a) SMILES similarity search
  b) SMILES substructure search
  c) SMARTS search
  d) Reselect database
  e) Show pool info
  s) String search
  q) quit

Select an option [q]: 
EOPrompt

}

########################################################
###  DU_PRINTERRORS()
########################################################

sub DU_PRINTERRORS {
 $errs = dt_errors(DX_ERR_ERROR);
  while (NULL_OB != ($err = dt_next($errs))) {
    $errstring = dt_stringvalue($err);
    print "$errstring\n";
  }
}

########################################################
###  WRITETDTS($hitlist)
########################################################

sub WRITETDTS {

  print "Write a TDT file for these $N? [n]: ";
  ($ans = substr(<STDIN>, 0, 1)) =~ y/A-Z/a-z/;
  if ($ans ne "y") {
    print "Write a MOL file for these $N? [n]: ";
    ($ans = substr(<STDIN>, 0, 1)) =~ y/A-Z/a-z/;
    return if ($ans ne "y");
    print "Filename?: "; chop($FILE = <STDIN>);
    if ("" eq $FILE) { return (0); }
    $writemol = 1;
  } else {
    $writemol = 0;
    print "Filename? [stdout]: "; chop($FILE = <STDIN>);
    if ("" eq $FILE) { $FILE = "-"; }
  }
  if (!open(FILE, ">".$FILE)) {
    print "Can't open \"$FILE\".\n";
    return (0);
  } else {
    print "\"$FILE\" opened for writing.\n";
  }

  ##########################################################
  ## Connect to Thorserver, open database.
  ##########################################################
  $tserver = dt_thor_server($host, "thor", $user, $userpw, $isnew);
  if (NULL_OB == $tserver) {
    print "Can't connect to Thorserver: \"$host:thor:$user%$userpw\"\n";
    return (0);
  } elsif (NULL_OB ==
      ($thordb = dt_open($tserver, $dbname, "r", $dbpw, $isnew))) {
    print "Can't open database: \"$dbname\%$dbpw\@$host:thor:$user%$userpw\"\n";
    return (0);
  }
  print "Opened database: \"$dbname\%$dbpw\@$host:thor:$user%$userpw\"\n";

  ##########################################################
  ## Write top $N hitlist TDTs.
  ##########################################################
  $smitype  = dt_getdatatype($thordb, "\$SMI");
  for ($i = $j = 0; $i < 10; $i++) {
    $smi = dt_mer_cellvalue($cols{"\$SMI"}, $hitlist, $i);
    $tdt_h = dt_thor_tdtget($thordb, $smitype, $smi, 0, $isnew);
    if (NULL_OB != $tdt_h) {
      $tdt = dt_thor_tdt2str($tdt_h, 0);
      &PRINTTDT("FILE", $tdt); ++$j;
      dt_dealloc($tdt_h);
    }
  }
  close(FILE);
  if ($writemol) {
    if (&TDT2MOL("FILE")) {
      print "$j MOLs written to \"$FILE\".\n";
    } else {
      print "Unable to write molfile \"$FILE\".\n";
      return (0);
    }
  } else {
  print "$j TDTs written to \"$FILE\".\n";
  }
  dt_dealloc($tserver);
  return (1);
}

########################################################
###  TIME()
########################################################

sub TIME {
  ($s,$m,$h,$md,$mon,$y,$wd,$yd,$isdst) = localtime(time);
  $month = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec)[$mon];
  $wday = (Sun,Mon,Tue,Wed,Thu,Fri,Sat)[$wd];
  return ($wday." ".$month." ".$md." ".$h.":".$m.":".$s." 19".$y);
}

########################################################
###  CHECKSMI($smi)
########################################################

sub CHECKSMI {
  local($smi) = @_;
  local($mol);

  if (NULL_OB == ($mol = dt_smilin($smi))) {
    &DU_PRINTERRORS;
    return (0);
  } else {
    dt_dealloc($mol);
    return (1);
  }
}

########################################################
###  CHECKSMA($sma)
########################################################

sub CHECKSMA {
  local($sma) = @_;
  local($pat);

  if (NULL_OB == ($pat = dt_smartin($sma))) {
    &DU_PRINTERRORS;
    return (0);
  } else {
    dt_dealloc($pat);
    return (1);
  }
}

########################################################
###  POOLINFO($pool)
########################################################

sub POOLINFO {
 
  local($pool) = @_;
  local($dtypes, $dtype, $i, $ftypes, $ftype, $nitems);

  print STDERR "Current pool: $dbname\@$host:$service:$user ($nrows rows)\n";
  $dtypes = dt_stream($pool, TYP_DATATYPE);
  if (NULL_OB == $dtypes) { print STDERR "ERROR (1)\n"; }
  else {
    printf (STDERR "---- DATATYPE---------------------- -------TAG --------#\n");
    for ($i = 1; NULL_OB != ($dtype = dt_next($dtypes)); ++$i) {
      $ftypes = dt_stream($dtype, TYP_FIELDTYPE);
      $ftype = dt_next($ftypes);
      dt_dealloc($ftypes);
      $nitems = dt_mer_getnitems($pool, $dtype);
      printf (STDERR "%3d. %-30s %10s %9d\n",$i, dt_name($ftype), dt_tag($ftype), $nitems);
    }
    printf (STDERR "--------------------------------------------------------\n");
    dt_dealloc($dtypes);
  }
}

################################################################################
##  SUBROUTINE PRINTTDT
################################################################################
 
sub PRINTTDT {
 
  local($fileptr, $tdt) = @_;
  local($buff, $i);
 
  $buff = $tdt;
  while ($buff ne "") {
    if (0 > ($i = &DU_INDEX($buff, ">", 0))) {
      print $fileptr "$buff\n";
      $buff = "";
    } else {
      print $fileptr substr($buff, 0, $i + 1)."\n";
      $buff = substr($buff, $i + 1);
    }
  }
}

################################################################################
##  SUBROUTINE DU_INDEX -- find next occurance of a character in a TDT
##  respecting Thor's quoting rules.  For example, the following are
##  legal TDTs:
##                 $SMI<CC>$NAM<ethane>REM<"vbar: |">|
##                 $SMI<CCCCC>$NAM<pentane>REM<"This ->""<- is a quote">|
##  And these are not legal:
##                 $SMI<C>$NAM<methane>BP< >0.8K>|
##                 $SMI<CC>$NAM<ethane>REM<It's a "gas", man!>|
################################################################################
##   $position -- look from here on in string
##   $i        -- this is where a target char is
##   $j        -- this is where a opening quote is
##   $k        -- this is where an ending quote is
################################################################################
 
sub DU_INDEX {
 
  local($tdt, $char, $position) = @_;
  local($i, $j, $k, $balanced);
 
  while (0 <= ($i = index($tdt, $char, $position))) {
    $j = index($tdt, "\"", $position);              ## 1st quote after $position
    if ($j < 0 || $i < $j) {
      last;
    } else {                                        ## find next quote
      $balanced = 0;
      $k = $j + 1;
      while (0 < ($k = index($tdt, "\"", $k))) {
        if ("\"" eq substr($tdt, $k + 1, 1)) {      ## quoted quote?
          $position = $k += 2;
        } else {
          $position = ++$k;
          $balanced = 1;
        }
      }
      if (!$balanced) {
        $i = -1;
        last;
      }
    }
  }
  $position = $i;
}


########################################################
###  DEBUG!!
########################################################

sub DEBUG {

 print "DEBUG: \$dbname = \"$dbname\"\n";
 print "DEBUG: \$dbpw = \"$dbpw\"\n";
 print "DEBUG: \$host = \"$host\"\n";
 print "DEBUG: \$service = \"$service\"\n";
 print "DEBUG: \$user = \"$user\"\n";
 print "DEBUG: \$userpw = \"$userpw\"\n";
 print "DEBUG: \$a = \"$a\"\n";
 print "DEBUG: \$p1 = \"$p1\"\n";
 print "DEBUG: \$p2 = \"$p2\"\n";
 print "DEBUG: \$c1 = \"$c1\"\n";
 print "DEBUG: \$c2 = \"$c2\"\n";
}

################################################################################
##  SUBROUTINE TDT2MOL
################################################################################
 
sub TDT2MOL {
 
  local($fileptr) = @_;
  local($buff);
 
### This doesn't catch 'tdt2mol: not found' error ###

  if (!open(MOLFILE, "cat $$fileptr | tdt2mol |")) {
    print "Can't run tdt2mol.\n";
    return (0);
  }
  while (<MOLFILE>) { $buff .= $_; }

  if (!open($fileptr, ">".$$fileptr)) {
    print "Can't open \"$$fileptr\".\n";
    return (0);
  }
  printf($fileptr "%s", $buff);
  return (1);
}