################################################################################
##  DU_LIB.pm - miscellaneous Daylight User subroutines (non-toolkit)
##
##  See also DU_TLIB.pm, containing toolkit (DayPerl) subroutines.
################################################################################
## DU_ASSIGNVTAGS
## DU_CHECKTDT
## DU_DEQUOTE
## DU_DITEM2FIELDS
## DU_GETVTAGS
## DU_FINDITEM
## DU_FPRINTTDT
## DU_FREADTDT
## DU_HEXSTR
## DU_INDEX
## DU_PARSE_DB
## DU_RAWITEM2FIELDS
## DU_READTDT
## DU_TDT2ITEMS
## DU_TDT2LIST
## DU_TDT2PAGE
## STR2LINES
################################################################################
##  Author: Jeremy Yang
##  Rev:   27 Apr 1999
################################################################################

package DU_LIB;

################################################################################
## DU_ASSIGNVTAGS - assign vtags array of brief-names associated with
##                  datatype tags.  This is a kludge; ideally we'd get
##                  tags dynamically (DU_GETVTAGS).
##
################################################################################
## Note that the vtags array can be built easily from a datatypes database
## with a command like:
##
## thorlist -TDT_OUTPUT_FORMAT DUMP <db> | vtagscript
## where vtagscript consists of:
##
##	#!/usr/local/bin/perl -n
##	s/\$D<"*([^>"]+)"*>.*_V<"*([^>"]+).*$/\'$1\', \'$2\',/;
##	print;
################################################################################
sub main'DU_ASSIGNVTAGS
{
  %vtags = (

  '$D', 'DATATYPE',         ### Built-in datatype tags
  '_V', 'Field names',
  '_B', 'Brief names',
  '_N', 'Normalization',
  '_S', 'Summary',
  '_D', 'Description',
  '_P', 'Pool Inclusion',
  '_M', 'Set Membership',
  '_O', 'Owner',
  
  '$ACD', 'ACD Number',
  '$AMOL', 'Agent',
  '$CAS', 'CAS Number',
  '$CAT', 'Catalog ID',
  '$CLG', 'Cluster generation;Source;Version;Input;Parameters',
  '$D3D', 'Conformation;Name;3D-coords;Source;Comment',
  '$DOC', 'Document',
  '$DXRN', 'Derwent external registry name',
  '$FPG', 'FP generation;Source;Version;Input;Parameters',
  '$GRF', 'Graph',
  '$I', 'Ikey;Content',
  '$ICNO', 'Index Chemicus Registry Number',
  '$ISA', 'indirect/authors;author(s)',
  '$ISC', 'indirect/citation;citation',
  '$ISG', 'indirect/gencat;gencat',
  '$ISK', 'indirect/patent class;patent class',
  '$ISL', 'indirect/institution;institution (location)',
  '$ISM', 'Isomeric SMILES',
  '$ISO', 'indirect/patent owner;patent owner',
  '$IST', 'indirect/title;title',
  '$ISW', 'indirect/keywords;keywords',
  '$ISX', 'indirect/abstract;article abstract',
  '$MONO', 'Monomer Symbol',
  '$NAM', 'Name',
  '$NNG', 'NN generation;Source;Version;Input;Parameters',
  '$PMOL', 'Product',
  '$REG', 'Registration Number',
  '$RMOL', 'Reactant',
  '$RNO', 'Reaction Registry Number',
  '$SMI', 'SMILES',
  '$SNO', 'SPRESI Registry Number',
  '$SRNO', 'SPRESI Reaction Registry Number',
  '$SS', 'Subset',
  '$WLN', 'WLN',
  '2D', '2D-coordinates;Comment',
  'ABS', 'Abstract',
  'AC', 'Activity type;Reference',
  'ACD', 'ACD number',
  'AE', 'Adverse effects',
  'AMW', 'Ave molecular weight',
  'APN', 'Approved name;Code',
  'CAS', 'CAS number',
  'CAT', 'Catalog No.;Supplier;Name;Grade;Purity;Cost;USD/g;Remarks;Updated',
  'CHO', 'Components, CHORTLES',
  'CI', 'Contraindications',
  'CIT', 'Journal article;Author(s);Institution;Citation;Language;Year;Document ID',
  'CL', 'Cluster;Size;Run ID;Variance',
  'COM', 'Comment',
  'COMB_PREP', 'Combination Prep;Manufacturer;Country;Components',
  'CONF', 'Conference;Fast-Track Ref. No.;Presentation Details;WDA Reference No.',
  'COND', 'Reaction Conditions',
  'CP', 'CLOGP;Error level;Version',
  'CR', 'CMR;Error level;Version',
  'DCHO', 'Components',
  'DEF', 'Monomer Definition',
  'DMF', 'Derwent Molform',
  'DPN', 'Derwent preferred name',
  'DRN', 'Derwent name',
  'DYQ', 'Derwent update code',
  'EXPT', 'Experiment Name',
  'F', 'Formula',
  'FP', 'Fingerprint;Orig nbits;Orig nbits set;Nbits;Nbits set;Version;ID',
  'GENCAT', 'General Category',
  'GRD', 'Grade',
  'IA', 'Interactions',
  'INN', 'International non-proprietary name;INN/status',
  'ISM', 'Isomer',
  'IT', 'Index Chemicus Index term',
  'IU', 'Indications and usage',
  'JA', 'Journal article;Author(s);Institution;Citation;Keywords;Language;Year;Document ID',
  'JOUR', 'Reference;Journal;ID',
  'KWD', 'Reaction type keywords',
  'MA', 'Mechanism of action',
  'MCN', 'Manufacturer codes',
  'MDEF', 'Monomer Definition',
  'MF', 'MolForm',
  'MNAM', 'Monomer Description',
  'MR', 'MR;Reference',
  'NAM', 'Name',
  'ORI', 'Orientation;TR matrix;Comment',
  'P', 'LogP;Solvent pair;Reference;Footnote;Selected;pH;Comment',
  'P1', 'LogPstar;Confidence',
  'P2', 'LogPgood',
  'PAR', 'Parent mixture, Reg. No.',
  'PAT', 'Patent;Author(s);Owner;Country;Number;Class;Keywords;Language;Year;Document ID',
  'PCN', 'Local Name',
  'IMG', 'Image;Title;Description;Filetype;Size',
  'PKA', 'pKa;Solvent;Reference;Footnote;at Temp, C;Comment',
  'PKA1', 'pKa1;Solvent;Reference;Footnote;at Temp, C;Comment',
  'PN', 'Preferred name',
  'PT', 'Activity keywords',
  'PW', 'Precautions and warnings',
  'REF', 'Miscellaneous Reference',
  'REM', 'Remark',
  'RNO', 'Reaction Registry Number',
  'RTYP', 'Reaction Type number;Examples, this document;Total documents;Total examples',
  'SBP', 'Boiling point (C,min);Boiling point (C,max);Pressure (Torr,min);Pressure (Torr,max);Remark;Document ID',
  'SD', 'Substance description',
  'SDE', 'Density (g/cc);Measurement temperature (C);Reference temperature (C);Remark;Document ID',
  'SDI', 'Dissociation (pK,min);Dissociation (pK,max);Error range (pK);Dissociation step/kind;Measurement temperature (C);Solvent;Remark;Document ID',
  'SDP', 'Decomposition point (C,min);Decomposition pt (C,max);Solvation;Purification solvent;Remark;Document ID',
  'SM', 'Set membership',
  'SMP', 'Melting point (C,min);Melting point (C,max);Polymorphy;Decompostion;Transformation;Solvation;Solvent;Remark;Document ID',
  'SMU', 'Mutarotation (min);Mutarotation (max);Temperature (C);Wavelength (nm);Concentration;Solvent;Remark;Document ID',
  'SNM', 'Synonym',
  'SOR', 'Optical rotation (power);Temperature (C);Wavelength (nm);Concentration;Solvent;Remark;Document ID',
  'SRI', 'Refractive index;Temperature (C);Wavelength (nm);Remark;Document ID',
  'SRNO', 'SPRESI Reaction Registry Number',
  'SSK', 'Substructure keywords',
  'SSP', 'Sublimation point (C,min);Sublimation point (C,max);Pressure (Torr,min);Pressure (Torr,max);Remark;Document ID',
  'STEP', 'Reaction Step info',
  'TEMP', 'Reaction condition/temp',
  'TIME', 'Reaction condition/time',
  'TN', 'Trade name;Manufacturer;Country',
  'TS', 'Timestamp',
  'TST', 'Example assay, % inhibition',
  'USAN', 'United States Adopted Name;Code',
  'WARN', 'Warning',
  'XCL', 'Reaction Xor Cluster;Size;Run ID;Variance',
  'XFP', 'Reaction Xor Fingerprint;Obits;Oset;Nbits;Nset;Type;Run ID',
  'XFP', 'Reaction Xor Fingerprint;Orig size;Obits on;Size;Bits on;Type;Run ID',
  'YLD', 'Percent Reaction Yield',

  );
  return (%vtags);
}

################################################################################
##  DU_CHECKTDT
################################################################################
sub main'DU_CHECKTDT
{
  $_ = shift;

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

################################################################################
##  DU_DEQUOTE - cook a raw and maybe quoted datafield
################################################################################
sub main'DU_DEQUOTE
{
  $_ = shift;
 
  s/^\"//;        s/\"$//;        s/\"\"/\"/g;
 
  return $_;
}

################################################################################
##  DU_DITEM2FIELDS - return array of de-quoted datafields
################################################################################
sub main'DU_DITEM2FIELDS
{
  local($ditem) = @_;
  local($i, $j, @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));
    push(@dfields, $dfield);
    $i = $j + 1;
  }
  $j = &main'DU_INDEX($ditem, ">", $i);
  $dfield = &main'DU_DEQUOTE(substr($ditem, $i, $j - $i));
  push(@dfields, $dfield);
  return @dfields;
}
 
################################################################################
##  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_FREADTDT
###
###  Note: pass file handle as type glob, as in &DU_FREADTDT(*FILE).
###  Use DU_READTDT for STDIN.
#############################################################################
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_GETVTAGS - open datatypes database, get vtags array of brief-names
##               associated with datatype tags.  Expects full db spec
##               with passwords.  Note that toolkit not used.
##
## Note that "[\s\S]*" behaves like a multiline ".*".
##
##  Rev:    12 Feb 1999
################################################################################
sub main'DU_GETVTAGS
{
  my $dbspec = shift;
  my %vtags;
 
  open(TDTS, "\$DY_ROOT/bin/thorlist -TDT_OUTPUT_FORMAT DUMP $dbspec |");
  while (<TDTS>) {
    if (!/\|$/) {   ### Case: TDT contains newline(s).
      do {
        $buff = $_;
        $_ = <TDTS>;
        $_ = $buff.$_;
      } until (/\|$/);
    }
    chop();
 
    next if (!/^\$D</);
 
    ($tag = $_) =~ s/^\$D<"*([^>"]+)"*>[\s\S]*$/$1/m;
    ($val = $_) =~ s/^[\s\S]*_V<"*([^>"]+)[\s\S]*$/$1/m;
 
    $vtags{$tag} = $val;
  }
  close(TDTS);
  return %vtags;
}

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

################################################################################
##  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_PARSE_DB($db)
##
## This function assigns variables $dbname, $dbpw, $host, $service, $user,
## and $userpw as specified or to defaults.
##
##    where
##
##      db = dbname[%[dbpw]][@[host][:[service][:[user]]][%[userpw]]]
##
## Returns zero length list on ERROR.
################################################################################
##  AUTHOR: Jeremy Yang
##  Rev:    17 Mar 1999
################################################################################
sub main'DU_PARSE_DB
{
  $_ = shift;

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

  ########################################################
  ### Parse fields from db specification.
  ########################################################
  /([^%@]+)(%([^@]*))?(@([^:%]*)?(:([^:%]*))?(:([^%]*))?(%(.*))?)?$/;

  $dbname  = $1;
  $dbpw    = $3;
  $host    = $5  if ($5);
  $service = $7  if ($7);
  $user    = $9  if ($9);
  $userpw = $11  if ($11);

  ########################################################
  ###  Check for errors.                             
  ########################################################
  if ((0 <= index($dbname.$dbpw.$host.$service.$user.$userpw, "%")) ||
      (0 <= index($dbname.$dbpw.$host.$service.$user.$userpw, "@")) ||
      (0 <= index($dbname.$dbpw.$host.$service.$user.$userpw, ":"))) {
    return(); ## Error state: return zero length list
  }
  return ($dbname, $dbpw, $host, $service, $user, $userpw);
}

################################################################################
##  DU_RAWITEM2FIELDS
##    Split a raw Daylight dataitem into datafields respecting quoting.
################################################################################
sub main'DU_RAWITEM2FIELDS
{
  my $ditemraw = shift;
  my ($i, $j, @dfields);

  while (0 <= ($i = &main'DU_INDEX($ditemraw, ";", $j))) {
    push(@dfields, substr($ditemraw, $j, $i - $j));
    $j = $i + 1;
  }
  push(@dfields, substr($ditemraw, $j));

  return (@dfields);
}

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

################################################################################
##  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_TDT2LIST
##    Split a TDT into a list of dataitems with tags, respecting quoting.
################################################################################
sub main'DU_TDT2LIST
{
  my $tdt = shift;
  my ($i, $j, @tdtlist);

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

################################################################################
## DU_TDT2PAGE - converts TDT to text page (string).
##      
##      - note: $hidetypes is list of datatypes to be hidden.
##      
## AUTHOR: Jeremy Yang
## Rev:    28 Oct 1998
################################################################################
sub main'DU_TDT2PAGE
{
  local($tdt, $hidetypes) = @_;
  local($output);

  $numtypes = '3D-coords 3D-coordinates 2D-coords 2D-coordinates';

  $t = "    ";            ### indent size
  $NLEN = 14;             ### Default field name width

  %vtags = &main'DU_ASSIGNVTAGS();  ### Assign vtags array

  $tab = 0;
  $root = 1;

  @ditems = (&main'DU_TDT2ITEMS($tdt), "|");

  for (@ditems) {
    $firstdf = 1;
    if ($_ eq "|") {
      $output .= "+"."="x(79)."\n";
      return ($output);
    }
    $i = index($_, "<", 0);
    $j = main'DU_INDEX($_, ">", $i);
    $tag = substr($_, 0, $i);
    if (index($hidetypes, $tag) >= 0) { next; }
    $data = substr($_, $i + 1, $j - $i - 1);

    if (!$tag && $data || $tag && !$data ) {
      print STDERR "Bad TDT dataitem \"$_\"\n";
      next;
    }

    if ($tag =~ /^\$/) {
      if ($root) { $tab = $ttab = 0; }
      else       { $tab = $ttab = 1; }
      $root = 0;
      $id = 1;
    } else {
      $tab = $ttab + 1; $id = 0;
    }

    @datum = &main'DU_RAWITEM2FIELDS($data);

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

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

    ####################################################################
    ###  Get verbose tags if known (present in %vtags), or use
    ###  raw tags.
    ####################################################################
    if (exists($vtags{$tag})) {
      @vtag = split(/;/, $vtags{$tag});
    } else {
      for ($i = 0; $i <= $#datum; ++$i) { $vtag[$i] = "($tag)"; }
    }

    for ($i = 0; $i <= $#vtag; ++$i) {

      ###################################################
      ### Print dtype name & next indent if it's long
      ###################################################
      if (length($vtag[$i]) > $NLEN) {
        $output .= sprintf "%s|%s\n", "|$t"x$tab, $vtag[$i];
        $output .= sprintf "%s|%s ", "|$t"x$tab, " "x$NLEN;
      } else {
        $output .= sprintf "%s|%"."$NLEN"."s ", "|$t"x$tab, $vtag[$i];
      }
    
      ####################################################################
      ###  N-tuple numerical?
      ####################################################################
      if (index($numtypes, $vtag[$i]) >= 0) {
        @nums = split(/,/, $datum[$i]);
        $output .= sprintf "%d numerical data\n", $#nums + 1;

      ####################################################################
      ###  Empty?
      ####################################################################
      } elsif ($datum[$i] =~ /^\s*$/) {
        $output .= "~\n";

      ####################################################################
      ###  Normal.
      ####################################################################
      } else {
        $datum[$i] =~ s/^"(.+)"$/$1/;
        $datum[$i] =~ s/""/"/g;
        @lines = &STR2LINES($datum[$i], $width);
        foreach $line (@lines) {
          if ($line ne $lines[0]) {
            $output .= sprintf "%s|%s ", "|$t"x$tab, " "x$NLEN;
          }
          $output .= sprintf "%s\n", $line;
        }
      }
    }
    $root = $firstdf = 0;
  }
}

################################################################################
### STR2LINES - splits ($string) into an array of strings <=($width)
### (Used by DU_TDT2PAGE)
################################################################################
sub STR2LINES
{
  my $string = shift;
  my $width = shift;
  my ($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 (); }
  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?
      push(@array, substr($string, $k));
      return(@array);
    } else {
      for ($i = $k; ($i = index($string, " ", $i)) > 0 ; ++$i) { ### Word loop
        last if ($i - $k + 1 > $width);
        $j = $i;
      }
      push(@array, substr($string, $k, $j - $k + 1));
    }
  }
}

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

1;  ## package return value
