Community Company Search Contact

UCAann.pm from eXtensible Genome Data Broker at Krugle

Show UCAann.pm syntax highlighted

package UCAann;
use base "AnnotationTrack";

do 'SITEDEF.pl';

use DBI;
use CGI ":all";
use CGI::SSI;

sub hello{
  my $self = shift;
  print "hello I'm a ";
  $self->SUPER::whatami();
  print "$self->{DSOname}\n";
}

sub _init{
  my $self = shift;

  $self->SUPER::_init(@_);

  $self->{db_table} = (exists($self->{db_table})) ? $self->{db_table} : 'user_gene_annotation';
  $self->{trackname} = (exists($self->{trackname}))? $self->{trackname}: 'UCA';

  #### specifc query strings ####
  my $DB_TABLE = $self->{db_table};

 $UCAviewableSQL = ($self->{USERfname} eq "ADMIN") ?  "" : "((USERid = '$self->{USERid}')||(status = 'ACCEPTED'))&&";

  $self->{gsegSQL_BASE}=  $self->{SQL_BASE}         = qq{SELECT uid, c.geneId, c.chr,c.strand,c.l_pos,c.r_pos,c.gene_structure,c.description,c.comment,c.CDSstart,c.CDSstop,c.status,c.modDate,c.geneAliases,c.proteinAliases,c.proteinId,c.comment,c.USERid as owner,c.evidence,c.description,c.CDSstart,c.CDSstop FROM user_gene_annotation as c };
#ELECT c.uid,c.geneId,c.chr,c.strand,c.l_pos,c.r_pos,c.gene_structure,c.description,c.note,c.CDSstart,c.CDSstop,c.transcript_id

  $self->{gsegREGION_QUERY} = $self->{chrREGION_QUERY}  = qq{$self->{SQL_BASE} WHERE $UCAviewableSQL (c.chr=?)&&(c.r_pos>=?)&&(c.l_pos<=?) };


  $self->{gsegDESC_QUERY} = $self->{chrDESC_QUERY}    = qq{$self->{SQL_BASE} WHERE $UCAviewableSQL (MATCH (description,comment) AGAINST (? IN BOOLEAN MODE)) };

  $self->{gsegUID_QUERY} = $self->{chrUID_QUERY}     = qq{SELECT c.geneId FROM user_gene_annotation as c WHERE $UCAviewableSQL (c.uid=?)        };

  $self->{gsegQUERY} = $self->{chrQUERY}         = qq{$self->{SQL_BASE} WHERE $UCAviewableSQL (c.geneId=?) };



  $self->{MULTI_ID_QUERY} = sub {
    my ($BASE,$idlist) = @_;
    return $BASE . "WHERE (geneId IN ($idlist)) )";
  };

#  do "$self->{DSO_MOD}" if(exists($self->{DSO_MOD}));  
#  $self->{VALIDATE_ID} = \&MOD_VALIDATE_ID if(exists(&MOD_VALIDATE_ID));

}

sub drawCombinedImage{
  my $self = shift;
  my ($view,$startY) = @_;
  my ($prevUID,$puid,$recordHR,$stINFO,$bottom,$recAR,%imap);

  $prevUID = -1; $bottom=0;
  foreach $recordHR (sort _by_CLR values %{$self->{pgsREGION_href}}){
    $stINFO = $self->structINFO('pgs',$recordHR);
    $stINFO->[1]{startHeight} = $startY;
    ($labelAR,$recAR) = $view->addGene(@$stINFO[1..$#$stINFO]);
    $view->addCDS($recAR->[0],$recordHR->{cdsstart},$recordHR->{cdsstop});
    $imap{$self->{resid} . "_" . $recordHR->{uid}} = [$labelAR,$recAR];
    $bottom = $recAR->[1] if($recAR->[1] > $bottom);
  }
  return (\%imap,$bottom);
}

sub drawREGION{
  my $self = shift;
  my ($argHR,$img_paramHR,$imgfn) = @_;
  my ($link,$imgW,$imgH,$stINFO,$defL,$imgHTML,$initIMG);
  my ($view_IM,$view);
  my ($view2_IM,$view2,$imgfn2);
  my ($labelAR,$recAR,$label2AR,$rec2AR);

  $imgW    = exists($argHR->{imgW})?$argHR->{imgW}:600;
  $imgH    = exists($argHR->{imgH})?$argHR->{imgH}:30;
  $initIMG = exists($argHR->{initialIMG})?$argHR->{initialIMG}:"";
 
  $view = new GeneView($imgW,$imgH,$argHR->{l_pos},$argHR->{r_pos},1);
  $view->setLabelOn(1);
  $view_IM = "<MAP NAME=\"$self->{trackname}_IM\">\n";
  
  ## view2 is for the flags display
  $imgfn2 = "flagged_" . $imgfn;
  $view2 = new GeneView($imgW,$imgH,$argHR->{l_pos},$argHR->{r_pos},1);
  $view2->setLabelOn(1);
  $view2_IM = "<MAP NAME=\"flagged_$self->{trackname}_IM\">\n";

  foreach $recordHR (sort _by_CLR values %{$self->{pgsREGION_href}}){
    $stINFO = $self->structINFO('pgs',$recordHR);
    $defL   = CGI::unescapeHTML(CGI::unescape($recordHR->{description}));
    $defL =~ s/\'/\\\'/g;
    $defL =~ s/\r//g;  ## Get rid of any pesky carriage returns
    $defL =~ s/\n/\\n/g; ## Escape the newline so that HTML works
    $link = $self->getRecordLink($argHR,$recordHR);
    ($labelAR,$recAR) = $view->addGene(@$stINFO[1..$#$stINFO]);
    $view->addCDS($recAR->[0],$recordHR->{cdsstart},$recordHR->{cdsstop});
    $view_IM .= "<AREA SHAPE=\"RECT\" COORDS=".join(',',@$recAR[2,0,$#$recAR,1])." HREF=\"${link}\"  onmouseover=\"document.guiFORM.defline.value='$defL';\" onmouseout=\"document.guiFORM.defline.value='Mouse over for description. Click to retrieve individual record.';\">\n";

    ($label2AR,$rec2AR) = $view2->addGene(@$stINFO[1..$#$stINFO]);
    $view2->addCDS($rec2AR->[0],$recordHR->{cdsstart},$recordHR->{cdsstop});
    if(0){## if has flags draw flags
    }
    $view2_IM .= "<AREA SHAPE=\"RECT\" COORDS=".join(',',@$rec2AR[2,0,$#$recAR,1])." HREF=\"${link}\"  onmouseover=\"document.guiFORM.defline.value='$defL';\" onmouseout=\"document.guiFORM.defline.value='Mouse over for description. Click to retrieve individual record.';\">\n";
  }
  
  $view_IM  .= "</MAP>\n";
  $view2_IM .= "</MAP>\n";

  $imgHTML = img({src    => "${DIR}${initIMG}${imgfn}",
		  usemap => "#${initIMG}$self->{trackname}_IM",
		  border => 0,
		  %$img_paramHR});
  
  $view->drawPNG($TMPDIR.$imgfn);
  $view2->drawPNG($TMPDIR.$imgfn2);
  
  return ($view_IM.$view2_IM.$imgHTML,"${DIR}${initIMG}${imgfn}","${initIMG}$self->{trackname}_IM");
}

sub getTRACKCELL{
  my $self = shift;
  my ($argHR,$imgfn) = @_;
  my ($extrahtml,$color,$name);

  my ($stdESTcheck,$cogESTcheck) = ('checked','');

  if((exists($argHR->{initIMG}))&&($argHR->{initIMG} eq 'flags')){
    $stdANNcheck = ''; $flagANNcheck = 'checked';
  }

  $name  = $self->{trackname};
  $color = $self->{primaryColor};
  $extrahtml  = <<END_OF_EXTRAHTML;
<font style="font-family:Arial;font-size:11px" color=white>
<input type=radio id='${name}' name='${name}' value='0' onclick="image_toggle('$self->{resid}','${DIR}flagged_${imgfn}','$self->{trackname}_IM');" ${flagANNcheck}>show flags
<BR>
<input type=radio id='${name}' name='${name}' value='1' onclick="image_toggle('$self->{resid}','${DIR}${imgfn}','flagged_$self->{trackname}_IM');" ${stdANNcheck}>hide flags
</font>
END_OF_EXTRAHTML

  return ($extrahtml,$color,$name);
}

sub structINFO{
  my $self = shift;
  my ($type,$record,$argHR) = @_;
  my ($c,$c_a,$c_s,$c_d,$label,$str,@pgs);
  
  return undef if(!(defined($record) && exists($record->{uid})));

  $c = $c_a = $c_s = $c_d = $self->{primaryColor};

  $label = (exists($record->{geneid}))?$record->{geneid}:$self->{geneid};
  
  ($str) = $record->{gene_structure} =~ /^\D*(.*)/;
  @pgs = split(/[^\d]+/,$str);

  if($record->{strand} eq 'r'){
    @pgs = reverse @pgs;
  }

  return ["${type}$record->{uid}",
	  {label=>$label,color=>$c,arrowColor=>$c_a,startColor=>$c_s,dotColor=>$c_d,drawArrowhead=>1},
	  @pgs];
}

sub getLOCI{
  my $self = shift;
  my ($argHR) = @_;
  my ($recordHR,$hitlist,$link);
  
  $hitlist = [];
  if((exists($argHR->{LOCI_href}))&&(keys %{$argHR->{LOCI_href}})){
    foreach $recordHR (values %{$argHR->{LOCI_href}}){
      $link    = "${CGIPATH}getRegion.pl?chr=$recordHR->{chr}&l_pos=" . ($recordHR->{l_pos} - 500) . "&r_pos=" .($recordHR->{r_pos} + 500) ; ## link to chr/gseg context ?
      push(@$hitlist,[$recordHR->{chr},$recordHR->{l_pos},$self->{primaryColor},$link]);
    }
  }
  ## add gseg entries with no chr positions??

  return $hitlist;
}

 sub showRECORD{
   my $self = shift;
   my ($argHR) = @_;
   @$argHR{'recordTYPE','selectedRECORD'} = $self->selectRECORD($argHR); ## need to check undefs

   my $ssi = CGI::SSI->new();
   my $result = $ssi->include(virtual => "${ucaPATH}AnnotationDetail.pl?uid=$argHR->{selectedRECORD}->{uid}&dbid=$argHR->{dbid}");

   my $htmlHR = {-title=>"${SITENAMEshort} $self->{trackname}:$self->{geneid}",
                 -bgcolor=>"#FFFFFF",
                };
   my $script;
   return ($htmlHR,$script,$result);
 }

sub getMULTILOCI{
  my $self = shift;
  my ($argHR) = @_;
  my ($recordHR,$hitlist,$link);
  
  $hitlist = exists($argHR->{LOCIhitlist}) ? $argHR->{LOCIhitlist} : [];
  if((exists($self->{chrMULTILOCI_href}))&&(keys %{$self->{chrMULTILOCI_href}})){
    foreach $recordHR (values %{$self->{chrMULTILOCI_href}}){
      $link = "${CGIPATH}getRegion.pl?chr=$recordHR->{chr}&l_pos=" . ($recordHR->{l_pos} - 500) . "&r_pos=" .($recordHR->{r_pos} + 500) ; ## link to chr/gseg context ?
      push(@$hitlist,[$recordHR->{chr},$recordHR->{l_pos},$self->{primaryColor},$link]);
    }
  }
  ## add gseg entries with no chr positions??

  return $hitlist;
}

sub showLOCI_TABLE{
  my $self = shift;
  my ($argHR) = @_;
  my ($recordHR,$x,$strand,$record_link,$region_link,@rows);

  exists($argHR->{selectedRECORD}) || ($argHR->{selectedRECORD} = "");
  
  $x=0;
  @rows = (th({-align=>'center'},['Entry','Chr','Strand','Left','Right','CDS start','CDS stop']));
  if((exists($argHR->{LOCI_href}))&&(keys %{$argHR->{LOCI_href}})){
    foreach $recordHR (sort _by_CLR values %{$argHR->{LOCI_href}}){
      $x++;
      $strand=(($recordHR{strand} eq 'f')||($recordHR{strand} eq '+'))?'+':'-';
      $record_link = "${CGIPATH}getRecord.pl?resid=$self->{resid}&chrUID=$recordHR->{uid}"; ## link to individual record
      $region_link = "${CGIPATH}getRegion.pl?chr=$recordHR->{chr}&l_pos=" . ($recordHR->{l_pos} - 500) . "&r_pos=" .($recordHR->{r_pos} + 500) ; ## link to chr/gseg context
      if($argHR->{selectedRECORD} == $recordHR){
	push(@rows,td({style=>'color:#FF0000;'},[$x,a({href=>$region_link,style=>"color:green;"},$recordHR->{chr}),
						 $strand,@$recordHR{'l_pos','r_pos','CDSstart','CDSstop'}]
		     ));
      }else{
	push(@rows,td([a({href=>$record_link,style=>"color:$self->{primaryColor};"},$x),a({href=>$region_link,style=>"color:green;"},$recordHR->{chr}),
		       $strand,@$recordHR{'l_pos','r_pos','CDSstart','CDSstop'}]
		     ));
      }
    }
  }
  ## Still need to deal with gseg entries

  return  caption("Genomic Loci for $self->{trackname}: gi-" . $self->{geneid}) . Tr({-align=>'center',-valign=>'top'},\@rows);
}

sub showMULTILOCI_TABLE{
  my $self = shift;
  my ($argHR) = @_;
  my ($recordHR,$x,$y,$z,$strand,$record_link,$region_link,$currentGI,@MLrows,@rows);

  $x=0;$y=1;$z=0;
  if((exists($self->{chrMULTILOCI_href}))&&(keys %{$self->{chrMULTILOCI_href}})){
    @MLrows = (th({style=>"text-align:center; border:0;"},['Entry','Chr','Strand','Left','Right','Start Codon','Stop Codon']));
    foreach $recordHR (sort _by_ICLR values %{$self->{chrMULTILOCI_href}}){
      $strand=(($recordHR{strand} eq 'f')||($recordHR{strand} eq '+'))?'+':'-';
      $record_link = "${CGIPATH}getRecord.pl?resid=$self->{resid}&chrUID=$recordHR->{uid}"; ## link to individual record
      $region_link = "${CGIPATH}getRegion.pl?chr=$recordHR->{chr}&l_pos=" . ($recordHR->{l_pos} - 500) . "&r_pos=" .($recordHR->{r_pos} + 500) ; ## link to chr/gseg context
      if($recordHR->{geneid} ne $currentGI){
	push(@MLrows,td({colspan=>7,style=>"background:#DCDCDC; color:#808000; text-align:left; border:0;"},["UCA: geneID-" . $recordHR->{geneid}]));
	$y=1;$x++;
      }
      push(@MLrows,td({style=>"text-align:center;"},[a({href=>$record_link,style=>"color:$self->{primaryColor};"},"$x-$y"),a({href=>$region_link,style=>"color:green;"},$recordHR->{chr}),$strand,@$recordHR{'l_pos','r_pos','cdsstart','cdsstop'}]));
      $y++;$z++;
      $currentGI = $recordHR->{geneid};
    }
    ## Still need to deal with gseg entries
  }
  
  unshift(@MLrows,td({colspan=>7,style=>"background:$self->{primaryColor}; color:#FFFFFF; text-align:left; border:0;"},[strong("$self->{trackname} ($x loci / $z models)")]));

  return table({width=>500,border=>1,valign=>'top'},Tr(\@MLrows)) . "\n";
}

sub _by_ICLR{
  return (
	  ($a->{geneid}    <=> $b->{geneid})    ||
	  ($a->{chr}       <=> $b->{chr})       ||
	  ($a->{l_pos}     <=> $b->{l_pos})     ||
	  ($b->{r_pos}     <=> $a->{r_pos})
	 );
}

sub _by_CLR{
  return (
	  ($a->{chr}       <=> $b->{chr})       ||
	  ($a->{l_pos}     <=> $b->{l_pos})     ||
	  ($b->{r_pos}     <=> $a->{r_pos})
	 );
}

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

  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