[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.15, Fri Nov 10 22:01:36 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 98  Line 113 
113    
114  =item 4  =item 4
115    
116  In the C<SearchSkeleton.cgi> script, add a C<use> statement for your search tool  In the C<SearchSkeleton.cgi> script and add a C<use> statement for your search tool.
 and then put the class name in the C<@advancedClasses> list.  
117    
118  =back  =back
119    
# Line 139  Line 153 
153    
154  =item 1  =item 1
155    
156  L</NmpdrGenomeMenu> generates a control for selecting one or more genomes.  L</NmpdrGenomeMenu> generates a control for selecting one or more genomes. Use
157    L</GetGenomes> to retrieve all the genomes passed in for a specified parameter
158    name. Note that as an assist to people working with GET-style links, if no
159    genomes are specified and the incoming request style is GET, all genomes will
160    be returned.
161    
162  =item 2  =item 2
163    
# Line 158  Line 176 
176    
177  =back  =back
178    
179    If you are doing a feature search, you can also change the list of feature
180    columns displayed and their display order by overriding
181    L</DefaultFeatureColumns>.
182    
183  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
184  query parameters as default values so that the search request is persistent.  query parameters as default values so that the search request is persistent.
185    
# Line 195  Line 217 
217                      }                      }
218                  }                  }
219              }              }
         }  
220          # Close the session file.          # Close the session file.
221          $self->CloseSession();          $self->CloseSession();
222            }
223          # Return the result count.          # Return the result count.
224          return $retVal;          return $retVal;
225      }      }
226    
227  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
228  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
229  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
230  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
231  above code is just a loose framework.  above code is just a loose framework.
# Line 218  Line 240 
240  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
241  the number of items found.  the number of items found.
242    
 =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.  
   
243  =cut  =cut
244    
245  # 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 295 
295                    orgs => {},                    orgs => {},
296                    name => $formName,                    name => $formName,
297                    scriptQueue => [],                    scriptQueue => [],
298                      genomeList => undef,
299                      genomeParms => [],
300                      filtered => 0,
301                   };                   };
302      # Bless and return it.      # Bless and return it.
303      bless $retVal, $class;      bless $retVal, $class;
# Line 319  Line 319 
319      return $self->{query};      return $self->{query};
320  }  }
321    
322    
323    
324  =head3 DB  =head3 DB
325    
326  C<< my $sprout = $shelp->DB(); >>  C<< my $sprout = $shelp->DB(); >>
# Line 610  Line 612 
612    
613  =head3 PutFeature  =head3 PutFeature
614    
615  C<< $shelp->PutFeature($fquery); >>  C<< $shelp->PutFeature($fdata); >>
616    
617  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
618  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 623 
623  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
624  code adds columns for essentiality and virulence.  code adds columns for essentiality and virulence.
625    
626      $fq->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor);      $fd->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor);
627      $shelp->PutFeature($fq);      $shelp->PutFeature($fd);
628    
629  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
630  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 634 
634      if (! $essentialFlag) {      if (! $essentialFlag) {
635          $essentialFlag = undef;          $essentialFlag = undef;
636      }      }
637      $fq->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor);      $fd->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor);
638      $shelp->PutFeature($fq);      $shelp->PutFeature($fd);
639    
640  =over 4  =over 4
641    
642  =item fquery  =item fdata
643    
644  FeatureQuery object containing the current feature data.  B<FeatureData> object containing the current feature data.
645    
646  =back  =back
647    
# Line 647  Line 649 
649    
650  sub PutFeature {  sub PutFeature {
651      # Get the parameters.      # Get the parameters.
652      my ($self, $fq) = @_;      my ($self, $fd) = @_;
653        # Get the CGI query object.
654        my $cgi = $self->Q();
655      # Get the feature data.      # Get the feature data.
656      my $record = $fq->Feature();      my $record = $fd->Feature();
657      my $extraCols = $fq->ExtraCols();      my $extraCols = $fd->ExtraCols();
658      # Check for a first-call situation.      # Check for a first-call situation.
659      if (! defined $self->{cols}) {      if (! defined $self->{cols}) {
660          # Here we need to set up the column information. Start with the defaults.          Trace("Setting up the columns.") if T(3);
661          $self->{cols} = $self->DefaultFeatureColumns();          # Here we need to set up the column information. Start with the extras,
662          # Append the extras, sorted by column name.          # sorted by column name.
663            my @colNames = ();
664          for my $col (sort keys %{$extraCols}) {          for my $col (sort keys %{$extraCols}) {
665              push @{$self->{cols}}, "X=$col";              push @colNames, "X=$col";
666          }          }
667            # Add the default columns.
668            push @colNames, $self->DefaultFeatureColumns();
669            # Add any additional columns requested by the feature filter.
670            push @colNames, FeatureQuery::AdditionalColumns($self);
671            # Save the full list.
672            $self->{cols} = \@colNames;
673          # 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
674          # output.          # output.
675          $self->WriteColumnHeaders(map { $self->FeatureColumnTitle($_) } @{$self->{cols}});          $self->WriteColumnHeaders(map { $self->FeatureColumnTitle($_) } @{$self->{cols}});
676      }      }
677      # Get the feature ID.      # Get the feature ID.
678      my ($fid) = $record->Value('Feature(id)');      my $fid = $fd->FID();
679      # Loop through the column headers, producing the desired data.      # Loop through the column headers, producing the desired data.
680      my @output = ();      my @output = ();
681      for my $colName (@{$self->{cols}}) {      for my $colName (@{$self->{cols}}) {
682          push @output, $self->FeatureColumnValue($colName, $record, $extraCols);          push @output, $self->FeatureColumnValue($colName, $record, $extraCols);
683      }      }
684      # 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
685      # top of the return list.      # top of the return list.
686      my $group = $self->FeatureGroup($fid);      my $key = $self->SortKey($fd);
     my $key = ($group ? "A$group" : "ZZ");  
687      # Write the feature data.      # Write the feature data.
688      $self->WriteColumnData($key, @output);      $self->WriteColumnData($key, @output);
689  }  }
# Line 754  Line 764 
764      # Check for an open session file.      # Check for an open session file.
765      if (defined $self->{fileHandle}) {      if (defined $self->{fileHandle}) {
766          # We found one, so close it.          # We found one, so close it.
767            Trace("Closing session file.") if T(2);
768          close $self->{fileHandle};          close $self->{fileHandle};
769      }      }
770  }  }
# Line 771  Line 782 
782      my $retVal;      my $retVal;
783      # Get a digest encoder.      # Get a digest encoder.
784      my $md5 = Digest::MD5->new();      my $md5 = Digest::MD5->new();
785      # 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
786      if (open(R, "/dev/urandom")) {      # actually two numbers, and we get them both because we're in list
787          my $b;      # context.
788          read(R, $b, 1024);      $md5->add($$, $ENV{REMOTE_ADDR}, $ENV{REMOTE_PORT}, gettimeofday());
789          $md5->add($b);      # Hash up all this identifying data.
790      }      $retVal = $md5->hexdigest();
791      # 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.  
792      return $retVal;      return $retVal;
793  }  }
794    
# Line 827  Line 832 
832                                                      ['Genome(genus)', 'Genome(species)',                                                      ['Genome(genus)', 'Genome(species)',
833                                                       'Genome(unique-characterization)',                                                       'Genome(unique-characterization)',
834                                                       'Genome(primary-group)']);                                                       'Genome(primary-group)']);
835          # Null out the supporting group.          # Format and cache the name and display group.
836          $group = "" if ($group eq $FIG_Config::otherGroup);          ($orgName, $group) = $self->SaveOrganismData($group, $genomeID, $genus, $species,
837          # 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];  
838      }      }
839      # Return the result.      # Return the result.
840      return ($orgName, $group);      return ($orgName, $group);
# Line 942  Line 936 
936      } else {      } else {
937          # Here we can get its genome data.          # Here we can get its genome data.
938          $retVal = $self->Organism($genomeID);          $retVal = $self->Organism($genomeID);
939          # Append the type and number.          # Append the FIG ID.
940          $retVal .= " [$type $num]";          $retVal .= " [$fid]";
941      }      }
942      # Return the result.      # Return the result.
943      return $retVal;      return $retVal;
# Line 991  Line 985 
985      my ($self, $incomingType, $desiredType, $sequence) = @_;      my ($self, $incomingType, $desiredType, $sequence) = @_;
986      # Declare the return variable. If an error occurs, it will remain undefined.      # Declare the return variable. If an error occurs, it will remain undefined.
987      my $retVal;      my $retVal;
988        # This variable will be cleared if an error is detected.
989        my $okFlag = 1;
990      # Create variables to hold the FASTA label and data.      # Create variables to hold the FASTA label and data.
991      my ($fastaLabel, $fastaData);      my ($fastaLabel, $fastaData);
992        Trace("FASTA incoming type is $incomingType, desired type is $desiredType.") if T(4);
993      # Check for a feature specification.      # Check for a feature specification.
994      if ($sequence =~ /^\s*(\w+\|\S+)\s*$/) {      if ($sequence =~ /^\s*(\w+\|\S+)\s*$/) {
995          # 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
996          # it.          # it.
997          my $fid = $1;          my $fid = $1;
998            Trace("Feature ID for fasta is $fid.") if T(3);
999          my $sprout = $self->DB();          my $sprout = $self->DB();
1000          # 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
1001          # 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 1003 
1003          my ($figID) = $sprout->FeaturesByAlias($fid);          my ($figID) = $sprout->FeaturesByAlias($fid);
1004          if (! $figID) {          if (! $figID) {
1005              $self->SetMessage("No feature found with the ID \"$fid\".");              $self->SetMessage("No feature found with the ID \"$fid\".");
1006                $okFlag = 0;
1007          } else {          } else {
1008              # Set the FASTA label.              # Set the FASTA label.
1009              my $fastaLabel = $fid;              my $fastaLabel = $fid;
1010              # Now proceed according to the sequence type.              # Now proceed according to the sequence type.
1011              if ($desiredType =~ /prot/i) {              if ($desiredType eq 'prot') {
1012                  # We want protein, so get the translation.                  # We want protein, so get the translation.
1013                  $fastaData = $sprout->FeatureTranslation($figID);                  $fastaData = $sprout->FeatureTranslation($figID);
1014                    Trace(length $fastaData . " characters returned for translation of $fastaLabel.") if T(3);
1015              } else {              } else {
1016                  # 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.
1017                  my @locList = $sprout->FeatureLocation($figID);                  my @locList = $sprout->FeatureLocation($figID);
1018                  $fastaData = $sprout->DNASeq(\@locList);                  $fastaData = $sprout->DNASeq(\@locList);
1019                    Trace(length $fastaData . " characters returned for DNA of $fastaLabel.") if T(3);
1020              }              }
1021          }          }
1022      } elsif ($incomingType =~ /prot/ && $desiredType =~ /dna/) {      } elsif ($incomingType eq 'prot' && $desiredType eq 'dna') {
1023          # Here we're being asked to do an impossible conversion.          # Here we're being asked to do an impossible conversion.
1024          $self->SetMessage("Cannot convert a protein sequence to DNA.");          $self->SetMessage("Cannot convert a protein sequence to DNA.");
1025            $okFlag = 0;
1026      } else {      } else {
1027            Trace("Analyzing FASTA sequence.") if T(4);
1028          # 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.
1029          if ($sequence =~ /^>\s*(\S.*)\s*\n(.+)$/) {          if ($sequence =~ /^>[\n\s]*(\S[^\n]*)\n(.+)$/s) {
1030                Trace("Label \"$1\" found in match to sequence:\n$sequence") if T(4);
1031              # Here we have a label, so we split it from the data.              # Here we have a label, so we split it from the data.
1032              $fastaLabel = $1;              $fastaLabel = $1;
1033              $fastaData = $2;              $fastaData = $2;
1034          } else {          } else {
1035                Trace("No label found in match to sequence:\n$sequence") if T(4);
1036              # 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
1037              # as data.              # as data.
1038              $fastaLabel = "User-specified $incomingType sequence";              $fastaLabel = "User-specified $incomingType sequence";
# Line 1040  Line 1045 
1045          # we've already prevented a conversion from protein to DNA.          # we've already prevented a conversion from protein to DNA.
1046          if ($incomingType ne $desiredType) {          if ($incomingType ne $desiredType) {
1047              $fastaData = Sprout::Protein($fastaData);              $fastaData = Sprout::Protein($fastaData);
1048                # Check for bad characters.
1049                if ($fastaData =~ /X/) {
1050                    $self->SetMessage("Invalid characters detected. Is the input really of type $incomingType?");
1051                    $okFlag = 0;
1052                }
1053            } elsif ($desiredType eq 'dna' && $fastaData =~ /[^agct]/i) {
1054                $self->SetMessage("Invaid characters detected. Is the input really a DNA sequence?");
1055                $okFlag = 0;
1056          }          }
1057      }      }
1058      # At this point, either "$fastaLabel" and "$fastaData" have values or an error is      Trace("FASTA data sequence: $fastaData") if T(4);
1059      # in progress.      # Only proceed if no error was detected.
1060      if (defined $fastaLabel) {      if ($okFlag) {
1061          # 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
1062          # grep-split trick. The split, because of the presence of the parentheses,          # grep-split trick. The split, because of the presence of the parentheses,
1063          # includes the matched delimiters in the output list. The grep strips out          # includes the matched delimiters in the output list. The grep strips out
1064          # the empty list items that appear between the so-called delimiters, since          # the empty list items that appear between the so-called delimiters, since
1065          # the delimiters are what we want.          # the delimiters are what we want.
1066          my @chunks = grep { $_ } split /(.{1,60})/, $fastaData;          my @chunks = grep { $_ } split /(.{1,60})/, $fastaData;
1067          my $retVal = join("\n", ">$fastaLabel", @chunks, "");          $retVal = join("\n", ">$fastaLabel", @chunks, "");
1068      }      }
1069      # Return the result.      # Return the result.
1070      return $retVal;      return $retVal;
# Line 1059  Line 1072 
1072    
1073  =head3 NmpdrGenomeMenu  =head3 NmpdrGenomeMenu
1074    
1075  C<< my $htmlText = $shelp->NmpdrGenomeMenu($menuName, \%options, \@selected); >>  C<< my $htmlText = $shelp->NmpdrGenomeMenu($menuName, $multiple, \@selected, $rows); >>
1076    
1077  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
1078  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 1084 
1084    
1085  Name to give to the menu.  Name to give to the menu.
1086    
1087  =item options  =item multiple
1088    
1089  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.  
1090    
1091  =item selected  =item selected
1092    
# Line 1084  Line 1094 
1094  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
1095  list is empty, nothing will be pre-selected.  list is empty, nothing will be pre-selected.
1096    
1097    =item rows (optional)
1098    
1099    Number of rows to display. If omitted, the default is 1 for a single-select list
1100    and 10 for a multi-select list.
1101    
1102    =item crossMenu (optional)
1103    
1104    If specified, is presumed to be the name of another genome menu whose contents
1105    are to be mutually exclusive with the contents of this menu. As a result, instead
1106    of the standard onChange event, the onChange event will deselect any entries in
1107    the other menu.
1108    
1109  =item RETURN  =item RETURN
1110    
1111  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 1116 
1116    
1117  sub NmpdrGenomeMenu {  sub NmpdrGenomeMenu {
1118      # Get the parameters.      # Get the parameters.
1119      my ($self, $menuName, $options, $selected) = @_;      my ($self, $menuName, $multiple, $selected, $rows, $cross) = @_;
1120      # Get the Sprout and CGI objects.      # Get the Sprout and CGI objects.
1121      my $sprout = $self->DB();      my $sprout = $self->DB();
1122      my $cgi = $self->Q();      my $cgi = $self->Q();
1123        # Compute the row count.
1124        if (! defined $rows) {
1125            $rows = ($multiple ? 10 : 1);
1126        }
1127        # Create the multiple tag.
1128        my $multipleTag = ($multiple ? " multiple" : "");
1129      # Get the form name.      # Get the form name.
1130      my $formName = $self->FormName();      my $formName = $self->FormName();
1131        # Check to see if we already have a genome list in memory.
1132        my $genomes = $self->{genomeList};
1133        my $groupHash;
1134        if (defined $genomes) {
1135            # We have a list ready to use.
1136            $groupHash = $genomes;
1137        } else {
1138      # 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
1139      # 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
1140      # take advantage of an existing index.      # take advantage of an existing index.
# Line 1111  Line 1146 
1146      # 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
1147      # 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
1148      # name.      # name.
1149      my %groupHash = ();          my %gHash = ();
1150      for my $genome (@genomeList) {      for my $genome (@genomeList) {
1151          # Get the genome data.          # Get the genome data.
1152          my ($group, $genomeID, $genus, $species, $strain) = @{$genome};          my ($group, $genomeID, $genus, $species, $strain) = @{$genome};
1153          # Form the genome name.              # Compute and cache its name and display group.
1154          my $name = "$genus $species";              my ($name, $displayGroup) = $self->SaveOrganismData($group, $genomeID, $genus, $species,
1155          if ($strain) {                                                                  $strain);
1156              $name .= " $strain";              # Push the genome into the group's list. Note that we use the real group
1157          }              # name here, not the display group name.
1158          # Push the genome into the group's list.              push @{$gHash{$group}}, [$genomeID, $name];
1159          push @{$groupHash{$group}}, [$genomeID, $name];          }
1160            # Save the genome list for future use.
1161            $self->{genomeList} = \%gHash;
1162            $groupHash = \%gHash;
1163      }      }
1164      # 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
1165      # the supporting-genome group last.      # the supporting-genome group last.
1166      my @groups = sort grep { $_ ne $FIG_Config::otherGroup } keys %groupHash;      my @groups = sort grep { $_ ne $FIG_Config::otherGroup } keys %{$groupHash};
1167      push @groups, $FIG_Config::otherGroup;      push @groups, $FIG_Config::otherGroup;
1168      # 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
1169      my %selectedHash = map { $_ => 1 } @{$selected};      # with the possibility of undefined values in the incoming list.
1170      # Now it gets complicated. We need a way to mark all the NMPDR genomes.      my %selectedHash = ();
1171        if (defined $selected) {
1172            %selectedHash = map { $_ => 1 } grep { defined($_) } @{$selected};
1173        }
1174        # Now it gets complicated. We need a way to mark all the NMPDR genomes. We take advantage
1175        # of the fact they come first in the list. We'll accumulate a count of the NMPDR genomes
1176        # and use that to make the selections.
1177        my $nmpdrCount = 0;
1178      # Create the type counters.      # Create the type counters.
1179      my $groupCount = 1;      my $groupCount = 1;
1180      # Compute the ID for the status display.      # Compute the ID for the status display.
# Line 1138  Line 1183 
1183      my $showSelect = "showSelected($menuName, '$divID', 1000);";      my $showSelect = "showSelected($menuName, '$divID', 1000);";
1184      # If multiple selection is supported, create an onChange event.      # If multiple selection is supported, create an onChange event.
1185      my $onChange = "";      my $onChange = "";
1186      if ($options->{multiple}) {      if ($cross) {
1187            # Here we have a paired menu. Selecting something in our menu unselects it in the
1188            # other and redisplays the status of both.
1189            $onChange = " onChange=\"crossUnSelect($menuName, '$divID', $cross, '${formName}_${cross}_status', 1000)\"";
1190        } elsif ($multiple) {
1191            # This is an unpaired menu, so all we do is redisplay our status.
1192          $onChange = " onChange=\"$showSelect\"";          $onChange = " onChange=\"$showSelect\"";
1193      }      }
1194      # Create the SELECT tag and stuff it into the output array.      # Create the SELECT tag and stuff it into the output array.
1195      my $select = "<" . join(" ", "SELECT name=\"$menuName\"$onChange", map { " $_=\"$options->{$_}\"" } keys %{$options}) . ">";      my @lines = ("<SELECT name=\"$menuName\"$onChange$multipleTag size=\"$rows\">");
     my @lines = ($select);  
1196      # Loop through the groups.      # Loop through the groups.
1197      for my $group (@groups) {      for my $group (@groups) {
1198          # Create the option group tag.          # Create the option group tag.
1199          my $tag = "<OPTGROUP label=\"$group\">";          my $tag = "<OPTGROUP label=\"$group\">";
1200          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.  
         my $label = ($group eq $FIG_Config::otherGroup ? "other" : "nmpdr");  
1201          # Get the genomes in the group.          # Get the genomes in the group.
1202          for my $genome (@{$groupHash{$group}}) {          for my $genome (@{$groupHash->{$group}}) {
1203                # Count this organism if it's NMPDR.
1204                if ($group ne $FIG_Config::otherGroup) {
1205                    $nmpdrCount++;
1206                }
1207                # Get the organism ID and name.
1208              my ($genomeID, $name) = @{$genome};              my ($genomeID, $name) = @{$genome};
1209              # See if it's selected.              # See if it's selected.
1210              my $select = ($selectedHash{$genomeID} ? " selected" : "");              my $select = ($selectedHash{$genomeID} ? " selected" : "");
1211              # Generate the option tag.              # Generate the option tag.
1212              my $optionTag = "<OPTION value=\"$genomeID\" label=\"$label\"$select>$name <em>($genomeID)</em></OPTION>";              my $optionTag = "<OPTION value=\"$genomeID\"$select>$name <em>($genomeID)</em></OPTION>";
1213              push @lines, "    $optionTag";              push @lines, "    $optionTag";
1214          }          }
1215          # Close the option group.          # Close the option group.
# Line 1170  Line 1218 
1218      # Close the SELECT tag.      # Close the SELECT tag.
1219      push @lines, "</SELECT>";      push @lines, "</SELECT>";
1220      # Check for multiple selection.      # Check for multiple selection.
1221      if ($options->{multiple}) {      if ($multiple) {
1222          # Since multi-select is on, we can set up some buttons to set and clear selections.          # Multi-select is on, so we need to add some selection helpers. First is
1223            # the search box. This allows the user to type text and have all genomes containing
1224            # the text selected automatically.
1225            my $searchThingName = "${menuName}_SearchThing";
1226            push @lines, "<br>Select genomes containing <INPUT type=\"text\" name=\"$searchThingName\" " .
1227                         "size=\"30\" onBlur=\"selectViaSearch($menuName, $searchThingName); $showSelect\" />";
1228            # Next are the buttons to set and clear selections.
1229          push @lines, "<br />";          push @lines, "<br />";
         push @lines, "<INPUT type=\"button\" name=\"SelectAll\" class=\"bigButton\" value=\"Select All\" onClick=\"selectAll($menuName); $showSelect\" />";  
1230          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\" />";
1231          push @lines, "<INPUT type=\"button\" name=\"NMPDROnly\" class=\"bigButton\"  value=\"Select NMPDR\" onClick=\"selectSome($menuName, 'nmpdr'); $showSelect\" />";          push @lines, "<INPUT type=\"button\" name=\"SelectAll\" class=\"bigButton\" value=\"Select All\" onClick=\"selectAll($menuName); $showSelect\" />";
1232          push @lines, "<INPUT type=\"button\" name=\"OtherOnly\" class=\"bigButton\" value=\"Select Supporting\" onClick=\"selectSome($menuName, 'other'); $showSelect\" />";          push @lines, "<INPUT type=\"button\" name=\"NMPDROnly\" class=\"bigButton\"  value=\"Select NMPDR\" onClick=\"selectSome($menuName, $nmpdrCount, true); $showSelect\" />";
1233            push @lines, "<INPUT type=\"button\" name=\"OtherOnly\" class=\"bigButton\" value=\"Select Supporting\" onClick=\"selectSome($menuName, $nmpdrCount, false); $showSelect\" />";
1234          # Add the status display, too.          # Add the status display, too.
1235          push @lines, "<DIV id=\"$divID\" class=\"selectStatus\"></DIV>";          push @lines, "<DIV id=\"$divID\" class=\"selectStatus\"></DIV>";
1236          # 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 1239 
1239          # in case we decide to twiddle the parameters.          # in case we decide to twiddle the parameters.
1240          $showSelect =~ s/showSelected\(/showSelected\(thisForm\./;          $showSelect =~ s/showSelected\(/showSelected\(thisForm\./;
1241          $self->QueueFormScript($showSelect);          $self->QueueFormScript($showSelect);
1242            # Finally, add this parameter to the list of genome parameters. This enables us to
1243            # easily find all the parameters used to select one or more genomes.
1244            push @{$self->{genomeParms}}, $menuName;
1245      }      }
1246      # Assemble all the lines into a string.      # Assemble all the lines into a string.
1247      my $retVal = join("\n", @lines, "");      my $retVal = join("\n", @lines, "");
# Line 1192  Line 1249 
1249      return $retVal;      return $retVal;
1250  }  }
1251    
1252    =head3 PropertyMenu
1253    
1254    C<< my $htmlText = $shelp->PropertyMenu($menuName, $selected, $force); >>
1255    
1256    Generate a property name dropdown menu.
1257    
1258    =over 4
1259    
1260    =item menuName
1261    
1262    Name to give to the menu.
1263    
1264    =item selected
1265    
1266    Value of the property name to pre-select.
1267    
1268    =item force (optional)
1269    
1270    If TRUE, then the user will be forced to choose a property name. If FALSE,
1271    then an additional menu choice will be provided to select nothing.
1272    
1273    =item RETURN
1274    
1275    Returns a dropdown menu box that allows the user to select a property name. An additional
1276    selection entry will be provided for selecting no property name
1277    
1278    =back
1279    
1280    =cut
1281    
1282    sub PropertyMenu {
1283        # Get the parameters.
1284        my ($self, $menuName, $selected, $force) = @_;
1285        # Get the CGI and Sprout objects.
1286        my $sprout = $self->DB();
1287        my $cgi = $self->Q();
1288        # Create the property name list.
1289        my @propNames = ();
1290        if (! $force) {
1291            push @propNames, "";
1292        }
1293        # Get all the property names, putting them after the null choice if one exists.
1294        push @propNames, $sprout->GetChoices('Property', 'property-name');
1295        # Create a menu from them.
1296        my $retVal = $cgi->popup_menu(-name=> $menuName, -values => \@propNames,
1297                                      -default => $selected);
1298        # Return the result.
1299        return $retVal;
1300    }
1301    
1302  =head3 MakeTable  =head3 MakeTable
1303    
1304  C<< my $htmlText = $shelp->MakeTable(\@rows); >>  C<< my $htmlText = $shelp->MakeTable(\@rows); >>
# Line 1254  Line 1361 
1361      # Get the parameters.      # Get the parameters.
1362      my ($self) = @_;      my ($self) = @_;
1363      my $cgi = $self->Q();      my $cgi = $self->Q();
1364      # Declare the return variable.      # Get the current page size.
1365        my $pageSize = $cgi->param('PageSize');
1366        # Get the incoming external-link flag.
1367        my $aliases = ($cgi->param('ShowAliases') ? 1 : 0);
1368        # 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 => $cgi->param('PageSize'))),                                                      -default => $pageSize) . " " .
1373                                       $cgi->checkbox(-name => 'ShowURL',
1374                                                      -value => 1,
1375                                                      -label => 'Show URL')),
1376                            $cgi->td($cgi->submit(-class => 'goButton',                            $cgi->td($cgi->submit(-class => 'goButton',
1377                                                  -name => 'Search',                                                  -name => 'Search',
1378                                                  -value => 'Go')));                                                  -value => 'Go')));
# Line 1270  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 1322  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 1352  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 1359  Line 1475 
1475      return $retVal;      return $retVal;
1476  }  }
1477    
1478    =head3 GetGenomes
1479    
1480    C<< my @genomeList = $shelp->GetGenomes($parmName); >>
1481    
1482    Return the list of genomes specified by the specified CGI query parameter.
1483    If the request method is POST, then the list of genome IDs is returned
1484    without preamble. If the request method is GET and the parameter is not
1485    specified, then it is treated as a request for all genomes. This makes it
1486    easier for web pages to link to a search that wants to specify all genomes.
1487    
1488    =over 4
1489    
1490    =item parmName
1491    
1492    Name of the parameter containing the list of genomes. This will be the
1493    first parameter passed to the L</NmpdrGenomeMenu> call that created the
1494    genome selection control on the form.
1495    
1496    =item RETURN
1497    
1498    Returns a list of the genomes to process.
1499    
1500    =back
1501    
1502    =cut
1503    
1504    sub GetGenomes {
1505        # Get the parameters.
1506        my ($self, $parmName) = @_;
1507        # Get the CGI query object.
1508        my $cgi = $self->Q();
1509        # Get the list of genome IDs in the request header.
1510        my @retVal = $cgi->param($parmName);
1511        Trace("Genome list for $parmName is (" . join(", ", @retVal) . ") with method " . $cgi->request_method() . ".") if T(3);
1512        # Check for the special GET case.
1513        if ($cgi->request_method() eq "GET" && ! @retVal) {
1514            # Here the caller wants all the genomes.
1515            my $sprout = $self->DB();
1516            @retVal = $sprout->Genomes();
1517        }
1518        # Return the result.
1519        return @retVal;
1520    }
1521    
1522    =head3 GetHelpText
1523    
1524    C<< my $htmlText = $shelp->GetHelpText(); >>
1525    
1526    Get the help text for this search. The help text is stored in files on the template
1527    server. The help text for a specific search is taken from a file named
1528    C<SearchHelp_>I<class>C<.inc> in the template directory C<$FIG_Config::template_url>.
1529    There are also three standard help files: C<SearchHelp1_Filtering.inc> describes the
1530    feature filtering performed by the B<FeatureQuery> object, C<SearchHelp1_GenomeControl.inc>
1531    describes how to use a multiple-selection genome control, and C<SearchHelp1_Standard.inc>
1532    describes the standard controls for a search, such as page size, URL display, and
1533    external alias display.
1534    
1535    =cut
1536    
1537    sub GetHelpText {
1538        # Get the parameters.
1539        my ($self) = @_;
1540        # Create a list to hold the pieces of the help.
1541        my @helps = ();
1542        # Get the template directory URL.
1543        my $urlBase = $FIG_Config::template_url;
1544        # Start with the specific help.
1545        my $class = $self->{class};
1546        push @helps, PageBuilder::GetPage("$urlBase/SearchHelp_$class.inc");
1547        # Add the genome control help if needed.
1548        if (scalar @{$self->{genomeParms}}) {
1549            push @helps, PageBuilder::GetPage("$urlBase/SearchHelp1_GenomeControl.inc");
1550        }
1551        # Next the filter help.
1552        if ($self->{filtered}) {
1553            push @helps, PageBuilder::GetPage("$urlBase/SearchHelp1_Filtering.inc");
1554        }
1555        # Finally, the standard help.
1556        push @helps, PageBuilder::GetPage("$urlBase/SearchHelp1_Standard.inc");
1557        # Assemble the pieces.
1558        my $retVal = join("\n<p>&nbsp;</p>\n", @helps);
1559        # Return the result.
1560        return $retVal;
1561    }
1562    
1563    =head3 ComputeSearchURL
1564    
1565    C<< my $url = $shelp->ComputeSearchURL(); >>
1566    
1567    Compute the GET-style URL for the current search. In order for this to work, there
1568    must be a copy of the search form on the current page. This will always be the
1569    case if the search is coming from C<SearchSkeleton.cgi>.
1570    
1571    A little expense is involved in order to make the URL as smart as possible. The
1572    main complication is that if the user specified all genomes, we'll want to
1573    remove the parameter entirely from a get-style URL.
1574    
1575    =cut
1576    
1577    sub ComputeSearchURL {
1578        # Get the parameters.
1579        my ($self) = @_;
1580        # Get the database and CGI query object.
1581        my $cgi = $self->Q();
1582        my $sprout = $self->DB();
1583        # Start with the full URL.
1584        my $retVal = $cgi->url(-full => 1);
1585        # Get all the query parameters in a hash.
1586        my %parms = $cgi->Vars();
1587        # Now we need to do some fixing. Each multi-valued parameter is encoded as a string with null
1588        # characters separating the individual values. We have to convert those to lists. In addition,
1589        # the multiple-selection genome parameters and the feature type parameter must be checked to
1590        # determine whether or not they can be removed from the URL. First, we get a list of the
1591        # genome parameters and a list of all genomes. Note that we only need the list if a
1592        # multiple-selection genome parameter has been found on the form.
1593        my %genomeParms = map { $_ => 1 } @{$self->{genomeParms}};
1594        my @genomeList;
1595        if (keys %genomeParms) {
1596            @genomeList = $sprout->Genomes();
1597        }
1598        # Create a list to hold the URL parameters we find.
1599        my @urlList = ();
1600        # Now loop through the parameters in the hash, putting them into the output URL.
1601        for my $parmKey (keys %parms) {
1602            # Get a list of the parameter values. If there's only one, we'll end up with
1603            # a singleton list, but that's okay.
1604            my @values = split (/\0/, $parms{$parmKey});
1605            # Check for special cases.
1606            if (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF ShowURL)) {
1607                # These are bookkeeping parameters we don't need to start a search.
1608                @values = ();
1609            } elsif ($parmKey =~ /_SearchThing$/) {
1610                # Here the value coming in is from a genome control's search thing. It does
1611                # not affect the results of the search, so we clear it.
1612                @values = ();
1613            } elsif ($genomeParms{$parmKey}) {
1614                # Here we need to see if the user wants all the genomes. If he does,
1615                # we erase all the values just like with features.
1616                my $allFlag = $sprout->IsAllGenomes(\@values, \@genomeList);
1617                if ($allFlag) {
1618                    @values = ();
1619                }
1620            }
1621            # If we still have values, create the URL parameters.
1622            if (@values) {
1623                push @urlList, map { "$parmKey=" . uri_escape($_) } @values;
1624            }
1625        }
1626        # Add the parameters to the URL.
1627        $retVal .= "?" . join(";", @urlList);
1628        # Return the result.
1629        return $retVal;
1630    }
1631    
1632    =head3 GetRunTimeValue
1633    
1634    C<< my $htmlText = $shelp->GetRunTimeValue($text); >>
1635    
1636    Compute a run-time column value.
1637    
1638    =over 4
1639    
1640    =item text
1641    
1642    The run-time column text. It consists of 2 percent signs, a column type, an equal
1643    sign, and the data for the current row.
1644    
1645    =item RETURN
1646    
1647    Returns the fully-formatted HTML text to go into the current column of the current row.
1648    
1649    =back
1650    
1651    =cut
1652    
1653    sub GetRunTimeValue {
1654        # Get the parameters.
1655        my ($self, $text) = @_;
1656        # Declare the return variable.
1657        my $retVal;
1658        # Parse the incoming text.
1659        if ($text =~ /^%%([^=]+)=(.*)$/) {
1660            $retVal = $self->RunTimeColumns($1, $2);
1661        } else {
1662            Confess("Invalid run-time column string \"$text\" encountered in session file.");
1663        }
1664        # Return the result.
1665        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    We use the %INC variable to accomplish this.
1676    
1677    =cut
1678    
1679    sub AdvancedClassList {
1680        my @retVal = map { $_ =~ /^SH(\w+)\.pm/; $1 } grep { $_ =~ /^SH/ } keys %INC;
1681        return @retVal;
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 1379  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 1391  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);
1717  }  }
1718    
1719  =head3 FeatureColumnTitle  =head3 FeatureColumnTitle
# Line 1423  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 1492  Line 1819 
1819          if (defined $extraCols->{$1}) {          if (defined $extraCols->{$1}) {
1820              $retVal = $extraCols->{$1};              $retVal = $extraCols->{$1};
1821          }          }
1822      } elsif ($colName eq 'orgName') {      } elsif ($colName eq 'alias') {
1823          # Here we want the formatted organism name and feature number.          # In this case, the user wants a list of external aliases for the feature.
1824          $retVal = $self->FeatureName($fid);          # These are very expensive, so we compute them when the row is displayed.
1825            $retVal = "%%alias=$fid";
1826      } elsif ($colName eq 'fid') {      } elsif ($colName eq 'fid') {
1827          # Here we have the raw feature ID. We hyperlink it to the protein page.          # Here we have the raw feature ID. We hyperlink it to the protein page.
1828          $retVal = HTML::set_prot_links($fid);          $retVal = HTML::set_prot_links($fid);
     } elsif ($colName eq 'alias') {  
         # In this case, the user wants a list of external aliases for the feature.  
         # The complicated part is we have to hyperlink them. First, get the  
         # aliases.  
         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);  
         }  
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 1520  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 1534  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.
1865        return $retVal;
1866    }
1867    
1868    =head3 RunTimeColumns
1869    
1870    C<< my $htmlText = $shelp->RunTimeColumns($type, $text); >>
1871    
1872    Return the HTML text for a run-time column. Run-time columns are evaluated when the
1873    list is displayed, rather than when it is generated.
1874    
1875    =over 4
1876    
1877    =item type
1878    
1879    Type of column.
1880    
1881    =item text
1882    
1883    Data relevant to this row of the column.
1884    
1885    =item RETURN
1886    
1887    Returns the fully-formatted HTML text to go in the specified column.
1888    
1889    =back
1890    
1891    =cut
1892    
1893    sub RunTimeColumns {
1894        # Get the parameters.
1895        my ($self, $type, $text) = @_;
1896        # Declare the return variable.
1897        my $retVal = "";
1898        # Get the Sprout and CGI objects.
1899        my $sprout = $self->DB();
1900        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.
1903        if ($type eq 'alias') {
1904            # Here the caller wants external alias links for a feature. The text
1905            # is the feature ID.
1906            my $fid = $text;
1907            # The complicated part is we have to hyperlink them. First, get the
1908            # aliases.
1909            Trace("Generating aliases for feature $fid.") if T(4);
1910            my @aliases = $sprout->FeatureAliases($fid);
1911            # Only proceed if we found some.
1912            if (@aliases) {
1913                # Join the aliases into a comma-delimited list.
1914                my $aliasList = join(", ", @aliases);
1915                # Ask the HTML processor to hyperlink them.
1916                $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.
1943        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
2014    
2015    =head3 Form
2016    
2017    C<< my $html = $shelp->Form(); >>
2018    
2019    Generate the HTML for a form to request a new search.
2020    
2021    =head3 Find
2022    
2023    C<< my $resultCount = $shelp->Find(); >>
2024    
2025    Conduct a search based on the current CGI query parameters. The search results will
2026    be written to the session cache file and the number of results will be
2027    returned. If the search parameters are invalid, a result count of C<undef> will be
2028    returned and a result message will be stored in this object describing the problem.
2029    
2030    =head3 Description
2031    
2032    C<< my $htmlText = $shelp->Description(); >>
2033    
2034    Return a description of this search. The description is used for the table of contents
2035    on the main search tools page. It may contain HTML, but it should be character-level,
2036    not block-level, since the description is going to appear in a list.
2037    
2038    =head3 SortKey
2039    
2040    C<< my $key = $shelp->SortKey($fdata); >>
2041    
2042    Return the sort key for the specified feature data. The default is to sort by feature name,
2043    floating NMPDR organisms to the top. If a full-text search is used, then the default
2044    sort is by relevance followed by feature name. This sort may be overridden by the
2045    search class to provide fancier functionality. This method is called by
2046    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
2050    
2051    =item record
2052    
2053    The C<FeatureData> containing the current feature.
2054    
2055    =item RETURN
2056    
2057    Returns a key field that can be used to sort this row in among the results.
2058    
2059    =back
2060    
2061    =cut
2062    
2063    sub SortKey {
2064        # Get the parameters.
2065        my ($self, $fdata) = @_;
2066        # Get the feature ID from the record.
2067        my $fid = $fdata->FID();
2068        # Get the group from the feature ID.
2069        my $group = $self->FeatureGroup($fid);
2070        # Ask the feature query object to form the sort key.
2071        my $retVal = $fdata->SortKey($self, $group);
2072      # Return the result.      # Return the result.
2073      return $retVal;      return $retVal;
2074  }  }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3