#!/usr/bin/perl
package sdevSinglePageFormat;
use strict;
######################################################################
# Author: Stan Dong
# Date: August, 2002
# Comment: Contains all necessary methods for display of single
# page format
######################################################################
use DBI;
use GD;
use CGI qw/:all :html3/;
use CGI::Carp qw(fatalsToBrowser);
use LWP::UserAgent;
use lib "/usr/local/dicty/www_dictybase/db/lib/common";
use Login qw (ConnectToDatabase);
use TextUtil qw (DeleteUnwantedChar);
use lib "/usr/local/dicty/www_dictybase/db/lib/dictyBase";
use dictyBaseDEVObject;
use dictyBaseCentralMod qw (:formatPage :navigateInfo);
use lib "/usr/local/dicty/www_dictybase/db/lib/dictyBase/Objects";
use Go;
use Locus;
use dictyBaseid;
use Feature;
use Pdb_sequence;
use Reference;
use GeneInfo;
use Reflink;
use Phenotype;
use ParagraphUI;
use ConfigURLdictyBase;
use ConfigPathdictyBase;
use CreateGD;
use Motif;
use Chromosome;
use Gene_product;
use Pdb_sequence;
use Pdb_alignment;
use DBD::Oracle qw(:ora_types); # access to ora_types, namely ORA_CLOB
$| = 1;
######################################################################
# Class Globals
######################################################################
my $dbh;
my $seperator;
my $configUrl = ConfigURLdictyBase->new;
my $helpBase = $configUrl->dictyBaseHelp;
my $db;
my $dblink;
my $showNm;
#for motif
my $configPath = ConfigPathdictyBase->new;;
my %gene4orf;
my %commonMotif;
my $defaultRulerWidth = 700;
my $defaultBarHeight = 15;
#for pdbStr
my $pvalueCutOff = 1e-2;
my $alignCutOff = 0;
my $helpButton = $configUrl->dictyBaseImages. "help.png";
my %nextButton;
my %helpURL;
if (!(user_agent() =~/Mac/i)) { # if it's not MAC IE
$seperator = br; # need a seperator
}
######################################################################
sub new {
######################################################################
my ($self, %args) = @_;
$self = {};
bless $self;
$self->{'_help'} = $args{'help'};
$self->{'_database'} = $args{'database'};
$dbh = &ConnectToDatabase($self->database);
$dblink = $configUrl->dblink($self->database);
if ($args{'database'} eq 'dictyBase') {
$db = 'dictyBase';
}
else {
$db = 'dictyBaseDEV';
}
return $self;
}
sub help { $helpBase . $_[0]->{_help} }
sub database { $_[0]->{_database} }
sub featNm { $_[0]->{_featNm} }
sub featNo { $_[0]->{_featureNo} }
sub locusNm { $_[0]->{_locusNm} }
sub locusNo { $_[0]->{_locusNo} }
sub dictyBaseid { $_[0]->{_dictyBaseid} }
sub showNm { $_[0]->{_showNm} }
sub featureType { $_[0]->{_featureType} }
sub alias { $_[0]->{_alias} }
sub query { $_[0]->{_query} }
sub queryType { $_[0]->{_queryType} }
######################################################################
sub proteinNm {
######################################################################
my ($self) = @_;
my $redNm = lc($self->locusNm).'p';
my $first = substr( $redNm, 0, 1);
substr( $redNm, 0, 1) = uc($first);
return $redNm;
}
######################################################################
sub DESTROY { ############ destructor ##############################
######################################################################
if (defined $dbh) {
$dbh->disconnect;
}
exit;
}
######################################################################
sub print {
######################################################################
# This method prints out everything required for the the locus page
my ($self) = @_;
my $query;
my $queryType;
if (param('locus')) {
$query = param('locus');
$queryType = 'locus';
}
elsif (param('dictyBaseid')) {
$query = param('dictyBaseid');
$queryType = 'dictyBaseid';
}
elsif (param('search')) {
$query = param('search');
$queryType = 'search';
}
$self->{'_query'} = $query;
$self->{'_queryType'} = $queryType;
if (!$query) {
$self->SearchForm;
}
#validate search
elsif ($query =~/\w+/) {
#wildcard search
if ($query =~ /\*/) {
# $self->wildCardSearch;
}
else {
$self->SinglePage;
}
}
#invalid search
else {
my $mssg = "\'".font({-color=>'red'}, $query)."\' is an invalid input. Please include at least one character or digit in your query\n";
$self->SearchForm($mssg);
}
$self->DESTROY;
}
#######################################################################
sub SearchForm {
#######################################################################
my ($self, $mssg) = @_;
my $title = "Search for Single Page Format";
&printStartPage($self->database, $title, $self->help);
print center(h2($mssg)) if ($mssg);
print p,p;
print center(table({-border=>3, -cellpadding=>4,-cellspacing=>4},
Tr({-align=>'LEFT'}, [
td({-bgcolor=>"#b7d8e4", -width=>350},
"Enter a locus name (ACT1), ORF name (YFL039C) or dictyBaseID (S0001855).".br.
table({-border=>0},
Tr({align=>'LEFT'}, [
td(start_form, "Search item : ").
td(textfield(-name=>'search', -size=>'25')),
td(" ").td(submit,reset,end_form)
]))
)
])));
print p,p;
&printEndPage;
$self->DESTROY;
}
#######################################################################
sub SinglePage {
#######################################################################
my ($self) = @_;
$self->getIDs;
if ((!$self->featNm) && (!$self->locusNm)) {
$self->err_report("No LOCUS and Feature Name: Invalid entry!\n");
}
elsif (!$self->dictyBaseid) {
$self->err_report("No dictyBaseID!\n");
}
my $dictyBase;
$dictyBase = dictyBaseDEVObject->new(dictyBaseid=>$self->dictyBaseid,
database=>$self->{'_database'});
#to be able to retrieve candida homolog URL
$dictyBase->_initURLs;
$showNm = $self->locusNm.'/'.$self->featNm;
if (!$self->locusNm) {
$showNm = $self->featNm;
}
$self->{'_showNm'} = $showNm;
my $title = "$showNm Single Page Format";
my $Locus = $self->locusNm || $self->featNm;
my $locus_url = $configUrl->dictyBaseCGIRoot ."gene_page.pl?dictyBaseid=".$self->dictyBaseid;
my $startMssg = "This page provides a single page alternative format to the ". a({-href=>$locus_url}, "dictyBase Locus Page") . ". Note that all of the information provided here is also available on the dictyBase locus page, either directly or a single click away. ";
my $aaUrl = $configUrl->dictyBaseCGIRoot."$db/protein/aa.pl?locus=".$self->locusNm."&feat=".$self->featNm;
# Here's the javascript code that we include in the document.
my $javascript = "
"
;
&printStartPage($self->database, $title, $self->help);
print $javascript;
print p, font({-size=>'+1'}, $startMssg), p;
print $self->contentBlock($dictyBase, $locus_url), p;
print $self->namesIdentifiers($dictyBase), p;
print $self->goAnnotations, p;
print $self->pathways($dictyBase), p;
print $self->summaryParagraph($dictyBase), p;
print $self->phenotypesAlleles($dictyBase), p;
print $self->homologs($dictyBase), p;
print $self->proteinInfo($dictyBase), p;
print $self->pdbStructure($dictyBase), p;
print $self->motifs($dictyBase), p;
print $self->genomeWideAnalysis($dictyBase), p;
print $self->locusHistory, p;
print $self->sequenceRetrieve($dictyBase), p;
print $self->maptableDisplay, p;
print $self->interactions($dictyBase), p;
print $self->communityAnnotation, p;
print $self->literatureGuide, p;
&printEndPage;
$self->DESTROY;
}
########################################################################
sub contentBlock {
########################################################################
my ($self, $dictyBase, $locus_url) = @_;
my $content = h2(a({-name=>"top"}, "Contents"));
my $positionalInfo = $dictyBase->positionalInfoSinglePage;
my $orfMapUrl = $configUrl->dictyBaseCGIRoot."$db/ORFMAP/ORFmap?dictyBaseid=".$self->dictyBaseid;
my $miniMapUrl = $configUrl->dictyBaseCGIRoot."$db/ORFMAP/miniORFmap?dictyBaseid=".$self->dictyBaseid;
my $mappingData = $dictyBase->mappingData;
my @cont =
( td(li(a({-href=>"#names"}, "Names and Identifiers"))),
td(li(a({-href=>"#go"},"GO Annotations"))),
td(li(a({-href=>"#pathways"},"Pathways"))),
td(li(a({-href=>"#paragraph"}, "Summary Paragraph"))),
td(li(a({-href=>"#phenotype"}, "Phenotypes"))),
td(li(a({-href=>"#homologs"}, "Homologs"))),
td(li(a({-href=>"#proteininfo"}, "Protein Info") . " (physical properties, transcript info)")),
td(li(a({-href=>"#pdb"}, "PDB Homologs") . " (protein structure info)")),
td(li(a({-href=>"#motifs"}, "Motifs"))),
td(li(a({-href=>"#exp"}, "Genome-wide Expression") . br . "(and other large-scale analyses)")),
td(li(a({-href=>"#notes"}, "Locus History") . " (misc. notes)")),
td(li(a({-href=>"#seq"}, "Sequence Retrieval and Analysis"))),
td(li(a({-href=>"#map"}, "Map and Table Displays"))),
td(li(a({-href=>"#interactions"}, "Interactions"))),
td(li(a({-href=>"#commanno"}, "Community Annotation"))),
td(li(a({-href=>"#literature"}, "Literature Guide")))
);
my $count = 0;
my $rows;
while ($count < @cont) {
$rows .= Tr($cont[$count], $cont[$count+1]) . "\n";
$count = $count + 2;
}
my $list = td(
table({-width=>'100%', -border=>0, -cellspsacing=>6},
$rows));
my ($geneticPositionBlock, $blockCont);
if ($positionalInfo) {
$blockCont .= a({-href=>$orfMapUrl}, img({-alt=>"ORFMAP",-border=>"0", -src=>$miniMapUrl})) . br . br . $positionalInfo;
}
if ($mappingData) {
$blockCont .= br. a({-href=>$mappingData}, "Genetic Map Data");
}
$geneticPositionBlock = td($blockCont);
$content .=
ul(
table({-width=>'100%'},
Tr($list, $geneticPositionBlock
)
)
);
$content .= h2(a({-href=>$locus_url}, "dictyBase Locus Page"));
return blockquote($content);
}
########################################################################
sub namesIdentifiers {
########################################################################
my ($self, $dictyBase) = @_;
my $NameColumn = "Standard Name";
$NameColumn = "Reserved Name" if ($dictyBase->isReserved);
my $rows = $self->titleRow("Names and Identifiers", "names", "", '5');
$rows .= Tr({-align=>'left', -bgcolor=>"a4abc2"},
th($NameColumn) . "\n",
th("Systematic Name") . "\n",
th("Alias") . "\n",
th("Feature Type") . "\n",
th("dictyBaseID") . "\n"
) . "\n" .
Tr(
td($self->locusNm || " "),
td($self->featNm || " "),
td($self->alias || " "),
td($self->featureType || " "),
td($self->dictyBaseid || " ")
) . "\n" ;
if ($dictyBase->fetchRelatedInteractors) {
$rows .= Tr(td({-colspan=>'6'}, b("See ". a({-href=>"#interactions"}, "Nomenclature Note") ."."))) . "\n";
}
#gene reservation info
my $locusObj = Locus->new(dbh=>$dbh, locus_no=>$self->locusNo) if ($self->locusNo);
my $featObj = Feature->new(dbh=>$dbh, feature_no=>$self->featNo) if ($self->featNo);
if ( $locusObj && (my($Rnum, $Rdate, $Edate, $Sdate, $isStd) =
split(/\:/, $locusObj->geneReservationInfo)) ) {
my $reservInfo;
if ($isStd eq "Y") {
$reservInfo = $self->locusNm ." is the standard name for ".
$self->featNm . ".". br ." Gene name standardized on: ". $Sdate . "." . br;
}
else {
$reservInfo = "This name is reserved with dictyBase according to the ". a({-href=>"http://www.Dictyosteliumgenome.org/gene_guidelines.html"}, "Gene Naming Guidelines") ." agreed upon by the Dictyostelium community." .br. "Gene name reserved on: ". $Rdate .". Gene name expires on ". $Edate ."." .br;
}
if (my @colleague = split(/\t/, $locusObj->colleagueNmNo)) {
my $contInfo = b("Contacts: ");
foreach my $contact (@colleague) {
my ($fullname, $colleagueNo) = split(/::/, $contact);
$contInfo .= a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/colleague/colleagueSearch?id=$colleagueNo"},$fullname) . " ";
}
$reservInfo .= $contInfo;
}
$rows .= Tr(td({-colspan=>'5'}, $reservInfo));
}
return table({-width=>"100%", -cellpadding=>"0", -cellspacing=>"1",
-border=>"1"},$rows);
}
########################################################################
sub goAnnotations {
########################################################################
my ($self) = @_;
my $rows = $self->titleRow("GO Annotations", "go", "", '3');
my ($functionRows, $processRows, $componentRows) = $self->getGoAnnotationRow;
if ($functionRows) {
$rows .= Tr(td({-colspan=>'3'}, $self->getGoAnnotTable("Function", $functionRows)));
}
if ($processRows) {
$rows .= Tr(td({-colspan=>'3'}, $self->getGoAnnotTable("Process", $processRows)));
}
if ($componentRows) {
$rows .= Tr(td({-colspan=>'3'}, $self->getGoAnnotTable("Component", $componentRows)));
}
if ((!$functionRows) && (!$processRows) && (!$componentRows)) {
$rows .= Tr(td({-colspan=>'3'}, "No GO Annotations available."));
}
return table({-width=>"100%", -cellpadding=>"0", -cellspacing=>"1",
-border=>"1"}, $rows);
}
########################################################################
sub pathways {
########################################################################
my ($self, $dictyBase) = @_;
my $pathAref = $dictyBase->pathwayRow;
my $pathRow = join(br, @$pathAref) || "No pathways available";
my $rows = $self->titleRow("Pathways", "pathways");
return table({-width=>"100%", -cellpadding=>"0", -cellspacing=>"1",
-border=>"1"}, $rows.Tr(td({-colspan=>'6'}, $pathRow)));
}
########################################################################
sub summaryParagraph {
########################################################################
my ($self, $dictyBase) = @_;
my $summary = ParagraphUI->new();
my $sumRow = $summary->displayParagraph(dictyBaseObject=>$dictyBase)
|| "No summary paragraph available";
my $rows = $self->titleRow("Summary Paragraph", "paragraph");
return table({-width=>"100%", -cellpadding=>"0", -cellspacing=>"1",
-border=>"1"}, $rows.Tr(td({-colspan=>'6'}, $sumRow)));
}
########################################################################
sub phenotypesAlleles {
########################################################################
my ($self, $dictyBase) = @_;
my $phenoArrayRef;
#get phenotype info
if ($self->locusNo) {
my $locusObj = Locus->new(dbh=>$dbh,
locus_no=>$self->locusNo);
$phenoArrayRef = $locusObj->phenotypeInfoArrayRef;
}
elsif ($self->featNo) {
my $featObj = Feature->new(dbh=>$dbh,
feature_no=>$self->featNo);
$phenoArrayRef = $featObj->phenotypeInfoArrayRef;
}
my $bgcolor = "#a4abc2";
my $header = $self->titleRow("Phenotypes", "phenotype", "", '4');
$header .= Tr(th({-bgcolor=>$bgcolor,
-align=>'LEFT'},
"Mutant Type")."\n".
th({-bgcolor=>$bgcolor,
-align=>'LEFT'},
"Phenotype")."\n".
th({-bgcolor=>$bgcolor,
-align=>'LEFT'},
"Description").
th({-bgcolor=>$bgcolor,
-align=>'LEFT'},
"Reference(s)"));
my ($i, $rows);
foreach my $rowRef (@$phenoArrayRef) {
my ($phenotypeNo, $phenotype, $phenotypeType, $sentence) = @$rowRef;
if ($i++%2) { $bgcolor = '#d8d8d8'; }
else { $bgcolor = '#FFFFFF'; }
my $phenoLk = $phenotype;
$phenoLk =~ s/ /\+/g;
my $pheno = a({-href=>$configUrl->dictyBaseCGIRoot . "$db/phenotype/phenotype.pl?phenotype=". $phenotypeNo. "&display=no"}, $phenotype);
my $arrayRef;
if ($self->locusNo) {
$arrayRef = Phenotype->GetReferenceInfo(dbh=>$dbh,
type=>'LOCUS',
No=>$self->locusNo,
phenotype_no=>$phenotypeNo,
phenotype_type=>$phenotypeType);
}
else {
$arrayRef = Phenotype->GetReferenceInfo(dbh=>$dbh,
type=>'FEATURE',
No=>$self->featNo,
phenotype_no=>$phenotypeNo,
phenotype_type=>$phenotypeType);
}
my $papers;
foreach my $rowRef (@$arrayRef) {
my ($refNo, $citation) = @$rowRef;
if (!$citation) { next; }
my $refObj = Reference->new(dbh=>$dbh,
reference_no=>$refNo);
my $formatedCitation = $refObj->formatedCitation;
$papers .= $formatedCitation . br;
}
$papers =~ s/\$//;
if (!$sentence) { $sentence = br; }
$rows .= Tr(td({-valign=>'TOP',
-bgColor=>$bgcolor,
-width=>"10%"}, $phenotypeType). "\n" .
td({-valign=>'TOP',
-bgColor=>$bgcolor,
-width=>"10%"}, $pheno). "\n" .
td({-valign=>'TOP',
-bgColor=>$bgcolor,
-width=>"10%"}, $sentence) . "\n" .
td({-valign=>'TOP',
-bgColor=>$bgcolor,
-width=>"60%"}, $papers) . "\n"
) . "\n";
}
#add old format phenotype
# my $oldpheno = font(b('Old format, free text phenotype description: '));
#. $dictyBase->SacchdbPhenotype;
# if ($oldpheno) {
# $rows .= Tr(td({-colspan=>'4'}, $oldpheno)) . "\n";
# }
#add openBio link
my $openBioUrl = $dictyBase->openBio;
if ($openBioUrl) {
$rows .= Tr(td({-colspan=>'4'}, a({-href=>$openBioUrl}, "Order mutant strains used in the systematic deletion project"))) . "\n";
}
if (!$rows) {
$rows = Tr(td({-colspan=>'4'}, "No Phenotype/Allele information available."));
}
return table({-width=>"100%", -cellpadding=>"0", -cellspacing=>"1",
-border=>"1"}, $header.$rows);
}
########################################################################
sub homologs {
########################################################################
my ($self, $dictyBase) = @_;
my $candidaComp = $dictyBase->candidaComp;
my $wormComp = $dictyBase->wormComp;
my $mamComp = $dictyBase->mamComp;
my $syntenyViewer = $dictyBase->syntenyViewer;
my $fungalAlign = $dictyBase->fungalAlign;
my $rows = $self->titleRow("Homologs", "homologs");
$rows .= Tr( th({-bgcolor=>'#a4abc2',-align=>'left', -colspan=>'6', -width=>'100%'}, "Other homolog displays and links")
) . "\n" .
Tr( td({-colspan=>'6'}, a({-href=>$fungalAlign}, "Fungal alignments") . ", " . a({-href=>$syntenyViewer}, "Synteny Viewer") . ", " . a({-href=>$candidaComp}, "Candida homologs") . " at CandidaDB, " . a({-href=>$wormComp}, "Worm homologs") . " (last update 1998), " . a({-href=>$mamComp}, "Mammalian homologs") . " (last update 1997), " . "Genome-wide similarity view (" . a({-href=>"http://www.Dictyosteliumgenome.org/cgi-bin/dictyBase/SWA/swaStart.pl?set=1&crit=0&orfs=" . $self->featNm}, "DNA") . " or " . a({-href=>"http://www.Dictyosteliumgenome.org/cgi-bin/dictyBase/SWA/swaStart.pl?set=0&crit=0&orfs=" . $self->featNm}, "Protein") . ")" )
) . "\n";
return table({-width=>"100%", -cellpadding=>"0", -cellspacing=>"1",
-border=>"1"}, $rows);
}
########################################################################
sub proteinInfo {
########################################################################
my ($self, $dictyBase) = @_;
my $rows = $self->titleRow("Physical Properties and Transcript Information", "proteininfo", ": predicted from sequence", '2');
if (!$dictyBase->protInfo) {
$rows .= Tr(td({-colspan=>'2'}, "No protein information available."));
return table({-width=>"100%", -cellpadding=>"0", -cellspacing=>"1",
-border=>"1"}, $rows);
}
#get protein data from DB
my $sth = $dbh->prepare ("
SELECT p.molecular_weight, p.pi, p.protein_length,
p.n_term_seq, p.c_term_seq, p.codon_bias,
p.cai, p.fop_score, p.gravy_score, p.aromaticity_score
FROM CGM_DDB.feature f, CGM_DDB.protein_info p
WHERE f.feature_name = ? and
f.feature_no = p.feature_no
");
$sth->execute($self->featNm);
my @data = $sth->fetchrow;
$sth->finish;
#trim codonW results
for (my $i=5; $i<10; $i++) {
$data[$i] = sprintf("%.3f", $data[$i]);
}
#put ',' in long integer
my $mw = $self->formatNumber($data[0]);
my $prlen = $self->formatNumber($data[2]);
my $aaUrl = $configUrl->dictyBaseCGIRoot."$db/protein/aa.pl?locus=".$self->locusNm."&feat=".$self->featNm;
my $secStrbaseURL = $configUrl->dictyBaseCGIRoot."$db/protein/secStructure?Feat=".$self->featNm."&Locus=".$self->proteinNm;
my $heli = $secStrbaseURL."&Type=HW";
my $pepplot = $secStrbaseURL."&Type=PP";
my $pepStr = $secStrbaseURL."&Type=PS";
$rows .= Tr(
td({-align=>'left', -valign=>'top', -rowspan=>'10'},
table({-border=>2, -width=>325, -cellpadding=>3, -cellspacing=>0},
Tr({-bgcolor=>"a4abc2"},
td({-align=>'center', -colspan=>2},
b('Protein Sequence Calculations').
br.
font({-size=>"-1"}, 'from Predicted Full length Translation')
)
),
Tr({-align=>'center'},
th({-bgcolor=>'#d8d8d8'}, 'N-term'),
td($data[3])
),
Tr({-align=>'center'},
th({-bgcolor=>'#d8d8d8'}, 'C-term'),
td($data[4])
),
Tr({-align=>'center'},
th({-bgcolor=>'#d8d8d8'}, 'Length(aa)'),
td($prlen)
),
Tr({-align=>'center'},
th({-bgcolor=>'#d8d8d8'}, 'MW(Da)'),
td($mw)
),
Tr({-align=>'center'},
th({-bgcolor=>'#d8d8d8'}, 'pI'),
td($data[1])
),
Tr({-align=>'center'},
th({-colspan=>2}, a({-href=>"javascript:newwindow()"},'Amino Acid Composition (full length)'))
),
Tr({-align=>'center'},
td({-colspan=>2}, b("GCG tools: ") . a({-href=>$pepplot}, "PepPlot"). ", " . a({-href=>$heli}, "Helical Wheel") . ", " . a({-href=>$pepStr}, "PepStruct"))
)
), p, #table contain the seq calculation table
table({-border=>2, -width=>325, -cellpadding=>3, -cellspacing=>0},
Tr({-bgcolor=>"a4abc2"},
td({-align=>'center', -colspan=>2},
b('Transcript Translation Calculations')
)
),
Tr({-align=>'right'},
th({-bgcolor=>'#d8d8d8'}, 'Codon Bias'),
td($data[5]." "." ")
),
Tr({-align=>'right'},
th({-bgcolor=>'#d8d8d8'}, 'Codon Adaptation Index'),
td($data[6]." "." ")
),
Tr({-align=>'right'},
th({-bgcolor=>'#d8d8d8'}, 'Frequency of Optimal Codons'),
td($data[7]." "." ")
),
Tr({-align=>'right'},
th({-bgcolor=>'#d8d8d8'}, 'Hydropathicity of Protein'),
td($data[8]." "." ")
),
Tr({-align=>'right'},
th({-bgcolor=>'#d8d8d8'}, 'Aromaticity Score'),
td($data[9]." "." ")
)
)
), #td
td(
pre($self->DomainDisplaySeq)
)
);
return table({-width=>"100%", -cellpadding=>"0", -cellspacing=>"1",
-border=>"1"}, $rows);
}
########################################################################
sub motifs {
########################################################################
my ($self, $dictyBase) = @_;
my $rows = $self->titleRow("Motifs", "motifs", ": determined by regular expression search (not sequence similarity) against motifs in the eMOTIFs database.", '1');
if (!$dictyBase->motifInfo) {
$rows .= Tr(td("No motif information available."));
}
else {
my $motifObj = Motif->new(seqname=>$self->featNm);
$self->{'_sequence'} = $motifObj->getSequence;
my ($domainRef, $relatedProteinDomainRef)
= $motifObj->getMotifInfo;
if ($domainRef) {
$rows .= Tr(td($self->printBarGraph($domainRef)));
}
else {
$rows .= Tr(td("No motif information available."));
}
}
return table({-width=>"100%", -cellpadding=>"0", -cellspacing=>"1",
-border=>"1"}, $rows);
}
########################################################################
sub pdbStructure {
########################################################################
my ($self, $dictyBase) = @_;
my $rows = $self->titleRow("Protein Structures from PDB", "pdb", ": proteins of known structure with sequence similarity to $showNm, based on Smith-Waterman analysis.");
if (!$dictyBase->pdbInfo) {
$rows .= Tr(td({-colspan=>'6'}, "No protein structure information available."));
}
elsif ($self->featNm) {
my $seqObj = Pdb_sequence->new(dbh=>$dbh,
sequence_name=>$self->featNm);
my $alignInfoArrayRef =
Pdb_alignment->GetAlignInfoArrayRefBYqueryNo(dbh=>$dbh,
query_seq_no=>$seqObj->pdb_sequence_no,
score_cutoff=>$pvalueCutOff,
pct_aligned_cutoff=>$alignCutOff);
if ((!$seqObj) || (!@$alignInfoArrayRef)) {
$rows .= Tr(td("No structural information found!"));
return table({-width=>"100%", -cellpadding=>"0", -cellspacing=>"1", -border=>"1"}, $rows);
}
$rows .= Tr(td($self->printSummaryTable4ORF($alignInfoArrayRef)));
}
return table({-width=>"100%", -cellpadding=>"0", -cellspacing=>"1",
-border=>"1"}, $rows);
}
########################################################################
sub genomeWideAnalysis {
########################################################################
my ($self, $dictyBase) = @_;
my $rows = $self->titleRow("Genome-wide Expression and Other Large-Scale Analyses", "exp", "", '2');
my $cellcycle = $dictyBase->cellcycle;
my $curagen = $dictyBase->curagen;
my $triples = $dictyBase->triples;
my $marcotte = $dictyBase->marcotte;
my $sporulation = $dictyBase->sporulation;
my $diauxic = $dictyBase->diauxic;
my $evolution = $dictyBase->evolution;
my $alpha_conc = $dictyBase->alpha_conc;
my $alpha_time = $dictyBase->alpha_time;
my $histone = $dictyBase->histone;
my $stressResponse = $dictyBase->stressResponse;
my $dnaDamage = $dictyBase->dnaDamage;
my $ygmv = $dictyBase->ygmv;
my $zinc = $dictyBase->zinc;
my $phosphate = $dictyBase->phosphate;
my %functions = (
$cellcycle=>"Stanford Cell Cycle",
$diauxic=>"Diauxic Shift",
$sporulation=>"Sporulation Time Series",
$curagen=>"Two Hybrid (Portal PathCalling)",
$triples=>"YGAC Triples",
$marcotte=>"UCLA Function Assignment",
$evolution=>"Glucose limitation",
$zinc=>"Zinc response",
$phosphate=>"PHO regulatory pathway",
$alpha_conc=>"Alpha Factor Concentration",
$alpha_time=>"Alpha Factor Time Series",
$histone=>"Histone Depletion",
$stressResponse=>"Stress Response",
$dnaDamage=>"DNA damage",
$ygmv => "Dictyostelium Global Microarray Viewer");
$rows .= Tr(td(start_form.
li(b("Functional Analysis Results:")).$seperator.
popup_menu(-name=>'funcAn',
-"values"=>[$alpha_conc, $alpha_time,
$cellcycle, $diauxic, $histone,
$sporulation, $stressResponse,
$dnaDamage, $evolution, $zinc,
$phosphate, $curagen, $triples,
$marcotte, $ygmv],
-labels=>\%functions).
button(-onClick=>'switchAddress(this.form.funcAn)', -name=>'View'). end_form) ,
td("You can also search multiple datasets simultaneously using ". a({-href=>$dictyBase->exprConn},"Expression Connection") ." for expression studies or ". a({-href=>$dictyBase->FuncJunc}, "Function Junction") ." for other large scale analyses.")
);
return table({-width=>"100%", -cellpadding=>"0", -cellspacing=>"1",
-border=>"1"}, $rows);
}
########################################################################
sub locusHistory {
########################################################################
my ($self) = @_;
my $locusObj = Locus->new(dbh=>$dbh, locus_no=>$self->locusNo) if ($self->locusNo);
my $featObj = Feature->new(dbh=>$dbh, feature_no=>$self->featNo) if ($self->featNo);
my @noteArrayRef;
if ($locusObj && @{$locusObj->curatorNoteInfoArrayRef}) {
push(@noteArrayRef, @{$locusObj->curatorNoteInfoArrayRef});
}
if ($featObj && @{$featObj->curatorNoteInfoArrayRef}) {
push(@noteArrayRef, @{$featObj->curatorNoteInfoArrayRef});
}
my $displayNote;
foreach my $rowRef (@noteArrayRef) {
my ($noteNo, $note, $isPublic) = @$rowRef;
if ($isPublic !~ /^Y/i) { next; }
$displayNote .= $note . p;
}
#unpublished references
my $dispalyUnpublish;
if ($locusObj && (my @paper = @{$locusObj->unPublishedPaperInfoArrayRef})) {
$dispalyUnpublish = b("Unpublished Locus References").br;
foreach my $rowRef (@paper) {
my ($refNo, $citation, $year) = @$rowRef;
my $refObj = Reference->new(dbh=>$dbh, reference_no=>$refNo);
$citation = $refObj->formatedCitation;
# $citation = $refNo.":".$citation.":". $year;
$dispalyUnpublish .= a({-href=>$configUrl->dictyBaseCGIRoot."$db/reference/reference.pl?refNo=$refNo", -target=>'infowin'}, $citation) .br;
}
}
my $rows = $self->titleRow("Locus History (misc. notes)", "notes", "", '1');
if ((!$displayNote) && (!$dispalyUnpublish)) {
$rows .= Tr(td("No locus history available."));
}
else {
$rows .= Tr(td($displayNote . $dispalyUnpublish));
}
return table({-width=>"100%", -cellpadding=>"0", -cellspacing=>"1",
-border=>"1"}, $rows);
}
########################################################################
sub sequenceRetrieve {
########################################################################
my ($self, $dictyBase) = @_;
my $rows = $self->titleRow("Sequence Retrieval", "seq", "", '2');
if (!$self->featNo) {
$rows .= Tr(td("No sequence data available."));
return table({-width=>"100%", -cellpadding=>"0", -cellspacing=>"1",
-border=>"1"}, $rows);
}
$rows .= Tr(th({-align=>'left', -bgcolor=>"#a4abc2"}, "Sequence Type"),
th({-align=>'left', -bgcolor=>"#a4abc2"}, "Output Format")
) . "\n" .
Tr(td(b("Genomic DNA")),
td(a({-href=>$configUrl->dictyBaseCGIRoot . "$db/getSeq?map=amap&seq=" . $self->featNm . "&flankl=&flankr=&rev="},"GCG")." | ". a({-href=>$configUrl->dictyBaseCGIRoot . "$db/getSeq?map=a3map&seq=" . $self->featNm . "&flankl=&flankr=&rev="},"FASTA") . " | " . a({-href=>$configUrl->dictyBaseCGIRoot . "$db/getSeq?map=a2map&seq=" . $self->featNm . "&flankl=&flankr=&rev="},"NoHeader"))
) . "\n" .
Tr(td(b("Genomic DNA with 1 kb up and downstream")),
td(a({-href=>$configUrl->dictyBaseCGIRoot . "$db/getSeq?map=amap&seq=" . $self->featNm . "&flankl=1000&flankr=1000&rev="},"GCG")." | ". a({-href=>$configUrl->dictyBaseCGIRoot . "$db/getSeq?map=a3map&seq=" . $self->featNm . "&flankl=1000&flankr=1000&rev="},"FASTA") . " | " . a({-href=>$configUrl->dictyBaseCGIRoot . "$db/getSeq?map=a2map&seq=" . $self->featNm . "&flankl=1000&flankr=1000&rev="},"NoHeader"))
) . "\n" .
Tr(td(b("DNA coding sequence") . br . "(without introns, without flanking regions)"),
td(a({-href=>$configUrl->dictyBaseCGIRoot . "$db/getSeq?map=nmap&seq=" . $self->featNm . "&flankl=&flankr=&rev="},"GCG")." | ". a({-href=>$configUrl->dictyBaseCGIRoot . "$db/getSeq?map=n3map&seq=" . $self->featNm . "&flankl=&flankr=&rev="},"FASTA") . " | " . a({-href=>$configUrl->dictyBaseCGIRoot . "$db/getSeq?map=n2map&seq=" . $self->featNm . "&flankl=&flankr=&rev="},"NoHeader"))
) . "\n" .
Tr(td(b("Protein Translation of ORF")),
td(a({-href=>$configUrl->dictyBaseCGIRoot . "$db/getSeq?map=pmap&seq=" . $self->featNm . "&flankl=&flankr=&rev="},"GCG")." | ". a({-href=>$configUrl->dictyBaseCGIRoot . "$db/getSeq?map=p3map&seq=" . $self->featNm . "&flankl=&flankr=&rev="},"FASTA") . " | " . a({-href=>$configUrl->dictyBaseCGIRoot . "$db/getSeq?map=p2map&seq=" . $self->featNm . "&flankl=&flankr=&rev="},"NoHeader"))
) . "\n" .
Tr(td(b("6-Frame Translation") . "(with Restriction Map)"),
td(a({-href=>$configUrl->dictyBaseCGIRoot . "$db/getSeq?map=rmap&seq=" . $self->featNm . "&flankl=&flankr=&rev="},"GCG"))
) . "\n" .
Tr(td(b("Restriction Fragment Sizes")),
td(a({-href=>$configUrl->dictyBaseCGIRoot . "$db/getSeq?map=fmap&seq=" . $self->featNm . "&flankl=&flankr=&rev="},"GCG"))
) . "\n" ;
#sequence analysis tools pulldown
my $blastp = $dictyBase->blastp;
my $blastn = $dictyBase->blastn;
my $bpNCBI = $dictyBase->bpNCBI; #blasp at NCBI
my $fastan = $dictyBase->fastan;
my $fastap = $dictyBase->fastap;
my $restrMap = $dictyBase->restrMap;
my $primer = $dictyBase->primer;
my @values;
push (@values, $blastp) if $blastp;
push (@values, $blastn) if $blastn;
push (@values, $bpNCBI) if $bpNCBI;
push (@values, $fastan) if $fastan;
push (@values, $fastap) if $fastap;
push (@values, $restrMap) if $restrMap;
push (@values, $primer) if $primer;
my %analysis = (
$blastn=>"BLASTN",
$blastp=>"BLASTP",
$bpNCBI=>"BLASTP at NCBI",
$fastan=>"FASTA nt",
$fastap=>"FASTA aa",
$restrMap=>"Restriction Map",
$primer=>"Design Primer"
);
if (@values) {
$rows .= Tr(th({-align=>'left', -bgcolor=>"#a4abc2", -colspan=>'2'}, "Sequence analysis tools:")) .
Tr(td({-colspan=>'2'},
start_form.
popup_menu(-name=>'analysis',
-"values"=>\@values,
-labels=>\%analysis).
button(-onClick=>'switchAddress(this.form.analysis)',
-name=>'Analyze').end_form)) . "\n";
}
my @otherDBseq = $self->getAssociatedSeq;
unshift(@otherDBseq, th({-align=>'left', -bgcolor=>"#a4abc2", -colspan=>'2'}, "Sequence from other databases"));
return table({-width=>"100%", -cellpadding=>"0", -cellspacing=>"1",
-border=>"1"}, $rows) .
table({-width=>"100%", -cellpadding=>"0", -cellspacing=>"1",
-border=>"1"}, Tr([@otherDBseq]));
}
########################################################################
sub maptableDisplay {
########################################################################
my ($self) = @_;
my $rows = $self->titleRow("Map and Table Displays", "map", "", '5');
if (!$self->featNo) {
$rows .= Tr(td("No Map and Table display available."));
return table({-width=>"100%", -cellpadding=>"0", -cellspacing=>"1",
-border=>"1"}, $rows);
}
my $featureObj = Feature->new(dbh=>$dbh, feature_no=>$self->featNo);
my $stripeUrl = "http://www.Dictyosteliumgenome.org/cgi-bin/dictyBase/SSV/stripe?" . $featureObj->chromosome . ":" . $self->featNm . ":" . $featureObj->start_coord . ":" . $featureObj->stop_coord . ":";
$rows .= Tr(td(b("Physical, Genetic Maps:")),
td(a({-href=>$configUrl->dictyBaseCGIRoot . "$db/ORFMAP/ORFmap?seq=" . $self->featNm}, "Chromosomal Feature Map")),
td(a({-href=>$configUrl->dictyBaseCGIRoot . "$db/PHYSMAP/PHYSmap?seq=" . $self->featNm}, "Physical Map")),
td(a({-href=>$configUrl->dictyBaseCGIRoot . "$db/PGMAP/PGmap?seq=" . $self->featNm}, "Combined Physical and Genetic Map")),
td(a({-href=>$configUrl->dictyBaseCGIRoot . "$db/PGMAP/ratioMap?seq=" . $self->featNm}, "Genetic Distance vs. Physical Distance Ratios"))
) .
Tr(td(b("Similarity Viewers:")),
td(a({-href=>$configUrl->dictyBaseCGIRoot . "FUNGI/FungiMap?locus=". $self->featNm}, "Synteny Viewer")),
td(a({-href=>$stripeUrl}, "Genomic Stripe View")),
td("Genome-wide similarity view [" . a({-href=>"http://www.Dictyosteliumgenome.org/cgi-bin/dictyBase/SWA/swaStart.pl?set=1&crit=0&orfs=" . $self->featNm}, "DNA") . " or " . a({-href=>"http://www.Dictyosteliumgenome.org/cgi-bin/dictyBase/SWA/swaStart.pl?set=0&crit=0&orfs=" . $self->featNm}, "Protein") . "]"),
td(a({-href=>$configUrl->dictyBaseCGIRoot . "$db/ORFMAP/ORFmap?gene=". $self->featNm . "&sage=1"}, "SAGE Results Map"))
);
return table({-width=>"100%", -cellpadding=>"0", -cellspacing=>"1",
-border=>"1"}, $rows);
}
########################################################################
sub interactions {
########################################################################
my ($self, $dictyBase) = @_;
my $rows = $self->titleRow("Interactions", "interactions", ": genetic, physical, and other gene-gene links.");
my $interactor = $self->relatedInteractors($dictyBase);
if ($interactor) {
$rows .= $interactor;
}
#get interaction pulldown
my $grid = $dictyBase->grid;
my $curagen = $dictyBase->curagen;
my $dip = $dictyBase->dip;
my %prot = (
$grid=>"Interactions DB (GRID)",
$curagen=>"Two Hybrid (Portal PathCalling)",
$dip=>"DB of Interacting Proteins (DIP)"
);
my @values;
push (@values, $grid) if $grid;
push (@values, $curagen) if $curagen;
push (@values, $dip) if $dip;
if (@values){
$rows .= Tr(td({-colspan=>'6'},
start_form .
"Search other databases for interactions: " .
popup_menu(-name=>'interact',
-"values"=>\@values,
-labels=>\%prot).
button(-onClick=>'switchAddress(this.form.interact)',
-name=>'View').
end_form));
}
return table({-width=>"100%", -cellpadding=>"0", -cellspacing=>"1",
-border=>"1"}, $rows);
}
########################################################################
sub communityAnnotation {
########################################################################
my ($self) = @_;
my $rows = $self->titleRow("Community Annotation", "commanno", "");
my $comAnSth = $dbh->prepare( "
SELECT * FROM CGM_DDB.community_annotation
WHERE dictyBaseid = ?
");
$comAnSth->execute($self->dictyBaseid);
my @comAn;
while (my @result = $comAnSth->fetchrow) {
push(@comAn, \@result);
}
$comAnSth->finish;
#rows to print for different topics.
my (@DNARow, @ProteinRow, @TechRow, @IntRow, @MutRow, @OthRow);
foreach my $rowRef (@comAn) {
my $topic = $$rowRef[3];
if ( $topic =~ /^DNA/ ) {
push(@DNARow, $rowRef);
}
elsif ($topic =~ /^Protein/ ) {
push(@ProteinRow, $rowRef);
}
elsif ($topic =~ /^Tech/ ) {
push(@TechRow, $rowRef);
}
elsif ($topic =~ /^Int/ ) {
push(@IntRow, $rowRef);
}
elsif ($topic =~ /^Alleles/ ) {
push(@MutRow, $rowRef);
}
else {
push(@OthRow, $rowRef);
}
}
my @annoCont;
if (@DNARow) {
my $row = $self->printRowForTopic("DNA", "DNA & RNA Details", @DNARow);
push(@annoCont, $row);
}
if (@ProteinRow) {
my $row = $self->printRowForTopic("Protein", "Protein Details", @ProteinRow);
push(@annoCont, $row);
}
if (@TechRow) {
my $row = $self->printRowForTopic("Tech", "Techniques & Reagents", @TechRow);
push(@annoCont, $row);
}
if (@IntRow) {
my $row = $self->printRowForTopic("Int", "Interactions", @IntRow);
push(@annoCont, $row);
}
if (@MutRow) {
my $row = $self->printRowForTopic("Mut", "Alleles, Strains, & Mutant Phenotypes", @MutRow);
push(@annoCont, $row);
}
if (@OthRow) {
my $row = $self->printRowForTopic("Oth", "Other", @OthRow);
push(@annoCont, $row);
}
if (!@annoCont) {
$rows .= Tr(td("No community annotation available."));
}
else {
for (my $j=0; $j<@annoCont; $j++) {
$rows .= Tr(td($annoCont[$j]));
}
}
return table({-width=>"100%", -cellpadding=>"0", -cellspacing=>"1",
-border=>"1"}, $rows);
}
########################################################################
sub literatureGuide {
########################################################################
my ($self) = @_;
my $rows = $self->titleRow("Literature Guide", "literature", ": papers categorized by topic.", '3');
my $giObject;
if ($self->featNm) {
$giObject = GeneInfo->new(dbh=>$dbh, locus=>$self->featNm);
}
else {
$giObject = GeneInfo->new(dbh=>$dbh, locus=>$self->locusNm);
}
my ($refsCurated, $countCurated) = $self->references4topic($giObject, "curated");
my ($refsNoCurate, $countNoCurate) = $self->references4topic($giObject, "not yet curated");
$rows .= Tr(th({-align=>'left', -bgcolor=>'#a4abc2'}, "Topics").
th({-align=>'left', -bgcolor=>'#a4abc2'}, "Reference").
th({-align=>'left', -bgcolor=>'#a4abc2'}, "Other Genes Addressed")) . td({-colspan=>'3'}, font({-color=>'red'}, $countCurated) . " curated references; " . font({-color=>'red'}, $countNoCurate) . " references not yet curated") . $refsCurated . $refsNoCurate;
return table({-width=>"100%", -cellpadding=>"0", -cellspacing=>"1",
-border=>"1"}, $rows);
}
########################################################################
sub titleRow {
########################################################################
my ($self, $title, $anchor, $subtitle, $col) = @_;
my $makeTitle = font({-size=>"+2", -color=>"white"},
a({-name=>$anchor}, $title));
if ($subtitle) {
$makeTitle .= font({-color=>"white"}, $subtitle);
}
$col = '6' if (!$col);
my $helplink = $helpURL{$anchor} || $self->help;
my $row = td({-align=>"left", -width=>"70%"}, $makeTitle
) . "\n" .
td({-align=>"center", -width=>"10%", -bgcolor=>"white"},
a({-href=>"#top"}, "[TOP]")
) . "\n";
if ($nextButton{$anchor}) {
$row .= td({-align=>"center", -width=>"10%", -bgcolor=>"white"},
a({ -href=>"#" . $nextButton{$anchor} }, "[NEXT]")
) . "\n";
}
else {
$row .= td({-align=>"center", -width=>"10%", -bgcolor=>"white"},
" ") . "\n";
}
$row .= td({-align=>"right", -width=>"10%", -bgcolor=>"white"},
a({-href=>$helplink}, img({-alt=>"Help",-border=>"0",
-align=>"right", -valign=>"middle", -src=>$helpButton}))
) . "\n";
return Tr(
th({-colspan=>"$col", -align=>"left", -width=>"100%", -bgcolor=>"purple"},
table({-width=>"100%", -cellpadding=>"0", -cellspacing=>"0",
-border=>"0"},
Tr($row))));
}
########################################################################
sub getIDs {
########################################################################
my ($self) = @_;
my $search = $self->query;
my $searchType = $self->queryType;
#parameter 'dictyBaseid' only accept dictyBaseid. parameter 'locus' cannot accept dictyBaseid
my $object;
if ($searchType eq 'dictyBaseid') {
$object = dictyBaseDEVObject->new(database=>$self->database, dictyBaseid=>$search);
}
elsif (($searchType eq 'locus') && ($search =~/^[SsLl]\d{7}/)) {
my $mssg = "Your search for \'".font({-color=>'red'},$self->query)."\' d
id not return any hits. Please modify your query and try again!";
$self->SearchForm($mssg);
}
else {
$object = dictyBaseDEVObject->new(database=>$self->database, query=>$search);
}
if ($object->isMultiple){
$self->err_report("Multiple results found\n");
$self->DESTROY;
}
%nextButton = ( 'names' => 'go', 'go' => 'pathways',
'pathways' => 'paragraph',
'paragraph' => 'phenotype', 'phenotype' => 'homologs',
'homologs' => 'proteininfo', 'proteininfo' => 'pdb',
'pdb' => 'motifs', 'motifs'=> 'exp',
'exp' => 'notes', 'notes' => 'seq',
'seq'=> 'map', 'map' => 'interactions',
'interactions' => 'commanno',
'commanno' => 'literature'
);
%helpURL = ( 'names' => $self->help . "#names_identifiers",
'go' => $helpBase . "GO.html",
'paragraph' => $helpBase . "parag_help.html",
'phenotype' => $self->help . "#phenotypes",
'homologs' => $self->help . "#homologs",
'proteininfo' => $helpBase . "protein_page.html",
'pdb' => $helpBase . "PDB_Homolog.html",
'motifs'=> $helpBase . "Protein_Motifs.html",
'exp' => $helpBase . "expression.html",
'notes' => $helpBase . "locusHistory.html",
'seq' => $self->help . "#Retrieval",
'map' => $self->help . "#map",
'interactions' => $self->help . "#interactions_help",
'literature' => $helpBase . "Literature_Topics.html"
);
$self->{'_featNm'} = $object->featureName;
$self->{'_locusNm'} = $object->locusName;
$self->{'_dictyBaseid'} = $object->primarydictyBaseID;
$self->{'_featureType'} = $object->featureType;
$self->{'_alias'} = $object->alias;
$self->{'_locusNo'} = $object->locusNo;
$self->{'_featureNo'} = $object->featureNo;
return;
}
########################################################################
sub getGoAnnotationRow {
########################################################################
my ($self) = @_;
my ($type, $No, $tabNm, $goArrayRef);
my $locusObj = Locus->new(dbh=>$dbh,
locus_name=>$self->locusNm) if ($self->locusNm);
if (!$locusObj) {
my $featObj = Feature->new(dbh=>$dbh,
feature_name=>$self->featNm);
if (!$featObj) {
$self->err_report("The feature/locus you entered (".font({-color=>'red'}, $self->locusNm).") is not found in database. Please correct it and try again.");
}
else {
$type = "Feature";
$No = $featObj->feature_no;
$tabNm = "GO_FEAT_GOEV";
$goArrayRef = $featObj->goInfoArrayRef;
}
}
else {
$type = "Locus";
$No = $locusObj->locus_no;
$tabNm = "GO_LOCUS_GOEV";
$goArrayRef = $locusObj->goInfoArrayRef;
}
if (!$$goArrayRef[0]) {
return;
}
my (%desc4code, %goEvCodeNo);
Go->GetGoEvidenceInfo(dbh=>$dbh,
goEvidenceDesc4CodeRef=>\%desc4code,
goEvidenceNoRef=>\%goEvCodeNo);
my ($functionRows, $processRows, $componentRows);
my $functionBgcolor= "#FFFFFF";
my $processBgcolor= "#FFFFFF";
my $componentBgcolor= "#FFFFFF";
foreach my $rowRef (@$goArrayRef) {
my ($goid, $goTerm, $goAspect, $goDefinition) = @$rowRef;
my $citationEtcArrayRef = Go->GetReferenceInfo(dbh=>$dbh,
goid=>$goid,
type=>$type,
No=>$No);
my $bgcolor;
if ($goAspect =~ /^F/i ) { $bgcolor = $functionBgcolor; }
elsif ($goAspect =~ /^P/i ) { $bgcolor = $processBgcolor; }
elsif ($goAspect =~ /^C/i ) { $bgcolor = $componentBgcolor; }
my ($rowspan, $isNotRowspan);
foreach my $refRow (@$citationEtcArrayRef) {
my ($citation, $refNo, $isNot, $dateCreated, $goevCodeList)
= split(/::/, $refRow);
if ($isNot =~ /^Y/i) { $isNotRowspan++; }
else { $rowspan++; }
}
my $row = td({-width=>'15%',
-bgcolor=>"$bgcolor",
-align=>'center',
-valign=>'middle',
-rowspan=>$rowspan},
a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/GO/go.pl?goid=$goid"}, $goTerm));
my $isNot = a({-href=>$configUrl->dictyBaseHelp."GO.html#not"},
b(i("NOT")));
if ($goAspect =~ /^F/i) { $isNot .= " a "; }
elsif ($goAspect =~ /^P/i) { $isNot .= " involved in "; }
else { $isNot .= " part of "; }
my $notRow = td({-width=>'15%',
-bgcolor=>"$bgcolor",
-align=>'center',
-valign=>'middle',
-rowspan=>$isNotRowspan},
$isNot.a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/GO/go.pl?goid=$goid"}, $goTerm));
my $notRows;
foreach my $refRow (@$citationEtcArrayRef) {
my ($citation, $refNo, $isNot, $dateCreated, $goevCodeList)
= split(/::/, $refRow);
$refNo =~ s/[^0-9]//g;
#### $goevCodeList = goevCodes delimited by '|'
my @evCode = split(/\|/, $goevCodeList);
my $codeList;
foreach my $evCode (@evCode) {
my $desc = $self->uppercaseWords($desc4code{$evCode});
$desc = "\u$desc";
my $prikey = $goid."::".$No."::".$goEvCodeNo{$evCode}."::".$isNot;
my $externalIdArrayRef = Go->GetExternalIdSourceInfo(dbh=>$dbh,
tab_name=>$tabNm,
primary_key=>$prikey);
my $with;
if (@$externalIdArrayRef) {
$with = " with ";
}
my $preSource;
foreach my $rowRef (@$externalIdArrayRef) {
my ($externalId, $source) = @$rowRef;
if ($preSource && $preSource ne $source) {
$with .= " and ".$source.": ";
}
elsif ($preSource ne $source) {
$with .= $source.": ";
}
else {
$with .= ", ";
}
if ($source =~ /dictyBase/i) {
my $dictyBaseidObj = dictyBaseid->new(dbh=>$dbh,
dictyBaseid=>$externalId);
my $showNm;
if ($dictyBaseidObj && $dictyBaseidObj->locus_name) {
$showNm = $dictyBaseidObj->locus_name;
}
elsif ($dictyBaseidObj) {
$showNm = $dictyBaseidObj->feature_name;
}
if ($showNm) {
$with .= a({-href=>$configUrl->dictyBaseCGIRoot."gene_page.pl?gene_name=$showNm"}, $showNm);
}
}
else {
$with .= $externalId;
}
$preSource = $source;
}
$codeList .= li($evCode." : ".a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/GO/goEvidence.pl#$evCode"}, $desc).$with);
}
####
### add with here
####
$codeList .= i("Last updated on $dateCreated");
my $refObj = Reference->new(dbh=>$dbh,
reference_no=>$refNo);
if (!$refObj) {
next;
}
my $formatedCitation = $refObj->formatedCitation;
my $cells = td({-width=>'55%',
-align=>'left',
-valign=>'top'},
$formatedCitation).
td({-width=>'30%',
-align=>'left',
-valign=>'top'},
$codeList);
if ($isNot =~ /^Y/i) {
$notRow .= $cells;
$notRows .= Tr({-bgcolor=>"$bgcolor"}, $notRow);
undef $notRow;
}
else {
$row .= $cells;
if ($goAspect =~ /^F/i) {
$functionRows .= Tr({-bgcolor=>"$bgcolor"}, $row);
}
elsif ($goAspect =~ /^P/i) {
$processRows .= Tr({-bgcolor=>"$bgcolor"}, $row);
}
elsif ($goAspect =~ /^C/i) {
$componentRows .= Tr({-bgcolor=>"$bgcolor"}, $row);
}
undef $row;
}
}
if ($notRows) {
if ($goAspect =~ /^F/i) {
$functionRows .= $notRows;
}
elsif ($goAspect =~ /^P/i) {
$processRows .= $notRows;
}
elsif ($goAspect =~ /^C/i) {
$componentRows .= $notRows;
}
}
if ($goAspect =~ /^F/i ) {
$functionBgcolor = $self->setBgcolor($bgcolor);
}
elsif ($goAspect =~ /^P/i ) {
$processBgcolor = $self->setBgcolor($bgcolor);
}
elsif ($goAspect =~ /^C/i ) {
$componentBgcolor = $self->setBgcolor($bgcolor);
}
}
if (!$functionRows && !$processRows && !$componentRows) {
&err_report("No go annotation found for feature/locus = '" . $self->locusNm . "'.");
}
return ($functionRows, $processRows, $componentRows);
}
########################################################################
sub getGoAnnotTable {
########################################################################
my ($self, $goAspect, $annotRows) = @_;
return table({-cellspacing=>'1',
-border=>'1',
-cellpadding=>'0',
-width=>'100%'},
$self->goAnnoHeaderRows($goAspect).
$annotRows).p;
}
########################################################################
sub goAnnoHeaderRows {
########################################################################
my ($self, $goAspect) = @_;
my $name = $goAspect;
$name =~ s/^([A-Z]).+$/$1/;
return Tr({-bgcolor=>'a4abc2'},
th({-align=>'left',
-colspan=>'6'},
a({-name=>$name}, $goAspect))).
Tr({-bgcolor=>'#b7d8e4'},
th({-align=>'left'}, "Annotation(s)").
th({-align=>'left'}, "Reference(s)").
th({-align=>'left'}, "Evidence"));
}
########################################################################
sub uppercaseWords {
########################################################################
my ($self, $sentence) = @_;
my @word = split(/ /, $sentence);
undef $sentence;
foreach my $word (@word) {
if ($word !~ /^(from|on|in|of|or|structural)$/) {
$word = "\u$word";
}
$sentence .= " ".$word;
}
$sentence =~ s/^ //;
return $sentence;
}
########################################################################
sub setBgcolor {
########################################################################
my ($self, $bgcolor) = @_;
if ($bgcolor =~ /^#FFFFFF/i ) {
$bgcolor = "#d8d8d8";
}
else {
$bgcolor = "#FFFFFF";
}
return $bgcolor;
}
########################################################################
sub err_report {
########################################################################
my ($self, $err) = @_;
&printStartPage($self->database, "Error Report", $self->help);
print $err, p;
&printEndPage;
$self->DESTROY;
exit;
}
################################################################
sub formatNumber {
################################################################
#used in physical properties.
my ($self, $data) = @_;
my @data = split(//, $data);
my $length = length($data);
my $formattedStr;
my $count=0;
for (my $i = $length-1; $i>=0; $i--) {
$count++;
$formattedStr .= $data[$i];
if (($count == 3) && ($i != 0)){
$formattedStr .= ',';
$count = 0;
}
}
return reverse($formattedStr);
}
########################################################################
sub printBarGraph {
########################################################################
#for motif section
my ($self, $domainRef) = @_;
my $yStart = 20;
my $rulerHeight = 3;
my $barGap = 16;
my $xGap = 80;
my ($newDomainRef, $rowNum) = $self->processImageCoords($yStart,
$xGap, $barGap, $rulerHeight,
$domainRef);
my $height = $yStart + $rulerHeight + ($rowNum+1)*$barGap +
($rowNum+1)*$defaultBarHeight + 40;
my $width = $defaultRulerWidth+$xGap+40;
my $gd = CreateGD->new(width=>$width,
height=>$height);
print "";
my $gifDir = $configPath->tmpDir;
my $gifHttp = $configUrl->dictyBaseHtmlTmp;
my $gifname = $self->featNm.".domain.gif";
open (OUT, ">".$gifDir.$gifname)||die "Can't create ".$gifDir.$gifname.":$!";
binmode OUT;
print OUT $gd->im->gif;
close OUT;
my $motifURL = $configUrl->dictyBaseCGIRoot . "$db/protein/getDomain?dictyBaseid=" . $self->dictyBaseid;
my $line = a({-href=>$motifURL}, "View") . " other Dictyostelium discoideum proteins that contain motifs in ". $self->locusNm . ".";
return center(img({-src=>$gifHttp.$gifname,
-usemap=>'#domainGif'})),p
,$self->printKeyGif(\@keyText), p, $line, p, $self->printDomainLink;
}
########################################################################
sub printKeyGif {
########################################################################
#for motif section
my ($self, $keyTextRef) = @_;
my $height = 40 + 15*@$keyTextRef;
my $xGap = 20;
my $gd = CreateGD->new(width=>$defaultRulerWidth+3*$xGap,
height=>$height);
print "";
my $gifDir = $configPath->tmpDir;
my $gifHttp = $configUrl->dictyBaseHtmlTmp;
my $gifname = "domain.$$.key.gif";
open (OUT, ">".$gifDir.$gifname)||die "Can't create ".$gifDir.$gifname.":$!";
binmode OUT;
print OUT $gd->im->gif;
close OUT;
return center(img({-src=>$gifHttp.$gifname,
-usemap=>'#domainKeyGif'})),p;
}
########################################################################
sub processImageCoords {
########################################################################
#for motif section
my ($self, $yStart, $xGap, $barGap, $rulerHeight, $domainRef) = @_;
$yStart += $rulerHeight + $barGap - 15;
my %data4domainNmRoot;
foreach my $row (@$domainRef) {
my ($orfNm, $orfLen, $domainNm, $pvalue, $orfBeg,
$orfEnd, $linkUrl, $domainDesc) = split(/\t/, $row);
my $domainNmRoot = $domainNm;
$domainNmRoot =~ s/^(IPB[0-9]{6}).*$/$1/;
$domainNmRoot =~ s/^(PF[0-9]{5}).*$/$1/;
$domainNmRoot =~ s/^(BP[0-9]{5}).*$/$1/;
$domainNmRoot =~ s/^(DM[0-9]{5}).*$/$1/;
$domainNmRoot =~ s/^(PR[0-9]{5}).*$/$1/;
$data4domainNmRoot{$domainNmRoot} .= "::".$row;
}
my @domain;
my $i;
foreach my $key (sort keys (%data4domainNmRoot)) {
$i++;
my @row = split(/::/, $data4domainNmRoot{$key});
shift @row;
my %domain;
foreach my $row (@row) {
my ($orfNm, $orfLen, $domainNm, $pvalue, $orfBeg,
$orfEnd, $linkUrl, $domainDesc) = split(/\t/, $row);
if ($domain{$orfBeg}) { $domain{$orfBeg} .= "\t"; }
$domain{$orfBeg} .= $orfNm.":".$orfLen.":".$domainNm.":".
$domainDesc.":".$pvalue.":".$orfBeg.":".
$orfEnd.":".$linkUrl;
}
my $preTx2;
my $j;
foreach my $key (sort {$a<=>$b} keys (%domain)) {
$j++;
my @entry = split(/\t/, $domain{$key});
foreach my $entry (@entry) {
my $linkUrl;
if ($entry =~ /^(.+):(http:.+)$/) {
$entry = $1;
$linkUrl = $2;
}
my ($orfNm, $orfLen, $domainNm, $domainDesc, $pvalue,
$orfBeg, $orfEnd) = split(/\:/, $entry);
my $Tx1 = $xGap+$defaultRulerWidth*$orfBeg/$orfLen;
my $Tx2 = $xGap+$defaultRulerWidth*$orfEnd/$orfLen;
my $Ty1 = $yStart+($i+1)*($barGap+$defaultBarHeight)-10;
if ($Tx1 < $preTx2 + 9) {
$Ty1 += 10;
}
else {
$preTx2 = $Tx2;
}
my $Ty2 = $Ty1 + $defaultBarHeight-10;
if ($j != 1) {
$domainDesc = "Unknown";
}
elsif ($domainNm =~ /^PR/i) {
$domainDesc =~ s/^(.+) [IXV]+$/$1/;
}
push(@domain, $orfNm.":".$orfLen.":".$domainNm.":".
$domainDesc.":".$pvalue.":".$Tx1.":".
$Ty1.":".$Tx2.":".$Ty2.":".$linkUrl);
}
}
}
return (\@domain, $i);
}
########################################################################
sub getEntryLinkUrl {
########################################################################
#for motif section
my ($self, $domainNm) = @_;
if ($domainNm =~ /^PR[0-9]+/i) {
return "http://methionine.sbc.man.ac.uk/cgi-bin/dbbrowser/sprint/searchprintss.cgi?prints_accn=$domainNm&display_opts=Prints&category=None&queryform=false";
}
elsif ($domainNm =~ /^IPB[0-9]+/) {
$domainNm =~ s/^IPB/IPR/i;
return "http://www.ebi.ac.uk/interpro/ISimpleSearch?query=$domainNm";
}
else {
return "http://blocks.fhcrc.org/blocks-bin/getblock.sh?$domainNm";
}
}
########################################################################
sub getBarColor {
########################################################################
#for motif section
my ($self, $gd, $pvalue) = @_;
my $barColor;
if ($pvalue <= 1.0e-20) {
$barColor = $gd->red;
}
elsif ($pvalue <= 1.0e-10) {
$barColor = $gd->magenta;
}
else {
$barColor = $gd->maroon;
}
return $barColor;
}
########################################################################
sub printDomainLink {
########################################################################
#for motif section
my ($self) = @_;
if (!$self->{'_sequence'}) { return; }
my @urlVals = ('NCBI Dart', 'SMART domain', 'PFAM domain', 'PROSITE pattern', 'SCOP');
my $motifURL = $configUrl->dictyBaseCGIRoot . "$db/protein/getDomain?dictyBaseid=" . $self->dictyBaseid;
return table({-align=>'center'},
Tr(td({-align=>'left'},
font({-size=>'+1'}, "Search other databases for protein motifs:")).
td({-align=>'left'},
table({-align=>'left',
-border=>'0',
-cellpadding=>'1',
-cellspacing=>'1',
-bgcolor=>'#d8d8d8'},
Tr(td(start_form({-action=>$motifURL, -method=>"POST", -target=>'infowin'}).
hidden(-name=>'sequence',
-value=>$self->{'_sequence'}).
hidden(-name=>'showNm',
-value=>$self->showNm).
hidden(-name=>'featNm',
-value=>$self->featNm).
popup_menu(-name=>'externalDb',
-"values"=>\@urlVals).
submit(-name=>'submit', -value=>'Go!').
end_form))))));
}
########################################################################
sub printSummaryTable4ORF {
########################################################################
#for pdbStructure
my ($self, $alignInfoArrayRef) = @_;
my %chains4pdbid;
my %rows4pdbid;
my %count4pdbid;
my $showNm = $self->locusNm || $self->featNm;
foreach my $rowRef (@$alignInfoArrayRef) {
my ($pdb, $organism, $note, $identical, $similar, $score)
= @$rowRef;
my ($pdbid, $chain) = split(/\_/, $pdb);
if (!$chain) { next; }
##### chain
if (!$chains4pdbid{$pdbid}) {
$chains4pdbid{$pdbid} = " Chain: $chain";
}
else {
$chains4pdbid{$pdbid} .= ", ".$chain;
}
$count4pdbid{$pdbid}++;
if ($count4pdbid{$pdbid} == 1) { next; }
$rows4pdbid{$pdbid} .= Tr(td({-align=>'center'},
b("Chain $chain = ").
$self->convertScore($score)).
td({-align=>'center'}, b($identical)).
td({-align=>'center'}, b($similar)).
td({-align=>'center'},
$self->alignmentLink($self->featNm, $pdb, "View alignment")));
}
my %pdbidFound;
my $rows = Tr(th({-colspan=>'2',
-rowspan=>'2',
-align=>'center',
-width=>'30%',
-bgcolor=>'#CCCFFF'},
"PDB protein structure(s) homologous to $showNm").
th({-rowspan=>'2',
-align=>'center',
-width=>'20%',
-bgcolor=>'#CCCFFF'},
"Homolog Source (per PDB)").
th({-colspan=>'4',
-align=>'center',
-width=>'40%',
-bgcolor=>'#CCCFFF'},
"Protein Alignment: $showNm vs. Homolog").
th({-rowspan=>'2',
-align=>'center',
-width=>'10%',
-bgcolor=>'#CCCFFF'}, "External Links")).
Tr(th({-align=>'center',
-bgcolor=>'#b7d8e4'}, "P-Value").
th({-align=>'center',
-bgcolor=>'#b7d8e4'}, "%Identical").
th({-align=>'center',
-bgcolor=>'#b7d8e4'}, "%Similar").
th({-align=>'center',
-bgcolor=>'#b7d8e4'}, "Alignment"));
my $bgcolor = "white";
foreach my $rowRef (@$alignInfoArrayRef) {
my ($pdb, $organism, $note, $identical, $similar, $score)
= @$rowRef;
my ($pdbid, $chain) = split(/\_/, $pdb);
if ($pdbidFound{$pdbid}) { next; }
my ($source, $desc) = $self->getSourceDesc($organism, $note);
my $count = $count4pdbid{$pdbid} || '1';
my $alignLink = $self->alignmentLink($self->featNm, $pdb, "View alignment");
$score = $self->convertScore($score);
if ($rows4pdbid{$pdbid}) {
$score = b("Chain $chain = ").$score;
}
else { $score = b($score); }
my $pdbDesc = b($pdbid." (".$chains4pdbid{$pdbid}.")").br.$desc;
my $rows4pdbid = $rows4pdbid{$pdbid};
$rows4pdbid =~ s//
/g;
$rows .= Tr({-bgcolor=>"$bgcolor"},
td({-rowspan=>"$count"},
$pdbDesc).
td({-rowspan=>"$count"},
$self->pdbInfoLink($pdb)).
td({-rowspan=>"$count"}, $source).
td({-align=>'center'}, $score).
td({-align=>'center'}, b($identical)).
td({-align=>'center'}, b($similar)).
td({-align=>'center'}, $alignLink).
td({-rowspan=>"$count",
-align=>'left'}, $self->externalDbLink($pdbid))).
$rows4pdbid;
$pdbidFound{$pdbid}++;
if ($bgcolor eq "white") {
$bgcolor = "#d8d8d8";
}
else { $bgcolor = "white"; }
}
my $count = keys(%pdbidFound);
return table({-align=>'center',
-border=>1,
-cellpadding=>4,
-cellspacing=>2},
$rows);
}
########################################################################
sub convertScore {
########################################################################
#for pdbStructure
my ($self, $score) = @_;
$score = exp($score);
$score =~ s/^([^\.])\.([0-9]).+(e-.+)$/$1\.$2$3/;
if ($score !~ /e/i) {
$score = substr($score, 0, 8);
}
return $score;
}
########################################################################
sub alignmentLink {
########################################################################
#for pdbStructure
my ($self, $orf, $pdb, $showNm) = @_;
return a({-href=>$configUrl->dictyBaseCGIRoot."$db/protein/get3d?locus=$orf&pdb=$pdb&align=1"}, $showNm);
}
########################################################################
sub getSourceDesc {
########################################################################
#for pdbStructure
my ($self, $organism, $note) = @_;
$note =~ s/\$//g;
my ($source, $desc);
if ($organism !~ /^(unknown|other)$/i) {
$source = $organism;
}
elsif ($note =~ /organism_scientific: /) {
lc($note);
my @note = split(/organism_scientific: /, $note);
shift @note;
my %foundOrg;
foreach my $thisNote (@note) {
if ($thisNote =~ /^([^\;]+)/) {
my $thisOrg = $1;
if (!$foundOrg{"\U$thisOrg"}) {
$thisOrg = "\u$thisOrg";
if ($source) { $source .= " | "; }
$source .= $thisOrg;
}
$foundOrg{"\U$thisOrg"}++;
}
}
}
elsif ($note =~ /SOURCE: (.+)$/i) {
$source = "\u$1";
}
else {
$source = "Unknown";
}
if ($note =~ /^(.+)\; SOURCE: /i) {
$desc = $1;
}
else {
$desc = $note;
}
if ($source =~ /^\((.+)\)$/) {
$source = "\u$1";
}
return ($source, $desc);
}
########################################################################
sub externalDbLink {
########################################################################
#for pdbStructure
my ($self, $pdbid) = @_;
return li(a({-href=>"http://scop.mrc-lmb.cam.ac.uk/scop/search.cgi?pdb=$pdbid", -target=>'infowin'}, "SCOP")).
li(a({-href=>"http://www3.ncbi.nlm.nih.gov/htbin-post/Entrez/query?db=t&form=6&Dopt=s&uid=$pdbid", -target=>'infowin'}, "MMDB")).
li(a({-href=>"http://www.biochem.ucl.ac.uk/cgi-bin/cath/CATHSrch.pl?query=$pdbid&type=PDB", -target=>'infowin'}, "CATH"));
}
########################################################################
sub pdbInfoLink {
########################################################################
#for pdbStructure
my ($self, $pdb, $quick) = @_;
my ($pdbid, $chain) = split(/\_/, $pdb);
my $pdbInfoLink = li(a({-href=>$configUrl->pdbCGIRoot."explore.cgi?pdbId=$pdbid",
-target=>'infowin'},
"PDB_Info"));
my $seqObj = Pdb_sequence->new(dbh=>$dbh,
sequence_name=>$pdb);
if (!$quick) {
$pdbInfoLink .= li(a({-href=>$configUrl->pdbCGIRoot."explore.cgi?job=graphics&pdbId=$pdbid",
-target=>'infowin'},
"PDB_Structure"));
}
if ($seqObj) {
my $refNoList = Reflink->GetRefNoListBYtabNmPrikeyPrikeycol(
dbh=>$dbh,
tab_name=>'PDB_SEQUENCE',
primary_key=>$seqObj->pdb_sequence_no,
primary_key_col=>'PDB_SEQUENCE_NO');
my @refNo = split(/\:/, $refNoList);
if (@refNo == 1) {
$pdbInfoLink .= li(a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/reference/reference.pl?refNo=$refNo[0]",
-target=>'infowin'}, "Reference"));
}
elsif (@refNo > 1) {
$pdbInfoLink .= li(a({-href=>url."?pdbid=$pdbid&refNo=$refNoList",
-target=>'infowin'}, "References"));
}
}
if ($quick) {
$pdbInfoLink .= li($self->QuickPDB($pdbid));
}
return $pdbInfoLink;
}
#######################################################################
sub getAssociatedSeq {
#######################################################################
#for sequence retrieval
my ($self) = @_;
my $featureNo = $self->featNo;
my $locusNo = $self->locusNo;
my $locusName = $self->locusNm;
my $featName = $self->featNm;
#store rows to print
my @rows;
#the first row in the table is the dictyBase systematic sequence
my $sysNm;
if ($featName && $locusName) {
$sysNm = $featName;
}
elsif ($locusName) {
$sysNm = $locusName;
}
elsif ($featName) {
$sysNm = $featName;
}
else {
return;
}
gene_page.pl?gene_name='.$sysNm;
if ($featName) {
my $sysurl = $configUrl->dictyBaseCGIRoot.'dictyBase/seqTools?back=1&seqname='.$featName;
push (@rows, td(a({-href=>$sysurl}, $featName)).td('dictyBase Systematic Sequence'));
}
#prepare SQL statement to retrieve from external_id and template_url table.
my $sth = $dbh->prepare("
SELECT e.external_id, t.source, t.template_url
FROM CGM_DDB.external_id e, CGM_DDB.ei_tu u, CGM_DDB.template_url t
WHERE e.tab_name = ?
AND e.primary_key = ?
AND e.external_id_no = u.external_id_no
AND u.template_url_no = t.template_url_no
AND e.source in ('Entrez GI', 'GenBank DNA Version', 'InterPro', 'MIPS', 'PDB', 'PIR', 'RefSeq Version', 'SwissProt', 'YPD')
");
#get data associated with locus
if ($locusNo){
$sth->execute("LOCUS", $locusNo);
while (my ($eid, $source, $url) = $sth->fetchrow){
#swap specific external_id into template_url
$url =~ s/_SUBSTITUTE_THIS_/$eid/;
push (@rows, td(a({-href=>$url}, $eid)).td($source));
}
$sth->finish;
}
#get data associated with feature
if ($featureNo){
$sth->execute("FEATURE", $featureNo);
while (my ($eid, $source, $url) = $sth->fetchrow){
$url =~ s/_SUBSTITUTE_THIS_/$eid/;
push (@rows, td(a({-href=>$url}, $eid)).td($source));
}
$sth->finish;
}
if (@rows){
#table header
unshift (@rows, th({-align=>'left', -bgcolor=>"#b7d8e4"}, "Sequence ID").th({-align=>'left', -bgcolor=>"#b7d8e4"}, "Source"));
}else{
push(@rows, th({-align=>'left', -bgcolor=>"#b7d8e4"}, "Sequence ID").th({-align=>'left', -bgcolor=>"#b7d8e4"}, "Source"));
push(@rows, h3("There are no sequences from external DBs associated with this gene."));
}
return @rows;
}
#######################################################################
sub relatedInteractors {
#######################################################################
#for interactions section
my ($self, $dictyBase) = @_;
my ($dictyBaseid, $interaction, $description, $object, $rows);
my @data = $dictyBase->fetchRelatedInteractors;
while (@data){
$dictyBaseid = shift @data;
$interaction = shift @data;
$description = shift @data;
#for associated gene
$object = dictyBaseDEVObject->new(dictyBaseid=>$dictyBaseid);
$rows .= Tr(td(a({-href=>$configUrl->dictyBaseCGIRoot."gene_page.pl?dictyBaseid=" . $dictyBaseid}, $object->standardName)).
td($interaction).
td($description));
}
if ($rows){
return Tr(th({-align=>'LEFT',
-bgcolor=>"#a4abc2"}, "Name").
th({-align=>'LEFT',
-bgcolor=>"#a4abc2"}, "Relevance").
th({-align=>'LEFT',
-bgcolor=>"#a4abc2"}, "Description")) . $rows;
}else{
return;
}
}
########################################################################
sub references4topic {
########################################################################
#for literature section
my ($self, $giObject, $topic) = @_;
#get all papers associated with this gene/feature;
my $sthCurated = $dbh->prepare("
SELECT * FROM (
SELECT unique GI.reference_no, R.citation, R.year,
R.pubmed, J.abbreviation
FROM CGM_DDB.locus_gene_info GI, CGM_DDB.reference R,
CGM_DDB.journal J
WHERE GI.locus_no = ?
AND GI.reference_no = R.reference_no
AND R.journal_no = J.journal_no(+)
AND upper(GI.literature_topic) != 'NOT YET CURATED'
UNION
SELECT unique GI.reference_no, R.citation, R.year,
R.pubmed, J.abbreviation
FROM CGM_DDB.feat_gene_info GI, CGM_DDB.reference R,
CGM_DDB.journal J
WHERE GI.feature_no = ?
AND GI.reference_no = R.reference_no
AND R.journal_no = J.journal_no(+)
AND upper(GI.literature_topic) != 'NOT YET CURATED'
)
ORDER BY year
");
my $sthNotCurated = $dbh->prepare("
SELECT * FROM (
SELECT unique GI.reference_no, R.citation, R.year,
R.pubmed, J.abbreviation
FROM CGM_DDB.locus_gene_info GI, CGM_DDB.reference R,
CGM_DDB.journal J
WHERE GI.locus_no = ?
AND GI.reference_no = R.reference_no
AND R.journal_no = J.journal_no(+)
AND upper(GI.literature_topic) = 'NOT YET CURATED'
UNION
SELECT unique GI.reference_no, R.citation, R.year,
R.pubmed, J.abbreviation
FROM CGM_DDB.feat_gene_info GI, CGM_DDB.reference R,
CGM_DDB.journal J
WHERE GI.feature_no = ?
AND GI.reference_no = R.reference_no
AND R.journal_no = J.journal_no(+)
AND upper(GI.literature_topic) = 'NOT YET CURATED'
)
ORDER BY year
");
my $arrayRef;
if ($topic =~ /^curated/) {
$sthCurated->execute($self->locusNo, $self->featNo);
$arrayRef = $sthCurated->fetchall_arrayref();
$sthCurated->finish;
}
else {
$sthNotCurated->execute($self->locusNo, $self->featNo);
$arrayRef = $sthNotCurated->fetchall_arrayref();
$sthNotCurated->finish;
}
my @refs = reverse(@$arrayRef);
my $count = @refs;
my $returnList;
my ($locusNm4RefNoHashRef, $featNm4RefNoHashRef, $url4RefNoHashRef);
my ($relatedRefInfo4RefNoHashRef, $webSupplementUrl4RefNOHashRef);
=comment
if (!$self->locusNm && @refs > 100) {
$locusNm4RefNoHashRef = $giObject->getLocusNm4RefNoHashRef;
$featNm4RefNoHashRef = $giObject->getFeatNm4RefNoHashRef;
$url4RefNoHashRef = $giObject->getUrl4RefNoHashRef;
$relatedRefInfo4RefNoHashRef
= $giObject->getRelatedRefInfo4RefNoHashRef;
$webSupplementUrl4RefNOHashRef
= $giObject->getWebSupplementUrl4RefNoHashRef;
}
=cut
foreach my $rowRef (@refs) {
my ($refNo, $ORIcitation, $year, $pubmed, $journal) = @$rowRef;
my ($refObject, $topList);
if ($refNo) {
$refObject = Reference->new(dbh=>$dbh, reference_no=>$refNo);
}
my ($citation, $locusList, $featureList);
if (!$self->locusNm && @refs > 100) {
my $urls = $$url4RefNoHashRef{$refNo};
my $relatedRefInfo = $$relatedRefInfo4RefNoHashRef{$refNo};
my $webSuppUrl = $$webSupplementUrl4RefNOHashRef{$refNo};
$citation = $self->citation2($refNo, $ORIcitation, $pubmed,
$journal, $urls,
$relatedRefInfo, $webSuppUrl);
$locusList = $$locusNm4RefNoHashRef{$refNo};
$featureList = $$featNm4RefNoHashRef{$refNo};
}
else {
$citation = $self->citation($refObject, $topic);
foreach my $rowRef (@{$refObject->locusArrayRef}) {
my ($locusNm) = @$rowRef;
$locusList .= $locusNm."\t";
}
$locusList =~ s/\t$//;
foreach my $rowRef (@{$refObject->featureArrayRef}) {
my ($featNm) = @$rowRef;
$featureList .= $featNm."\t";
}
$featureList =~ s/\t$//;
}
my $thisgene = $self->locusNm || $self->featNm;
my $linkTopic;
if ($topic =~ /^curated/) {
my %foundtopic;
# my $linkTopic;
foreach my $rowRef (@{$refObject->locusTopicArrayRef}) {
my ($onetopic, $thislocus) = @$rowRef;
$foundtopic{$onetopic} = 1 if ($thislocus eq $self->locusNm);
}
foreach my $rowRef (@{$refObject->featureTopicArrayRef}) {
my ($onetopic, $thisfeatNm) = @$rowRef;
$foundtopic{$onetopic} = 1 if ($thisfeatNm eq $self->featNm);
}
foreach my $key (keys %foundtopic) {
$linkTopic = $key;
$linkTopic =~ s/ /+/;
$topList .= font({-size=>'-1'}, a({-href=>$configUrl->dictyBaseCGIRoot."$db/reference/geneinfo.pl?locus=$thisgene&topic=$linkTopic", -target=>'infowin'},$key)) . br;
}
}
else {
$linkTopic = $topic;
$linkTopic =~ s/ /+/;
$topList = font({size=>'-1'}, a({-href=>$configUrl->dictyBaseCGIRoot."$db/reference/geneinfo.pl?locus=$thisgene&topic=$linkTopic", -target=>'infowin'}, "Not Yet Curated"));
}
my $loci;
if ($locusList && $featureList) {
$loci = $locusList."\t".$featureList;
}
elsif ($locusList) { $loci = $locusList; }
elsif ($featureList) { $loci = $featureList; }
$loci =~ s/^\t//;
$loci =~ s/\t$//;
my @loci = split(/\t/, $loci);
my $listLoci;
foreach my $locus (@loci) {
if ($self->locusNm && $self->locusNm =~ /^$locus$/i) {
next;
}
$listLoci .= " |". font({-size=>'-1'}, a({-href=>$configUrl->dictyBaseCGIRoot."gene_page.pl?gene_name=$locus", -target=>'infowin'}, $locus));
}
$listLoci =~ s/^\|//;
if (!$listLoci) { $listLoci = br; }
$returnList .= Tr(td({-width=>"25%", -bgcolor=>"#b7d8e4",
-valign=>"top"},
$topList).
td({-width=>"50%",
-valign=>"top"},
$citation).
td({-width=>"25%",
-valign=>"top"},
$listLoci));
}
return ($returnList, $count);
}
########################################################################
sub citation {
########################################################################
my ($self, $refObject, $topic) = @_;
my $citation;
if ($topic =~ /not yet curated/i) {
$citation = $refObject->formatedCitation4notYetTopic;
}
else {
$citation = $refObject->formatedCitation;
}
return $citation;
}
########################################################################
sub citation2 {
########################################################################
my ($self, $refNo, $citation, $pubmed, $journal, $urls,
$relatedRefInfo, $webSuppUrl) = @_;
$citation =~ s/^([^0-9]+\([0-9]{4}\))(.+)$/$1<\/b>$2/;
$citation =~ s/^([^0-9]+\([0-9]{4}\))$/$1<\/b> personal communication/;
$citation .= br;
my $image = "dictyBaserefsml.gif";
$citation .= a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/reference/reference.pl?refNo=$refNo",
-target=>'infowin'},
img({-src=>$configUrl->dictyBaseImages."$image",
-border=>'0',
-alt=>"dictyBase Papers Entry"}));
if ($pubmed) {
$citation .= " ".a({-href=>$configUrl->ncbiUrlRoot."query.fcgi?cmd=Retrieve&db=PubMed&list_uids=${pubmed}&dopt=Abstract",
-target=>'infowin'},
img({-src=>$configUrl->dictyBaseImages."pubmedrefsml.gif",
-border=>'0',
-alt=>"Pubmed Entry"}))." ";
}
if ($urls) {
my $journalGif = $journal;
$journalGif =~ s/ /\./g;
$journalGif .= ".gif";
if (! -e $configPath->gifDir."$journalGif") {
$journalGif = "Generic.gif";
}
$citation .= a({-href=>"$urls",
-target=>'infowin'},
img({-src=>$configUrl->dictyBaseImages."$journalGif",
-border=>'0',
-alt=>"online article1"}))." ";
}
if ($webSuppUrl) {
$citation .= a({-href=>"$webSuppUrl",
-target=>'infowin'},
img({-src=>$configUrl->dictyBaseImages."webSupplement.gif",
-border=>'0',
-alt=>"Web Supplement"}));
}
if ($relatedRefInfo) {
$citation .= a({-href=>$configUrl->dictyBaseCGIRoot."$dblink/reference/reference.pl?refNo=".$refNo."&type=other",
-target=>'infowin'},
img({-src=>$configUrl->dictyBaseImages."C&E.gif",
-border=>'0',
-alt=>"dictyBase Curated Comments & Errata"}));
}
return $citation;
}
#######################################################################
sub DomainDisplaySeq {
#######################################################################
my ($self) = @_;
#set the maximum blob size
$dbh->{LongReadLen} = 10000;
#retrieve protein sequence from DB
my $seqSth = $dbh->prepare("
SELECT r.display_seq, r.seq_length
FROM CGM_DDB.display_seq r, CGM_DDB.feature f
WHERE f.feature_name = ? and
r.feature_no = f.feature_no and
r.display_seq_type = 'Protein'
");
if ($self->featNm) {
$seqSth->execute($self->featNm);
}
else {
return;
}
my ($sequence,$strLength) = $seqSth->fetchrow;
my $position = 0;
my $segmentLen = 50;
my $seqHeader = ' ' x 18;
my $ruler = ' ' x 18;
my $ruler1 = ' ' x 18;
for (my $i=10; $i<=50; $i=$i+10) {
$ruler .= ' ' x 9 .'|';
$ruler1 .= ' ' x 8 . $i;
}
my $seqForDisplay = $ruler1 ."\n".$ruler ."\n";
my $emptyLine = ' ' x $segmentLen;
#display in the format of multiple line (50 char per line)
while ($position < $strLength) {
my $subSeq = substr($sequence, $position, $segmentLen);
$seqForDisplay .= $seqHeader.$subSeq ."\n";
$position += $segmentLen;
}
return $seqForDisplay;
}
######################################################################
sub printRowForTopic {
######################################################################
#for community annotaion
my ($self, $anchor, $top, @data) = @_;
my $rows = Tr({-bgcolor=>"a4abc2"},
th({-colspan=>"4", -align=>"left"}, a({-name=>$anchor}, $top))).
Tr({-bgcolor=>"#b7d8e4"},
th({-align=>"left"}, "Topic"),
th({-align=>"left", -width=>"40%"}, "Research Highlight"),
th({-align=>"left", -width=>"40%"}, "Reference"),
th({-align=>"left"}, "Contributor")
);
if (!@data) {
return;
}
else {
foreach my $aref (@data) {
my ($comAnNo, $anSetNo, $dictyBaseidDB, $topic, $subTopic, $desc) = @$aref;
my $ref = $self->getRef($anSetNo);
my $contributor = $self->getContributor($anSetNo);
if (!$subTopic || !$desc) {
$self->err_report("No subTopic or desc!");
}
#get annotation detail
my $detail = $self->getAnnoDetail($comAnNo, $topic, $subTopic, $anSetNo);
if ($detail) {
$desc = b('Description: '). $desc. br. $detail;
}
$rows .= Tr(td($subTopic),
td($desc),
td($ref),
td($contributor)
);
}
}
return table({-cellpadding=>"2", -width=>"100%", -cellspacing=>"3", -border=>"1"}, $rows);
}
######################################################################
sub getAnnoDetail {
######################################################################
my ($self, $comAnNo, $topic, $subTopic, $anSetNo) = @_;
my $detail;
if (!$comAnNo) {$self->err-report("No comAnNo!");}
my $sth = $dbh->prepare("
SELECT detail_name, detail_value
FROM CGM_DDB.annotation_detail
WHERE community_annotation_no = ?
");
$sth->execute($comAnNo);
my %result;
while (my ($nm, $va) = $sth->fetchrow) {
$result{$nm} = $va;
}
#get glossary for annotation detail translation
my ($DNAgsy, $ProModType, $Proteingsy, $Techgsy, $Intgsy, $Mutgsy, $Phenogsy, $Othgsy) = $self->getAnDetailGlossary;
my %exclude = ('file'=>'1', 'supressor'=>'1', 'OtherPhenotypeDescription'=>'1', 'partialDelTo'=>'1', 'OtherMT'=>'1', 'condition' => '1');
if ($topic =~ /^Alleles/) {
my @Phenodesc;
my $specialDetail;
foreach my $key (keys %result) {
next if ($exclude{$key});
if ($$Phenogsy{$key}) {
my $tmpVal = $$Phenogsy{$key};
if ($key =~ /OtherPhenotype/) {
$tmpVal .= "($result{$key})";
}
elsif ($key =~ /inviableWhen/) {
$tmpVal .= "($result{'condition'})";
}
push(@Phenodesc, $tmpVal);
}
elsif ($$Mutgsy{$key}) {
if ($key =~ /partialDelfrom/) {
$detail .= 'Deletion chromosome sequence coordinates: '. b('from'). ': ' . $result{$key} . b(' to') .': '. $result{'partialDelTo'}. br;
next;
}
$detail .= b($$Mutgsy{$key}). ': ' . $result{$key} .br;
}
else {
$detail .= b($key). ': ' . $result{$key} .br;
}
}
#for multiple knockout strains, need to find those being knocked out
#together with this gene
if (($subTopic eq 'Multiple Knockout Strains') || ($subTopic eq 'Other Mutation')) {
$detail .= $self->getMultiRelation($anSetNo, $subTopic);
}
if (@Phenodesc) {
my $strPhe = join(', ', @Phenodesc);
$detail .= b('Phenotype description'). ': ' . $strPhe. br;
}
}
elsif ($topic =~ /^Int/) {
foreach my $key (keys %result) {
next if ($exclude{$key});
if ($$Intgsy{$key}) {
$detail .= b($$Intgsy{$key}). ': ' . $result{$key} .br;
}
else {
$detail .= b($key.'NotInGlossary'). ': ' . $result{$key} .br;
}
}
}
elsif ($topic =~ /^Protein/) {
my @modType;
foreach my $key (keys %result) {
next if ($exclude{$key});
if ($$ProModType{$key}) {
push(@modType, $result{$key});
}
elsif ($$Proteingsy{$key}) {
$detail .= b($$Proteingsy{$key}). ': ' . $result{$key} .br;
}
else {
$detail .= b($key). ': ' . $result{$key} .br;
}
}
if (@modType) {
$detail .= b('Modification Type'). ': '. join(', ', @modType) .br;
}
}
else {
foreach my $key (keys %result) {
next if ($exclude{$key});
if ($$DNAgsy{$key}) {
$detail .= b($$DNAgsy{$key}). ': ' . $result{$key} .br;
}
else {
$detail .= b($key). ': ' . $result{$key} .br;
}
}
}
return $detail;
}
######################################################################
sub getMultiRelation {
######################################################################
my ($self, $anSetNo, $subTopic) = @_;
my @genes;
my $sth = $dbh->prepare("
SELECT dictyBaseid
FROM CGM_DDB.community_annotation
WHERE annotation_set_no = ? AND
sub_topic = ?
");
$sth->execute($anSetNo, $subTopic);
while (my $tmpdictyBaseid = $sth->fetchrow) {
next if ($tmpdictyBaseid eq $self->dictyBaseid);
my $mkObj = dictyBaseDEVObject->new(database=>$self->database, dictyBaseid=>$tmpdictyBaseid);
my $tmpGeneNm = $mkObj->locusName || $mkObj->featureName;
push(@genes, $tmpGeneNm);
}
$sth->finish;
my $string;
if (@genes) {
$string = b('together with') . ': ' . join(', ', @genes) .br;
}
return $string;
}
######################################################################
sub getRef {
######################################################################
my ($self, $anSetNo) = @_;
my $sth = $dbh->prepare("
SELECT r.reference_no
FROM CGM_DDB.annotation_set a, CGM_DDB.reflink r
WHERE r.tab_name = 'ANNOTATION_SET' and
r.primary_key = ? and
r.primary_key_col = 'ANNOTATION_SET_NO'
");
$sth->execute($anSetNo);
my $refNo = $sth->fetchrow;
$sth->finish;
if (!$refNo) {
$self->err_report("No reference_no!");
}
my $refObj = Reference->new(dbh=>$dbh, reference_no=>$refNo);
if (!$refObj) {
$self->err_report("Invalid reference_no!");
}
my $formatedCitation = $refObj->formatedCitation;
return $formatedCitation;
}
######################################################################
sub getContributor {
######################################################################
my ($self, $anSetNo) = @_;
my $sth = $dbh->prepare( "
SELECT c.last_name, c.first_name, a.date_created
FROM CGM_DDB.annotation_set a, CGM_DDB.colleague c
WHERE a.colleague_no = c.colleague_no AND
a.annotation_set_no = ?
");
$sth->execute($anSetNo);
my ($ln, $fn, $date) = $sth->fetchrow();
$sth->finish;
if (!$ln || !$fn) {
$self->err_report("No lastName or firstName!");
}
return $fn. ' '. $ln. br. i($date);
}
######################################################################
sub getAnDetailGlossary {
######################################################################
#each topic has a glossary hash to translate what in the Db to what's
#going to be shown on user interface
my %DNAgsy = ('ChrCoordinate' => 'Chromosomal sequence coordinates',
'startCoord' => 'start',
'stopCoord' => 'stop',
'motifboundPr' => 'Protein(s) shown to bind this motif',
'primaryGene' => 'Binds to the motif and regulates'
);
my %ProModType = ('OtherModificationType' => 'OtherModificationType',
'Phosphorylation' => 'Phosphorylation',
'Glycosylation' => 'Glycosylation',
'N-terminal' => 'N-terminal',
'C-terminal' => 'C-terminal');
my %Proteingsy = ('modifiedAA' => 'modified Amino Acid',
'primaryGene' => 'is a substrate of');
my %Techgsy = ('strainBackground' => 'Strain background',
'strainNameGenotype' => 'Strain name & genotype'
);
my %Intgsy = ('mutation1' => 'mutation for this gene',
'mutation2' => 'mutation for the interacting gene',
'syntheticLethal' => 'is synthetic lethal with',
'epistatic' => 'is epistatic to',
'is suppressed by' => 'is suppressed by',
'is a suppressor of' => 'is a suppressor of',
'OtherDesc' => 'Other Interaction',
'strainBackground' => 'Strain background',
'strainNameGenotype' => 'Strain name & genotype',
# 'isRegulatedBy' => 'is regulated by',
# 'regulates' => 'regulates',
'regulator' => 'is a regulator of',
'regulated' => 'is regulated by',
'with' => 'with',
'otherTopic' => 'Other topic'
);
my %Mutgsy = ('allel' => 'Allele name',
'allele' => 'Allele name',
'strainBackground' => 'Strain background',
'strainNameGenotype' => 'Strain name & genotype',
'partialDelfrom' => 'from',
'partialDelTo' => 'to'
);
my %Phenogsy = ('Dominant' => 'Dominant',
'Recessive' => 'Recessive',
'Viable'=> 'Viable',
'Inviable' => 'Inviable',
'TemperatureSensitive' => 'TemperatureSensitive',
'ColdSensitive' => 'ColdSensitive',
'LossFunction' => 'LossFunction',
'GainFunction' => 'GainFunction',
'Revertable' => 'Revertable',
'NoPhenotype' => 'NoPhenotype',
'OtherPhenotypeDescription' => 'OtherPhenotypeDescription',
'OtherPhenotype' => 'OtherPhenotype',
'inviableWhen' => 'inviableWhen'
# 'condition' => 'condition'
);
my %Othgsy;
return (\%DNAgsy, \%ProModType, \%Proteingsy, \%Techgsy, \%Intgsy, \%Mutgsy, \%Phenogsy, \%Othgsy);
}
#######################################################################
1;
#######################################################################