changeset 2:7e52b8fb2df4 draft

planemo upload

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/rdock/lib/SDRecord.pm	Mon Aug 29 08:42:13 2016 -0400
@@ -0,0 +1,227 @@
+package SDRecord;
+# Perl module for reading/writing SD records from/to STDIN/STDOUT
+# Methods:  new
+#           readRec
+#           writeRec
+#           writeData
+#           copy
+#           addData
+#
+# Data:     LINES    - reference to array of record text lines
+#           DATA     - reference to hash array of record data fields
+#           DATAREF  - reference to hash array of line numbers for data fields
+
+my $LINES = 'LINES';
+my $DATA = 'DATA';
+#DM 27 Sept 1999 - also store line number of beginning each data field
+#so we can extract multi-line fields more easily from the LINES array
+my $DATAREF = 'DATAREF';
+
+############################################################
+# Constructor
+sub new {
+  my $this = {};
+  bless $this;
+  return $this;
+}
+
+############################################################
+# readRec() - read next SD record from STDIN
+# Input params:
+#   'LINES' => any value - save lines
+#   'DATA'  => any value - save data
+sub readRec {
+  my $this = shift;
+  my %params = @_;#input parameters
+  my @lines;#array for storing all text lines
+  my %data;#hash array for storing all data key,value pairs
+  my %dataref;#hash array for storing line number references for each data field
+  my ($fieldName,$ob,$cb);
+
+  #clear current data
+  delete $this->{$LINES};
+  delete $this->{$DATA};
+  delete $this->{$DATAREF};
+
+  #read lines from STDIN to the next record delimiter
+  #store in @lines array
+  #DM 16 Nov 1999 - can now cope with DOS text files directly
+  $/ = "\n";#Default Unix line separator
+  while (<>) {
+    chomp;#Get rid of Unix line separator
+    $/ = "\r";
+    chomp;#Get rid of DOS line separator
+    $/ = "\n";#Reset to normal Unix
+    last if ($_ eq '$$$$');#end of record
+    push @lines,$_;
+    #print "$_\n";
+  }
+
+  #check if we read anything
+  if (scalar(@lines) > 0) {
+    #store ref to @lines if required
+    $this->{$LINES} = \@lines if (defined $params{$LINES});
+    #search for data fields if required
+    if (defined $params{$DATA}) {
+      $fieldName = '';
+      my $lineNum = 0;
+      foreach $line (@lines) {
+	$lineNum++;
+	#DM 12 Jul 1999 - include the first three title lines as
+	#pseudo data fields
+	if ($lineNum <= 3) {
+	  $data{"_TITLE$lineNum"} = $line;
+	  #DM 20 Dec 1999 - include dimensionality (2D/3D) as pseudo data field
+	  if ($lineNum == 2) {
+	    $data{"_NDIM"} = substr($line,20,1);
+	  }
+	}
+	#DM 05 Aug 1999 - include number of atoms as pseudo data field
+	elsif ($lineNum == 4) {
+	  my @fields = split(" ",$line);
+	  $data{"_NATOMS"} = $fields[0] if (scalar(@fields)>0);
+	}
+	if (index($line,'>') == 0) {#found a data field
+	  $ob = index($line,'<');#first open bracket
+	  $cb = rindex($line,'>');#last close bracket
+	  if (($ob != -1) && ($cb != -1)) { #save field name
+	    $fieldName = substr($line,$ob+1,$cb-$ob-1);
+	    $dataref{$fieldName} = $lineNum-1;#store ref to line number
+	  }
+	}
+	#if field name defined, then store first line of value
+	elsif ($fieldName ne '') {
+	  $data{$fieldName} = $line;
+	  $fieldName = '';#clear field name
+	}
+      }
+      #store ref to %data in $this
+      $this->{$DATA} = \%data;
+      $this->{$DATAREF} = \%dataref;
+    }
+    return 1;
+  }
+  else {
+    return 0;
+  }
+}
+
+############################################################
+# writeRec() - write current record to STDOUT (mol + data)
+sub writeRec {
+  my $this = shift;
+  if (defined $this->{$LINES}) {
+    foreach $line (@{$this->{$LINES}}) {
+      print "$line\n";
+    }
+    print "\$\$\$\$\n";
+  }
+}
+
+############################################################
+# writeMol() - write current mol record to STDOUT
+sub writeMol {
+  my $this = shift;
+  if (defined $this->{$LINES}) {
+    foreach $line (@{$this->{$LINES}}) {
+      print "$line\n";
+      last if ($line eq "M  END");
+    }
+  }
+}
+
+############################################################
+# writeData() - list data field/values to STDOUT
+sub writeData {
+  my $this = shift;
+  my ($keys ,$value, $lineNum );
+  if (defined $this->{$DATA}) {
+    foreach $key (sort keys %{$this->{$DATA}}) {
+      $value = $this->{$DATA}->{$key};
+      $lineNum = $this->{$DATAREF}->{$key};
+      #print "$key eq $value (line $lineNum)\n";
+      print "\$$key eq \"$value\"\n";
+    }
+  }
+}
+
+############################################################
+# copy() - create deep copy of SDRecord
+# Input params:
+#   'LINES' = any value - deep copy of lines
+#   'DATA'  = any value - deep copy of data and dataref
+
+sub copy {
+  my $this = shift;
+  my %params = @_;#input parameters
+  my $clone = new SDRecord;
+  if ((defined $params{$LINES}) && (defined $this->{$LINES})) {
+    my @lines = @{$this->{$LINES}};
+    $clone->{$LINES} = \@lines;
+  }
+  if (defined $params{$DATA}) {
+    if (defined $this->{$DATA}) {
+      my %data = %{$this->{$DATA}};
+      $clone->{$DATA} = \%data;
+    }
+    # DM 24 Jul 2001 - DATAREF was missing from deep copy
+    # We copy the dataref array using the same DATA input parameter
+    # i.e. if the data is copied then so is dataref
+    if (defined $this->{$DATAREF}) {
+      my %dataref = %{$this->{$DATAREF}};
+      $clone->{$DATAREF} = \%dataref;
+    }
+  }
+  return $clone;
+}
+
+############################################################
+# addData() - adds data to data hash array
+sub addData {
+  my $this = shift;
+  my %params = @_;#input parameters
+  #if the array is already defined then add to it
+  if (defined $this->{$DATA}) {
+    my ($keys ,$value );
+    while (($key, $value) = each (%params)) {
+      $this->{$DATA}->{$key} = $value;
+    }
+  }
+  #if not defined, then create it
+  else {
+    $this->{$DATA} = \%params;
+  }
+}
+
+############################################################
+# addDataAndLines() - adds data to data hash array,
+# and adds corresponding lines also so that record may be
+# rewritten with the new fields
+sub addDataAndLines {
+  my $this = shift;
+  my %params = @_;#input parameters
+
+  while (($key, $value) = each (%params)) {
+    #DM 23 Oct 2000
+    #Check if data field already exists, if so replace value
+    #Note: this only works for single line data fields
+    if (defined $this->{$DATA}->{$key}) {
+      my $keyRef = $this->{$DATAREF}->{$key};
+      ${$this->{$LINES}}[$keyRef+1] = $value;
+    }
+    #else add the corresponding lines to the lines arrays
+    else {
+      my $keyRef = scalar(@{$this->{$LINES}});
+      $this->{$DATAREF}->{$key} = $keyRef;
+      push @{$this->{$LINES}},">  <$key>";
+      push @{$this->{$LINES}},"$value";
+      push @{$this->{$LINES}},"";
+    }
+  }
+
+  #DM 23 Oct 2000 - add data after adding the lines
+  $this->addData(%params);
+
+}
+
+1;

Binary file tools/rdock/lib/libRbt.so has changed

Binary file tools/rdock/lib/libRbt.so.rDock_2013.1_src has changed

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/rdock/lib/run_rbfuncs.pl	Mon Aug 29 08:42:13 2016 -0400
@@ -0,0 +1,296 @@
+#!/usr/bin/perl
+# Perl functions for the run_rb* collection of automated docking scripts
+
+use strict;
+
+################################################################################
+# sub get_prm_table
+#
+# Purpose: return a hash table of
+# key=parameter file name, value = file title
+# for all .prm files in a directory
+#
+# Usage: %prm_table = get_prm_table($dir)
+#
+# Arguments:
+# $prmDir - directory to search for .prm files
+#
+# Return parameters:
+# %prm_table - hash table
+#
+sub get_prm_table {
+#Arguments
+  my $prm_dir = shift;
+
+#Local variables
+  my @prm_list;
+  my %prm_table;
+  my $TITLEREC = "TITLE ";
+  my $file;
+  my $title;
+  my @titleLines;
+
+#Get the list of files ending in .prm
+  @prm_list = glob "$prm_dir/*.prm";
+
+#Read each file and extract the title record
+  foreach $file (@prm_list) {
+    open PRMHANDLE,$file;
+    @titleLines = grep /^$TITLEREC/,<PRMHANDLE>;
+    close PRMHANDLE;
+#Extract just the file name from the full path
+    my $prmName = substr($file, rindex($file,"/")+1);
+#Check if a title record was found
+    if (scalar @titleLines) {
+      $title = substr $titleLines[0],length($TITLEREC);
+      chomp $title;
+      $prm_table{$prmName} = $title;
+    }
+    else {
+      $prm_table{$prmName} = "No title";
+    }
+  }
+  return %prm_table;
+}
+################################################################################
+# sub get_dock_table
+#
+# Purpose: Modified version of get_prm_table
+# specific for the RBT_LIGDB docking database
+# Return a hash table of
+# key=docking library, value = expression for all sd files in that library
+#
+# Assumes that all subdirs within $db_dir are separate vendor libraries,
+# and that each subdir contains a set of compressed .sd.gz files
+#
+# Usage: %dock_table = get_dock_table($dir)
+#
+# Arguments:
+# $db_dir - directory to search for docking libraries
+#
+# Return parameters:
+# %dock_table - hash table#
+#
+sub get_dock_table {
+#Arguments
+  my $db_dir = shift;
+
+#Local variables
+  my ($lib,$sdfiles);
+  my (@lib_list,@sd_list);
+  my %dock_table;
+
+  opendir DBDIR,$db_dir;
+  @lib_list = readdir DBDIR;
+  closedir DBDIR;
+
+  foreach $lib (sort @lib_list) {
+    if (-d "$db_dir/$lib") {
+      $sdfiles = "$db_dir/$lib/*.sd*";
+      @sd_list = glob $sdfiles;
+      my $n = scalar(@sd_list);
+      if ($n > 0) {
+        $dock_table{"$lib ($n files)"} = $sdfiles;
+      }
+    }
+  }
+
+  return %dock_table;
+}
+#
+################################################################################
+# sub get_selection
+#
+# Purpose: allow a user to select from
+# a list of parameter files.
+#
+# Usage: $receptor = get_selection(\%prm_table,"receptor")
+#
+# Arguments:
+# $prm_table_ref - reference to hash table returned by get_prm_table
+# $name          - descriptive name for items (e.g. "receptor" or "script"
+#
+# Return parameters:
+# $item - selected items (key into %prm_table)
+#
+sub get_selection {
+#Arguments
+  my $prm_table_ref = shift;
+  my $name = shift;
+
+#Local variables
+  my @items = sort keys %$prm_table_ref;
+  my $nItems = scalar @items;
+  my ($i,$itemNum,$item);
+  my $inRange;
+
+  print "\n\n$name selection:\n\n";
+  $i=1;
+  foreach $item (@items) {
+    print "$i\t$item\t$$prm_table_ref{$item}\n";
+    $i++;
+  }
+  do {
+    print "\nEnter the $name number: ";
+    $itemNum = <STDIN>;
+    chomp $itemNum;
+    print "\n";
+    $inRange = (($itemNum >= 1) && ($itemNum <= $nItems));
+    print "$itemNum is out of range\n" if (!$inRange);
+  } until ($inRange);
+
+  print "\nYou have selected the following $name\n";
+  $item = $items[$itemNum-1];
+  print "$itemNum\t$item\t$$prm_table_ref{$item}\n";
+  return $item;
+}
+
+################################################################################
+# sub get_multiple_selection
+#
+# Purpose: allow a user to multiply select from the docking library list
+#
+# Usage: $receptor = get_selection(\%prm_table,"receptor")
+#
+# Arguments:
+# $prm_table_ref - reference to hash table returned by get_prm_table
+# $name          - descriptive name for items (e.g. "receptor" or "script"
+#
+# Return parameters:
+# $item - selected items (key into %prm_table)
+#
+sub get_multiple_selection {
+#Arguments
+  my $prm_table_ref = shift;
+  my $name = shift;
+
+#Local variables
+  my @items = sort keys %$prm_table_ref;
+  my $nItems = scalar @items;
+  my ($i,$idstring,$itemNum,$item);
+  my @itemNums;
+  my @selectedItems;
+  my $inRange;
+  my $allInRange;
+
+  print "\n\n$name selection:\n\n";
+  $i=1;
+  foreach $item (@items) {
+    print "$i\t$item\t$$prm_table_ref{$item}\n";
+    $i++;
+  }
+  do {
+    print "\nEnter the $name number(s): ";
+    my $idstring = <STDIN>;
+    chomp $idstring;
+    @itemNums = get_ids($idstring);
+    print "\n";
+    $allInRange = 1;
+    foreach $itemNum (@itemNums) {
+      $inRange = (($itemNum >= 1) && ($itemNum <= $nItems));
+      print "$itemNum is out of range\n" if (!$inRange);
+      $allInRange = $allInRange && $inRange;
+    }
+  } until ($allInRange);
+
+  print "\nYou have selected the following $name(s)\n";
+  foreach $itemNum (@itemNums) {
+    $item = $items[$itemNum-1];
+    push @selectedItems,$item;
+    print "$itemNum\t$item\t$$prm_table_ref{$item}\n";
+  }
+  return @selectedItems;
+}
+
+################################################################################
+# sub get_input
+#
+# Purpose: get user input, or returns default if no response given
+#
+# Usage: $nRuns = get_input("Enter no. of runs per ligand",10)
+#
+# Arguments:
+# $question    - text of question to ask
+# $defResponse - default answer
+#
+# Return parameters:
+# $response - user response, or default
+
+sub get_input {
+#Arguments
+  my $question = shift;
+  my $defResponse = shift;
+  print "$question [$defResponse]: ";
+  my $response = <STDIN>;
+  chomp $response;
+  $response = $defResponse if ($response eq "");
+  return $response;
+}
+
+# Based on //depot/intranet/1.0/lib/rbt_func.pl#1
+# this function converts a list of ids in one string
+# in the format 1,2,4-6,8,15-20
+# and returns an @array with the unique ids
+sub get_ids {
+  my $idstring = shift;
+  my %ids;
+
+  foreach my $id (split (',',$idstring)){
+    if ( grep (/-/,$id)){
+      (my $low, my $up) = split ('-',$id);
+      for ( my $co = $low; $co <= $up; $co++ ){
+	$ids{$co}=$co;
+      }
+    }
+    else {
+      $ids{$id}=$id;
+    }
+  }
+  
+  return (sort {$a<=>$b} keys %ids);
+}
+################################################################################
+# sub get_filter_table
+#
+# Purpose: return a hash table of
+# key=filter file name, value = file title
+# for all .filter files in a directory
+#
+# Usage: %filter_table = get_filter_table($dir)
+#
+# Arguments:
+# $filterDir - directory to search for .filter files
+# $tmp - temperature for first filter
+# Note:
+# The first two filters are not in a file, but are created here
+#
+# Return parameters:
+# %filter_table - hash table
+#
+sub get_filter_table {
+#Arguments
+  my $filter_dir = shift;
+  my $tmp = shift;
+
+#Local variables
+  my $pwd = $ENV{"PWD"};
+  my @filter_list;
+  my %filter_table;
+  my $file;
+
+#Get the list of files ending in .filter
+  @filter_list = ((glob "$pwd/*.filter"), (glob "$filter_dir/*.filter"));
+  $filter_table{"1no_other_filters"} = "";
+  # $filter_table{"1threshold"} = "\tSCORE.INTER < $tmp";
+  # $filter_table{"2cavity"} = "\t\tSCORE.RESTR.CAVITY < 1 ";
+
+#Read each file and extract the title record
+  foreach $file (@filter_list) {
+#Extract just the file name from the full path
+    my $filterName = substr($file, rindex($file,"/")+1);
+#Check if a title record was found
+    $filter_table{$filterName} = "No title";
+  }
+  return %filter_table;
+}
+1;