Community Company Search Contact

GSQDB.pm from eXtensible Genome Data Broker at Krugle

Show GSQDB.pm syntax highlighted

#!/usr/bin/perl
package GSQDB;

use GeneSeqerSequence;

do 'SITEDEF.pl';
#### NOT sure the following will work as expected (SHOULD USE argHR for pass)
do 'checkLOGIN.pl';  # added so USERid can be added to DSOprop  12.4.04
####

use GenomeView;
use CGI ':all';
use IO::File; ####<<<<####

use DBI;

sub new{
    my $class = shift;
    my ($argHR) = @_;
    my $self = {};
    $self->{dbid} = (exists($argHR->{dbid}))?$argHR->{dbid}:$#DBver;
    bless $self, ref($class) || $class;
    return $self;
}

sub _initDSO{
  my $self = shift;
  my ($rsc,$prop,$trackrsc,%DSOprop);
  foreach $rsc (@_){
    if((!defined($self->{resourceOBJ}->[$rsc]))&&(defined($DBver[$self->{dbid}]->{tracks}->[$rsc]))){
      $trackrsc = $DBver[$self->{dbid}]->{tracks}->[$rsc];
      eval "require DSO::$trackrsc->{DSOname}";
      
      %DSOprop = ();
      $DSOprop{db_id}       = $self->{dbid};
      $DSOprop{resid}       = $rsc;

      foreach $prop (keys %$trackrsc){
	$DSOprop{$prop} = $trackrsc->{$prop};
      }


      $DSOprop{db_host}     = (exists($trackrsc->{DBhost}))? $trackrsc->{DBhost}:(exists($DBver[$self->{dbid}]->{DBhost}))?$DBver[$self->{dbid}]->{DBhost}:$DB_HOST;
      $DSOprop{db_user}     = (exists($trackrsc->{DBuser}))? $trackrsc->{DBuser}:(exists($DBver[$self->{dbid}]->{DBuser}))?$DBver[$self->{dbid}]->{DBuser}:$DB_USER;
      $DSOprop{db_password} = (exists($trackrsc->{DBpass}))? $trackrsc->{DBpass}:(exists($DBver[$self->{dbid}]->{DBpass}))?$DBver[$self->{dbid}]->{DBpass}:$DB_PASSWORD;
      $DSOprop{db_name}     = (exists($trackrsc->{DB}))? $trackrsc->{DB}:$DBver[$self->{dbid}]->{DB};
      $DSOprop{dsn}         = "DBI:mysql:$DSOprop{db_name}:$DSOprop{db_host}";
      $DSOprop{dbh}         = DBI->connect($DSOprop{dsn},$DSOprop{db_user},$DSOprop{db_password},{ RaiseError => 1 });

      $DSOprop{USERid} = $cgi_paramHR->{USERid};
      $DSOprop{USERfname} = $cgi_paramHR->{USERfname};  
      $self->{resourceOBJ}->[$rsc] = $trackrsc->{DSOname}->new(%DSOprop);
    }
  }
}

sub _initALL_DSO{
  my $self = shift;
  $self->_initDSO(0..$#{$DBver[$self->{dbid}]->{tracks}});
}

sub search_by_ID{
  ## unique value lookup
  my $self = shift;
  my($id)=@_;
  my($rsc,$found,$search_path,$results);
  for($rsc=0;$rsc < scalar(@{$DBver[$self->{dbid}]->{tracks}});$rsc++){
    $self->_initDSO($rsc);
    if(defined($self->{resourceOBJ}->[$rsc])){
      ($found,$search_path) = $self->{resourceOBJ}->[$rsc]->search_by_ID($id);
      if($found){
	return $self->{resourceOBJ}->[$rsc]->showRECORD();
      }else{
	$results .= $search_path;
      } 
    }
  }
  return (undef,$results);
}

sub search_by_MULTIID{
  ## multiple value lookup
  my $self = shift;
  my ($IDaref) = @_;
  my ($rsc,$tmpc,$tmpg);
  my ($chrHITCNT,$gsegHITCNT) = (0,0);

  for($rsc=0;$rsc < scalar(@{$DBver[$self->{dbid}]->{tracks}});$rsc++){
    $self->_initDSO($rsc);
    if(defined($self->{resourceOBJ}->[$rsc])){
      ($tmpc,$tmpg) = $self->{resourceOBJ}->[$rsc]->load_multiID($IDaref);
    }
    $chrHITCNT  += $tmpc;
    $gsegHITCNT += $tmpg;
  }
  return ($chrHITCNT,$gsegHITCNT);
}
  

sub search_by_Desc{
  ## Multiple value lookup
  ##   uses GSQDB::showLOCI
  my $self = shift;
  my ($descAR)=@_;
  my ($rsc,$tmpc,$tmpg);
  my ($chrHITCNT,$gsegHITCNT) = (0,0);

  $self->_initALL_DSO();
  for($rsc=0;$rsc < scalar(@{$DBver[$self->{dbid}]->{tracks}});$rsc++){
    if(defined($self->{resourceOBJ}->[$rsc])){
      ($tmpc,$tmpg) = $self->{resourceOBJ}->[$rsc]->search_by_description($descAR);
    }
    $chrHITCNT  += $tmpc;
    $gsegHITCNT += $tmpg;
  }
  return ($chrHITCNT,$gsegHITCNT);
}

sub findRECORD{
  ## unique value lookup
  my $self = shift;
  my ($argHR)=@_;
  my ($rsc,$UIDtype,$uid);
  for($rsc=0;$rsc < scalar(@{$DBver[$self->{dbid}]->{tracks}});$rsc++){
    $self->_initDSO($rsc);
    if(defined($self->{resourceOBJ}->[$rsc])){
      ($UIDtype,$uid) = $self->{resourceOBJ}->[$rsc]->findRECORD($argHR);
      if(defined($UIDtype)){
	return ($rsc,$UIDtype,$uid);
      }
    }
  }
  return undef;
}

sub findREGION{
  ## unique value lookup
  my $self = shift;
  my ($argHR)=@_;
  my ($rsc,$type,$chr,$lpos,$rpos);
  for($rsc=0;$rsc < scalar(@{$DBver[$self->{dbid}]->{tracks}});$rsc++){
    $self->_initDSO($rsc);
    if(defined($self->{resourceOBJ}->[$rsc])){
      ($type,$chr,$lpos,$rpos) = $self->{resourceOBJ}->[$rsc]->findREGION($argHR);
      if($type =~ /^chr/){
	return ($chr,$lpos,$rpos);
      }
    }
  }
  return undef;
}

sub showGSQ{
  my $self = shift;
  my ($argHR) = @_;
  exists($argHR->{resid}) || return undef;
  $self->_initDSO($argHR->{resid}); ## init DSO for this resource if needed
  return $self->{resourceOBJ}->[$argHR->{resid}]->getGSQresults($argHR);
}

sub getRegionDetails{
  my $self = shift;
  my ($argHR) = @_;

  my ($pgsstatHR,$exstatHR,$instatHR,$lgapsHR,$imgHTML) = $self->getGSQ_REGION($argHR,"getIMAP_TV");   
  my $gSRC = (exists($argHR->{gsegSRC}))?"$argHR->{gseg_gi}:$argHR->{gsegSRC}":"$argHR->{chr}:GENOME";
  my $gapped_gseg = GeneSeqerSequence::_getGappedGenomeSeq($argHR->{dbid},$gSRC,$argHR->{l_pos},$argHR->{r_pos},"+",$lgapsHR);
  my $trackORDER   = exists($argHR->{trackORDER})?[split(',',$argHR->{trackORDER})]:[2,1,0];
  my $trackVISIBLE = exists($argHR->{trackVISIBLE})?[split(',',$argHR->{trackVISIBLE})]:[1,1,1];
  my $gCONTEXT = (exists($argHR->{altCONTEXT}))?$argHR->{altCONTEXT}:"chr";
  my @qseq = ();
  foreach $rsc (@$trackORDER){
    if($trackVISIBLE->[$rsc]){
      next if((!exists($self->{resourceOBJ}->[$rsc]->{"${gCONTEXT}VIEWABLE"}))||($self->{resourceOBJ}->[$rsc]->{"${gCONTEXT}VIEWABLE"} == 0));
      if(exists($self->{resourceOBJ}->[$rsc]->{gsqATYPE})){
	my $tmp = $self->{resourceOBJ}->[$rsc]->getGSQ_aSeqs($argHR,$lgapsHR,$gapped_gseg);
	push(@qseq,@$tmp);
      }else{## still a viewable sequence (annotation perhaps)
      }
    }
  }
  return ($pgsstatHR,$exstatHR,$instatHR,\@qseq,$gapped_gseg,$imgHTML);
}

sub getUCAimage{
  my $self = shift;
  my ($argHR) = @_;

  my ($pgsstatHR,$exstatHR,$instatHR,$lgapsHR,$imgHTML) = $self->getGSQ_REGION($argHR,"getIMAP_UCA");   
  return ($pgsstatHR,$exstatHR,$instatHR,undef,undef,$imgHTML);
}

sub getGSQ_REGION{
  my $self = shift;
  my ($argHR,$DSO_IMAP_FUNCTION) = @_;
  my ($trackORDER,$trackVISIBLE,$rsc,$tmp,$lgapsHR,$startY);
  my ($pgsstatHR,$exstatHR,$instatHR);
  
  my $gCONTEXT = (exists($argHR->{altCONTEXT}))?$argHR->{altCONTEXT}:"chr";
  
  require GeneView;
  $imgW    = exists($argHR->{imgW})?$argHR->{imgW}:600;
  $imgfn = "tv$$.png";
  $startY = 15;
  my $view = new GeneView($imgW,100,$argHR->{l_pos},$argHR->{r_pos},0);
  
  $trackORDER   = exists($argHR->{trackORDER})?[split(',',$argHR->{trackORDER})]:[2,1,0];
  $trackVISIBLE = exists($argHR->{trackVISIBLE})?[split(',',$argHR->{trackVISIBLE})]:[1,1,1];
  $lgapsHR = {}; $pgsstatHR = {}; $exstatHR = {}; $instatHR = {};
  
  
  foreach $rsc (@$trackORDER){
    if($trackVISIBLE->[$rsc]){
      $self->_initDSO($rsc);
      if(defined($self->{resourceOBJ}->[$rsc])){
	next if((!exists($self->{resourceOBJ}->[$rsc]->{"${gCONTEXT}VIEWABLE"}))||($self->{resourceOBJ}->[$rsc]->{"${gCONTEXT}VIEWABLE"} == 0));
	$self->{resourceOBJ}->[$rsc]->loadREGION($argHR);
	if(exists($self->{resourceOBJ}->[$rsc]->{gsqATYPE})){ 
	  ## THIS IS A GeneSeqer DATA SOURCE
	  $tmp = $self->{resourceOBJ}->[$rsc]->getGSQ_pgsStats($argHR);
	  $pgsstatHR = {%$pgsstatHR,%$tmp};
	  $tmp = $self->{resourceOBJ}->[$rsc]->getGSQ_exStats($argHR);
	  $exstatHR = {%$exstatHR,%$tmp};
	  $tmp = $self->{resourceOBJ}->[$rsc]->getGSQ_inStats($argHR);
	  $instatHR = {%$instatHR,%$tmp};
	  
	  $self->{resourceOBJ}->[$rsc]->combineLGAPS($argHR,$lgapsHR);
	}else{
	  ## see if DSO provides access to standard info
	  if($tmp = $self->{resourceOBJ}->[$rsc]->get_pgsStats($argHR)){
	    $pgsstatHR = {%$pgsstatHR,%$tmp};
	  }
	  if($tmp = $self->{resourceOBJ}->[$rsc]->get_exStats($argHR)){
	    $exstatHR = {%$exstatHR,%$tmp};
	  }
	  if($tmp = $self->{resourceOBJ}->[$rsc]->get_inStats($argHR)){
	    $instatHR = {%$instatHR,%$tmp};
	  }
	  
	}
 	
	## Draw combined image & return imap hash
	($imapHR,$startY) = $self->{resourceOBJ}->[$rsc]->drawCombinedImage($view,$startY);
	$startY+=20; ## Allow vertical margin between DSOs
	$imapHTML .= $self->{resourceOBJ}->[$rsc]->$DSO_IMAP_FUNCTION($argHR,$imapHR,$pgsstatHR,$exstatHR,$instatHR);
      }
    }
  }
  $view->drawPNG($TMPDIR . $imgfn);
  $imgHTML = <<END_OF_IMG;
<script>
var structXPosL = new Object();
var structYPos = new Object();
var structWid = new Object();
</script>
<map NAME='tvmap'>
${imapHTML}
</map>
<img src='${DIR}$imgfn' id='tview' usemap='#tvmap' border=0>
END_OF_IMG

  return ($pgsstatHR,$exstatHR,$instatHR,$lgapsHR,$imgHTML);
}

sub showRECORD{
  my $self = shift;
  my ($argHR) = @_;
  exists($argHR->{resid}) || return undef;
  $self->_initDSO($argHR->{resid}); ## init DSO for this resource if needed
  return $self->{resourceOBJ}->[$argHR->{resid}]->showRECORD($argHR);
}

sub showREGION{
  my $self = shift;
  my ($argHR)=@_;
  my ($x,$rsc,$imgW,$rulerfn,$trackORDER,$trackCNT);
  my ($tcNAME,$tcCOLOR,$tcHTML,$imgHTML);
  my ($tcTABLE,$tcSCRIPT,$imgTABLE);

  require GeneView;
  $imgW    = exists($argHR->{imgW})?$argHR->{imgW}:600;
  $rulerfn = "ruler$$.png";
  my $viewruler = new GeneView($imgW,35,$argHR->{l_pos},$argHR->{r_pos},0);
  $viewruler->drawPNG($TMPDIR.$rulerfn);

  $trackORDER   = exists($argHR->{trackORDER})?[split(',',$argHR->{trackORDER})]:[3,2,1,0];
  $trackVISIBLE = exists($argHR->{trackVISIBLE})?[split(',',$argHR->{trackVISIBLE})]:[1,1,1,1];
  $trackCNT     = $#$trackORDER + 1;

  $tcTABLE  = <<END_OF_TCTABLE;
<!-- Track control table START -->
<table border=0 cellspacing=0 cellpadding=0 width=200>
END_OF_TCTABLE

  $tcSCRIPT = <<END_OF_TCSCRIPT;
<script language=Javascript>
//document.write("");
var tracksArr     =  new Array($trackCNT);
var openArr       =  new Array($trackCNT);
var colorsArr     =  new Array($trackCNT);
var extraArr      =  new Array($trackCNT);
var extraHTML     =  new Array($trackCNT);
var namesArr      =  new Array($trackCNT);
var imageArr      =  new Array($trackCNT);
var imagemapArr   =  new Array($trackCNT);
END_OF_TCSCRIPT

  $imgTABLE = <<END_OF_IMGTABLE;
<!-- Image table START -->
<table cellspacing=0 cellpadding=0 border=0>
END_OF_IMGTABLE

if(!exists($argHR->{altCONTEXT}) || ($argHR->{altCONTEXT} =~ /^chr$/i)){
  $imgTABLE .= <<END_OF_IMGTABLE;
<tr><td></td><td><img src="${DIR}${rulerfn}"></td></tr>
END_OF_IMGTABLE
}
  
  $x=0;
  $self->_initALL_DSO();
  $argHR->{customORDER} = '';
  $argHR->{customVISIBLE} = '';
  foreach $rsc (@$trackORDER){
    if(defined($self->{resourceOBJ}->[$rsc])){ 
#<DEBUG>#      print STDERR "[GSQDB.pm::showREGION] drawing DSO " . $self->{resourceOBJ}->[$rsc]->{trackname} . "\n";

      ## alter this section to be definable in SITEDEF. Use a generic function call to each listed genomic sequence centric view. ??
      if(exists($argHR->{altCONTEXT}) && ($argHR->{altCONTEXT} !~ /^chr$/i)){ 
	if($self->{resourceOBJ}->[$rsc]->{DSOname} eq $argHR->{altCONTEXT}){
	  my $imgfn = "GSEGruler_$self->{dbid}_" . join('-',@$argHR{'gseg_gi','l_pos','r_pos'}) . "GC.png";
	  ($imgHTML,$imgNAME,$imgIMAP) = $self->{resourceOBJ}->[$rsc]->draw_GSEG_RULER($argHR,{name=>"GSEGimage"},$imgfn,undef);
	  $imgTABLE .= "<tr><td></td><td>\n${imgHTML}\n</td></tr>\n";
	}
	
	next if((!exists($self->{resourceOBJ}->[$rsc]->{$argHR->{altCONTEXT}."VIEWABLE"}))||($self->{resourceOBJ}->[$rsc]->{$argHR->{altCONTEXT}."VIEWABLE"} == 0));

	## Add elsif blocks for various contig views (genomic sequence centric view, e.g. GSSview)

      }else{ 
	next if((!exists($self->{resourceOBJ}->[$rsc]->{chrVIEWABLE}))||($self->{resourceOBJ}->[$rsc]->{chrVIEWABLE} == 0)); 
      }

      ($tcNAME,$tcCOLOR,$tcHTML,$imgHTML,$imgNAME,$imgIMAP) = $self->{resourceOBJ}->[$rsc]->queryREGION($argHR,{name=>"image${x}"});
      $argHR->{customORDER}   .= "$rsc,";
      $argHR->{customVISIBLE} .= "$trackVISIBLE->[${rsc}],";

      $imgTABLE .= <<ENDHTML;
<tr><td></td><td id="imagecell${x}">     <!-- Region Image ${x} -->
${imgHTML}\n</td></tr>
ENDHTML

      $tcTABLE  .= <<ENDHTML;
<tr bgcolor="${tcCOLOR}" id="track${x}" style="white-space:nowrap;">  <!-- Track Control ${x} -->
  <td align=left valign=top style="white-space:nowrap;">
    &nbsp;
    <a href="javascript:extratrack(${x});"><img src="${IMAGEDIR}plus.jpg" border=0></a>
    <input  name="trackname${x}" type=text style="background:${tcCOLOR}; border-width:0; color:white; font:bold 12pt Times,serif;" READONLY size=20 value="${tcNAME}"><br>
    <div id="extra${x}" style="display:none">\n${tcHTML}    </div>
  </td>
  <td>
    <table border=0 cellspacing=0 cellpadding=0>
      <tr><td><a href="javascript:goup(${x});"><img class="buttonIMG" src="${IMAGEDIR}uparrow.gif" border=0></a></td></tr>
      <tr><td><a href="javascript:godown(${x});"><img class="buttonIMG" src="${IMAGEDIR}downarrow.gif" border=0></a></td></tr>
    </table>
  </td>
  <td valign=top style="white-space:nowrap;">
    <input type=checkbox name="opencheck${x}" onClick="javascript:closedown(${x});" checked>
  </td>
</tr>
ENDHTML

      $tcHTML =~ s/\'/\\\'/g;
      $tcHTML =~ s/\n//g;
      $tcSCRIPT .= <<ENDHTML;
tracksArr[${x}]    = $rsc;
openArr[${x}]      = $trackVISIBLE->[${rsc}];
colorsArr[${rsc}]    = "${tcCOLOR}";
extraArr[${rsc}]     = 0;
extraHTML[${rsc}]    = '$tcHTML';
namesArr[${rsc}]     = '$tcNAME';
imageArr[${rsc}]     = '$imgNAME';
imagemapArr[${rsc}]  = '$imgIMAP';
ENDHTML

      $x++;
    }
  }

  chop($argHR->{customORDER});
  chop($argHR->{customVISIBLE});

  $tcTABLE  .= "\n${tcSCRIPT}</script>\n</table>\n<!-- Track control table END -->\n";
  $imgTABLE .= "</table>\n<!-- Image table END -->\n";

  return ($tcTABLE,$imgTABLE);
}

sub showSTRUCT{
}

sub showMULTILOCUS{
## Assumes each OBJ defines a $self-{chrMULTILOCI_href} containing pertinent records
  my $self = shift;
  my ($argHR) = @_;
  my ($rscORDER,$rsc,$tmp,$hitlist,@MLTableCol);
  my ($mlociMapInfo,$mlociTableInfo);

  $rscORDER   = exists($argHR->{rscORDER})?[split(',',$argHR->{rscORDER})]:[0..$#{$self->{resourceOBJ}}];

  $hitlist = [];
  foreach $rsc (@$rscORDER){
    if(defined($self->{resourceOBJ}->[$rsc])){
      $self->{resourceOBJ}->[$rsc]->getMULTILOCI({LOCIhitlist=>$hitlist});
      $tmp = $self->{resourceOBJ}->[$rsc]->showMULTILOCI_TABLE($argHR);
      if((length($MLTableCol[0]) < (0.5 * length($MLTableCol[1]))) ||
	 ((length($MLTableCol[0]) + length($tmp)) < (1.25 * length($MLTableCol[1])))){
	$MLTableCol[0] .= $tmp;
      }else{
	$MLTableCol[1] .= $tmp;
      }
    }
  }

  $mlociMapInfo   = $self->showHITMAP($#DB,$hitlist,{align=>'center'});
  $mlociTableInfo = table(Tr({valign=>'top'},[td(\@MLTableCol)]));

  return ($mlociMapInfo,$mlociTableInfo);
}

sub showHITMAP{
  ##$$ NEED TO ALTER FN TO ALLOW CGI ARGS FOR AREA AND IMG TAGS
  my $self = shift;
  my ($dbID,$hitLIST,$imgPHR) = @_;

  my $imgMapInfo="\n".'<MAP NAME="map_HM">'."\n";
  my $view = new GenomeView(350,225,$DBver[$dbID]->{chrSIZE},$DBver[$dbID]->{centLOC});
  my ($j,@rect);
  for($j=0;$j<=$#$hitLIST;$j++){
    ## my ($pCHR,$lpos,$color,$link) = @{$hitLIST->[$j]}
    @rect = $view->addRect(@{$hitLIST->[$j]}[0..2]);
    
    $imgMapInfo .= '<AREA SHAPE="RECT" COORDS="'.join(',',@rect).'" HREF="' . $hitLIST->[$j]->[3]  . '">'."\n";
  }
  my $imgfn="tmp${$}HM".'.png';
  $view->drawPNG($TMPDIR.$imgfn);
  $imgMapInfo .= "</MAP>\n" . img({align=>'left',width=>350,height=>225,src=>"${DIR}${imgfn}",usemap=>'#map_HM',%$imgPHR});

  return $imgMapInfo;
}

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

sub validateLOGIN {
  my ($self,$Lid,$pwd) = @_;
  my %attr = (PrintError=>0,RaiseError=>0);
  my $ANNdbh = DBI->connect($USER_AUTH_DB,$USER_AUTH_USER,$USER_AUTH_PASS,\%attr);
  my $SQLquery = "Select ACCgroup from users where (USERid = \"$Lid\") && (Upass = \"$pwd\")";

  my $sth = $ANNdbh->prepare($SQLquery);
  $sth->execute();
  my @arr = $sth->fetchrow_array();
  if(scalar(@arr)){
    $rtv = $arr[0];
  }else{
    $rtv = -1; # no entry with this user pass combo
  }
  print STDERR "$ANNdsn\n$SQLquery\n";
  $sth->finish();
  $ANNdbh->disconnect();
  return $rtv;
}

sub retrieveUser {
  my ($self,$type,$value) = @_;
  my %attr = (PrintError=>0,RaiseError=>0);
  my $ANNdbh = DBI->connect($USER_AUTH_DB,$USER_AUTH_USER,$USER_AUTH_PASS,\%attr);
  my $SQLquery = "";
  if($type == 0){
    $SQLquery = "Select USERid,Upass,email from users where (USERid = \"$value\")";
  }elsif($type == 1){
    $SQLquery = "Select USERid,Upass,email from users where (email = \"$value\")";
  }
  my $sth = $ANNdbh->prepare($SQLquery);
  $sth->execute();
  my @arr = $sth->fetchrow_array();
  if(scalar(@arr)){
    my $msg = "A request has been made from the $SITENAMEshort webservice to retrieve the login information associated with this email address.\n\n";
    $msg .= "LOGIN: $arr[0] \nPASSWORD: $arr[1]\n";
    my $TMP_FILE = tmpnam('tmpLOGIN','.req');
    open(TMP,">$TMP_FILE");
    print TMP "$msg\n\n";
    close(TMP);
    my $SYScmd = "mail -s $SITENAMEshort login information $arr[2] < $TMP_FILE";
    `$SYScmd`;
    unlink $TMP_FILE;
    $rtv = 1;
  }else{
    $rtv = 0; # no entry with this value
  }
  return $rtv;
}

sub isAdmin{
  my ($self,$Lid) = @_;
  my %attr = (PrintError=>0,RaiseError=>0);
  my $ANNdbh = DBI->connect($USER_AUTH_DB,$USER_AUTH_USER,$USER_AUTH_PASS,\%attr);
  my $SQLquery  = "Select ACCgroup from users where (USERid = \"$Lid\")";
  my $sth = $ANNdbh->prepare($SQLquery);
  $sth->execute();
  my @arr = $sth->fetchrow_array();
  if((scalar(@arr)) && ($arr[0] eq 'ADMIN')){
    return 1;
  }else{
    return 0;
  }
}

sub registerUSER {
  my ($self,$Lid,$pwd,$email,$phone,$fullname) = @_;
  my %attr = (PrintError=>0,RaiseError=>0);
  my $ANNdbh = DBI->connect($USER_AUTH_DB,$USER_AUTH_USER,$USER_AUTH_PASS,\%attr);
  my $SQLquery  = "Select APPcount from users where (USERid = \"$Lid\")";
  my $SQLquery2 = "Select APPcount from users where (email = \"$email\")";
  my $sth = $ANNdbh->prepare($SQLquery);
  $sth->execute();
  my @arr = $sth->fetchrow_array();
  $sth = $ANNdbh->prepare($SQLquery2);
  $sth->execute();
  my @arr2 = $sth->fetchrow_array();
  if(scalar(@arr)){
    $rtv = 0; #login id already taken
  }elsif(scalar(@arr2)){
    $rtv = -1; #email taken
  }else{
    $SQLquery = "INSERT into users VALUES (\"$Lid\",\"$pwd\",0,\"$email\",\"$phone\",\"$fullname\",\"USER\")";
    $ANNdbh->do($SQLquery);
    $rtv = 1;
  }
  $sth->finish();
  $ANNdbh->disconnect();
  return $rtv;
}

sub updateUSER {
  my ($self,$Lid,$pwd,$email,$phone,$fullname) = @_;
  my %attr = (PrintError=>0,RaiseError=>0);
  my $ANNdbh = DBI->connect($USER_AUTH_DB,$USER_AUTH_USER,$USER_AUTH_PASS,\%attr);
  my $SQLquery = "Select APPcount from users where (USERid != \"$Lid\")&&(email = \"$email\")";
  my $sth = $ANNdbh->prepare($SQLquery);
  $sth->execute();
  my @arr = $sth->fetchrow_array();
  if(($email)&&(scalar(@arr))){
    $rtv = 0; #email not unique to this user
  }else{
    $SQLquery = "UPDATE users SET ";
    if($pwd){
      $SQLquery .="Upass=\"$pwd\",";
    }
    if($email){
      $SQLquery .="email=\"$email\",";
    }
    if($phone){
      $SQLquery .="phone=\"$phone\",";
    }
    if($fullname){
      $SQLquery .="fullname=\"$fullname\",";
    }
    chop($SQLquery);
    $SQLquery .= " where (USERid = \"$Lid\")";
    $ANNdbh->do($SQLquery);
    $ANNdbh->disconnect();
    $rtv = 1;
  }
  return $rtv;
}


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


sub getSequence {
  my ($self,$db,$dbid,$seqAR) = @_;
  my ($indx,%seqs,@SeqResults);

  $dbid = $#DBver if($dbid < 0);

  if($db eq 'GENOME'){
    open(SR,$DBver[$dbid]->{seqFILE}) || return undef;
    for(my $x=0;$x<=$#$seqAR;$x++){
      my ($chr,$lft,$rgt) = $seqAR->[$x] =~ /^([^:]*):(\d+):(\d+)/;
      seek(SR,($DBver[$dbid]->{genomeST}->[($chr - 1)] + $lft - 1),0);
      read(SR,$seqs,$rgt - $lft + 1);
      $seqs =~ s/(.{70})/$1\n/g;
      $indx = defined($#SeqResults)? ($#SeqResults + 1) : 0;
      $SeqResults[$x] = ">${LATINORGN} chromosome $chr $DBver[$dbid]->{DBtag} bases $lft - $rgt\n$seqs";
    }
    close(SR);
  }else{
    my $tmpfn = "${TMPDIR}tmp$$".'.lst';
    open(TMP,">$tmpfn") || die;
    foreach (sort {return $a cmp $b;} @{$seqAR}){
      if(/^([^:]*):(\d+):(\d+)/){
	$seqs{$1} = ($2==0)?($3==0)?[0,0]:[1,$3]:[$2,$3];
	print TMP $1 . "\n";
      }else{
	$seqs{$_} = [0,0];
	print TMP $_ . "\n";
      }
    }
    close TMP;
    my $cmd = $FASTACMD . " -d $BLAST_DB{$db}->[1] -i $tmpfn";
    $seqs = `$cmd`;

    @results = split(/^>/,$seqs);
    foreach (@results){
      if($_ ne ''){
	$indx = defined($#SeqResults)? ($#SeqResults + 1) : 0;
	@line = split('\n',$_);
	$processed = 0;
	foreach $seqid (split(/[\s\|]/,$line[0])){
	  if(exists($seqs{$seqid})){
	    if($seqs{$seqid}->[0] == 0){
	      $SeqResults[$indx] = ">$_";
	    }else{
	      $lineLength = length($line[1]);
	      $sequence = join('',@line[1..$#line]);
	      $sequence =~ s/\s+//g;
	      $mod_seq = substr($sequence,($seqs{$seqid}->[0] - 1),($seqs{$seqid}->[1] - $seqs{$seqid}->[0] + 1));
	      $mod_seq =~ s/(.{$lineLength})/$1\n/g;
	      $region = "(bases $seqs{$seqid}->[0] - $seqs{$seqid}->[1])";
	      $line[0] =~ s/^(\S+)/>$1 $region/;
	      $SeqResults[$indx] = "$line[0]\n$mod_seq";
	    }
	    $processed = 1;
	  }
	}
	print STDERR "[GSQDB::getSequence] ERROR with $line[0]\n" if(! $processed);
      }
    }
  }

  return \@SeqResults;
}

sub doBLASTprompt {
  my ($self,$seq) = @_;
  my $name = '';

  if($seq =~ /^>([^\n]*)/){$name = $1;}

  my $PAGE = "<H2>BLAST Search &nbsp;&nbsp;&nbsp;&nbsp;<A name=\"BRSviewHELP\" href=\"#\" onclick=\"open('${DOCDIR}brsviewDOC.html','BRSviewHELP','screenX=50,screenY=50,toolbar=no,status=yes,scrollbars=yes,location=no,menubar=yes,directories=no,width=640,height=480');\"><IMG src=\"${IMAGEDIR}helpINFO.gif\" border=0 valign=\"center\"></A></H2>" .
    table(
	  TR({-align=>LEFT},
	     th('Query name (optional)'),
	     th('Program'),
	     th('Database')),
	  TR(td(textfield(-name=>'name',
			  -value=>$name)),
	     td(popup_menu(-name=>'program',
			   -value=>[qw/blastn blastp blastx tblastn/],
			   -default=>'blastn')),
	     td(popup_menu(-name=>'db',-value=>[keys %BLAST_DB],
			   -default=>'ATest'))),
	 ) .
	   strong('Paste query sequence (raw or FASTA format):') . br;
  if($seq){
    $PAGE .= textarea(-name=>'sequence',-rows=>5,-cols=>72,-wrap=>'virtual',-value=>$seq) . br;
  }else{
    $PAGE .= textarea(-name=>'sequence',-rows=>5,-cols=>72,-wrap=>'virtual') . br;
  }
  $PAGE .= strong("Or upload query sequence: ") .
    filefield(-name=>'upload', -size=>40) . br .
      submit(-name=>'runBLAST',-value=>'Run BLAST') .
	reset();
  return $PAGE;
}

sub doBLAST{
  my $self = shift;
  my ($sequence,$name,$program,$db) = @_;
  my %BLAST_OPTS= ('blastn'   =>  [qw/-progress 2 -filter dust/],
		   'tblastn'  =>  [qw/-progress 2 -filter seg/],
		  );
  my $JSCRIPT=<<END;
<SCRIPT LANGUAGE="JavaScript">
  function check(field,checkflag) {
    if (checkflag == "  Select All  ") {
      if (!field.length) {
	field.checked = true;
      }
      else {
	for (i = 0; i < field.length; i++) {
	  field[i].checked = true;
	}
      }
      checkflag = " Unselect All ";
      return " Unselect All ";
    }
    else {
      if (!field.length) {
	field.checked = false;
      }
      else {
	for (i = 0; i < field.length; i++) {
	  field[i].checked = false;
	}
      }
      checkflag = "  Select All  ";
      return "  Select All  ";
    }
  }
  function showFASTA(DB) {
    Hlink = "${CGIPATH}returnFASTA.pl?db=" + DB;
    Qnum = 1;
    while(eval("document.guiFORM.hits" + Qnum)){
      HitLIST = eval("document.guiFORM.hits" + Qnum);
      if (!HitLIST.length) {
        Hlink = Hlink + "&hits=" + HitLIST.value;
      }else{
        for(x=0;x<HitLIST.length;x++) {
	  if(HitLIST[x].checked){
	    Hlink = Hlink + "&hits=" + HitLIST[x].value;
	  }
        }
      }
      Qnum++;
    }
    window.open(Hlink,'640x480','toolbar=no,status=yes,scrollbars=yes,location=no,menubar=yes,directories=no,width=640,height=480');
  }
</SCRIPT>
END

  local(*B);
  my $TMP_FILE = tmpnam($program,'.fasta');
  to_fasta($TMP_FILE,$sequence,$name);
  my $cmd = sprintf("%s -p %s -d %s -i %s -e 1E-20 -IT -FF -TT",$BLAST,$program, $BLAST_DB{$db}->[1], $TMP_FILE);
  open(B,"-|") || do {exec($cmd) && die "Couldn't exec: $!";};
  my $result = $JSCRIPT .
    "<H2>BLAST Results &nbsp;&nbsp;&nbsp;&nbsp;<A name=\"BRRviewHELP\" href=\"#\" onclick=\"open('${DOCDIR}brrviewDOC.html','BRRviewHELP','screenX=50,screenY=50,toolbar=no,status=yes,scrollbars=yes,location=no,menubar=yes,directories=no,width=640,height=480');\"><IMG src=\"${IMAGEDIR}helpINFO.gif\" border=0 valign=\"center\"></A></H2>".
      "<div align=\"left\">" .
	hidden(-name=>'db',-value=>"$db",-override=>1);

  # print out the top boilerplate
  $| = 1;
  my $Qnum=0;
  while ($_ = B->getline) {
    $adjustedLine = &addLink($_,$Qnum);
    $result .= $adjustedLine;
    if((! $selectableResults)&&($adjustedLine =~ /TYPE=\"checkbox\"/)){
      $selectableResults = 1;
      $result =~ s/<!-- SELECTION TOOLS QUERY $Qnum -->/<!-- SELECTION TOOLS QUERY $Qnum -->\n$tools/;
    }
    # The Qnum scalar in the  following is used to take care of hits resulting from multiple query inputs
    if(/^Searching\.+done/){
      $Qnum++;
      $selectableResults = 0;
      $result .= "\n<!-- SELECTION TOOLS QUERY $Qnum -->\n";
      $tools = '<input type=button name="selection' . $Qnum . 
	       '" value="  Select All  " onClick="this.value=check(this.form.hits' . $Qnum . ',this.value)">' .
	       button(-name=>"retrieve$Qnum", -value=>"Display selected hits in FASTA format", -onclick=>"showFASTA('${db}');");
    }
  }
  STDOUT->flush;
  unlink $TMP_FILE;
  close B;
  $result .= "</div>";

  return $result;
}

# replace the link for gi to queryID and build link for SQ;
sub addLink{
  my ($line,$QN)=@_;
  my ($link);
  my $id;
  my $ESTLINK = "${CGIPATH}findRecord.pl?id=";

  if($line =~ /^<.*>gi\|(\d+)\|/){
    $link= '"' . $ESTLINK . $1 . '"';
    $id=$1;
    $line =~ s/<a href[^>]*>/<INPUT TYPE=\"checkbox\" NAME=\"hits${QN}\" VALUE=\"${id}\"><a href=$link>/;

  }elsif($line =~ /gi\|(\d+)\|/){
    $link='"'.$ESTLINK.$1.'"';
    $line =~ s/a href[^>]*>/a href=$link>/;

  }elsif($line =~ /^(At\dg\S+)/){
    my $geneId=$1;
    ($id) = $geneId =~ /(At\dg\d{5})/;
    $link = "<INPUT TYPE=\"checkbox\" NAME=\"hits${QN}\" VALUE=\"${id}\"><a href=\"${gsqpLink}${id}\">$geneId</a>";
    $line =~ s/$geneId/$link/;

  }elsif($line =~ /(At\dg[0-9.]+)/ ){
    my $geneId=$1;
    ($id) = $geneId =~ /(At\dg\d{5})/;
    $link = "\"${gsqpLink}${id}\"";
    $line =~ s/a name = ${geneId}\s*>\s*<\/a>/a name=${geneId} href=$link>/;

  }
  return $line;
}

sub to_fasta {
  my ($tmp,$sequence,$name) = @_;
  my ($seq);

  my $file = IO::File->new(">$tmp") || AceError("Couldn't open temporary file for writing sequence: $!");

  while($sequence =~ m|>([^\n]+)\n([^>]+)|g){
    $name = $1;
    $seq = $2;
    $seq =~ tr/a-zA-Z//cd;
    $seq =~ s/(.{80})/$1\n/g;
    print $file ">$name\n$seq\n";
  }
  if(!($sequence =~ /^>/)){
    $sequence=~tr/a-zA-Z//cd;
    $sequence=~s/(.{80})/$1\n/g;
    print $file '>Untitled Sequence submitted by ' .
      remote_host() .
	"\n$sequence\n";
  }
  $file->close();
  return " ";
}

sub tmpnam {
  my ($TMPNAM,$suffix) = @_;
  while(1) {
    my $tmpfile = "$TMPDIR/${$}" . $TMPNAM++ . $suffix;
    return $tmpfile if IO::File->new($tmpfile,O_EXCL|O_CREAT);
  }
}



# end of package;
1;

See more files for this project here

eXtensible Genome Data Broker

The xGDB project provides scientists with an online portal for the integration of diverse sources of genomic data. Portals allow researchers to effectively target a specific scientific question by customizing their interactions with available data.

Project homepage: http://sourceforge.net/projects/xgdb
Programming language(s): JavaScript,Perl,PHP
License: other

  DSO/
    AnnotationTrack.pm
    BAC.pm
    CDNApgs.pm
    ESTpgs.pm
    GBKann.pm
    GSEG.pm
    GeneSeqerSequence.pm
    GenomeSegmentTrack.pm
    Locus.pm
    Marker.pm
    PROBE.pm
    SequenceTrack.pm
    TIGRtu.pm
    UCAann.pm
  fct/
    GenomeData.pm
  GDBgui.pm
  GSQDB.pm
  GeneView.pm
  GenomeView.pm
  SeqUtils.pm
  checkLOGIN.pl
  getPARAM.pl
  index.html
  xGDB_SUPPORTED_COLORS.pl