[Bio] / Sprout / SearchHelper.pm Repository:
ViewVC logotype

Diff of /Sprout/SearchHelper.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.4, Mon Oct 2 03:15:37 2006 UTC revision 1.14, Wed Nov 8 23:18:24 2006 UTC
# Line 177  Line 177 
177    
178  =back  =back
179    
180    If you are doing a feature search, you can also change the list of feature
181    columns displayed and their display order by overriding
182    L</DefaultFeatureColumns>.
183    
184  Finally, when generating the code for your controls, be sure to use any incoming  Finally, when generating the code for your controls, be sure to use any incoming
185  query parameters as default values so that the search request is persistent.  query parameters as default values so that the search request is persistent.
186    
# Line 214  Line 218 
218                      }                      }
219                  }                  }
220              }              }
         }  
221          # Close the session file.          # Close the session file.
222          $self->CloseSession();          $self->CloseSession();
223            }
224          # Return the result count.          # Return the result count.
225          return $retVal;          return $retVal;
226      }      }
227    
228  A Find method is of course much more complicated than generating a form, and there  A Find method is of course much more complicated than generating a form, and there
229  are variations on the above them. For example, you could eschew feature filtering  are variations on the above theme. For example, you could eschew feature filtering
230  entirely in favor of your own custom filtering, you could include extra columns  entirely in favor of your own custom filtering, you could include extra columns
231  in the output, or you could search for something that's not a feature at all. The  in the output, or you could search for something that's not a feature at all. The
232  above code is just a loose framework.  above code is just a loose framework.
# Line 316  Line 320 
320      return $self->{query};      return $self->{query};
321  }  }
322    
323    
324    
325  =head3 DB  =head3 DB
326    
327  C<< my $sprout = $shelp->DB(); >>  C<< my $sprout = $shelp->DB(); >>
# Line 607  Line 613 
613    
614  =head3 PutFeature  =head3 PutFeature
615    
616  C<< $shelp->PutFeature($fquery); >>  C<< $shelp->PutFeature($fdata); >>
617    
618  Store a feature in the result cache. This is the workhorse method for most  Store a feature in the result cache. This is the workhorse method for most
619  searches, since the primary data item in the database is features.  searches, since the primary data item in the database is features.
# Line 618  Line 624 
624  the feature query object using the B<AddExtraColumns> method. For example, the following  the feature query object using the B<AddExtraColumns> method. For example, the following
625  code adds columns for essentiality and virulence.  code adds columns for essentiality and virulence.
626    
627      $fq->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor);      $fd->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor);
628      $shelp->PutFeature($fq);      $shelp->PutFeature($fd);
629    
630  For correct results, all values should be specified for all extra columns in all calls to  For correct results, all values should be specified for all extra columns in all calls to
631  B<PutFeature>. (In particular, the column header names are computed on the first  B<PutFeature>. (In particular, the column header names are computed on the first
# Line 629  Line 635 
635      if (! $essentialFlag) {      if (! $essentialFlag) {
636          $essentialFlag = undef;          $essentialFlag = undef;
637      }      }
638      $fq->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor);      $fd->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor);
639      $shelp->PutFeature($fq);      $shelp->PutFeature($fd);
640    
641  =over 4  =over 4
642    
643  =item fquery  =item fdata
644    
645  FeatureQuery object containing the current feature data.  B<FeatureData> object containing the current feature data.
646    
647  =back  =back
648    
# Line 644  Line 650 
650    
651  sub PutFeature {  sub PutFeature {
652      # Get the parameters.      # Get the parameters.
653      my ($self, $fq) = @_;      my ($self, $fd) = @_;
654      # Get the CGI query object.      # Get the CGI query object.
655      my $cgi = $self->Q();      my $cgi = $self->Q();
656      # Get the feature data.      # Get the feature data.
657      my $record = $fq->Feature();      my $record = $fd->Feature();
658      my $extraCols = $fq->ExtraCols();      my $extraCols = $fd->ExtraCols();
659      # Check for a first-call situation.      # Check for a first-call situation.
660      if (! defined $self->{cols}) {      if (! defined $self->{cols}) {
661          # Here we need to set up the column information. Start with the defaults.          Trace("Setting up the columns.") if T(3);
662          $self->{cols} = $self->DefaultFeatureColumns();          # Here we need to set up the column information. Start with the extras,
663          # Add the externals if they were requested.          # sorted by column name.
664          if ($cgi->param('ShowAliases')) {          my @colNames = ();
             push @{$self->{cols}}, 'alias';  
         }  
         # Append the extras, sorted by column name.  
665          for my $col (sort keys %{$extraCols}) {          for my $col (sort keys %{$extraCols}) {
666              push @{$self->{cols}}, "X=$col";              push @colNames, "X=$col";
667          }          }
668            # Add the default columns.
669            push @colNames, $self->DefaultFeatureColumns();
670            # Add any additional columns requested by the feature filter.
671            push @colNames, FeatureQuery::AdditionalColumns($self);
672            # Save the full list.
673            $self->{cols} = \@colNames;
674          # Write out the column headers. This also prepares the cache file to receive          # Write out the column headers. This also prepares the cache file to receive
675          # output.          # output.
676          $self->WriteColumnHeaders(map { $self->FeatureColumnTitle($_) } @{$self->{cols}});          $self->WriteColumnHeaders(map { $self->FeatureColumnTitle($_) } @{$self->{cols}});
677      }      }
678      # Get the feature ID.      # Get the feature ID.
679      my ($fid) = $record->Value('Feature(id)');      my $fid = $fd->FID();
680      # Loop through the column headers, producing the desired data.      # Loop through the column headers, producing the desired data.
681      my @output = ();      my @output = ();
682      for my $colName (@{$self->{cols}}) {      for my $colName (@{$self->{cols}}) {
683          push @output, $self->FeatureColumnValue($colName, $record, $extraCols);          push @output, $self->FeatureColumnValue($colName, $record, $extraCols);
684      }      }
685      # Compute the sort key. The sort key floats NMPDR organism features to the      # Compute the sort key. The sort key usually floats NMPDR organism features to the
686      # top of the return list.      # top of the return list.
687      my $key = $self->SortKey($record);      my $key = $self->SortKey($fd);
688      # Write the feature data.      # Write the feature data.
689      $self->WriteColumnData($key, @output);      $self->WriteColumnData($key, @output);
690  }  }
# Line 756  Line 765 
765      # Check for an open session file.      # Check for an open session file.
766      if (defined $self->{fileHandle}) {      if (defined $self->{fileHandle}) {
767          # We found one, so close it.          # We found one, so close it.
768            Trace("Closing session file.") if T(2);
769          close $self->{fileHandle};          close $self->{fileHandle};
770      }      }
771  }  }
# Line 823  Line 833 
833                                                      ['Genome(genus)', 'Genome(species)',                                                      ['Genome(genus)', 'Genome(species)',
834                                                       'Genome(unique-characterization)',                                                       'Genome(unique-characterization)',
835                                                       'Genome(primary-group)']);                                                       'Genome(primary-group)']);
836          # Null out the supporting group.          # Format and cache the name and display group.
837          $group = "" if ($group eq $FIG_Config::otherGroup);          ($orgName, $group) = $self->SaveOrganismData($group, $genomeID, $genus, $species,
838          # If the organism does not exist, format an unknown name.                                                              $strain);
         if (! defined($genus)) {  
             $orgName = "Unknown Genome $genomeID";  
         } else {  
             # It does exist, so format the organism name.  
             $orgName = "$genus $species";  
             if ($strain) {  
                 $orgName .= " $strain";  
             }  
         }  
         # Save this organism in the cache.  
         $cache->{$genomeID} = [$orgName, $group];  
839      }      }
840      # Return the result.      # Return the result.
841      return ($orgName, $group);      return ($orgName, $group);
# Line 987  Line 986 
986      my ($self, $incomingType, $desiredType, $sequence) = @_;      my ($self, $incomingType, $desiredType, $sequence) = @_;
987      # Declare the return variable. If an error occurs, it will remain undefined.      # Declare the return variable. If an error occurs, it will remain undefined.
988      my $retVal;      my $retVal;
989        # This variable will be cleared if an error is detected.
990        my $okFlag = 1;
991      # Create variables to hold the FASTA label and data.      # Create variables to hold the FASTA label and data.
992      my ($fastaLabel, $fastaData);      my ($fastaLabel, $fastaData);
993        Trace("FASTA incoming type is $incomingType, desired type is $desiredType.") if T(4);
994      # Check for a feature specification.      # Check for a feature specification.
995      if ($sequence =~ /^\s*(\w+\|\S+)\s*$/) {      if ($sequence =~ /^\s*(\w+\|\S+)\s*$/) {
996          # Here we have a feature ID in $1. We'll need the Sprout object to process          # Here we have a feature ID in $1. We'll need the Sprout object to process
997          # it.          # it.
998          my $fid = $1;          my $fid = $1;
999            Trace("Feature ID for fasta is $fid.") if T(3);
1000          my $sprout = $self->DB();          my $sprout = $self->DB();
1001          # Get the FIG ID. Note that we only use the first feature found. We are not          # Get the FIG ID. Note that we only use the first feature found. We are not
1002          # supposed to have redundant aliases, though we may have an ID that doesn't          # supposed to have redundant aliases, though we may have an ID that doesn't
# Line 1001  Line 1004 
1004          my ($figID) = $sprout->FeaturesByAlias($fid);          my ($figID) = $sprout->FeaturesByAlias($fid);
1005          if (! $figID) {          if (! $figID) {
1006              $self->SetMessage("No feature found with the ID \"$fid\".");              $self->SetMessage("No feature found with the ID \"$fid\".");
1007                $okFlag = 0;
1008          } else {          } else {
1009              # Set the FASTA label.              # Set the FASTA label.
1010              my $fastaLabel = $fid;              my $fastaLabel = $fid;
1011              # Now proceed according to the sequence type.              # Now proceed according to the sequence type.
1012              if ($desiredType =~ /prot/i) {              if ($desiredType eq 'prot') {
1013                  # We want protein, so get the translation.                  # We want protein, so get the translation.
1014                  $fastaData = $sprout->FeatureTranslation($figID);                  $fastaData = $sprout->FeatureTranslation($figID);
1015                    Trace(length $fastaData . " characters returned for translation of $fastaLabel.") if T(3);
1016              } else {              } else {
1017                  # We want DNA, so get the DNA sequence. This is a two-step process.                  # We want DNA, so get the DNA sequence. This is a two-step process.
1018                  my @locList = $sprout->FeatureLocation($figID);                  my @locList = $sprout->FeatureLocation($figID);
1019                  $fastaData = $sprout->DNASeq(\@locList);                  $fastaData = $sprout->DNASeq(\@locList);
1020                    Trace(length $fastaData . " characters returned for DNA of $fastaLabel.") if T(3);
1021              }              }
1022          }          }
1023      } elsif ($incomingType =~ /prot/ && $desiredType =~ /dna/) {      } elsif ($incomingType eq 'prot' && $desiredType eq 'dna') {
1024          # Here we're being asked to do an impossible conversion.          # Here we're being asked to do an impossible conversion.
1025          $self->SetMessage("Cannot convert a protein sequence to DNA.");          $self->SetMessage("Cannot convert a protein sequence to DNA.");
1026            $okFlag = 0;
1027      } else {      } else {
1028            Trace("Analyzing FASTA sequence.") if T(4);
1029          # Here we are expecting a FASTA. We need to see if there's a label.          # Here we are expecting a FASTA. We need to see if there's a label.
1030          if ($sequence =~ /^>\s*(\S.*)\s*\n(.+)$/) {          if ($sequence =~ /^>[\n\s]*(\S[^\n]*)\n(.+)$/s) {
1031                Trace("Label \"$1\" found in match to sequence:\n$sequence") if T(4);
1032              # Here we have a label, so we split it from the data.              # Here we have a label, so we split it from the data.
1033              $fastaLabel = $1;              $fastaLabel = $1;
1034              $fastaData = $2;              $fastaData = $2;
1035          } else {          } else {
1036                Trace("No label found in match to sequence:\n$sequence") if T(4);
1037              # Here we have no label, so we create one and use the entire sequence              # Here we have no label, so we create one and use the entire sequence
1038              # as data.              # as data.
1039              $fastaLabel = "User-specified $incomingType sequence";              $fastaLabel = "User-specified $incomingType sequence";
# Line 1036  Line 1046 
1046          # we've already prevented a conversion from protein to DNA.          # we've already prevented a conversion from protein to DNA.
1047          if ($incomingType ne $desiredType) {          if ($incomingType ne $desiredType) {
1048              $fastaData = Sprout::Protein($fastaData);              $fastaData = Sprout::Protein($fastaData);
1049                # Check for bad characters.
1050                if ($fastaData =~ /X/) {
1051                    $self->SetMessage("Invalid characters detected. Is the input really of type $incomingType?");
1052                    $okFlag = 0;
1053                }
1054            } elsif ($desiredType eq 'dna' && $fastaData =~ /[^agct]/i) {
1055                $self->SetMessage("Invaid characters detected. Is the input really a DNA sequence?");
1056                $okFlag = 0;
1057          }          }
1058      }      }
1059      # At this point, either "$fastaLabel" and "$fastaData" have values or an error is      Trace("FASTA data sequence: $fastaData") if T(4);
1060      # in progress.      # Only proceed if no error was detected.
1061      if (defined $fastaLabel) {      if ($okFlag) {
1062          # We need to format the sequence into 60-byte chunks. We use the infamous          # We need to format the sequence into 60-byte chunks. We use the infamous
1063          # grep-split trick. The split, because of the presence of the parentheses,          # grep-split trick. The split, because of the presence of the parentheses,
1064          # includes the matched delimiters in the output list. The grep strips out          # includes the matched delimiters in the output list. The grep strips out
1065          # the empty list items that appear between the so-called delimiters, since          # the empty list items that appear between the so-called delimiters, since
1066          # the delimiters are what we want.          # the delimiters are what we want.
1067          my @chunks = grep { $_ } split /(.{1,60})/, $fastaData;          my @chunks = grep { $_ } split /(.{1,60})/, $fastaData;
1068          my $retVal = join("\n", ">$fastaLabel", @chunks, "");          $retVal = join("\n", ">$fastaLabel", @chunks, "");
1069      }      }
1070      # Return the result.      # Return the result.
1071      return $retVal;      return $retVal;
# Line 1082  Line 1100 
1100  Number of rows to display. If omitted, the default is 1 for a single-select list  Number of rows to display. If omitted, the default is 1 for a single-select list
1101  and 10 for a multi-select list.  and 10 for a multi-select list.
1102    
1103    =item crossMenu (optional)
1104    
1105    If specified, is presumed to be the name of another genome menu whose contents
1106    are to be mutually exclusive with the contents of this menu. As a result, instead
1107    of the standard onChange event, the onChange event will deselect any entries in
1108    the other menu.
1109    
1110  =item RETURN  =item RETURN
1111    
1112  Returns the HTML text to generate a C<SELECT> menu inside a form.  Returns the HTML text to generate a C<SELECT> menu inside a form.
# Line 1092  Line 1117 
1117    
1118  sub NmpdrGenomeMenu {  sub NmpdrGenomeMenu {
1119      # Get the parameters.      # Get the parameters.
1120      my ($self, $menuName, $multiple, $selected, $rows) = @_;      my ($self, $menuName, $multiple, $selected, $rows, $cross) = @_;
1121      # Get the Sprout and CGI objects.      # Get the Sprout and CGI objects.
1122      my $sprout = $self->DB();      my $sprout = $self->DB();
1123      my $cgi = $self->Q();      my $cgi = $self->Q();
# Line 1126  Line 1151 
1151          for my $genome (@genomeList) {          for my $genome (@genomeList) {
1152              # Get the genome data.              # Get the genome data.
1153              my ($group, $genomeID, $genus, $species, $strain) = @{$genome};              my ($group, $genomeID, $genus, $species, $strain) = @{$genome};
1154              # Form the genome name.              # Compute and cache its name and display group.
1155              my $name = "$genus $species";              my ($name, $displayGroup) = $self->SaveOrganismData($group, $genomeID, $genus, $species,
1156              if ($strain) {                                                                  $strain);
1157                  $name .= " $strain";              # Push the genome into the group's list. Note that we use the real group
1158              }              # name here, not the display group name.
             # Push the genome into the group's list.  
1159              push @{$gHash{$group}}, [$genomeID, $name];              push @{$gHash{$group}}, [$genomeID, $name];
1160          }          }
1161          # Save the genome list for future use.          # Save the genome list for future use.
# Line 1148  Line 1172 
1172      if (defined $selected) {      if (defined $selected) {
1173          %selectedHash = map { $_ => 1 } grep { defined($_) } @{$selected};          %selectedHash = map { $_ => 1 } grep { defined($_) } @{$selected};
1174      }      }
1175      # Now it gets complicated. We need a way to mark all the NMPDR genomes.      # Now it gets complicated. We need a way to mark all the NMPDR genomes. We take advantage
1176        # of the fact they come first in the list. We'll accumulate a count of the NMPDR genomes
1177        # and use that to make the selections.
1178        my $nmpdrCount = 0;
1179      # Create the type counters.      # Create the type counters.
1180      my $groupCount = 1;      my $groupCount = 1;
1181      # Compute the ID for the status display.      # Compute the ID for the status display.
# Line 1157  Line 1184 
1184      my $showSelect = "showSelected($menuName, '$divID', 1000);";      my $showSelect = "showSelected($menuName, '$divID', 1000);";
1185      # If multiple selection is supported, create an onChange event.      # If multiple selection is supported, create an onChange event.
1186      my $onChange = "";      my $onChange = "";
1187      if ($multiple) {      if ($cross) {
1188            # Here we have a paired menu. Selecting something in our menu unselects it in the
1189            # other and redisplays the status of both.
1190            $onChange = " onChange=\"crossUnSelect($menuName, '$divID', $cross, '${formName}_${cross}_status', 1000)\"";
1191        } elsif ($multiple) {
1192            # This is an unpaired menu, so all we do is redisplay our status.
1193          $onChange = " onChange=\"$showSelect\"";          $onChange = " onChange=\"$showSelect\"";
1194      }      }
1195      # Create the SELECT tag and stuff it into the output array.      # Create the SELECT tag and stuff it into the output array.
1196      my $select = "<SELECT name=\"$menuName\"$onChange$multipleTag size=\"$rows\">";      my @lines = ("<SELECT name=\"$menuName\"$onChange$multipleTag size=\"$rows\">");
     my @lines = ($select);  
1197      # Loop through the groups.      # Loop through the groups.
1198      for my $group (@groups) {      for my $group (@groups) {
1199          # Create the option group tag.          # Create the option group tag.
1200          my $tag = "<OPTGROUP label=\"$group\">";          my $tag = "<OPTGROUP label=\"$group\">";
1201          push @lines, "  $tag";          push @lines, "  $tag";
         # Compute the label for this group's options. This is seriously dirty stuff, as the  
         # label option may have functionality in future browsers. If that happens, we'll need  
         # to modify the genome text so that the "selectSome" method can tell which are NMPDR  
         # organisms and which aren't. Sadly, the OPTGROUP tag is invisible in the DOM Javascript  
         # hierarchy, so we can't use it.  
         my $label = ($group eq $FIG_Config::otherGroup ? "other" : "nmpdr");  
1202          # Get the genomes in the group.          # Get the genomes in the group.
1203          for my $genome (@{$groupHash->{$group}}) {          for my $genome (@{$groupHash->{$group}}) {
1204                # Count this organism if it's NMPDR.
1205                if ($group ne $FIG_Config::otherGroup) {
1206                    $nmpdrCount++;
1207                }
1208                # Get the organism ID and name.
1209              my ($genomeID, $name) = @{$genome};              my ($genomeID, $name) = @{$genome};
1210              # See if it's selected.              # See if it's selected.
1211              my $select = ($selectedHash{$genomeID} ? " selected" : "");              my $select = ($selectedHash{$genomeID} ? " selected" : "");
1212              # Generate the option tag.              # Generate the option tag.
1213              my $optionTag = "<OPTION value=\"$genomeID\" label=\"$label\"$select>$name <em>($genomeID)</em></OPTION>";              my $optionTag = "<OPTION value=\"$genomeID\"$select>$name <em>($genomeID)</em></OPTION>";
1214              push @lines, "    $optionTag";              push @lines, "    $optionTag";
1215          }          }
1216          # Close the option group.          # Close the option group.
# Line 1194  Line 1224 
1224          push @lines, "<br />";          push @lines, "<br />";
1225          push @lines, "<INPUT type=\"button\" name=\"SelectAll\" class=\"bigButton\" value=\"Select All\" onClick=\"selectAll($menuName); $showSelect\" />";          push @lines, "<INPUT type=\"button\" name=\"SelectAll\" class=\"bigButton\" value=\"Select All\" onClick=\"selectAll($menuName); $showSelect\" />";
1226          push @lines, "<INPUT type=\"button\" name=\"ClearAll\" class=\"bigButton\"  value=\"Clear All\" onClick=\"clearAll($menuName); $showSelect\" />";          push @lines, "<INPUT type=\"button\" name=\"ClearAll\" class=\"bigButton\"  value=\"Clear All\" onClick=\"clearAll($menuName); $showSelect\" />";
1227          push @lines, "<INPUT type=\"button\" name=\"NMPDROnly\" class=\"bigButton\"  value=\"Select NMPDR\" onClick=\"selectSome($menuName, 'nmpdr'); $showSelect\" />";          push @lines, "<INPUT type=\"button\" name=\"NMPDROnly\" class=\"bigButton\"  value=\"Select NMPDR\" onClick=\"selectSome($menuName, $nmpdrCount, true); $showSelect\" />";
1228          push @lines, "<INPUT type=\"button\" name=\"OtherOnly\" class=\"bigButton\" value=\"Select Supporting\" onClick=\"selectSome($menuName, 'other'); $showSelect\" />";          push @lines, "<INPUT type=\"button\" name=\"OtherOnly\" class=\"bigButton\" value=\"Select Supporting\" onClick=\"selectSome($menuName, $nmpdrCount, false); $showSelect\" />";
1229          # Now add the search box. This allows the user to type text and have all genomes containing          # Now add the search box. This allows the user to type text and have all genomes containing
1230          # the text selected automatically.          # the text selected automatically.
1231          my $searchThingName = "${menuName}_SearchThing";          my $searchThingName = "${menuName}_SearchThing";
# Line 1338  Line 1368 
1368      # Create the row.      # Create the row.
1369      my $retVal = $cgi->Tr($cgi->td("Results/Page"),      my $retVal = $cgi->Tr($cgi->td("Results/Page"),
1370                            $cgi->td($cgi->popup_menu(-name => 'PageSize',                            $cgi->td($cgi->popup_menu(-name => 'PageSize',
1371                                                      -values => [10, 25, 45, 100, 1000],                                                      -values => [10, 25, 50, 100, 1000],
1372                                                      -default => $pageSize) . " " .                                                      -default => $pageSize) . " " .
1373                                     $cgi->checkbox(-name => 'ShowURL',                                     $cgi->checkbox(-name => 'ShowURL',
1374                                                    -value => 1,                                                    -value => 1,
# Line 1354  Line 1384 
1384    
1385  C<< my $htmlText = $shelp->FeatureFilterRows(); >>  C<< my $htmlText = $shelp->FeatureFilterRows(); >>
1386    
1387  This method creates table rows that can be used to filter features. There are  This method creates table rows that can be used to filter features. The form
1388  two rows returned, and the values can be used to select features by genome  values can be used to select features by genome using the B<FeatureQuery>
1389  using the B<FeatureQuery> object.  object.
1390    
1391  =cut  =cut
1392    
# Line 1406  Line 1436 
1436          # Get the feature location string.          # Get the feature location string.
1437          my $loc = $sprout->FeatureLocation($feat);          my $loc = $sprout->FeatureLocation($feat);
1438          # Compute the contig, start, and stop points.          # Compute the contig, start, and stop points.
1439          my($start, $stop, $contig) = BasicLocation::Parse($loc);          my($contig, $start, $stop) = BasicLocation::Parse($loc);
1440            Trace("Start and stop are ($start,$stop) on contig $contig.") if T(3);
1441          # Now we need to do some goofiness to insure that the location is not too          # Now we need to do some goofiness to insure that the location is not too
1442          # big and that we get some surrounding stuff.          # big and that we get some surrounding stuff.
1443          my $mid = int(($start + $stop) / 2);          my $mid = int(($start + $stop) / 2);
# Line 1436  Line 1467 
1467          }          }
1468          my $seg_id = $contig;          my $seg_id = $contig;
1469          $seg_id =~ s/:/--/g;          $seg_id =~ s/:/--/g;
1470            Trace("Show limits are ($show_start,$show_stop) in genome $genomeID with ref $seg_id.") if T(3);
1471          # Assemble all the pieces.          # Assemble all the pieces.
1472          $retVal = "gbrowse.cgi/GB_$genomeID?ref=$seg_id&start=$show_start&stop=$show_stop";          $retVal = "gbrowse.cgi/GB_$genomeID?ref=$seg_id&start=$show_start&stop=$show_stop";
1473      }      }
# Line 1571  Line 1603 
1603          # a singleton list, but that's okay.          # a singleton list, but that's okay.
1604          my @values = split (/\0/, $parms{$parmKey});          my @values = split (/\0/, $parms{$parmKey});
1605          # Check for special cases.          # Check for special cases.
1606          if ($parmKey eq 'featureTypes') {          if (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF ShowURL)) {
             # Here we need to see if the user wants all the feature types. If he  
             # does, we erase all the values so that the parameter is not output.  
             my %valueCheck = map { $_ => 1 } @values;  
             my @list = FeatureQuery::AllFeatureTypes();  
             my $okFlag = 1;  
             for (my $i = 0; $okFlag && $i <= $#list; $i++) {  
                 if (! $valueCheck{$list[$i]}) {  
                     $okFlag = 0;  
                 }  
             }  
             if ($okFlag) {  
                 @values = ();  
             }  
         } elsif (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF ShowURL)) {  
1607              # These are bookkeeping parameters we don't need to start a search.              # These are bookkeeping parameters we don't need to start a search.
1608              @values = ();              @values = ();
1609          } elsif ($parmKey =~ /_SearchThing$/) {          } elsif ($parmKey =~ /_SearchThing$/) {
# Line 1647  Line 1665 
1665      return $retVal;      return $retVal;
1666  }  }
1667    
1668    =head3 AdvancedClassList
1669    
1670    C<< my @classes = SearchHelper::AdvancedClassList(); >>
1671    
1672    Return a list of advanced class names. This list is used to generate the directory
1673    of available searches on the search page.
1674    
1675    The reason we have to convert the list from a string is that the B<NMPDRSetup.pl>
1676    script is only able to insert strings into the generated B<FIG_Config> file.
1677    
1678    =cut
1679    
1680    sub AdvancedClassList {
1681        return split /\s+/, $FIG_Config::advanced_classes;
1682    }
1683    
1684  =head2 Feature Column Methods  =head2 Feature Column Methods
1685    
1686  The methods in this column manage feature column data. If you want to provide the  The methods in this column manage feature column data. If you want to provide the
# Line 1667  Line 1701 
1701    
1702  =head3 DefaultFeatureColumns  =head3 DefaultFeatureColumns
1703    
1704  C<< my $colNames = $shelp->DefaultFeatureColumns(); >>  C<< my @colNames = $shelp->DefaultFeatureColumns(); >>
1705    
1706  Return a reference to a list of the default feature column identifiers. These  Return a list of the default feature column identifiers. These identifiers can
1707  identifiers can be passed to L</FeatureColumnTitle> and L</FeatureColumnValue> in  be passed to L</FeatureColumnTitle> and L</FeatureColumnValue> in order to
1708  order to produce the column titles and row values.  produce the column titles and row values.
1709    
1710  =cut  =cut
1711    
# Line 1679  Line 1713 
1713      # Get the parameters.      # Get the parameters.
1714      my ($self) = @_;      my ($self) = @_;
1715      # Return the result.      # Return the result.
1716      return ['orgName', 'function', 'gblink', 'protlink',      return qw(orgName function gblink protlink);
             FeatureQuery::AdditionalColumns($self)];  
1717  }  }
1718    
1719  =head3 FeatureColumnTitle  =head3 FeatureColumnTitle
# Line 1712  Line 1745 
1745      if ($colName =~ /^X=(.+)$/) {      if ($colName =~ /^X=(.+)$/) {
1746          # Here we have an extra column.          # Here we have an extra column.
1747          $retVal = $1;          $retVal = $1;
     } elsif ($colName eq 'orgName') {  
         $retVal = "Name";  
     } elsif ($colName eq 'fid') {  
         $retVal = "FIG ID";  
1748      } elsif ($colName eq 'alias') {      } elsif ($colName eq 'alias') {
1749          $retVal = "External Aliases";          $retVal = "External Aliases";
1750        } elsif ($colName eq 'fid') {
1751            $retVal = "FIG ID";
1752      } elsif ($colName eq 'function') {      } elsif ($colName eq 'function') {
1753          $retVal = "Functional Assignment";          $retVal = "Functional Assignment";
1754      } elsif ($colName eq 'gblink') {      } elsif ($colName eq 'gblink') {
1755          $retVal = "GBrowse";          $retVal = "GBrowse";
     } elsif ($colName eq 'protlink') {  
         $retVal = "NMPDR Protein Page";  
1756      } elsif ($colName eq 'group') {      } elsif ($colName eq 'group') {
1757          $retVal = "NMDPR Group";          $retVal = "NMDPR Group";
1758        } elsif ($colName =~ /^keyword:(.+)$/) {
1759            $retVal = ucfirst $1;
1760        } elsif ($colName eq 'orgName') {
1761            $retVal = "Feature Name";
1762        } elsif ($colName eq 'protlink') {
1763            $retVal = "NMPDR Protein Page";
1764        } elsif ($colName eq 'subsystem') {
1765            $retVal = "Subsystems";
1766      }      }
1767      # Return the result.      # Return the result.
1768      return $retVal;      return $retVal;
1769  }  }
1770    
1771    
1772  =head3 FeatureColumnValue  =head3 FeatureColumnValue
1773    
1774  C<< my $value = $shelp->FeatureColumnValue($colName, $fid, \%extraCols); >>  C<< my $value = $shelp->FeatureColumnValue($colName, $fid, \%extraCols); >>
# Line 1781  Line 1819 
1819          if (defined $extraCols->{$1}) {          if (defined $extraCols->{$1}) {
1820              $retVal = $extraCols->{$1};              $retVal = $extraCols->{$1};
1821          }          }
     } elsif ($colName eq 'orgName') {  
         # Here we want the formatted organism name and feature number.  
         $retVal = $self->FeatureName($fid);  
     } elsif ($colName eq 'fid') {  
         # Here we have the raw feature ID. We hyperlink it to the protein page.  
         $retVal = HTML::set_prot_links($fid);  
1822      } elsif ($colName eq 'alias') {      } elsif ($colName eq 'alias') {
1823          # In this case, the user wants a list of external aliases for the feature.          # In this case, the user wants a list of external aliases for the feature.
1824          # These are very expensive, so we compute them when the row is displayed.          # These are very expensive, so we compute them when the row is displayed.
1825          $retVal = "%%aliases=$fid";          $retVal = "%%alias=$fid";
1826        } elsif ($colName eq 'fid') {
1827            # Here we have the raw feature ID. We hyperlink it to the protein page.
1828            $retVal = HTML::set_prot_links($fid);
1829      } elsif ($colName eq 'function') {      } elsif ($colName eq 'function') {
1830          # The functional assignment is just a matter of getting some text.          # The functional assignment is just a matter of getting some text.
1831          ($retVal) = $record->Value('Feature(assignment)');          ($retVal) = $record->Value('Feature(assignment)');
# Line 1801  Line 1836 
1836                            $cgi->img({ src => "../images/button-gbrowse.png",                            $cgi->img({ src => "../images/button-gbrowse.png",
1837                                        border => 0 })                                        border => 0 })
1838                           );                           );
     } elsif ($colName eq 'protlink') {  
         # Here we want a link to the protein page using the official NMPDR button.  
         my $hurl = HTML::fid_link($cgi, $fid, 0, 1);  
         $retVal = $cgi->a({ href => $hurl, title => "Protein page for $fid" },  
                           $cgi->img({ src => "../images/button-nmpdr.png",  
                                      border => 0 })  
                          );  
1839      } elsif ($colName eq 'group') {      } elsif ($colName eq 'group') {
1840          # Get the NMPDR group name.          # Get the NMPDR group name.
1841          my (undef, $group) = $self->OrganismData($fid);          my (undef, $group) = $self->OrganismData($fid);
# Line 1815  Line 1843 
1843          my $nurl = $sprout->GroupPageName($group);          my $nurl = $sprout->GroupPageName($group);
1844          $retVal = $cgi->a({ href => $nurl, title => "$group summary" },          $retVal = $cgi->a({ href => $nurl, title => "$group summary" },
1845                            $group);                            $group);
1846        } elsif ($colName =~ /^keyword:(.+)$/) {
1847            # Here we want keyword-related values. This is also expensive, so
1848            # we compute them when the row is displayed.
1849            $retVal = "%%$colName=$fid";
1850        } elsif ($colName eq 'orgName') {
1851            # Here we want the formatted organism name and feature number.
1852            $retVal = $self->FeatureName($fid);
1853        } elsif ($colName eq 'protlink') {
1854            # Here we want a link to the protein page using the official NMPDR button.
1855            my $hurl = HTML::fid_link($cgi, $fid, 0, 1);
1856            $retVal = $cgi->a({ href => $hurl, title => "Protein page for $fid" },
1857                              $cgi->img({ src => "../images/button-nmpdr.png",
1858                                         border => 0 })
1859                             );
1860        }elsif ($colName eq 'subsystem') {
1861            # Another run-time column: subsystem list.
1862            $retVal = "%%subsystem=$fid";
1863      }      }
1864      # Return the result.      # Return the result.
1865      return $retVal;      return $retVal;
# Line 1853  Line 1898 
1898      # Get the Sprout and CGI objects.      # Get the Sprout and CGI objects.
1899      my $sprout = $self->DB();      my $sprout = $self->DB();
1900      my $cgi = $self->Q();      my $cgi = $self->Q();
1901        Trace("Runtime column $type with text \"$text\" found.") if T(4);
1902      # Separate the text into a type and data.      # Separate the text into a type and data.
1903      if ($type eq 'aliases') {      if ($type eq 'alias') {
1904          # Here the caller wants external alias links for a feature. The text          # Here the caller wants external alias links for a feature. The text
1905          # is the feature ID.          # is the feature ID.
1906          my $fid = $text;          my $fid = $text;
# Line 1869  Line 1915 
1915              # Ask the HTML processor to hyperlink them.              # Ask the HTML processor to hyperlink them.
1916              $retVal = HTML::set_prot_links($cgi, $aliasList);              $retVal = HTML::set_prot_links($cgi, $aliasList);
1917          }          }
1918        } elsif ($type eq 'subsystem') {
1919            # Here the caller wants the subsystems in which this feature participates.
1920            # The text is the feature ID. We will list the subsystem names with links
1921            # to the subsystem's summary page.
1922            my $fid = $text;
1923            # Get the subsystems.
1924            Trace("Generating subsystems for feature $fid.") if T(4);
1925            my %subs = $sprout->SubsystemsOf($fid);
1926            # Convert them to links.
1927            my @links = map { HTML::sub_link($cgi, $_) } sort keys %subs;
1928            # String them into a list.
1929            $retVal = join(", ", @links);
1930        } elsif ($type =~ /^keyword:(.+)$/) {
1931            # Here the caller wants the value of the named keyword. The text is the
1932            # feature ID.
1933            my $keywordName = $1;
1934            my $fid = $text;
1935            # Get the attribute values.
1936            Trace("Getting $keywordName values for feature $fid.") if T(4);
1937            my @values = $sprout->GetFlat(['Feature'], "Feature(id) = ?", [$fid],
1938                                          "Feature($keywordName)");
1939            # String them into a list.
1940            $retVal = join(", ", @values);
1941      }      }
1942      # Return the result.      # Return the result.
1943      return $retVal;      return $retVal;
1944  }  }
1945    
1946    =head3 SaveOrganismData
1947    
1948    C<< my ($name, $displayGroup) = $shelp->SaveOrganismData($group, $genomeID, $genus, $species, $strain); >>
1949    
1950    Format the name of an organism and the display version of its group name. The incoming
1951    data should be the relevant fields from the B<Genome> record in the database. The
1952    data will also be stored in the genome cache for later use in posting search results.
1953    
1954    =over 4
1955    
1956    =item group
1957    
1958    Name of the genome's group as it appears in the database.
1959    
1960    =item genomeID
1961    
1962    ID of the relevant genome.
1963    
1964    =item genus
1965    
1966    Genus of the genome's organism. If undefined or null, it will be assumed the genome is not
1967    in the database. In this case, the organism name is derived from the genomeID and the group
1968    is automatically the supporting-genomes group.
1969    
1970    =item species
1971    
1972    Species of the genome's organism.
1973    
1974    =item strain
1975    
1976    Strain of the species represented by the genome.
1977    
1978    =item RETURN
1979    
1980    Returns a two-element list. The first element is the formatted genome name. The second
1981    element is the display name of the genome's group.
1982    
1983    =back
1984    
1985    =cut
1986    
1987    sub SaveOrganismData {
1988        # Get the parameters.
1989        my ($self, $group, $genomeID, $genus, $species, $strain) = @_;
1990        # Declare the return values.
1991        my ($name, $displayGroup);
1992        # If the organism does not exist, format an unknown name and a blank group.
1993        if (! defined($genus)) {
1994            $name = "Unknown Genome $genomeID";
1995            $displayGroup = "";
1996        } else {
1997            # It does exist, so format the organism name.
1998            $name = "$genus $species";
1999            if ($strain) {
2000                $name .= " $strain";
2001            }
2002            # Compute the display group. This is currently the same as the incoming group
2003            # name unless it's the supporting group, which is nulled out.
2004            $displayGroup = ($group eq $FIG_Config::otherGroup ? "" : $group);
2005        }
2006        # Cache the group and organism data.
2007        my $cache = $self->{orgs};
2008        $cache->{$genomeID} = [$name, $displayGroup];
2009        # Return the result.
2010        return ($name, $displayGroup);
2011    }
2012    
2013  =head2 Virtual Methods  =head2 Virtual Methods
2014    
2015  =head3 Form  =head3 Form
# Line 1901  Line 2037 
2037    
2038  =head3 SortKey  =head3 SortKey
2039    
2040  C<< my $key = $shelp->SortKey($record); >>  C<< my $key = $shelp->SortKey($fdata); >>
2041    
2042  Return the sort key for the specified record. The default is to sort by feature name,  Return the sort key for the specified feature data. The default is to sort by feature name,
2043  floating NMPDR organisms to the top. This sort may be overridden by the search class  floating NMPDR organisms to the top. If a full-text search is used, then the default
2044  to provide fancier functionality. This method is called by B<PutFeature>, so it  sort is by relevance followed by feature name. This sort may be overridden by the
2045  is only used for feature searches. A non-feature search would presumably have its  search class to provide fancier functionality. This method is called by
2046  own sort logic.  B<PutFeature>, so it is only used for feature searches. A non-feature search
2047    would presumably have its own sort logic.
2048    
2049  =over 4  =over 4
2050    
2051  =item record  =item record
2052    
2053  The C<DBObject> from which the current row of data is derived.  The C<FeatureData> containing the current feature.
2054    
2055  =item RETURN  =item RETURN
2056    
# Line 1925  Line 2062 
2062    
2063  sub SortKey {  sub SortKey {
2064      # Get the parameters.      # Get the parameters.
2065      my ($self, $record) = @_;      my ($self, $fdata) = @_;
2066      # Get the feature ID from the record.      # Get the feature ID from the record.
2067      my ($fid) = $record->Value('Feature(id)');      my $fid = $fdata->FID();
2068      # Get the group from the feature ID.      # Get the group from the feature ID.
2069      my $group = $self->FeatureGroup($fid);      my $group = $self->FeatureGroup($fid);
2070      # Ask the feature query object to form the sort key.      # Ask the feature query object to form the sort key.
2071      my $retVal = FeatureQuery::SortKey($self, $group, $record);      my $retVal = $fdata->SortKey($self, $group);
2072      # Return the result.      # Return the result.
2073      return $retVal;      return $retVal;
2074  }  }
2075    
2076  1;  1;

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.14

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3