Parent Directory
| 
Revision Log
Revision 1.1 - (view) (download) (as text)
| 1 : | parrello | 1.1 | #!/usr/bin/perl -w |
| 2 : | |||
| 3 : | package SHOrgSumSearch; | ||
| 4 : | |||
| 5 : | use strict; | ||
| 6 : | use Tracer; | ||
| 7 : | use CGI qw(-nosticky); | ||
| 8 : | use Sprout; | ||
| 9 : | |||
| 10 : | use RHFeatures; | ||
| 11 : | use base 'SearchHelper'; | ||
| 12 : | |||
| 13 : | =head1 | ||
| 14 : | |||
| 15 : | =head2 Introduction | ||
| 16 : | |||
| 17 : | This is a simple search that returns features which are named or hypothetical | ||
| 18 : | and in or not in subsystems. The goal is to separate the genes according to how | ||
| 19 : | much we know about them. Genes in subsystems are ones in which we have a high | ||
| 20 : | degree of confidence about their existence. Genes that are hypothetical are ones | ||
| 21 : | in which we do not know the function. The two criteria lead to four different | ||
| 22 : | possible sets. | ||
| 23 : | |||
| 24 : | This search has the following extra parameters. | ||
| 25 : | |||
| 26 : | =over 4 | ||
| 27 : | |||
| 28 : | =item genome | ||
| 29 : | |||
| 30 : | ID of the target genome | ||
| 31 : | |||
| 32 : | =item hypothetical | ||
| 33 : | |||
| 34 : | C<hypo> if we only want hypothetical genes, C<named> if we only want | ||
| 35 : | named genes, and C<both> if we want both hypothetical and named genes. | ||
| 36 : | |||
| 37 : | =item insubsystem | ||
| 38 : | |||
| 39 : | C<in> if we only want genes in subsystems, C<out> if we only want genes | ||
| 40 : | not in subsystems, and C<both> if we want all genes. | ||
| 41 : | |||
| 42 : | =back | ||
| 43 : | |||
| 44 : | =head2 Virtual Methods | ||
| 45 : | |||
| 46 : | =head3 Form | ||
| 47 : | |||
| 48 : | my $html = $shelp->Form(); | ||
| 49 : | |||
| 50 : | Generate the HTML for a form to request a new search. | ||
| 51 : | |||
| 52 : | =cut | ||
| 53 : | |||
| 54 : | sub Form { | ||
| 55 : | # Get the parameters. | ||
| 56 : | my ($self) = @_; | ||
| 57 : | # Get the CGI and sprout objects. | ||
| 58 : | my $cgi = $self->Q(); | ||
| 59 : | my $sprout = $self->DB(); | ||
| 60 : | # Get the incoming parameter values. | ||
| 61 : | my $genomeID = $cgi->param('genome'); | ||
| 62 : | my $hypothetical = $cgi->param('hypothetical') || 'both'; | ||
| 63 : | my $inSubsystem = $cgi->param('insubsystem') || 'both'; | ||
| 64 : | # Start the form. | ||
| 65 : | my $retVal = $self->FormStart("Organism Summary Gene Search"); | ||
| 66 : | # Declare a variable to hold the table rows. | ||
| 67 : | my @rows = (); | ||
| 68 : | # Start with a genome control. | ||
| 69 : | push @rows, CGI::Tr(CGI::th('Select a genome'), | ||
| 70 : | CGI::td($self->NmpdrGenomeMenu('genome', | ||
| 71 : | 0, [$genomeID], 10))); | ||
| 72 : | # Now the checkboxes. | ||
| 73 : | push @rows, CGI::Tr(CGI::th("Function"), | ||
| 74 : | CGI::td(CGI::popup_menu(-name => 'hypothetical', | ||
| 75 : | -values => [qw(hypo named both)], | ||
| 76 : | -labels => { hypo => 'Hypothetical only', | ||
| 77 : | named => 'Named only', | ||
| 78 : | both => 'Both hypothetical and named' }, | ||
| 79 : | -default => $hypothetical))); | ||
| 80 : | push @rows, CGI::Tr(CGI::th("Status"), | ||
| 81 : | CGI::td(CGI::popup_menu(-name => 'insubsystem', | ||
| 82 : | -values => [qw(in out both)], | ||
| 83 : | -labels => { in => 'Subsystem genes only', | ||
| 84 : | out => 'Non-subsystem genes only', | ||
| 85 : | both => 'Both subsystem and non-subsystem genes' }, | ||
| 86 : | -default => $inSubsystem))); | ||
| 87 : | # The last row is for the submit button. | ||
| 88 : | push @rows, $self->SubmitRow(); | ||
| 89 : | # Create the table. | ||
| 90 : | $retVal .= $self->MakeTable(\@rows); | ||
| 91 : | # Close the form. | ||
| 92 : | $retVal .= $self->FormEnd(); | ||
| 93 : | # Return the result. | ||
| 94 : | return $retVal; | ||
| 95 : | } | ||
| 96 : | |||
| 97 : | =head3 Find | ||
| 98 : | |||
| 99 : | my $resultCount = $shelp->Find(); | ||
| 100 : | |||
| 101 : | Conduct a search based on the current CGI query parameters. The search results will | ||
| 102 : | be written to the session cache file and the number of results will be | ||
| 103 : | returned. If the search parameters are invalid, a result count of C<undef> will be | ||
| 104 : | returned and a result message will be stored in this object describing the problem. | ||
| 105 : | |||
| 106 : | =cut | ||
| 107 : | |||
| 108 : | # This hash is used to compute the sort key. The input value is hypothetical flag | ||
| 109 : | # followed by in-subsystem flag. | ||
| 110 : | use constant SORT_POSITION => { ' X' => 1, | ||
| 111 : | ' ' => 2, | ||
| 112 : | 'XX' => 3, | ||
| 113 : | 'X ' => 4}; | ||
| 114 : | |||
| 115 : | sub Find { | ||
| 116 : | my ($self) = @_; | ||
| 117 : | # Get the CGI and Sprout objects. | ||
| 118 : | my $cgi = $self->Q(); | ||
| 119 : | my $sprout = $self->DB(); | ||
| 120 : | # Declare the return variable. If it remains undefined, the caller will | ||
| 121 : | # know that an error occurred. | ||
| 122 : | my $retVal; | ||
| 123 : | # Get the result helper. | ||
| 124 : | my $rhelp = RHFeatures->new($self); | ||
| 125 : | # Validate the filtering parameters. | ||
| 126 : | if ($rhelp->Valid()) { | ||
| 127 : | # Get the search parameters. | ||
| 128 : | my $genome = $cgi->param('genome'); | ||
| 129 : | my $hypothetical = $cgi->param('hypothetical') || 'both'; | ||
| 130 : | my $insubsystem = $cgi->param('insubsystem') || 'both'; | ||
| 131 : | # These hashes tell us which truth values for the subsystem | ||
| 132 : | # flag and the hypothetical flag correspond to features we | ||
| 133 : | # want to keep. | ||
| 134 : | my %subFlags = (' ' => ($insubsystem ne 'in'), | ||
| 135 : | 'X' => ($insubsystem ne 'out')); | ||
| 136 : | my %hypoFlags = (' ' => ($hypothetical ne 'hypo'), | ||
| 137 : | 'X' => ($hypothetical ne 'named')); | ||
| 138 : | # Insure we have a genome ID. | ||
| 139 : | if (! defined $genome) { | ||
| 140 : | $self->SetMessage("Please select a genome."); | ||
| 141 : | } else { | ||
| 142 : | # Initialize the result counter. | ||
| 143 : | $retVal = 0; | ||
| 144 : | # Get the default columns. | ||
| 145 : | $self->DefaultColumns($rhelp); | ||
| 146 : | Trace("Column list is " . join(", ", @{$rhelp->GetColumnHeaders()})) if T(3); | ||
| 147 : | # Add the extra columns. | ||
| 148 : | $rhelp->AddExtraColumn(hypothetical => undef, download => 'text', | ||
| 149 : | title => 'Hypothetical', style => 'center'); | ||
| 150 : | $rhelp->AddOptionalColumn(subsystem => undef); | ||
| 151 : | # Start the output session. | ||
| 152 : | $self->OpenSession($rhelp); | ||
| 153 : | # Create an SQL pattern for this genome's features. | ||
| 154 : | my $genomePattern = "fig|$genome.%"; | ||
| 155 : | # Now we want to create a hash of all the features in this | ||
| 156 : | # genome that are in subsystems. We do this by querying the | ||
| 157 : | # HasRoleInSubsystem table. | ||
| 158 : | $self->PrintLine(CGI::p("Analyzing subsystems.")); | ||
| 159 : | my %inSubsystem; | ||
| 160 : | my $qh = $sprout->Get('HasRoleInSubsystem', | ||
| 161 : | "HasRoleInSubsystem(from-link) LIKE ?", | ||
| 162 : | [$genomePattern]); | ||
| 163 : | while (my $feature = $qh->Fetch()) { | ||
| 164 : | $inSubsystem{$feature->PrimaryValue('from-link')} = 1; | ||
| 165 : | } | ||
| 166 : | # Create the query for all the features in this genome. | ||
| 167 : | $self->PrintLine(CGI::p("Computing query.")); | ||
| 168 : | $qh = $sprout->Get('Feature', | ||
| 169 : | "Feature(id) LIKE ?", [$genomePattern]); | ||
| 170 : | # Count the genome's features in here so the user gets progress. | ||
| 171 : | my $featureCount = 0; | ||
| 172 : | $self->PrintLine(CGI::p("Processing results.")); | ||
| 173 : | # Loop through them. | ||
| 174 : | while (my $feature = $qh->Fetch()) { | ||
| 175 : | # Get the feature ID. | ||
| 176 : | my $fid = $feature->PrimaryValue('id'); | ||
| 177 : | # Check to see if we're hypothetical. | ||
| 178 : | my $assignment = $feature->PrimaryValue('assignment'); | ||
| 179 : | my $hypoFlag = ($assignment =~ /hypothetical/ ? 'X' : ' '); | ||
| 180 : | # Check to see if we're in a subsystem. | ||
| 181 : | my $subFlag = ($inSubsystem{$fid} ? 'X' : ' '); | ||
| 182 : | # Do we want to keep this feature? | ||
| 183 : | if ($hypoFlags{$hypoFlag} && $subFlags{$subFlag}) { | ||
| 184 : | # Yes. Count it as a result. | ||
| 185 : | $retVal++; | ||
| 186 : | # Output its hypothetical flag. | ||
| 187 : | $rhelp->PutExtraColumns(hypothetical => $hypoFlag); | ||
| 188 : | # Compute the sort key. We sort from least confidence | ||
| 189 : | # to most. | ||
| 190 : | my $sortKey = SORT_POSITION->{"$hypoFlag$subFlag"} . $fid; | ||
| 191 : | # Output the feature. | ||
| 192 : | $rhelp->PutData($sortKey, $fid, $feature); | ||
| 193 : | } | ||
| 194 : | # Count this feature. | ||
| 195 : | $featureCount++; | ||
| 196 : | if ($featureCount % 500 == 0) { | ||
| 197 : | $self->PrintLine(CGI::p("$featureCount features processed, $retVal kept.")); | ||
| 198 : | } | ||
| 199 : | } | ||
| 200 : | # Close the session file. | ||
| 201 : | $self->CloseSession(); | ||
| 202 : | Trace("Session closed.") if T(3); | ||
| 203 : | } | ||
| 204 : | } | ||
| 205 : | # Return the result count. | ||
| 206 : | return $retVal; | ||
| 207 : | } | ||
| 208 : | |||
| 209 : | =head3 SearchTitle | ||
| 210 : | |||
| 211 : | my $titleHtml = $shelp->SearchTitle(); | ||
| 212 : | |||
| 213 : | Return the display title for this search. The display title appears above the search results. | ||
| 214 : | If no result is returned, no title will be displayed. The result should be an html string | ||
| 215 : | that can be legally put inside a block tag such as C<h3> or C<p>. | ||
| 216 : | |||
| 217 : | =cut | ||
| 218 : | |||
| 219 : | sub SearchTitle { | ||
| 220 : | # Get the parameters. | ||
| 221 : | my ($self) = @_; | ||
| 222 : | # Compute the title. | ||
| 223 : | my $cgi = $self->Q(); | ||
| 224 : | my $genomeID = $cgi->param('genome') || 'unknown genome'; | ||
| 225 : | my $retVal = "Organism Summary Search Search Results for $genomeID."; | ||
| 226 : | # Return it. | ||
| 227 : | return $retVal; | ||
| 228 : | } | ||
| 229 : | |||
| 230 : | =head3 Description | ||
| 231 : | |||
| 232 : | my $htmlText = $shelp->Description(); | ||
| 233 : | |||
| 234 : | Return a description of this search. The description is used for the table of contents | ||
| 235 : | on the main search tools page. It may contain HTML, but it should be character-level, | ||
| 236 : | not block-level, since the description is going to appear in a list. | ||
| 237 : | |||
| 238 : | =cut | ||
| 239 : | |||
| 240 : | sub Description { | ||
| 241 : | # Get the parameters. | ||
| 242 : | my ($self) = @_; | ||
| 243 : | # Return the result. | ||
| 244 : | return "Search for %FIG{genes}% with certain characteristics in a single %FIG{genome}%."; | ||
| 245 : | } | ||
| 246 : | |||
| 247 : | |||
| 248 : | 1; |
| MCS Webmaster | ViewVC Help |
| Powered by ViewVC 1.0.3 |