################################################################################
##  DU_LIB - miscellaneous Daylight user DayPerl subroutines
##
##  Rev: 05 Jun 1998
################################################################################

package DU_LIB;

use DayPerl;

################################################################################
##  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 main'DU_INDEX
{
  local($tdt, $char, $position) = @_;
  local($i, $j, $k, $balanced);
 
  FIND:
  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))) {    ## skip over quoted section

        if ("\"" eq substr($tdt, $k + 1, 1)) {      ## quoted quote?
          $position = $k += 2;
        } else {
          $position = ++$k;
          $balanced = 1;
          next FIND;
        }
      }
      if (!$balanced) {
        $i = -1;
        last;
      }
    }
  }
  $position = $i;
}

################################################################################
##  DU_FINDITEM - find item from tag (1st occurance)
################################################################################
sub main'DU_FINDITEM
{
  local($tdt, $tag) = @_;
  local($i, $j, $taglen);
 
  $taglen = length($tag);
 
  if (substr($tdt, 0, $taglen) eq $tag) {
    $i = 0;
  } else {
 
    while (($i = &main'DU_INDEX($tdt, ">", $i)) > 0) {
      if (substr($tdt, ++$i, $taglen) eq $tag) {
        last;
      }
    }
    if ($i < 0) { return ""; }
  }
 
  $j = &main'DU_INDEX($tdt, ">", $i);
  return substr($tdt, $i, $j - $i + 1);
}
 
################################################################################
##  DU_TDT2DITEMS - return array of raw dataitem strings including tags
################################################################################
sub main'DU_TDT2ITEMS
{
  local($tdt) = @_;
  local($i, $j);
  local(@ditems);
 
  $i = 0;
 
  while (($j = &main'DU_INDEX($tdt, ">", $i)) > 0) {
    @ditems = (@ditems, substr($tdt, $i, $j - $i + 1));
    $i = $j + 1;
  }
  return @ditems;
}
 
################################################################################
##  DU_DITEM2FIELDS - return array of de-quoted datafields
################################################################################
sub main'DU_DITEM2FIELDS
{
  local($ditem) = @_;
  local($i, $j);
  local(@dfields, $dfield);
 
  $i = &main'DU_INDEX($ditem, "<", 0) + 1;
 
  while (($j = &main'DU_INDEX($ditem, ";", $i)) >= 0) {
    $dfield = &main'DU_DEQUOTE(substr($ditem, $i, $j - $i));
    @dfields = (@dfields, $dfield);
    $i = $j + 1;
  }
  $j = &main'DU_INDEX($ditem, ">", $i);
  $dfield = &main'DU_DEQUOTE(substr($ditem, $i, $j - $i));
  @dfields = (@dfields, $dfield);
  return @dfields;
}
 
################################################################################
##  DU_DEQUOTE - cook a raw and maybe quoted datafield
################################################################################
sub main'DU_DEQUOTE
{
  local($_) = @_;
 
  s/^\"//;        s/\"$//;        s/\"\"/\"/g;
 
  return $_;
}

################################################################################
##  DU_TDT2LIST
################################################################################
sub main'DU_TDT2LIST
{
  local($tdt) = @_;
  local($i, $j) = ( 0, 0 );

  while ($i < length($tdt)) {
    if (0 > ($j = &main'DU_INDEX($tdt, ">", $i))) {  ### should be "|"
      @tdtlist = (@tdtlist, substr($tdt, $i));
      return (@tdtlist);
    } else {
      @tdtlist = (@tdtlist, substr($tdt, $i, $j - $i + 1));
      $i = $j + 1;
    }
  }
  return (@tdtlist);
}

################################################################################
##  DU_HEXSTR - returns 2 hex bytes per char (ASCII encoding).
################################################################################
sub main'DU_HEXSTR
{
  local($str) = @_;
  local($hex, $i);
 
  for ($i = 0, $hex = ""; $i < length($str); ++$i) {
    $hex  .= sprintf("%2x", ord(substr($str, $i, 1)));
  }
  return ($hex);
}

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


########################################################
###  DU_READTDT()
########################################################
sub main'DU_READTDT
{
  return(&main'DU_FREADTDT(*STDIN));
}

########################################################
###  DU_FREADTDT()
###
###  Note: pass file handle as type glob, as in
###  &DU_FREADTDT(*FILE).
########################################################
sub main'DU_FREADTDT
{
  local (*FILEIN) = @_;
  local ($tdt) = ( );

  while (<FILEIN>) {
    chop();
    $tdt .= $_;
    last if (/\|$/);
  }
  if ($_ && !/\|$/) { print STDERR "ERROR: Incomplete last TDT: \"$tdt\"\n"; }

  return($tdt);
}

################################################################################
##  DU_FPRINTTDT
################################################################################
sub main'DU_FPRINTTDT
{
  local($tdt, $format, *FILEOUT) = @_;
  local($buff, $i);

  if ($format eq "DUMP") {
    print FILEOUT "$tdt\n";
  } else {
    $buff = $tdt;
    while ($buff) {
      if (0 > ($i = &main'DU_INDEX($buff, ">", 0))) {
        print FILEOUT "$buff\n";
        $buff = "";
      } else {
        print FILEOUT substr($buff, 0, $i + 1)."\n";
        $buff = substr($buff, $i + 1);
      }
    }
  }
  return(1);
}

################################################################################
##  DU_CHECKTDT
################################################################################
sub main'DU_CHECKTDT
{
  local($tdt) = @_;
  $_ = $tdt;

  if (!/^\$.*\|$/) {
    print STDERR "ERROR: Illegal TDT \"$tdt\"\n";
    0;
  } else { 1; }
}


################################################################################

1;  ## package return value
