DPInteract: $title

#!/usr/local/bin/perl $ENV{'PERL5LIB'}="/usr/local/lib/perl5"; $ENV{'PGPLOT_BACKGROUND'}="white"; $ENV{'PGPLOT_FOREGROUND'}="black"; #require ("/usr/local/lib/perl5/pgplot.pl"); &primeRegSubs; if ($ARGV[0]=~/-gtest/) { # &blastGraph($ARGV[1],"/XWIN"); exit; } $queryString = $ENV{'QUERY_STRING'}; if ( $queryString=~/^gif=on/i) { $gifOn=1; } else { $gifOn=0 ; } $queryString=~s/^gif=[a-z]+\&//; if ( $queryString =~ m/sequence/) { &doblast; } else { &intro; } exit; sub doblast { &printHeader("BLASTN Results"); $queryString =~ s/%3E/>/g; $queryString =~ s/%0A/\n/g; $queryString =~ s/%0D/ /g; $queryString =~ s/^sequence=//g; $queryString =~ s/[+]/ /g; $database = "$dpiDocsPath/sites.fasta"; $blastFile=&genSeqFile($queryString); $command="dec_blast/blastall -pblastn -b0 -ddec_blast/sites.fasta -i$blastFile -o$blastFile.out\n"; #print "Executing $command\n"; system($command); #`touch /tmp/index.html; dec_blast/blastall -pblastn -b0 -ddec_blast/sites.fasta -i$blastFile -o$blastFile.out`; ; if ($gifOn==1) { # &blastGraph("$blastFile.out","$blastFile.gif/GIF"); print "

\n"; print "

Blue: forward strand. Red: complementary strand.

\n"; } open(BLAST,"$blastFile.out"); while ( $_ = ) { if (! m/^Notice:|^To identify|^BLASTN|^Reference|^and David|^215:403|Smallest$|Poisson$|Probability$/) { if (m/^Searching/) { print "

";  }
     elsif (m/^Sequences producing/) {}
#       { print "\n\n\t\t+ Proven site\t? Candidate site\t- Pseudo-site\n"; }
     elsif (m/^Query=/) { print "$_"; }
     elsif (m/^Database:/) { print "Database:  Ec DNA BP Ds:\t+ Proven\t? Candidate\t- Pseudo\n"; } 
     else
      {
        s!^([+\-\?])([a-zA-Z0-9_]*)([ \t]*#)([0-9]*)!$1$2$3$4!o;
            s!^>(.)([a-zA-Z0-9_]*)([ \t]*#)([0-9]*)!>$1$2$3$4!o;
        print $_;

      }
   }
}
print "$claimer";
if (rand(10)<1) { &cleanup; }
  exit;
} 

sub intro
{
&printHeader("BLASTN Search");
print '

';
print '

DNA sequence to search
',"\n";
# print 'Graphical Map of Hits',"\n";
print '


Enter a DNA sequence with either no comments or in FASTA format. You may include spaces and carriage returns in the sequence entry; they will be ignored by BLAST.




Please report problems with this service to krobison@nucleus.harvard.edu
';
 exit;
}


sub blastGraph
{
  local($blastData,$outDevice)=@_;
  local($i);
  open(BLAST,$blastData);
  while ( $_ =  )
    {
      if (/^ +\([0-9]+ letters/)
	{
	  s/^ +[(]//; 
	  ($seqLen)=split;
	}
      elsif (/^>/)
	{
	  chop; ($hitId)=split; 
	  $hitId=~s/_.*$//; 
	  $hitId=~s/^>.//;
	  push(@hitNames,$hitId);	  
	}
      elsif (/^Query:/)
	{
	  ($dum,$qStart,$dum,$qEnd)=split;
	  push(@qStarts,$qStart);
	  push(@qEnds,$qEnd);
	  if ($qStart<$qEnd) { push(@qStrands,1); }
	  else               { push(@qStrands,-1); }
	}
   }
  &makePlot($outDevice,$seqLen,*hitNames,*qStarts,*qEnds,qStrands);	
  close(BLAST);      
 }
  
#!/usr/local/bin/perl

&primeRegSubs;

sub printHeader
{
 ($title,$isIndex,$notScript)=@_;
 if ($notScript==1) {} else { print "Content-type: text/html\n"; }
 print "\n";
 print "\n";
 print "DPInteract: $title\n";
 if ($isIndex==1) { print "\n"; }
 print "\n";
 print "$title\n";
}
sub primeRegSubs
{
$RelayBase = "http://golgi.harvard.edu/htbin/relay";
 $Cgsc     = "http://cgsc.biology.yale.edu/cgi-bin/sybgw/cgsc/Site/";
 $GenbankA = "$RelayBase/genbank-acc?";

 $Medline  = "http://golgi.harvard.edu/htbin/dpinteract/medline-muid?";
 $MedNeigh = 'http://atlas.nlm.nih.gov:5700/htbin/enf/entrezmmnei?';
 $Pir      = "http://www3.ncbi.nlm.nih.gov/htbin-post/Entrez/query?db=p&form=6&uid=";
 $Pdb      = 'http://expasy.hcuge.ch/cgi-bin/pdb_entry_or_image?';
 $Prints   = 'http://www.biochem.ucl.ac.uk/cgi-bin/attwood/DoPRINTS.pl?cmd_a=Display&qua_a=/Full&fun_a=Code&qst_a=';
 $Blocks   = 'http://www.blocks.fhcrc.org/blocks-bin/getblock.www?';

 $dpiServer = "http://arep.med.harvard.edu";
 $dpiCgi = "$dpiServer/cgi-bin/dpinteract";
 $dpiDocsPath = "/usr/arep/a3/httpd/htdocs/dpinteract"; 
 $dpiDocsUrl ="$dpiServer/dpinteract";
 $dpiFam   = "$dpiCgi/family?";
 $dpiSfam  = "$dpiCgi/subfamily?";
 $dpiGene  = "$dpiCgi/gene?";
 $dpiClass = "$dpiCgi/class?";
 $dpiMsearch = "$dpiCgi/msearch?"; 
 $dpiSearch = "$dpiCgi/search?"; 
 $dpiRefSearch = "$dpiCgi/ref?";
 $dpiMrefSearch = "$dpiCgi/mref?";
 $dpiSeqregSearch = "$dpiCgi/seqreg?";
 $dpiBlastnSearch = "$dpiCgi/blastn";
 $dpiMatSearch = "$dpiCgi/matsrch";

 $Expasy  = "http://expasy.hcuge.ch";
 $Prosite  = "$Expasy/cgi-bin/get-prosite-entry?";
 $Prodoc   = "$Expasy/cgi-bin/get-prodoc-entry?";
 $Scop     = "http://www.bio.cam.ac.uk/scop/data";
# $Sprot    = "$Expasy/cgi-bin/get-sprot-entry?";
 $Sprot    = "http://expasy.hcuge.ch/cgi-bin/get-sprot-entry?";
 $SprotPi  = "http://expasy.hcuge.ch/cgi-bin/getpI?";
 $seqAnalRef = "$Expasy/cgi-bin/get-seqanalr-entry?";

 $ecocycGene="http://ecocyc.ai.sri.com:1555/new-image?type=GENE&object=EG";
 $ecocycMap="http://ecocyc.ai.sri.com:1555/new-image?type=LOCUS-POSITION&object=EG";

 $entrezProtein = "http://www3.ncbi.nlm.nih.gov/htbin-post/Entrez/query?db=p&form=6&Dopt=r&uid=";
 $entrezMedline = "http://www3.ncbi.nlm.nih.gov/htbin-post/Entrez/query?db=m&form=6&Dopt=r&uid=";
 $mailKr = 'krobison@nucleus.harvard.edu';
 
 $claimer = "
Help: Overview, Fields
Note: This database copyright 1994 Harvard University.

 
Robison, K., and Church, G.M. DPInteract: A database on DNA-protein interactions.  (1994).  Electronically published and manuscript in preparation.

Please contact $mailKr to report additional data or problems with this database.


DPInteract Home


";
 $subsPrimed = 1;
 return
}

$docs = '
Documentation

Welcome and Overview
Field Abbreviations
';

sub makeDpiSubs
{
  if (/^AC/)
    {
      s/^AC\tBDBPG?/AC\tDP/;
    }
  if (m/^PG/ )
    {  s#^PG[\t]*([A-Za-z0-9]*)#PG	$1 sub-family#o; }  
  if (m/^PF/ && ! m/Unclassified[^_]/i)
    {  s#^PF[\t]*([A-Za-z0-9]*)#PF	$1 family#o; }
  if (m/^PC/ && ! m/Unclassified/i)
  {  s#^PC[\t]*([A-Za-z0-9\-]*)#PC	Class $1#o; }
  if (m/^SP/)
    {
      s#([A-Za-z0-9_]*)(.)([A-Z][0-9]{5})#SwissProt: $1$2$3 Expasy Entrez pI & MW#o; 
    }
  if ( m/^XR|^RX/ )
    {
      s#Gene: *([A-Za-z0-9_]*)#Gene: $1#oi;
      s#Family: *([A-Za-z0-9_]*)#Family: $1#io;
      s#Class: *([A-Za-z0-9_\-]*)#Class: $1#io;
      s#\t(BL[0-9]*)#\tBlocks:                  $1#o;
    s#\tEG([0-9]*)#\tEcoGene $1 Map EcoCyc#io;
      s#\t(PS[0-9]*)#\tProsite Pattern          $1#o;
      s#\t(PDOC[0-9]*)#\tProsite Documentation  $1#o;
      s#\tCGSC:?([0-9]*)#\tColi Genetic Stock Center: Site \#$1#o;
      s#\tPIR:([A-Z0-9]*)#	PIR (Entrez):$1#o;
      s#\tPDB:([A-Z0-9]*)#	PDB:$1#o;
      s#\tGI:([A-Z0-9]*)#	Entrez:$1#o;
      s#\tPRINTS:\t*([A-Z0-9]+)#	Prints:$1#oi;
      s#SAR:([A-Z]*[0-9]*)#SeqAnalRef $1#o;
      s#SCOP([0-9\.]*)#SCOP:$1#o;
    }
  s#^RM	([0-9]*)#RM	Medline MUID $1#o;  
  if (/^RL/ && /J Biol Chem/ && /\(199[5-9]\)/)
    {
      $tmp=$_; $tmp=~s/^.*J Biol Chem *//; 
      $tmp=~s/://;
      $tmp=~s/-/ /;
      local($vol,$fp)=split(/[ \t\n]+/,$tmp);
      s#$#\tJBC On-Line#;
    }
  return;
}

sub cleanup
{
$oneHourInSeconds = 60*60;
$cutoff=6*$oneHourInSeconds;
@fileList=split(/[ \t\n]+/,`ls /tmp/dpi* /tmp/sh*`);
$myUid=$<;
for ($i=0; $i<=$#fileList; $i++)
{
  ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
              $atime,$mtime,$ctime,$blksize,$blocks)
                  = stat($fileList[$i]);
  if ($uid==$myUid && (($t-$mtime) > $cutoff))
    {
      unlink($fileList[$i]);
    }
}
}

sub acc2Name
{
 local($targAcc)=@_;
 local($dum,$name,$regexp);
 $targAcc=~s/^DP0*//;
 $regexp="^DP0*$targAcc";

 open(ACCTAB,"$dpiDocsPath/accessions.tab");
 $name=$targAcc;
 while ( $_ =  )
   {
     if (/$regexp/o)
       {

	 chop;
	 ($dum,$name)=split;
	 close(ACCTAB);
       }
   }
 $name=~s/[.][a-z]*$//i;
 return $name;
}

sub getEntry
{
  # 0 args; get Gene $ARGV[0]
  # 1 arg;  specify entry type in first arg, entry id in $ARGV[]0
  # 2 args; specify entry type in first arg, entry id in 2nd arg
  local($targ,$entryType,*args,$origName);
  @args=@_;
  if ($#args<0) { $entryType="Gene"; } else { $entryType= $args[0]; }
  if ($#args<1) { $targ=$ENV{'QUERY_STRING'};    } 
  else { $targ     = $args[1]; }

  &primeRegSubs;
  
  $targ=~s/[ \t\n]*//g;  
  $origName=$targ;

  if ($targ=~/^DP|^[0-9]/)
    {
      $targ=&acc2Name($targ);
   } 
  &printHeader("$targ $entryType");
  local($targFile);
  if    ($entryType=~/gene/i)   { $targFile ="genes/$targ.gene"; }
  elsif ($entryType=~/family/i) { $targFile ="fams/$targ.fam"; }
  elsif ($entryType=~/class/i)  { $targFile =     "$targ.class"; }
  $targFile="$dpiDocsPath/$targFile"; 
  if ( -e $targFile )
    {
      open (ENTRY,$targFile);
      print "\n";
      $bCount=0;
      while ( $_ =  )
	{
	  &makeDpiSubs;
	  if (m/^B[PNS]\t/) { $bCount++; print ""; }
	  print $_;
	}
    }
  else
    {
      $targ="Not Found";
      print "Not Found!
 DPInteract does not contain an entry of type $entryType for $origName.
  If you reached this point from an outside database, please contact the adminstrator(s) for that database; if you reached here from another location in DPInteract, please send E-mail to $mailKr.";

    }
  return $targ;
}

sub msearchForm
{
local($i);
print '
',"\n";
print "Blank terms are ignored. Only gene entries are searched.  A gene entry must match all terms to be returned (boolean AND).\n";
for ($i=0; $i<4; $i++)
{
  print 'Term: ',"\n";
  print 'Search field(s) 
',"\n";
}
print '
';
print '
';
print '',"\n";
print '',"\n";

}
sub mrefForm
{
local($i);
print "\n",'',"\n";
print "Blank terms are ignored. Only gene entries are searched.  A gene entry must match all terms to be returned (boolean AND).\n";
for ($i=0; $i<=4; $i++)
{
  print "\n",'Term: ',"\n";
  print 'Search citation field(s) 
',"\n";
}
if (1==0)
{
  print "Reference Keyword\n";
}
print '',"\n";
print '',"\n";
}

sub genSeqFile
{
  local($seqData)=@_;
  local($rand)= $$;
  local($searchFile)="/tmp/dpi.$rand";
  local(*seqDataLines,$line);
  $searchFile=~s/%3E/>/;
  open (SEARCH_INPUT, ">$searchFile");
  @seqDataLines=split(/\n/,$seqData);
  print SEARCH_INPUT ">Your Query\n" unless ($seqDataLines[0]=~/^>/);
  foreach $line(@seqDataLines)
    {
      unless ($line=~/^>/)
	{
	  $line=~s/[^A-Za-z]+//g;
	}
      print SEARCH_INPUT $line,"\n";
    }
  close(SEARCH_INPUT);
  return ($searchFile);
}
1;

sub makePlot
{
  local($outDevice,$seqLen,*hitNames,*qStarts,*qEnds,*qStrands)=@_;
  local($i,$baseY,$y2,*hitList,*nameList,$textUp,$seqNum,$seqTick);
  &pgbeg(0,$outDevice,1,1);
  &pgpap(6,0.4);
  &pgpage;	    
  &pgvstd;
  open(LOG,">/tmp/bpbd.makePlot.log");
  for ($i=0; $i<=$#hitNames; $i++)
    {
      $hitList{$hitNames[$i]}=1;
    }
  @nameList=reverse(sort(keys(%hitList)));
  &pgswin(-10,$seqLen+10,0,$#nameList+2);
  &pgsch(2);
  &pglabel("Query","Matches","Hits");
  
  &pgbox("NS",0,0,"",100,10);
  $textUp=0.85;
  for ($i=0; $i<= $#nameList; $i++)
    {
      $hitList{$nameList[$i]}=$i+1;
      &pgptxt(0,$i+$textUp,0,1.0,$nameList[$i]);
      &pgptxt($seqLen+10,$i+$textUp,0,1.0,$nameList[$i]);
    }
  
  
  for ($i=0; $i<= $#hitNames; $i++)
    {
      $qStart=$qStarts[$i];
      $qEnd=$qEnds[$i];
      $hitId=$hitNames[$i];
      $y1=$hitList{$hitId};
      if ($qStrands[$i]==0)  # Neither strand
	{
	  $y2=$y1+0.25;
	  $y1=$y1-0.25;
	  &pgsci(1);
	}
      elsif ($qStrands[$i]==1)
	{
	  &pgsci(4); 
	  $y2=$y1+0.25;
	}
      elsif ($qStrands[$i]==-1)
	{
	  &pgsci(2); 
	  $y2=$y1-0.25;	  
	}
      &pgrect($qStart,$qEnd,$y1,$y2);
      print LOG "$i\t$hitId\t$qStart\t$qEnd\t$y1\t$y2\n";      
    }
  &pgend;
}