[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.2, Wed Sep 27 16:55:38 2006 UTC revision 1.12, Mon Oct 16 22:58:37 2006 UTC
# Line 17  Line 17 
17      use HTML;      use HTML;
18      use BasicLocation;      use BasicLocation;
19      use FeatureQuery;      use FeatureQuery;
20        use URI::Escape;
21        use PageBuilder;
22    
23  =head1 Search Helper Base Class  =head1 Search Helper Base Class
24    
# Line 73  Line 75 
75    
76  List of JavaScript statements to be executed after the form is closed.  List of JavaScript statements to be executed after the form is closed.
77    
78    =item genomeHash
79    
80    Cache of the genome group hash used to build genome selection controls.
81    
82    =item genomeParms
83    
84    List of the parameters that are used to select multiple genomes.
85    
86    =item filtered
87    
88    TRUE if this is a feature-filtered search, else FALSE. B<NOTE> that this
89    field is updated by the B<FeatureQuery> object.
90    
91  =back  =back
92    
93  =head2 Adding a new Search Tool  =head2 Adding a new Search Tool
# Line 139  Line 154 
154    
155  =item 1  =item 1
156    
157  L</NmpdrGenomeMenu> generates a control for selecting one or more genomes.  L</NmpdrGenomeMenu> generates a control for selecting one or more genomes. Use
158    L</GetGenomes> to retrieve all the genomes passed in for a specified parameter
159    name. Note that as an assist to people working with GET-style links, if no
160    genomes are specified and the incoming request style is GET, all genomes will
161    be returned.
162    
163  =item 2  =item 2
164    
# Line 195  Line 214 
214                      }                      }
215                  }                  }
216              }              }
         }  
217          # Close the session file.          # Close the session file.
218          $self->CloseSession();          $self->CloseSession();
219            }
220          # Return the result count.          # Return the result count.
221          return $retVal;          return $retVal;
222      }      }
# Line 218  Line 237 
237  by calling L</SetMessage>. If the parameters are valid, then the method must return  by calling L</SetMessage>. If the parameters are valid, then the method must return
238  the number of items found.  the number of items found.
239    
 =head2 Virtual Methods  
   
 =head3 Form  
   
 C<< my $html = $shelp->Form(); >>  
   
 Generate the HTML for a form to request a new search.  
   
 =head3 Find  
   
 C<< my $resultCount = $shelp->Find(); >>  
   
 Conduct a search based on the current CGI query parameters. The search results will  
 be written to the session cache file and the number of results will be  
 returned. If the search parameters are invalid, a result count of C<undef> will be  
 returned and a result message will be stored in this object describing the problem.  
   
 =head3 Description  
   
 C<< my $htmlText = $shelp->Description(); >>  
   
 Return a description of this search. The description is used for the table of contents  
 on the main search tools page. It may contain HTML, but it should be character-level,  
 not block-level, since the description is going to appear in a list.  
   
240  =cut  =cut
241    
242  # This counter is used to insure every form on the page has a unique name.  # This counter is used to insure every form on the page has a unique name.
# Line 298  Line 292 
292                    orgs => {},                    orgs => {},
293                    name => $formName,                    name => $formName,
294                    scriptQueue => [],                    scriptQueue => [],
295                      genomeList => undef,
296                      genomeParms => [],
297                      filtered => 0,
298                   };                   };
299      # Bless and return it.      # Bless and return it.
300      bless $retVal, $class;      bless $retVal, $class;
# Line 319  Line 316 
316      return $self->{query};      return $self->{query};
317  }  }
318    
319    
320    
321  =head3 DB  =head3 DB
322    
323  C<< my $sprout = $shelp->DB(); >>  C<< my $sprout = $shelp->DB(); >>
# Line 610  Line 609 
609    
610  =head3 PutFeature  =head3 PutFeature
611    
612  C<< $shelp->PutFeature($fquery); >>  C<< $shelp->PutFeature($fdata); >>
613    
614  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
615  searches, since the primary data item in the database is features.  searches, since the primary data item in the database is features.
# Line 621  Line 620 
620  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
621  code adds columns for essentiality and virulence.  code adds columns for essentiality and virulence.
622    
623      $fq->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor);      $fd->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor);
624      $shelp->PutFeature($fq);      $shelp->PutFeature($fd);
625    
626  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
627  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 632  Line 631 
631      if (! $essentialFlag) {      if (! $essentialFlag) {
632          $essentialFlag = undef;          $essentialFlag = undef;
633      }      }
634      $fq->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor);      $fd->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor);
635      $shelp->PutFeature($fq);      $shelp->PutFeature($fd);
636    
637  =over 4  =over 4
638    
639  =item fquery  =item fdata
640    
641  FeatureQuery object containing the current feature data.  B<FeatureData> object containing the current feature data.
642    
643  =back  =back
644    
# Line 647  Line 646 
646    
647  sub PutFeature {  sub PutFeature {
648      # Get the parameters.      # Get the parameters.
649      my ($self, $fq) = @_;      my ($self, $fd) = @_;
650        # Get the CGI query object.
651        my $cgi = $self->Q();
652      # Get the feature data.      # Get the feature data.
653      my $record = $fq->Feature();      my $record = $fd->Feature();
654      my $extraCols = $fq->ExtraCols();      my $extraCols = $fd->ExtraCols();
655      # Check for a first-call situation.      # Check for a first-call situation.
656      if (! defined $self->{cols}) {      if (! defined $self->{cols}) {
657          # Here we need to set up the column information. Start with the defaults.          # Here we need to set up the column information. Start with the defaults.
658          $self->{cols} = $self->DefaultFeatureColumns();          $self->{cols} = $self->DefaultFeatureColumns();
659            # Add any additional columns requested by the feature filter.
660            push @{$self->{cols}}, FeatureQuery::AdditionalColumns($self);
661          # Append the extras, sorted by column name.          # Append the extras, sorted by column name.
662          for my $col (sort keys %{$extraCols}) {          for my $col (sort keys %{$extraCols}) {
663              push @{$self->{cols}}, "X=$col";              push @{$self->{cols}}, "X=$col";
# Line 664  Line 667 
667          $self->WriteColumnHeaders(map { $self->FeatureColumnTitle($_) } @{$self->{cols}});          $self->WriteColumnHeaders(map { $self->FeatureColumnTitle($_) } @{$self->{cols}});
668      }      }
669      # Get the feature ID.      # Get the feature ID.
670      my ($fid) = $record->Value('Feature(id)');      my $fid = $fd->FID();
671      # Loop through the column headers, producing the desired data.      # Loop through the column headers, producing the desired data.
672      my @output = ();      my @output = ();
673      for my $colName (@{$self->{cols}}) {      for my $colName (@{$self->{cols}}) {
674          push @output, $self->FeatureColumnValue($colName, $record, $extraCols);          push @output, $self->FeatureColumnValue($colName, $record, $extraCols);
675      }      }
676      # 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
677      # top of the return list.      # top of the return list.
678      my $group = $self->FeatureGroup($fid);      my $key = $self->SortKey($fd);
     my $key = ($group ? "A$group" : "ZZ");  
679      # Write the feature data.      # Write the feature data.
680      $self->WriteColumnData($key, @output);      $self->WriteColumnData($key, @output);
681  }  }
# Line 754  Line 756 
756      # Check for an open session file.      # Check for an open session file.
757      if (defined $self->{fileHandle}) {      if (defined $self->{fileHandle}) {
758          # We found one, so close it.          # We found one, so close it.
759            Trace("Closing session file.") if T(2);
760          close $self->{fileHandle};          close $self->{fileHandle};
761      }      }
762  }  }
# Line 771  Line 774 
774      my $retVal;      my $retVal;
775      # Get a digest encoder.      # Get a digest encoder.
776      my $md5 = Digest::MD5->new();      my $md5 = Digest::MD5->new();
777      # If we have a randomization file, use it to seed the digester.      # Add the PID, the IP, and the time stamp. Note that the time stamp is
778      if (open(R, "/dev/urandom")) {      # actually two numbers, and we get them both because we're in list
779          my $b;      # context.
780          read(R, $b, 1024);      $md5->add($$, $ENV{REMOTE_ADDR}, $ENV{REMOTE_PORT}, gettimeofday());
781          $md5->add($b);      # Hash up all this identifying data.
782      }      $retVal = $md5->hexdigest();
783      # Add the PID and the time stamp.      # Return the result.
     $md5->add($$, gettimeofday);  
     # Hash it up and clean the result so that it works as a file name.  
     $retVal = $md5->b64digest();  
     $retVal =~ s,/,\$,g;  
     $retVal =~ s,\+,@,g;  
     # Return it.  
784      return $retVal;      return $retVal;
785  }  }
786    
# Line 827  Line 824 
824                                                      ['Genome(genus)', 'Genome(species)',                                                      ['Genome(genus)', 'Genome(species)',
825                                                       'Genome(unique-characterization)',                                                       'Genome(unique-characterization)',
826                                                       'Genome(primary-group)']);                                                       'Genome(primary-group)']);
827          # Null out the supporting group.          # Format and cache the name and display group.
828          $group = "" if ($group eq $FIG_Config::otherGroup);          ($orgName, $group) = $self->SaveOrganismData($group, $genomeID, $genus, $species,
829          # 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];  
830      }      }
831      # Return the result.      # Return the result.
832      return ($orgName, $group);      return ($orgName, $group);
# Line 942  Line 928 
928      } else {      } else {
929          # Here we can get its genome data.          # Here we can get its genome data.
930          $retVal = $self->Organism($genomeID);          $retVal = $self->Organism($genomeID);
931          # Append the type and number.          # Append the FIG ID.
932          $retVal .= " [$type $num]";          $retVal .= " [$fid]";
933      }      }
934      # Return the result.      # Return the result.
935      return $retVal;      return $retVal;
# Line 991  Line 977 
977      my ($self, $incomingType, $desiredType, $sequence) = @_;      my ($self, $incomingType, $desiredType, $sequence) = @_;
978      # Declare the return variable. If an error occurs, it will remain undefined.      # Declare the return variable. If an error occurs, it will remain undefined.
979      my $retVal;      my $retVal;
980        # This variable will be cleared if an error is detected.
981        my $okFlag = 1;
982      # Create variables to hold the FASTA label and data.      # Create variables to hold the FASTA label and data.
983      my ($fastaLabel, $fastaData);      my ($fastaLabel, $fastaData);
984        Trace("FASTA incoming type is $incomingType, desired type is $desiredType.") if T(4);
985      # Check for a feature specification.      # Check for a feature specification.
986      if ($sequence =~ /^\s*(\w+\|\S+)\s*$/) {      if ($sequence =~ /^\s*(\w+\|\S+)\s*$/) {
987          # 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
988          # it.          # it.
989          my $fid = $1;          my $fid = $1;
990            Trace("Feature ID for fasta is $fid.") if T(3);
991          my $sprout = $self->DB();          my $sprout = $self->DB();
992          # 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
993          # 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 1005  Line 995 
995          my ($figID) = $sprout->FeaturesByAlias($fid);          my ($figID) = $sprout->FeaturesByAlias($fid);
996          if (! $figID) {          if (! $figID) {
997              $self->SetMessage("No feature found with the ID \"$fid\".");              $self->SetMessage("No feature found with the ID \"$fid\".");
998                $okFlag = 0;
999          } else {          } else {
1000              # Set the FASTA label.              # Set the FASTA label.
1001              my $fastaLabel = $fid;              my $fastaLabel = $fid;
1002              # Now proceed according to the sequence type.              # Now proceed according to the sequence type.
1003              if ($desiredType =~ /prot/i) {              if ($desiredType eq 'prot') {
1004                  # We want protein, so get the translation.                  # We want protein, so get the translation.
1005                  $fastaData = $sprout->FeatureTranslation($figID);                  $fastaData = $sprout->FeatureTranslation($figID);
1006                    Trace(length $fastaData . " characters returned for translation of $fastaLabel.") if T(3);
1007              } else {              } else {
1008                  # 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.
1009                  my @locList = $sprout->FeatureLocation($figID);                  my @locList = $sprout->FeatureLocation($figID);
1010                  $fastaData = $sprout->DNASeq(\@locList);                  $fastaData = $sprout->DNASeq(\@locList);
1011                    Trace(length $fastaData . " characters returned for DNA of $fastaLabel.") if T(3);
1012              }              }
1013          }          }
1014      } elsif ($incomingType =~ /prot/ && $desiredType =~ /dna/) {      } elsif ($incomingType eq 'prot' && $desiredType eq 'dna') {
1015          # Here we're being asked to do an impossible conversion.          # Here we're being asked to do an impossible conversion.
1016          $self->SetMessage("Cannot convert a protein sequence to DNA.");          $self->SetMessage("Cannot convert a protein sequence to DNA.");
1017            $okFlag = 0;
1018      } else {      } else {
1019            Trace("Analyzing FASTA sequence.") if T(4);
1020          # 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.
1021          if ($sequence =~ /^>\s*(\S.*)\s*\n(.+)$/) {          if ($sequence =~ /^>[\n\s]*(\S[^\n]*)\n(.+)$/s) {
1022                Trace("Label \"$1\" found in match to sequence:\n$sequence") if T(4);
1023              # Here we have a label, so we split it from the data.              # Here we have a label, so we split it from the data.
1024              $fastaLabel = $1;              $fastaLabel = $1;
1025              $fastaData = $2;              $fastaData = $2;
1026          } else {          } else {
1027                Trace("No label found in match to sequence:\n$sequence") if T(4);
1028              # 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
1029              # as data.              # as data.
1030              $fastaLabel = "User-specified $incomingType sequence";              $fastaLabel = "User-specified $incomingType sequence";
# Line 1040  Line 1037 
1037          # we've already prevented a conversion from protein to DNA.          # we've already prevented a conversion from protein to DNA.
1038          if ($incomingType ne $desiredType) {          if ($incomingType ne $desiredType) {
1039              $fastaData = Sprout::Protein($fastaData);              $fastaData = Sprout::Protein($fastaData);
1040                # Check for bad characters.
1041                if ($fastaData =~ /X/) {
1042                    $self->SetMessage("Invalid characters detected. Is the input really of type $incomingType?");
1043                    $okFlag = 0;
1044                }
1045            } elsif ($desiredType eq 'dna' && $fastaData =~ /[^agct]/i) {
1046                $self->SetMessage("Invaid characters detected. Is the input really a DNA sequence?");
1047                $okFlag = 0;
1048          }          }
1049      }      }
1050      # At this point, either "$fastaLabel" and "$fastaData" have values or an error is      Trace("FASTA data sequence: $fastaData") if T(4);
1051      # in progress.      # Only proceed if no error was detected.
1052      if (defined $fastaLabel) {      if ($okFlag) {
1053          # 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
1054          # grep-split trick. The split, because of the presence of the parentheses,          # grep-split trick. The split, because of the presence of the parentheses,
1055          # includes the matched delimiters in the output list. The grep strips out          # includes the matched delimiters in the output list. The grep strips out
1056          # the empty list items that appear between the so-called delimiters, since          # the empty list items that appear between the so-called delimiters, since
1057          # the delimiters are what we want.          # the delimiters are what we want.
1058          my @chunks = grep { $_ } split /(.{1,60})/, $fastaData;          my @chunks = grep { $_ } split /(.{1,60})/, $fastaData;
1059          my $retVal = join("\n", ">$fastaLabel", @chunks, "");          $retVal = join("\n", ">$fastaLabel", @chunks, "");
1060      }      }
1061      # Return the result.      # Return the result.
1062      return $retVal;      return $retVal;
# Line 1059  Line 1064 
1064    
1065  =head3 NmpdrGenomeMenu  =head3 NmpdrGenomeMenu
1066    
1067  C<< my $htmlText = $shelp->NmpdrGenomeMenu($menuName, \%options, \@selected); >>  C<< my $htmlText = $shelp->NmpdrGenomeMenu($menuName, $multiple, \@selected, $rows); >>
1068    
1069  This method creates a hierarchical HTML menu for NMPDR genomes organized by category. The  This method creates a hierarchical HTML menu for NMPDR genomes organized by category. The
1070  category indicates the low-level NMPDR group. Organizing the genomes in this way makes it  category indicates the low-level NMPDR group. Organizing the genomes in this way makes it
# Line 1071  Line 1076 
1076    
1077  Name to give to the menu.  Name to give to the menu.
1078    
1079  =item options  =item multiple
1080    
1081  Reference to a hash containing the options to be applied to the C<SELECT> tag form the menu.  TRUE if the user is allowed to select multiple genomes, else FALSE.
 Typical options would include C<multiple> to specify  
 that multiple selections are allowed and C<size> to set the number of rows to display  
 in the menu.  
1082    
1083  =item selected  =item selected
1084    
# Line 1084  Line 1086 
1086  is not intended to allow multiple selections, the list should be a singleton. If the  is not intended to allow multiple selections, the list should be a singleton. If the
1087  list is empty, nothing will be pre-selected.  list is empty, nothing will be pre-selected.
1088    
1089    =item rows (optional)
1090    
1091    Number of rows to display. If omitted, the default is 1 for a single-select list
1092    and 10 for a multi-select list.
1093    
1094    =item crossMenu (optional)
1095    
1096    If specified, is presumed to be the name of another genome menu whose contents
1097    are to be mutually exclusive with the contents of this menu. As a result, instead
1098    of the standard onChange event, the onChange event will deselect any entries in
1099    the other menu.
1100    
1101  =item RETURN  =item RETURN
1102    
1103  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 1094  Line 1108 
1108    
1109  sub NmpdrGenomeMenu {  sub NmpdrGenomeMenu {
1110      # Get the parameters.      # Get the parameters.
1111      my ($self, $menuName, $options, $selected) = @_;      my ($self, $menuName, $multiple, $selected, $rows, $cross) = @_;
1112      # Get the Sprout and CGI objects.      # Get the Sprout and CGI objects.
1113      my $sprout = $self->DB();      my $sprout = $self->DB();
1114      my $cgi = $self->Q();      my $cgi = $self->Q();
1115        # Compute the row count.
1116        if (! defined $rows) {
1117            $rows = ($multiple ? 10 : 1);
1118        }
1119        # Create the multiple tag.
1120        my $multipleTag = ($multiple ? " multiple" : "");
1121      # Get the form name.      # Get the form name.
1122      my $formName = $self->FormName();      my $formName = $self->FormName();
1123        # Check to see if we already have a genome list in memory.
1124        my $genomes = $self->{genomeList};
1125        my $groupHash;
1126        if (defined $genomes) {
1127            # We have a list ready to use.
1128            $groupHash = $genomes;
1129        } else {
1130      # Get a list of all the genomes in group order. In fact, we only need them ordered      # Get a list of all the genomes in group order. In fact, we only need them ordered
1131      # by name (genus,species,strain), but putting primary-group in front enables us to      # by name (genus,species,strain), but putting primary-group in front enables us to
1132      # take advantage of an existing index.      # take advantage of an existing index.
# Line 1111  Line 1138 
1138      # Create a hash to organize the genomes by group. Each group will contain a list of      # Create a hash to organize the genomes by group. Each group will contain a list of
1139      # 2-tuples, the first element being the genome ID and the second being the genome      # 2-tuples, the first element being the genome ID and the second being the genome
1140      # name.      # name.
1141      my %groupHash = ();          my %gHash = ();
1142      for my $genome (@genomeList) {      for my $genome (@genomeList) {
1143          # Get the genome data.          # Get the genome data.
1144          my ($group, $genomeID, $genus, $species, $strain) = @{$genome};          my ($group, $genomeID, $genus, $species, $strain) = @{$genome};
1145          # Form the genome name.              # Compute and cache its name and display group.
1146          my $name = "$genus $species";              my ($name, $displayGroup) = $self->SaveOrganismData($group, $genomeID, $genus, $species,
1147          if ($strain) {                                                                  $strain);
1148              $name .= " $strain";              # Push the genome into the group's list. Note that we use the real group
1149          }              # name here, not the display group name.
1150          # Push the genome into the group's list.              push @{$gHash{$group}}, [$genomeID, $name];
1151          push @{$groupHash{$group}}, [$genomeID, $name];          }
1152            # Save the genome list for future use.
1153            $self->{genomeList} = \%gHash;
1154            $groupHash = \%gHash;
1155      }      }
1156      # Now we are ready to unroll the menu out of the group hash. First, we sort the groups, putting      # Now we are ready to unroll the menu out of the group hash. First, we sort the groups, putting
1157      # the supporting-genome group last.      # the supporting-genome group last.
1158      my @groups = sort grep { $_ ne $FIG_Config::otherGroup } keys %groupHash;      my @groups = sort grep { $_ ne $FIG_Config::otherGroup } keys %{$groupHash};
1159      push @groups, $FIG_Config::otherGroup;      push @groups, $FIG_Config::otherGroup;
1160      # Next, create a hash that specifies the pre-selected entries.      # Next, create a hash that specifies the pre-selected entries. Note that we need to deal
1161      my %selectedHash = map { $_ => 1 } @{$selected};      # with the possibility of undefined values in the incoming list.
1162        my %selectedHash = ();
1163        if (defined $selected) {
1164            %selectedHash = map { $_ => 1 } grep { defined($_) } @{$selected};
1165        }
1166      # 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.
1167      # Create the type counters.      # Create the type counters.
1168      my $groupCount = 1;      my $groupCount = 1;
# Line 1138  Line 1172 
1172      my $showSelect = "showSelected($menuName, '$divID', 1000);";      my $showSelect = "showSelected($menuName, '$divID', 1000);";
1173      # If multiple selection is supported, create an onChange event.      # If multiple selection is supported, create an onChange event.
1174      my $onChange = "";      my $onChange = "";
1175      if ($options->{multiple}) {      if ($cross) {
1176            $onChange = " onChange=\"crossUnSelect($menuName, '$divID', $cross, '${formName}_${cross}_status', 1000)\"";
1177        } elsif ($multiple) {
1178          $onChange = " onChange=\"$showSelect\"";          $onChange = " onChange=\"$showSelect\"";
1179      }      }
1180      # Create the SELECT tag and stuff it into the output array.      # Create the SELECT tag and stuff it into the output array.
1181      my $select = "<" . join(" ", "SELECT name=\"$menuName\"$onChange", map { " $_=\"$options->{$_}\"" } keys %{$options}) . ">";      my $select = "<SELECT name=\"$menuName\"$onChange$multipleTag size=\"$rows\">";
1182      my @lines = ($select);      my @lines = ($select);
1183      # Loop through the groups.      # Loop through the groups.
1184      for my $group (@groups) {      for my $group (@groups) {
# Line 1153  Line 1189 
1189          # label option may have functionality in future browsers. If that happens, we'll need          # label option may have functionality in future browsers. If that happens, we'll need
1190          # to modify the genome text so that the "selectSome" method can tell which are NMPDR          # to modify the genome text so that the "selectSome" method can tell which are NMPDR
1191          # organisms and which aren't. Sadly, the OPTGROUP tag is invisible in the DOM Javascript          # organisms and which aren't. Sadly, the OPTGROUP tag is invisible in the DOM Javascript
1192          # hierarchy.          # hierarchy, so we can't use it.
1193          my $label = ($group eq $FIG_Config::otherGroup ? "other" : "nmpdr");          my $label = ($group eq $FIG_Config::otherGroup ? "other" : "nmpdr");
1194          # Get the genomes in the group.          # Get the genomes in the group.
1195          for my $genome (@{$groupHash{$group}}) {          for my $genome (@{$groupHash->{$group}}) {
1196              my ($genomeID, $name) = @{$genome};              my ($genomeID, $name) = @{$genome};
1197              # See if it's selected.              # See if it's selected.
1198              my $select = ($selectedHash{$genomeID} ? " selected" : "");              my $select = ($selectedHash{$genomeID} ? " selected" : "");
# Line 1170  Line 1206 
1206      # Close the SELECT tag.      # Close the SELECT tag.
1207      push @lines, "</SELECT>";      push @lines, "</SELECT>";
1208      # Check for multiple selection.      # Check for multiple selection.
1209      if ($options->{multiple}) {      if ($multiple) {
1210          # Since multi-select is on, we can set up some buttons to set and clear selections.          # Since multi-select is on, we set up some buttons to set and clear selections.
1211          push @lines, "<br />";          push @lines, "<br />";
1212          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\" />";
1213          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\" />";
1214          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, 'nmpdr'); $showSelect\" />";
1215          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, 'other'); $showSelect\" />";
1216            # Now add the search box. This allows the user to type text and have all genomes containing
1217            # the text selected automatically.
1218            my $searchThingName = "${menuName}_SearchThing";
1219            push @lines, "<br>Select genomes containing <INPUT type=\"text\" name=\"$searchThingName\" size=\"30\" />&nbsp;" .
1220                         "<INPUT type=\"button\" name=\"Select\" class=\"button\" value=\"Search\" onClick=\"selectViaSearch($menuName, $searchThingName); $showSelect\" />";
1221          # Add the status display, too.          # Add the status display, too.
1222          push @lines, "<DIV id=\"$divID\" class=\"selectStatus\"></DIV>";          push @lines, "<DIV id=\"$divID\" class=\"selectStatus\"></DIV>";
1223          # Queue to update the status display when the form loads. We need to modify the show statement          # Queue to update the status display when the form loads. We need to modify the show statement
# Line 1185  Line 1226 
1226          # in case we decide to twiddle the parameters.          # in case we decide to twiddle the parameters.
1227          $showSelect =~ s/showSelected\(/showSelected\(thisForm\./;          $showSelect =~ s/showSelected\(/showSelected\(thisForm\./;
1228          $self->QueueFormScript($showSelect);          $self->QueueFormScript($showSelect);
1229            # Finally, add this parameter to the list of genome parameters. This enables us to
1230            # easily find all the parameters used to select one or more genomes.
1231            push @{$self->{genomeParms}}, $menuName;
1232      }      }
1233      # Assemble all the lines into a string.      # Assemble all the lines into a string.
1234      my $retVal = join("\n", @lines, "");      my $retVal = join("\n", @lines, "");
# Line 1192  Line 1236 
1236      return $retVal;      return $retVal;
1237  }  }
1238    
1239    =head3 PropertyMenu
1240    
1241    C<< my $htmlText = $shelp->PropertyMenu($menuName, $selected, $force); >>
1242    
1243    Generate a property name dropdown menu.
1244    
1245    =over 4
1246    
1247    =item menuName
1248    
1249    Name to give to the menu.
1250    
1251    =item selected
1252    
1253    Value of the property name to pre-select.
1254    
1255    =item force (optional)
1256    
1257    If TRUE, then the user will be forced to choose a property name. If FALSE,
1258    then an additional menu choice will be provided to select nothing.
1259    
1260    =item RETURN
1261    
1262    Returns a dropdown menu box that allows the user to select a property name. An additional
1263    selection entry will be provided for selecting no property name
1264    
1265    =back
1266    
1267    =cut
1268    
1269    sub PropertyMenu {
1270        # Get the parameters.
1271        my ($self, $menuName, $selected, $force) = @_;
1272        # Get the CGI and Sprout objects.
1273        my $sprout = $self->DB();
1274        my $cgi = $self->Q();
1275        # Create the property name list.
1276        my @propNames = ();
1277        if (! $force) {
1278            push @propNames, "";
1279        }
1280        # Get all the property names, putting them after the null choice if one exists.
1281        push @propNames, $sprout->GetChoices('Property', 'property-name');
1282        # Create a menu from them.
1283        my $retVal = $cgi->popup_menu(-name=> $menuName, -values => \@propNames,
1284                                      -default => $selected);
1285        # Return the result.
1286        return $retVal;
1287    }
1288    
1289  =head3 MakeTable  =head3 MakeTable
1290    
1291  C<< my $htmlText = $shelp->MakeTable(\@rows); >>  C<< my $htmlText = $shelp->MakeTable(\@rows); >>
# Line 1254  Line 1348 
1348      # Get the parameters.      # Get the parameters.
1349      my ($self) = @_;      my ($self) = @_;
1350      my $cgi = $self->Q();      my $cgi = $self->Q();
1351      # Declare the return variable.      # Get the current page size.
1352        my $pageSize = $cgi->param('PageSize');
1353        # Get the incoming external-link flag.
1354        my $aliases = ($cgi->param('ShowAliases') ? 1 : 0);
1355        # Create the row.
1356      my $retVal = $cgi->Tr($cgi->td("Results/Page"),      my $retVal = $cgi->Tr($cgi->td("Results/Page"),
1357                            $cgi->td($cgi->popup_menu(-name => 'PageSize',                            $cgi->td($cgi->popup_menu(-name => 'PageSize',
1358                                                      -values => [10, 25, 45, 100, 1000],                                                      -values => [10, 25, 50, 100, 1000],
1359                                                      -default => $cgi->param('PageSize'))),                                                      -default => $pageSize) . " " .
1360                                       $cgi->checkbox(-name => 'ShowURL',
1361                                                      -value => 1,
1362                                                      -label => 'Show URL')),
1363                            $cgi->td($cgi->submit(-class => 'goButton',                            $cgi->td($cgi->submit(-class => 'goButton',
1364                                                  -name => 'Search',                                                  -name => 'Search',
1365                                                  -value => 'Go')));                                                  -value => 'Go')));
# Line 1270  Line 1371 
1371    
1372  C<< my $htmlText = $shelp->FeatureFilterRows(); >>  C<< my $htmlText = $shelp->FeatureFilterRows(); >>
1373    
1374  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
1375  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>
1376  using the B<FeatureQuery> object.  object.
1377    
1378  =cut  =cut
1379    
# Line 1322  Line 1423 
1423          # Get the feature location string.          # Get the feature location string.
1424          my $loc = $sprout->FeatureLocation($feat);          my $loc = $sprout->FeatureLocation($feat);
1425          # Compute the contig, start, and stop points.          # Compute the contig, start, and stop points.
1426          my($start, $stop, $contig) = BasicLocation::Parse($loc);          my($contig, $start, $stop) = BasicLocation::Parse($loc);
1427            Trace("Start and stop are ($start,$stop) on contig $contig.") if T(3);
1428          # 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
1429          # big and that we get some surrounding stuff.          # big and that we get some surrounding stuff.
1430          my $mid = int(($start + $stop) / 2);          my $mid = int(($start + $stop) / 2);
# Line 1352  Line 1454 
1454          }          }
1455          my $seg_id = $contig;          my $seg_id = $contig;
1456          $seg_id =~ s/:/--/g;          $seg_id =~ s/:/--/g;
1457            Trace("Show limits are ($show_start,$show_stop) in genome $genomeID with ref $seg_id.") if T(3);
1458          # Assemble all the pieces.          # Assemble all the pieces.
1459          $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";
1460      }      }
# Line 1359  Line 1462 
1462      return $retVal;      return $retVal;
1463  }  }
1464    
1465    =head3 GetGenomes
1466    
1467    C<< my @genomeList = $shelp->GetGenomes($parmName); >>
1468    
1469    Return the list of genomes specified by the specified CGI query parameter.
1470    If the request method is POST, then the list of genome IDs is returned
1471    without preamble. If the request method is GET and the parameter is not
1472    specified, then it is treated as a request for all genomes. This makes it
1473    easier for web pages to link to a search that wants to specify all genomes.
1474    
1475    =over 4
1476    
1477    =item parmName
1478    
1479    Name of the parameter containing the list of genomes. This will be the
1480    first parameter passed to the L</NmpdrGenomeMenu> call that created the
1481    genome selection control on the form.
1482    
1483    =item RETURN
1484    
1485    Returns a list of the genomes to process.
1486    
1487    =back
1488    
1489    =cut
1490    
1491    sub GetGenomes {
1492        # Get the parameters.
1493        my ($self, $parmName) = @_;
1494        # Get the CGI query object.
1495        my $cgi = $self->Q();
1496        # Get the list of genome IDs in the request header.
1497        my @retVal = $cgi->param($parmName);
1498        Trace("Genome list for $parmName is (" . join(", ", @retVal) . ") with method " . $cgi->request_method() . ".") if T(3);
1499        # Check for the special GET case.
1500        if ($cgi->request_method() eq "GET" && ! @retVal) {
1501            # Here the caller wants all the genomes.
1502            my $sprout = $self->DB();
1503            @retVal = $sprout->Genomes();
1504        }
1505        # Return the result.
1506        return @retVal;
1507    }
1508    
1509    =head3 GetHelpText
1510    
1511    C<< my $htmlText = $shelp->GetHelpText(); >>
1512    
1513    Get the help text for this search. The help text is stored in files on the template
1514    server. The help text for a specific search is taken from a file named
1515    C<SearchHelp_>I<class>C<.inc> in the template directory C<$FIG_Config::template_url>.
1516    There are also three standard help files: C<SearchHelp1_Filtering.inc> describes the
1517    feature filtering performed by the B<FeatureQuery> object, C<SearchHelp1_GenomeControl.inc>
1518    describes how to use a multiple-selection genome control, and C<SearchHelp1_Standard.inc>
1519    describes the standard controls for a search, such as page size, URL display, and
1520    external alias display.
1521    
1522    =cut
1523    
1524    sub GetHelpText {
1525        # Get the parameters.
1526        my ($self) = @_;
1527        # Create a list to hold the pieces of the help.
1528        my @helps = ();
1529        # Get the template directory URL.
1530        my $urlBase = $FIG_Config::template_url;
1531        # Start with the specific help.
1532        my $class = $self->{class};
1533        push @helps, PageBuilder::GetPage("$urlBase/SearchHelp_$class.inc");
1534        # Add the genome control help if needed.
1535        if (scalar @{$self->{genomeParms}}) {
1536            push @helps, PageBuilder::GetPage("$urlBase/SearchHelp1_GenomeControl.inc");
1537        }
1538        # Next the filter help.
1539        if ($self->{filtered}) {
1540            push @helps, PageBuilder::GetPage("$urlBase/SearchHelp1_Filtering.inc");
1541        }
1542        # Finally, the standard help.
1543        push @helps, PageBuilder::GetPage("$urlBase/SearchHelp1_Standard.inc");
1544        # Assemble the pieces.
1545        my $retVal = join("\n<p>&nbsp;</p>\n", @helps);
1546        # Return the result.
1547        return $retVal;
1548    }
1549    
1550    =head3 ComputeSearchURL
1551    
1552    C<< my $url = $shelp->ComputeSearchURL(); >>
1553    
1554    Compute the GET-style URL for the current search. In order for this to work, there
1555    must be a copy of the search form on the current page. This will always be the
1556    case if the search is coming from C<SearchSkeleton.cgi>.
1557    
1558    A little expense is involved in order to make the URL as smart as possible. The
1559    main complication is that if the user specified all genomes, we'll want to
1560    remove the parameter entirely from a get-style URL.
1561    
1562    =cut
1563    
1564    sub ComputeSearchURL {
1565        # Get the parameters.
1566        my ($self) = @_;
1567        # Get the database and CGI query object.
1568        my $cgi = $self->Q();
1569        my $sprout = $self->DB();
1570        # Start with the full URL.
1571        my $retVal = $cgi->url(-full => 1);
1572        # Get all the query parameters in a hash.
1573        my %parms = $cgi->Vars();
1574        # Now we need to do some fixing. Each multi-valued parameter is encoded as a string with null
1575        # characters separating the individual values. We have to convert those to lists. In addition,
1576        # the multiple-selection genome parameters and the feature type parameter must be checked to
1577        # determine whether or not they can be removed from the URL. First, we get a list of the
1578        # genome parameters and a list of all genomes. Note that we only need the list if a
1579        # multiple-selection genome parameter has been found on the form.
1580        my %genomeParms = map { $_ => 1 } @{$self->{genomeParms}};
1581        my @genomeList;
1582        if (keys %genomeParms) {
1583            @genomeList = $sprout->Genomes();
1584        }
1585        # Create a list to hold the URL parameters we find.
1586        my @urlList = ();
1587        # Now loop through the parameters in the hash, putting them into the output URL.
1588        for my $parmKey (keys %parms) {
1589            # Get a list of the parameter values. If there's only one, we'll end up with
1590            # a singleton list, but that's okay.
1591            my @values = split (/\0/, $parms{$parmKey});
1592            # Check for special cases.
1593            if (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF ShowURL)) {
1594                # These are bookkeeping parameters we don't need to start a search.
1595                @values = ();
1596            } elsif ($parmKey =~ /_SearchThing$/) {
1597                # Here the value coming in is from a genome control's search thing. It does
1598                # not affect the results of the search, so we clear it.
1599                @values = ();
1600            } elsif ($genomeParms{$parmKey}) {
1601                # Here we need to see if the user wants all the genomes. If he does,
1602                # we erase all the values just like with features.
1603                my $allFlag = $sprout->IsAllGenomes(\@values, \@genomeList);
1604                if ($allFlag) {
1605                    @values = ();
1606                }
1607            }
1608            # If we still have values, create the URL parameters.
1609            if (@values) {
1610                push @urlList, map { "$parmKey=" . uri_escape($_) } @values;
1611            }
1612        }
1613        # Add the parameters to the URL.
1614        $retVal .= "?" . join(";", @urlList);
1615        # Return the result.
1616        return $retVal;
1617    }
1618    
1619    =head3 GetRunTimeValue
1620    
1621    C<< my $htmlText = $shelp->GetRunTimeValue($text); >>
1622    
1623    Compute a run-time column value.
1624    
1625    =over 4
1626    
1627    =item text
1628    
1629    The run-time column text. It consists of 2 percent signs, a column type, an equal
1630    sign, and the data for the current row.
1631    
1632    =item RETURN
1633    
1634    Returns the fully-formatted HTML text to go into the current column of the current row.
1635    
1636    =back
1637    
1638    =cut
1639    
1640    sub GetRunTimeValue {
1641        # Get the parameters.
1642        my ($self, $text) = @_;
1643        # Declare the return variable.
1644        my $retVal;
1645        # Parse the incoming text.
1646        if ($text =~ /^%%([^=]+)=(.*)$/) {
1647            $retVal = $self->RunTimeColumns($1, $2);
1648        } else {
1649            Confess("Invalid run-time column string \"$text\" encountered in session file.");
1650        }
1651        # Return the result.
1652        return $retVal;
1653    }
1654    
1655    =head3 AdvancedClassList
1656    
1657    C<< my @classes = SearchHelper::AdvancedClassList(); >>
1658    
1659    Return a list of advanced class names. This list is used to generate the directory
1660    of available searches on the search page.
1661    
1662    The reason we have to convert the list from a string is that the B<NMPDRSetup.pl>
1663    script is only able to insert strings into the generated B<FIG_Config> file.
1664    
1665    =cut
1666    
1667    sub AdvancedClassList {
1668        return split /\s+/, $FIG_Config::advanced_classes;
1669    }
1670    
1671  =head2 Feature Column Methods  =head2 Feature Column Methods
1672    
1673  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 1391  Line 1700 
1700      # Get the parameters.      # Get the parameters.
1701      my ($self) = @_;      my ($self) = @_;
1702      # Return the result.      # Return the result.
1703      return ['orgName', 'function', 'gblink', 'protlink'];      return ['orgName', 'function', 'gblink', 'protlink',
1704                FeatureQuery::AdditionalColumns($self)];
1705  }  }
1706    
1707  =head3 FeatureColumnTitle  =head3 FeatureColumnTitle
# Line 1500  Line 1810 
1810          $retVal = HTML::set_prot_links($fid);          $retVal = HTML::set_prot_links($fid);
1811      } elsif ($colName eq 'alias') {      } elsif ($colName eq 'alias') {
1812          # 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.
1813          # The complicated part is we have to hyperlink them. First, get the          # These are very expensive, so we compute them when the row is displayed.
1814          # aliases.          $retVal = "%%aliases=$fid";
         my @aliases = $sprout->FeatureAliases($fid);  
         # Only proceed if we found some.  
         if (@aliases) {  
             # Join the aliases into a comma-delimited list.  
             my $aliasList = join(", ", @aliases);  
             # Ask the HTML processor to hyperlink them.  
             $retVal = HTML::set_prot_links($aliasList);  
         }  
1815      } elsif ($colName eq 'function') {      } elsif ($colName eq 'function') {
1816          # The functional assignment is just a matter of getting some text.          # The functional assignment is just a matter of getting some text.
1817          ($retVal) = $record->Value('Feature(assignment)');          ($retVal) = $record->Value('Feature(assignment)');
# Line 1539  Line 1841 
1841      return $retVal;      return $retVal;
1842  }  }
1843    
1844    =head3 RunTimeColumns
1845    
1846    C<< my $htmlText = $shelp->RunTimeColumns($type, $text); >>
1847    
1848    Return the HTML text for a run-time column. Run-time columns are evaluated when the
1849    list is displayed, rather than when it is generated.
1850    
1851    =over 4
1852    
1853    =item type
1854    
1855    Type of column.
1856    
1857    =item text
1858    
1859    Data relevant to this row of the column.
1860    
1861    =item RETURN
1862    
1863    Returns the fully-formatted HTML text to go in the specified column.
1864    
1865    =back
1866    
1867    =cut
1868    
1869    sub RunTimeColumns {
1870        # Get the parameters.
1871        my ($self, $type, $text) = @_;
1872        # Declare the return variable.
1873        my $retVal = "";
1874        # Get the Sprout and CGI objects.
1875        my $sprout = $self->DB();
1876        my $cgi = $self->Q();
1877        # Separate the text into a type and data.
1878        if ($type eq 'aliases') {
1879            # Here the caller wants external alias links for a feature. The text
1880            # is the feature ID.
1881            my $fid = $text;
1882            # The complicated part is we have to hyperlink them. First, get the
1883            # aliases.
1884            Trace("Generating aliases for feature $fid.") if T(4);
1885            my @aliases = $sprout->FeatureAliases($fid);
1886            # Only proceed if we found some.
1887            if (@aliases) {
1888                # Join the aliases into a comma-delimited list.
1889                my $aliasList = join(", ", @aliases);
1890                # Ask the HTML processor to hyperlink them.
1891                $retVal = HTML::set_prot_links($cgi, $aliasList);
1892            }
1893        }
1894        # Return the result.
1895        return $retVal;
1896    }
1897    
1898    =head3 SaveOrganismData
1899    
1900    C<< my ($name, $displayGroup) = $shelp->SaveOrganismData($group, $genomeID, $genus, $species, $strain); >>
1901    
1902    Format the name of an organism and the display version of its group name. The incoming
1903    data should be the relevant fields from the B<Genome> record in the database. The
1904    data will also be stored in the genome cache for later use in posting search results.
1905    
1906    =over 4
1907    
1908    =item group
1909    
1910    Name of the genome's group as it appears in the database.
1911    
1912    =item genomeID
1913    
1914    ID of the relevant genome.
1915    
1916    =item genus
1917    
1918    Genus of the genome's organism. If undefined or null, it will be assumed the genome is not
1919    in the database. In this case, the organism name is derived from the genomeID and the group
1920    is automatically the supporting-genomes group.
1921    
1922    =item species
1923    
1924    Species of the genome's organism.
1925    
1926    =item strain
1927    
1928    Strain of the species represented by the genome.
1929    
1930    =item RETURN
1931    
1932    Returns a two-element list. The first element is the formatted genome name. The second
1933    element is the display name of the genome's group.
1934    
1935    =back
1936    
1937    =cut
1938    
1939    sub SaveOrganismData {
1940        # Get the parameters.
1941        my ($self, $group, $genomeID, $genus, $species, $strain) = @_;
1942        # Declare the return values.
1943        my ($name, $displayGroup);
1944        # If the organism does not exist, format an unknown name and a blank group.
1945        if (! defined($genus)) {
1946            $name = "Unknown Genome $genomeID";
1947            $displayGroup = "";
1948        } else {
1949            # It does exist, so format the organism name.
1950            $name = "$genus $species";
1951            if ($strain) {
1952                $name .= " $strain";
1953            }
1954            # Compute the display group. This is currently the same as the incoming group
1955            # name unless it's the supporting group, which is nulled out.
1956            $displayGroup = ($group eq $FIG_Config::otherGroup ? "" : $group);
1957        }
1958        # Cache the group and organism data.
1959        my $cache = $self->{orgs};
1960        $cache->{$genomeID} = [$name, $displayGroup];
1961        # Return the result.
1962        return ($name, $displayGroup);
1963    }
1964    
1965    =head2 Virtual Methods
1966    
1967    =head3 Form
1968    
1969    C<< my $html = $shelp->Form(); >>
1970    
1971    Generate the HTML for a form to request a new search.
1972    
1973    =head3 Find
1974    
1975    C<< my $resultCount = $shelp->Find(); >>
1976    
1977    Conduct a search based on the current CGI query parameters. The search results will
1978    be written to the session cache file and the number of results will be
1979    returned. If the search parameters are invalid, a result count of C<undef> will be
1980    returned and a result message will be stored in this object describing the problem.
1981    
1982    =head3 Description
1983    
1984    C<< my $htmlText = $shelp->Description(); >>
1985    
1986    Return a description of this search. The description is used for the table of contents
1987    on the main search tools page. It may contain HTML, but it should be character-level,
1988    not block-level, since the description is going to appear in a list.
1989    
1990    =head3 SortKey
1991    
1992    C<< my $key = $shelp->SortKey($fdata); >>
1993    
1994    Return the sort key for the specified feature data. The default is to sort by feature name,
1995    floating NMPDR organisms to the top. If a full-text search is used, then the default
1996    sort is by relevance followed by feature name. This sort may be overridden by the
1997    search class to provide fancier functionality. This method is called by
1998    B<PutFeature>, so it is only used for feature searches. A non-feature search
1999    would presumably have its own sort logic.
2000    
2001    =over 4
2002    
2003    =item record
2004    
2005    The C<FeatureData> containing the current feature.
2006    
2007    =item RETURN
2008    
2009    Returns a key field that can be used to sort this row in among the results.
2010    
2011    =back
2012    
2013    =cut
2014    
2015    sub SortKey {
2016        # Get the parameters.
2017        my ($self, $fdata) = @_;
2018        # Get the feature ID from the record.
2019        my $fid = $fdata->FID();
2020        # Get the group from the feature ID.
2021        my $group = $self->FeatureGroup($fid);
2022        # Ask the feature query object to form the sort key.
2023        my $retVal = $fdata->SortKey($self, $group);
2024        # Return the result.
2025        return $retVal;
2026    }
2027    
2028  1;  1;

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.12

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3