#! /usr/local/bin/perl
################################################################################
##  thorget - THOR lookup via primary or xref id
##      
##  AUTHOR: Jeremy Yang
##  Rev:   1 Nov 1996
################################################################################

use DayPerl;
$| = 1;
$FILEIN = "-";
$FILEOUT = ">-";

sub HELP {
  print STDERR 
    "\t******************************************************\n".
    "\t* thorget - Thor lookup via primary or xref id       *\n".
    "\t******************************************************\n".
    "\t* thorget [options] db [<infile] [outfile]           *\n".
    "\t*                                                    *\n".
    "\t*   -DTYPE <dtype>                                   *\n".
    "\t*   -INPUT_FORMAT [DAT|TDT]                          *\n".
    "\t*   -OUTPUT_FORMAT [PAGE|TDT|FDT]                    *\n".
    "\t*   -EXPAND_IREFS [FALSE|TRUE]                       *\n".
    "\t*   -INCLUDE_DTYPES <dt1 dt2 ...>                    *\n".
    "\t*   -EXCLUDE_DTYPES <dt1 dt2 ...>                    *\n".
    "\t*   -I [infile]                                      *\n".
    "\t*   -O [outfile]                                     *\n".
    "\t*   -HELP                                            *\n".
    "\t*                                                    *\n".
    "\t* Defaults are first values, except -EXPAND_IREFS is *\n".
    "\t* by default TRUE for PAGE/FDT output and FALSE for  *\n".
    "\t* TDT output.  INCLUDE_ takes precedence over        *\n".
    "\t* EXCLUDE_DTYPES.                                    *\n".
    "\t******************************************************\n".
    "\t*  Daylight Toolkit (DayPerl) Demonstration Program  *\n".
    "\t******************************************************\n";
  exit;
}

$count = $hit_count = 0;
$dtype = "\$SMI"; $dat_in = 1;  $ex_irefs = -1;  $outfmt = "PAGE";
$inc_dts = $exc_dts = "";

### Parse args ###
if ($#ARGV < 0) { &HELP; }
for ($i = 0; $i <= $#ARGV; $i++) {
  if ($ARGV[$i] =~ /-HELP/i) { &HELP; }
  elsif ($ARGV[$i] =~ /-DTYPE/i) {
    if (($dtype = $ARGV[++$i]) !~ /\$\S+$/) {
      print STDERR "Bad id tag \"$dtype\" ...\n"; &HELP;
    }
  }
  elsif ($ARGV[$i] =~ /-INPUT_FORMAT/i) {
    if ($ARGV[++$i] =~ /DAT/i)  { $dat_in = 1; $tdt_in = 0; }
    elsif ($ARGV[$i] =~ /TDT/i) { $dat_in = 0; $tdt_in = 1; }
    else { print STDERR "Bad option value \"$ARGV[$i]\" ...\n"; &HELP; }
  }
  elsif ($ARGV[$i] =~ /-OUTPUT_FORMAT/i) {
    if ($ARGV[++$i] =~ /PAGE/i) { $outfmt = "PAGE"; }
    elsif ($ARGV[$i] =~ /TDT/i) { $outfmt = "TDT"; }
    elsif ($ARGV[$i] =~ /FDT/i) { $outfmt = "FDT"; }
    else { print STDERR "Bad option value \"$ARGV[$i]\" ...\n"; &HELP; }
  }
  elsif ($ARGV[$i] =~ /-EXPAND_IREFS/i) {
    if ($ARGV[++$i] =~ /FALSE/i) { $ex_irefs = 0; }
    elsif ($ARGV[$i] =~ /TRUE/i) { $ex_irefs = 1; }
    else { print STDERR "Bad option value \"$ARGV[$i]\" ...\n"; &HELP; }
  }
  elsif ($ARGV[$i] =~ /-INCLUDE_DTYPES/i) { $inc_dts = $ARGV[++$i]; }
  elsif ($ARGV[$i] =~ /-EXCLUDE_DTYPES/i) { $exc_dts = $ARGV[++$i]; }
  elsif ($ARGV[$i] =~ /-I/i) { $FILEIN = $ARGV[++$i]; }
  elsif ($ARGV[$i] =~ /-O/i) { $FILEOUT = ">".$ARGV[++$i]; }
  elsif ($ARGV[$i] =~ /^-/) {
    print STDERR "Bad option \"$ARGV[$i]\" ...\n"; &HELP;
  }
  elsif ($i == $#ARGV) { $db = $ARGV[$i]; }
  else { print STDERR "Bad option \"$ARGV[$i]\" ...\n"; &HELP; }
}

if ($ex_irefs == -1) { $ex_irefs = ($outfmt ne "TDT") ? 1 : 0 }

if ($inc_dts) {
  print STDERR "Datatypes included:\n";
  foreach (split(/\s/, $inc_dts)) { print STDERR "\t\"$_\"\n"; }
} elsif ($exc_dts) {
  print STDERR "Datatypes excluded:\n";
  foreach (split(/\s/, $exc_dts)) { print STDERR "\t\"$_\"\n"; }
}

if (open(FILEIN)) {
   print STDERR "Opened \"$FILEIN\" for input...\n" if ($FILEIN ne "-");
} else { die "Can't open \"$FILEIN\" for input.\n"; }
if (open(FILEOUT)) {
  if ($FILEOUT ne ">-") {
    ($fname = $FILEOUT) =~ s/^>//;
    print STDERR "Opened \"$fname\" for output...\n"
  }
} else { die "Can't open \"$FILEOUT\" for output.\n"; }

if (!&PARSE_DB($db)) { print STDERR "DB syntax error...\n"; &HELP; }

##########################################################
## Connect to Thorserver, open database.
##########################################################
$server = dt_thor_server($host, "thor", $user, $userpw, $isnew);
if (NULL_OB == $server) {
  die "Can't connect to Thorserver: \"$host:thor:$user%$userpw\"\n";
} elsif (NULL_OB ==
    ($thordb = dt_open($server, $dbname, "r", $dbpw, $isnew))) {
  die "Can't open database: \"$dbname\%$dbpw\@$host:thor:$user%$userpw\"\n";
}
print STDERR "Opened database: \"$dbname\%$dbpw\@$host:thor:$user%$userpw\"\n";
 
##########################################################
###  Get the identifier datatype object.
##########################################################
if ($dat_in) {
  $dtype = "\$SMI" if (!$dtype);
  $dtype_h = dt_getdatatype($thordb, $dtype);
  if (NULL_OB == $dtype_h) {
    die "ERROR (thorget): Can't find dtype \"$dtype\"...\n";
  }
  print STDERR "Input datatype set to \"$dtype\"...\n";
}

##########################################################
###  Get the SMILES datatype.
##########################################################
if ($dtype eq "\$SMI") {
  $usesmiles = 1;
  $smitype_h = $dtype_h;
} else {
  $usesmiles = 0;
  if (NULL_OB == ($smitype_h = dt_getdatatype($thordb, "\$SMI"))) {
    print STDERR "No \$SMI datatype...\n";
    $smitype_h = NULL_OB;
  }
}

################################################################
###  Read ID's from input.  Look for TDT via primary ID route.
###  If this fails, and ID not SMILES, look via xref route.
###  Also allowed are escape commands:
###    ~d <datatype>
###    (e.g., ~d NAM changes input dtype to $NAM)
################################################################
inputloop:
for ( ; ; ++$count) {
 
  ################################################################
  ### DAT input
  ################################################################
  if ($dat_in) {
    ($id = <FILEIN>) || goto quit;
    chop($id);

    #######################################################
    ###  Escape sequences:
    ###    ~d <datatype>
    ###    (e.g., ~d $NAM changes input dtype to $NAM)
    ###    ~q  (quit)
    #######################################################
    if ($id =~ /^~/) {
      if ($id =~ /^~d /) {
        ($tmp_dtype = substr($id, 3)) =~ s/^\s*//;
        if (NULL_OB != ($tmp_h = dt_getdatatype($thordb, $tmp_dtype))) {
          $dtype_h = $tmp_h;
          $dtype = $tmp_dtype;
          print STDERR "Input datatype changed to \"$dtype\"...\n";
          if ($dtype eq "\$SMI") { $usesmiles = 1; }
          else { $usesmiles = 0; }
        }
        else {
          print STDERR "Can't find datatype \"$tmp_dtype\"...\n";
          print STDERR "Datatype remains \"$dtype\"...\n";
        }
      } elsif ($id =~ /^~q/) { goto quit; }
      else {
        print STDERR "Unknown escape sequence...\n";
        ++$errcount;
      }
      next inputloop;
    }
  }

  ################################################################
  ### TDT input
  ################################################################
  else {
    (&DU_READTDT($tdt)) || goto quit;

    $i = index($tdt, "<");
    $dtype = substr($tdt, 0, $i);

    if ($dtype eq "\$SMI") { $dtype_h = $smitype_h; }
    else {
      $dtype_h = dt_getdatatype($thordb, $dtype);
      if (NULL_OB == $dtype_h) {
        print STDERR "ERROR (thorget) Bad dtype \"$dtype\"...\n";
        ++$errcount;
        next inputloop;
      }
    }
    $j = index($tdt, ">");
    $id = substr($tdt, $i + 1, $j - $1 - 1);
  }

  ################################################################
  ###  Normal ID input (DAT or TDT mode).
  ################################################################
  $tdt_h = dt_thor_tdtget($thordb, $dtype_h, $id, 0, $isnew);
  if (NULL_OB != $tdt_h) {
    if ($outfmt eq "PAGE") { &DU_PRINT_TDPAGE($tdt_h, $ex_irefs, 
                              $inc_dts, $exc_dts); }
    elsif ($outfmt eq "FDT") { &DU_PRINT_FDT($tdt_h, $ex_irefs,
                                             $inc_dts, $exc_dts); }
    else {
      if (!&PRINTTDT(dt_thor_tdt2str($tdt_h, $ex_irefs), "LIST",
                $inc_dts, $exc_dts)) {
        print STDERR "PRINTTDT error.\n";
        ++$errcount;
      }
    }
    dt_dealloc($tdt_h);
    ++$hit_count;
  }

  ################################################################
  ###  The xref route . . . Note that dt_thor_xrefget returns a
  ###  sequence of string objects; the first is a string-object for
  ###  the xref itself; the rest are string-objects for the smiles
  ###  (may be >1 smiles if xref is ambiguous).
  ################################################################
  else {
    if ($usesmiles) { print STDERR "$dtype not found: \"$id\"\n"; }
    else {
      $seq_h = dt_thor_xrefget($thordb, $dtype_h, $id, $errcode);
      if (NULL_OB == $seq_h) {
        print STDERR "$dtype \"$id\" not found: \n";
        next inputloop;
      }
      if (2 < ($i = dt_count($seq_h, TYP_ANY))) {
        printf(STDERR "Ambiguous xref (%d hits) %s<%s>| ...\n",
                $i - 1, $dtype, $id); }
      dt_next($seq_h);
      while (NULL_OB != ($string_h = dt_next($seq_h))) {
        $smi = dt_stringvalue($string_h);
        $tdt_h = dt_thor_tdtget($thordb, $smitype_h, $smi, 0, $isnew);
        if (NULL_OB != $tdt_h) {
          if ($outfmt eq "PAGE") { &DU_PRINT_TDPAGE($tdt_h, $ex_irefs, 
                              $inc_dts, $exc_dts); }
          elsif ($outfmt eq "FDT") { &DU_PRINT_FDT($tdt_h, $ex_irefs,
                                                   $inc_dts, $exc_dts); }
          else {
            if (!&PRINTTDT(dt_thor_tdt2str($tdt_h, $ex_irefs), "LIST",
                      $inc_dts, $exc_dts)) {
              print STDERR "PRINTTDT error.\n";
              ++$errcount;
            }
          }
          dt_dealloc($tdt_h);
          ++$hit_count;
        }
        else {
          printf(STDERR "ERROR (thorget): Dangling xref: %s<%s>\$SMI<%s>|\n",
               $dtype, $id, dt_stringvalue($string_h));
          ++$errcount;
        }
      }
      dt_dealloc($seq_h);
    }
  }
  &DU_PRINTERRORS;
  dt_errorclear();
}

quit:
dt_dealloc($thordb);
dt_dealloc($server_h);
print STDERR "Thorget Results: Hits/Looks: $hit_count/$count\n";
print STDERR "Thorget Results: Errors: $errcount\n";
print STDERR "So long, baby!\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);
}

########################################################
###  DU_READTDT() - reads list or dump format TDTs 
###                 into $tdt.
###                 ("|" must be last char in a line.)
###  Returns (1) if ok, (0) if EOF, and (-1) on error.
########################################################

sub DU_READTDT
{
  $tdt = "";
  while ($buff = <FILEIN>) {
    chop($buff);
    $tdt .= $buff;
    if ($buff =~ /|$/) { return (1); }
  }
  return $buff ? (-1) : (0);  ### Error or EOF, respectively.
}

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

########################################################
###  DU_PRINT_TDPAGE - prints a TDT in human-readable
###                    "page" fashion.
########################################################
 
sub DU_PRINT_TDPAGE
{
  local($tdt_h,        ### TDT handle
        $ex_irefs,     ### Expand irefs flag
        $inc_dts,   ### Include-datatypes
        $exc_dts)   ### Exclude-datatypes
        = @_;
  local($subtdts,      ### Subtree stream
        $tdts,         ### All subtrees including $SMI-subtree
        $subtdt,       ### Subtree
        $dis,          ### Dataitem stream
        $di,           ### Dataitem handle
        $dfs,          ### Datafield stream
        $df,           ### Datafield handle
        $dfstr,        ### Datafield string
        $ttab,         ### Id indentation
        $tag,          ### Datatype tag
        $tab,          ### Total indentation
        $root,         ### Root dataitem flag
        $firstdf,      ### First datafield (in each di) flag
        $ok,           ### Datatype ok for printing?
        $t             ### "tab" = 4 spaces
       );

  $t = "    ";
  if    ($inc_dts) { @inc_dts = split(/\s/, $inc_dts); }
  elsif ($exc_dts) { @exc_dts = split(/\s/, $exc_dts); }

  if (NULL_OB == $tdt_h) { return (0); }
  $tdts = &DU_STREAM2SEQ($subtdts = dt_stream($tdt_h, TYP_DATATREE));
  dt_dealloc($subtdts);
  dt_reset($tdts);
  dt_insert($tdts, $tdt_h);
  dt_reset($tdts);
  if (NULL_OB == $tdts) { return (0); }

  ###################################################
  ### Sequence sub-TDTs (note that we have added 
  ### *the* TDT to the sequence, so its dataitems
  ### are handled.
  ###################################################
  for ($tab = 0, $root = 1; NULL_OB != ($subtdt = dt_next($tdts)); ) {

    ###################################################
    ### Stream dataitems for each sub-TDT
    ###################################################
    $dis = dt_stream($subtdt, TYP_DATAITEM);
dataitem:
    for ($firstdf = 1; NULL_OB != ($di = dt_next($dis)); $firstdf = 1) {

      ###################################################
      ### Check include/exclude restrictions
      ###################################################
      $tag = dt_tag(dt_datatype($di));
      $ok = 1;
      if ($inc_dts) {
        $ok = (MEMBER($tag, 0, @inc_dts)) ? 1 : 0;
      } elsif ($exc_dts) {
        $ok = (!MEMBER($tag, 0, @exc_dts)) ? 1 : 0;
      }
      next dataitem if (!$ok);

      $dfs = dt_stream($di, TYP_DATAFIELD);

      ###################################################
      ### Stream datafields for each dataitem
      ###################################################
      while (NULL_OB != ($df = dt_next($dfs))) {

        ###################################################
        ### Special handling for binary or indirect data
        ###################################################
        if (dt_dfnorm($df, DY_THOR_BINARY)) {
          $dfstr = sprintf("[%d binary bytes]", length(dt_stringvalue($df)));
        } elsif (!$ex_irefs && dt_dfnorm($df, DY_THOR_INDIRECT)) {
          $dfstr = dt_thor_raw_datafield($df);
        } else { $dfstr = dt_stringvalue($df); }

        ###################################################
        ### Get tag ($D).  Figure out depth in tree.
        ### Get verbose name (_V).
        ###################################################
        $dftype = dt_fieldtype($df);
        $tag = dt_tag($dftype);
        if ($root)            { $tab = $ttab = 0; $id = 1; }
        elsif ($tag =~ /^\$/) { $tab = $ttab = 1; $id = 1; }
        else { $tab = $ttab + 1; $id = 0; }
        $vname = dt_info($df, "name"); ### verbose name of dfield

        ###################################################
        ### Print delimiter before first field in each dataitem.
        ###################################################
        print FILEOUT "|$t"x$tab, "+", ($id?"=":"-") x (80-5*$tab-1), "\n"
        if ($firstdf);

        $NLEN = 12;                        ### Default field name width
        $width = 80 - 5*$tab - $NLEN - 2;  ### Width after indentation

        ###################################################
        ### Print dtype name & next indent if it's long
        ###################################################
        if (length($vname) > $NLEN) {
          printf(FILEOUT "%s|%s\n", "|$t"x$tab, $vname);
          printf(FILEOUT "%s|%s ", "|$t"x$tab, " "x$NLEN);
        } else {
          printf(FILEOUT "%s|%"."$NLEN"."s ", "|$t"x$tab, $vname);
        }

        ###################################################
        ### Print data.
        ### Handle long datastrings to avoid wraparound.
        ###################################################
       if (!$dfstr) { print FILEOUT "\n"; }
       @lines = &STR2LINES($dfstr, $width);
       foreach $line (@lines) {
         if ($line ne $lines[0]) {
           printf(FILEOUT "%s|%s ", "|$t"x$tab, " "x$NLEN);
         }
         printf(FILEOUT "%s\n", $line);
       }

        $root = $firstdf = 0;
      }
    }
  }
  print FILEOUT "+", "="x(79), "\n";
  return (1);
}

########################################################
###  DU_STREAM2SEQ($stream)
########################################################
 
sub DU_STREAM2SEQ
{
  ($stream) = @_;
  $seq = dt_alloc_seq();
 
  while (NULL_OB != ($ob = dt_next($stream))) {
    dt_append($seq, $ob);
  }
  return $seq;
}

################################################################################
##  PRINTTDT
################################################################################
 
sub PRINTTDT
{
  local($tdt, $format, $inc_dts, $exc_dts) = @_;
  local($ok, $tag);
 
  if    ($inc_dts) { @inc_dts = split(/\s/, $inc_dts); }
  elsif ($exc_dts) { @exc_dts = split(/\s/, $exc_dts); }
  while ($tdt ne "") {
    if (0 > ($i = &DU_INDEX($tdt, ">", 0))) {
      print FILEOUT "$tdt\n";
      if ($tdt eq "|") { return (1); } else { return (0); }
    } else {

      ###################################################
      ### Check include/exclude restrictions
      ###################################################
      $ok = 1;
      if ($inc_dts) {
        ($tag = $tdt) =~ s/<.*$//;
        $ok = (MEMBER($tag, 0, @inc_dts)) ? 1 : 0;
      } elsif ($exc_dts) {
        ($tag = $tdt) =~ s/<.*$//;
        $ok = (!MEMBER($tag, 0, @exc_dts)) ? 1 : 0;
      }
      if ($ok) {
        print FILEOUT substr($tdt, 0, $i + 1);
        print FILEOUT "\n" if ($format eq "LIST");
      }
      $tdt = substr($tdt, $i + 1);
    }
  }
  return (0);
}

################################################################################
##  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;
}

################################################################################
### MEMBER - is ($element) a member of (@array)?  Note that array must
###          be last arg or it is assigned all remaining args.
################################################################################

sub MEMBER
{
  local($element, $numerical, @array) = @_;
  local($member);

  if ($numerical) {
    foreach $member (@array) { if ($member == $element) { return (1); } }
  } else {
    foreach $member (@array) { if ($member eq $element) { return (1); } }
  }
  return (0);
}

################################################################################
### STR2LINES - splits ($string) into an array of strings <=($width)
################################################################################

sub STR2LINES
{
  local($string, $width) = @_;
  local($i,          ### Position of next space
        $j,          ### Position of last space in line
        $k,          ### Position of next line
        $len,        ### Length on string
        @array       ### Array of lines
       );
 
  if (!($len = length($string))) { return (@array = ()); }
  for ($k = 0; $len > $k; $k = $j + 1) {                         ### Line loop
    $j = $k + $width - 1;  ### In case no spaces exist

    if ($len - $k <= $width) {                                   ### Last line?
      return(@array = (@array, substr($string, $k)));
    } else {
      for ($i = $k; ($i = index($string, " ", $i)) > 0 ; ++$i) { ### Word loop
        last if ($i - $k + 1 > $width);
        $j = $i;
      }
      @array = (@array, substr($string, $k, $j - $k + 1));
    }
  }
}

################################################################################
### DU_PRINT_FDT - print a formatted datatree (FDT)
################################################################################

sub DU_PRINT_FDT
{
  local($tdt_h, $ex_irefs, $inc_dts, $exc_dts) = @_;
  local($subtdts,      ### Subtree stream
        $tdts,         ### All subtrees including $SMI-subtree
        $subtdt,       ### Subtree
        $dis,          ### Dataitem stream
        $di,           ### Dataitem handle
        $dfs,          ### Datafield stream
        $df,           ### Datafield handle
        $dfstr,        ### Datafield string
        $tag,          ### Datatype tag
        $ttab,         ### Id indentation
        $tab,          ### Total indentation
        $root,         ### Root dataitem flag
        $ok,           ### Datatype ok for printing?
       );

  if    ($inc_dts) { @inc_dts = split(/\s/, $inc_dts); }
  elsif ($exc_dts) { @exc_dts = split(/\s/, $exc_dts); }

  if (NULL_OB == $tdt_h) { return (0); }
  $tdts = &DU_STREAM2SEQ($subtdts = dt_stream($tdt_h, TYP_DATATREE));
  dt_dealloc($subtdts);
  dt_reset($tdts);
  dt_insert($tdts, $tdt_h);
  dt_reset($tdts);
  if (NULL_OB == $tdts) { return (0); }

  ###################################################
  ### Sequence sub-TDTs (note that we have added 
  ### *the* TDT to the sequence, so its dataitems
  ### are handled.
  ###################################################
  for ($tab = 0, $root = 1; NULL_OB != ($subtdt = dt_next($tdts)); ) {

    ###################################################
    ### Stream dataitems for each sub-TDT
    ###################################################
    $dis = dt_stream($subtdt, TYP_DATAITEM);
dataitem:
    while (NULL_OB != ($di = dt_next($dis))) {

      ###################################################
      ### Check include/exclude restrictions
      ###################################################
      $tag = dt_tag(dt_datatype($di));
      $ok = 1;
      if ($inc_dts) {
        $ok = (MEMBER($tag, 0, @inc_dts)) ? 1 : 0;
      } elsif ($exc_dts) {
        $ok = (!MEMBER($tag, 0, @exc_dts)) ? 1 : 0;
      }
      next dataitem if (!$ok);

      $dfs = dt_stream($di, TYP_DATAFIELD);

      ###################################################
      ### Stream datafields for each dataitem
      ###################################################
      for ($firstdf = 1; NULL_OB != ($df = dt_next($dfs)); $firstdf = 0) {

        ###################################################
        ### Special handling for binary or indirect data
        ###################################################
        if (dt_dfnorm($df, DY_THOR_BINARY)) {
          $dfstr = sprintf("[%d binary bytes]", length(dt_stringvalue($df)));
        } elsif (!$ex_irefs && dt_dfnorm($df, DY_THOR_INDIRECT)) {
          $dfstr = dt_thor_raw_datafield($df);
        } else { $dfstr = dt_stringvalue($df); }

        ###################################################
        ### Get tag ($D).  Figure out depth in tree.
        ### Get verbose name (_V).
        ###################################################
        $dftype = dt_fieldtype($df);
        $tag = dt_tag($dftype);
        if ($root)            { $tab = $ttab = 0; $id = 1; }
        elsif ($tag =~ /^\$/) { $tab = $ttab = 1; $id = 1; }
        else { $tab = $ttab + 1; $id = 0; }
        $vname = dt_info($df, "name"); ### verbose name of dfield

        ###################################################
        ### Print datatypename, preceded by tabs.
        ### Print data.  Don't print secondary fields 
        ### with no data.
        ###################################################
        if ($firstdf) {
          printf(FILEOUT "%s%s", "\t"x$tab, $vname);
          printf(FILEOUT "\t%s", $dfstr ? $dfstr : " ");
        }
        elsif ($dfstr) {
          printf(FILEOUT "\t%s", $vname);
          printf(FILEOUT "\t%s", $dfstr);
        }
        $root = 0;
      }
      printf(FILEOUT "\n", $dfstr);
    }
  }
  return (1);
}