[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.3, Fri Sep 29 15:10:05 2006 UTC revision 1.13, Fri Nov 3 00:40:16 2006 UTC
# Line 214  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 237  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 341  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 632  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 643  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 654  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 669  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.      # Get the CGI query object.
651      my $cgi = $self->Q();      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 the externals if they were requested.          # Add any additional columns requested by the feature filter.
660          if ($cgi->param('ShowAliases')) {          push @{$self->{cols}}, FeatureQuery::AdditionalColumns($self);
             push @{$self->{cols}}, 'alias';  
         }  
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 692  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 782  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 799  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 855  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 970  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 1019  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 1033  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 1068  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 1114  Line 1091 
1091  Number of rows to display. If omitted, the default is 1 for a single-select list  Number of rows to display. If omitted, the default is 1 for a single-select list
1092  and 10 for a multi-select list.  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 1124  Line 1108 
1108    
1109  sub NmpdrGenomeMenu {  sub NmpdrGenomeMenu {
1110      # Get the parameters.      # Get the parameters.
1111      my ($self, $menuName, $multiple, $selected, $rows) = @_;      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();
# Line 1158  Line 1142 
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.
             # Push the genome into the group's list.  
1150              push @{$gHash{$group}}, [$genomeID, $name];              push @{$gHash{$group}}, [$genomeID, $name];
1151          }          }
1152          # Save the genome list for future use.          # Save the genome list for future use.
# Line 1180  Line 1163 
1163      if (defined $selected) {      if (defined $selected) {
1164          %selectedHash = map { $_ => 1 } grep { defined($_) } @{$selected};          %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. We take advantage
1167        # of the fact they come first in the list. We'll accumulate a count of the NMPDR genomes
1168        # and use that to make the selections.
1169        my $nmpdrCount = 0;
1170      # Create the type counters.      # Create the type counters.
1171      my $groupCount = 1;      my $groupCount = 1;
1172      # Compute the ID for the status display.      # Compute the ID for the status display.
# Line 1189  Line 1175 
1175      my $showSelect = "showSelected($menuName, '$divID', 1000);";      my $showSelect = "showSelected($menuName, '$divID', 1000);";
1176      # If multiple selection is supported, create an onChange event.      # If multiple selection is supported, create an onChange event.
1177      my $onChange = "";      my $onChange = "";
1178      if ($multiple) {      if ($cross) {
1179            # Here we have a paired menu. Selecting something in our menu unselects it in the
1180            # other and redisplays the status of both.
1181            $onChange = " onChange=\"crossUnSelect($menuName, '$divID', $cross, '${formName}_${cross}_status', 1000)\"";
1182        } elsif ($multiple) {
1183            # This is an unpaired menu, so all we do is redisplay our status.
1184          $onChange = " onChange=\"$showSelect\"";          $onChange = " onChange=\"$showSelect\"";
1185      }      }
1186      # Create the SELECT tag and stuff it into the output array.      # Create the SELECT tag and stuff it into the output array.
1187      my $select = "<SELECT name=\"$menuName\"$onChange$multipleTag size=\"$rows\">";      my @lines = ("<SELECT name=\"$menuName\"$onChange$multipleTag size=\"$rows\">");
     my @lines = ($select);  
1188      # Loop through the groups.      # Loop through the groups.
1189      for my $group (@groups) {      for my $group (@groups) {
1190          # Create the option group tag.          # Create the option group tag.
1191          my $tag = "<OPTGROUP label=\"$group\">";          my $tag = "<OPTGROUP label=\"$group\">";
1192          push @lines, "  $tag";          push @lines, "  $tag";
         # Compute the label for this group's options. This is seriously dirty stuff, as the  
         # label option may have functionality in future browsers. If that happens, we'll need  
         # to modify the genome text so that the "selectSome" method can tell which are NMPDR  
         # organisms and which aren't. Sadly, the OPTGROUP tag is invisible in the DOM Javascript  
         # hierarchy, so we can't use it.  
         my $label = ($group eq $FIG_Config::otherGroup ? "other" : "nmpdr");  
1193          # Get the genomes in the group.          # Get the genomes in the group.
1194          for my $genome (@{$groupHash->{$group}}) {          for my $genome (@{$groupHash->{$group}}) {
1195                # Count this organism if it's NMPDR.
1196                if ($group ne $FIG_Config::otherGroup) {
1197                    $nmpdrCount++;
1198                }
1199                # Get the organism ID and name.
1200              my ($genomeID, $name) = @{$genome};              my ($genomeID, $name) = @{$genome};
1201              # See if it's selected.              # See if it's selected.
1202              my $select = ($selectedHash{$genomeID} ? " selected" : "");              my $select = ($selectedHash{$genomeID} ? " selected" : "");
1203              # Generate the option tag.              # Generate the option tag.
1204              my $optionTag = "<OPTION value=\"$genomeID\" label=\"$label\"$select>$name <em>($genomeID)</em></OPTION>";              my $optionTag = "<OPTION value=\"$genomeID\"$select>$name <em>($genomeID)</em></OPTION>";
1205              push @lines, "    $optionTag";              push @lines, "    $optionTag";
1206          }          }
1207          # Close the option group.          # Close the option group.
# Line 1226  Line 1215 
1215          push @lines, "<br />";          push @lines, "<br />";
1216          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\" />";
1217          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\" />";
1218          push @lines, "<INPUT type=\"button\" name=\"NMPDROnly\" class=\"bigButton\"  value=\"Select NMPDR\" onClick=\"selectSome($menuName, 'nmpdr'); $showSelect\" />";          push @lines, "<INPUT type=\"button\" name=\"NMPDROnly\" class=\"bigButton\"  value=\"Select NMPDR\" onClick=\"selectSome($menuName, $nmpdrCount, true); $showSelect\" />";
1219          push @lines, "<INPUT type=\"button\" name=\"OtherOnly\" class=\"bigButton\" value=\"Select Supporting\" onClick=\"selectSome($menuName, 'other'); $showSelect\" />";          push @lines, "<INPUT type=\"button\" name=\"OtherOnly\" class=\"bigButton\" value=\"Select Supporting\" onClick=\"selectSome($menuName, $nmpdrCount, false); $showSelect\" />";
1220          # Now add the search box. This allows the user to type text and have all genomes containing          # Now add the search box. This allows the user to type text and have all genomes containing
1221          # the text selected automatically.          # the text selected automatically.
1222          my $searchThingName = "${menuName}_SearchThing";          my $searchThingName = "${menuName}_SearchThing";
# Line 1370  Line 1359 
1359      # Create the row.      # Create the row.
1360      my $retVal = $cgi->Tr($cgi->td("Results/Page"),      my $retVal = $cgi->Tr($cgi->td("Results/Page"),
1361                            $cgi->td($cgi->popup_menu(-name => 'PageSize',                            $cgi->td($cgi->popup_menu(-name => 'PageSize',
1362                                                      -values => [10, 25, 45, 100, 1000],                                                      -values => [10, 25, 50, 100, 1000],
1363                                                      -default => $pageSize) . " " .                                                      -default => $pageSize) . " " .
                                    $cgi->checkbox(-name => 'ShowAliases',  
                                                   -value => 1,  
                                                   -label => 'Show Alias Links',  
                                                   -default => $aliases),  
1364                                     $cgi->checkbox(-name => 'ShowURL',                                     $cgi->checkbox(-name => 'ShowURL',
1365                                                    -value => 1,                                                    -value => 1,
1366                                                    -label => 'Show URL')),                                                    -label => 'Show URL')),
# Line 1390  Line 1375 
1375    
1376  C<< my $htmlText = $shelp->FeatureFilterRows(); >>  C<< my $htmlText = $shelp->FeatureFilterRows(); >>
1377    
1378  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
1379  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>
1380  using the B<FeatureQuery> object.  object.
1381    
1382  =cut  =cut
1383    
# Line 1442  Line 1427 
1427          # Get the feature location string.          # Get the feature location string.
1428          my $loc = $sprout->FeatureLocation($feat);          my $loc = $sprout->FeatureLocation($feat);
1429          # Compute the contig, start, and stop points.          # Compute the contig, start, and stop points.
1430          my($start, $stop, $contig) = BasicLocation::Parse($loc);          my($contig, $start, $stop) = BasicLocation::Parse($loc);
1431            Trace("Start and stop are ($start,$stop) on contig $contig.") if T(3);
1432          # 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
1433          # big and that we get some surrounding stuff.          # big and that we get some surrounding stuff.
1434          my $mid = int(($start + $stop) / 2);          my $mid = int(($start + $stop) / 2);
# Line 1472  Line 1458 
1458          }          }
1459          my $seg_id = $contig;          my $seg_id = $contig;
1460          $seg_id =~ s/:/--/g;          $seg_id =~ s/:/--/g;
1461            Trace("Show limits are ($show_start,$show_stop) in genome $genomeID with ref $seg_id.") if T(3);
1462          # Assemble all the pieces.          # Assemble all the pieces.
1463          $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";
1464      }      }
# Line 1607  Line 1594 
1594          # a singleton list, but that's okay.          # a singleton list, but that's okay.
1595          my @values = split (/\0/, $parms{$parmKey});          my @values = split (/\0/, $parms{$parmKey});
1596          # Check for special cases.          # Check for special cases.
1597          if ($parmKey eq 'featureTypes') {          if (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF ShowURL)) {
             # Here we need to see if the user wants all the feature types. If he  
             # does, we erase all the values so that the parameter is not output.  
             my %valueCheck = map { $_ => 1 } @values;  
             my @list = FeatureQuery::AllFeatureTypes();  
             my $okFlag = 1;  
             for (my $i = 0; $okFlag && $i <= $#list; $i++) {  
                 if (! $valueCheck{$list[$i]}) {  
                     $okFlag = 0;  
                 }  
             }  
             if ($okFlag) {  
                 @values = ();  
             }  
         } elsif (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF ShowURL)) {  
1598              # These are bookkeeping parameters we don't need to start a search.              # These are bookkeeping parameters we don't need to start a search.
1599              @values = ();              @values = ();
1600          } elsif ($parmKey =~ /_SearchThing$/) {          } elsif ($parmKey =~ /_SearchThing$/) {
# Line 1683  Line 1656 
1656      return $retVal;      return $retVal;
1657  }  }
1658    
1659    =head3 AdvancedClassList
1660    
1661    C<< my @classes = SearchHelper::AdvancedClassList(); >>
1662    
1663    Return a list of advanced class names. This list is used to generate the directory
1664    of available searches on the search page.
1665    
1666    The reason we have to convert the list from a string is that the B<NMPDRSetup.pl>
1667    script is only able to insert strings into the generated B<FIG_Config> file.
1668    
1669    =cut
1670    
1671    sub AdvancedClassList {
1672        return split /\s+/, $FIG_Config::advanced_classes;
1673    }
1674    
1675  =head2 Feature Column Methods  =head2 Feature Column Methods
1676    
1677  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 1715  Line 1704 
1704      # Get the parameters.      # Get the parameters.
1705      my ($self) = @_;      my ($self) = @_;
1706      # Return the result.      # Return the result.
1707      return ['orgName', 'function', 'gblink', 'protlink'];      return ['orgName', 'function', 'gblink', 'protlink',
1708                FeatureQuery::AdditionalColumns($self)];
1709  }  }
1710    
1711  =head3 FeatureColumnTitle  =head3 FeatureColumnTitle
# Line 1747  Line 1737 
1737      if ($colName =~ /^X=(.+)$/) {      if ($colName =~ /^X=(.+)$/) {
1738          # Here we have an extra column.          # Here we have an extra column.
1739          $retVal = $1;          $retVal = $1;
     } elsif ($colName eq 'orgName') {  
         $retVal = "Name";  
     } elsif ($colName eq 'fid') {  
         $retVal = "FIG ID";  
1740      } elsif ($colName eq 'alias') {      } elsif ($colName eq 'alias') {
1741          $retVal = "External Aliases";          $retVal = "External Aliases";
1742        } elsif ($colName eq 'fid') {
1743            $retVal = "FIG ID";
1744      } elsif ($colName eq 'function') {      } elsif ($colName eq 'function') {
1745          $retVal = "Functional Assignment";          $retVal = "Functional Assignment";
1746      } elsif ($colName eq 'gblink') {      } elsif ($colName eq 'gblink') {
1747          $retVal = "GBrowse";          $retVal = "GBrowse";
     } elsif ($colName eq 'protlink') {  
         $retVal = "NMPDR Protein Page";  
1748      } elsif ($colName eq 'group') {      } elsif ($colName eq 'group') {
1749          $retVal = "NMDPR Group";          $retVal = "NMDPR Group";
1750        } elsif ($colName =~ /^keyword:(.+)$/) {
1751            $retVal = ucfirst $1;
1752        } elsif ($colName eq 'orgName') {
1753            $retVal = "Name";
1754        } elsif ($colName eq 'protlink') {
1755            $retVal = "NMPDR Protein Page";
1756        } elsif ($colName eq 'subsystem') {
1757            $retVal = "Subsystems";
1758      }      }
1759      # Return the result.      # Return the result.
1760      return $retVal;      return $retVal;
1761  }  }
1762    
1763    
1764  =head3 FeatureColumnValue  =head3 FeatureColumnValue
1765    
1766  C<< my $value = $shelp->FeatureColumnValue($colName, $fid, \%extraCols); >>  C<< my $value = $shelp->FeatureColumnValue($colName, $fid, \%extraCols); >>
# Line 1816  Line 1811 
1811          if (defined $extraCols->{$1}) {          if (defined $extraCols->{$1}) {
1812              $retVal = $extraCols->{$1};              $retVal = $extraCols->{$1};
1813          }          }
     } elsif ($colName eq 'orgName') {  
         # Here we want the formatted organism name and feature number.  
         $retVal = $self->FeatureName($fid);  
     } elsif ($colName eq 'fid') {  
         # Here we have the raw feature ID. We hyperlink it to the protein page.  
         $retVal = HTML::set_prot_links($fid);  
1814      } elsif ($colName eq 'alias') {      } elsif ($colName eq 'alias') {
1815          # 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.
1816          # These are very expensive, so we compute them when the row is displayed.          # These are very expensive, so we compute them when the row is displayed.
1817          $retVal = "%%aliases=$fid";          $retVal = "%%alias=$fid";
1818        } elsif ($colName eq 'fid') {
1819            # Here we have the raw feature ID. We hyperlink it to the protein page.
1820            $retVal = HTML::set_prot_links($fid);
1821      } elsif ($colName eq 'function') {      } elsif ($colName eq 'function') {
1822          # The functional assignment is just a matter of getting some text.          # The functional assignment is just a matter of getting some text.
1823          ($retVal) = $record->Value('Feature(assignment)');          ($retVal) = $record->Value('Feature(assignment)');
# Line 1836  Line 1828 
1828                            $cgi->img({ src => "../images/button-gbrowse.png",                            $cgi->img({ src => "../images/button-gbrowse.png",
1829                                        border => 0 })                                        border => 0 })
1830                           );                           );
     } 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 })  
                          );  
1831      } elsif ($colName eq 'group') {      } elsif ($colName eq 'group') {
1832          # Get the NMPDR group name.          # Get the NMPDR group name.
1833          my (undef, $group) = $self->OrganismData($fid);          my (undef, $group) = $self->OrganismData($fid);
# Line 1850  Line 1835 
1835          my $nurl = $sprout->GroupPageName($group);          my $nurl = $sprout->GroupPageName($group);
1836          $retVal = $cgi->a({ href => $nurl, title => "$group summary" },          $retVal = $cgi->a({ href => $nurl, title => "$group summary" },
1837                            $group);                            $group);
1838        } elsif ($colName =~ /^keyword:(.+)$/) {
1839            # Here we want keyword-related values. This is also expensive, so
1840            # we compute them when the row is displayed.
1841            $retVal = "%%colName=$fid";
1842        } elsif ($colName eq 'orgName') {
1843            # Here we want the formatted organism name and feature number.
1844            $retVal = $self->FeatureName($fid);
1845        } elsif ($colName eq 'protlink') {
1846            # Here we want a link to the protein page using the official NMPDR button.
1847            my $hurl = HTML::fid_link($cgi, $fid, 0, 1);
1848            $retVal = $cgi->a({ href => $hurl, title => "Protein page for $fid" },
1849                              $cgi->img({ src => "../images/button-nmpdr.png",
1850                                         border => 0 })
1851                             );
1852        }elsif ($colName eq 'subsystem') {
1853            # Another run-time column: subsystem list.
1854            $retVal = "%%subsystem=$fid";
1855      }      }
1856      # Return the result.      # Return the result.
1857      return $retVal;      return $retVal;
# Line 1889  Line 1891 
1891      my $sprout = $self->DB();      my $sprout = $self->DB();
1892      my $cgi = $self->Q();      my $cgi = $self->Q();
1893      # Separate the text into a type and data.      # Separate the text into a type and data.
1894      if ($type eq 'aliases') {      if ($type eq 'alias') {
1895          # Here the caller wants external alias links for a feature. The text          # Here the caller wants external alias links for a feature. The text
1896          # is the feature ID.          # is the feature ID.
1897          my $fid = $text;          my $fid = $text;
# Line 1904  Line 1906 
1906              # Ask the HTML processor to hyperlink them.              # Ask the HTML processor to hyperlink them.
1907              $retVal = HTML::set_prot_links($cgi, $aliasList);              $retVal = HTML::set_prot_links($cgi, $aliasList);
1908          }          }
1909        } elsif ($type eq 'subsystem') {
1910            # Here the caller wants the subsystems in which this feature participates.
1911            # The text is the feature ID. We will list the subsystem names with links
1912            # to the subsystem's summary page.
1913            my $fid = $text;
1914            # Get the subsystems.
1915            Trace("Generating subsystems for feature $fid.") if T(4);
1916            my %subs = $sprout->SubsystemsOf($fid);
1917            # Convert them to links.
1918            my @links = map { HTML::sub_link($cgi, $_) } sort keys %subs;
1919            # String them into a list.
1920            $retVal = join(", ", @links);
1921        } elsif ($type =~ /^keyword:(.+)$/) {
1922            # Here the caller wants the value of the named keyword. The text is the
1923            # feature ID.
1924            my $keywordName = $1;
1925            my $fid = $text;
1926            # Get the attribute values.
1927            Trace("Getting $keywordName values for feature $fid.") if T(4);
1928            my @values = $sprout->GetFlat(['Feature'], "Feature(id) = ?", [$fid],
1929                                          "Feature($keywordName)");
1930            # String them into a list.
1931            $retVal = join(", ", @values);
1932        }
1933        # Return the result.
1934        return $retVal;
1935    }
1936    
1937    =head3 SaveOrganismData
1938    
1939    C<< my ($name, $displayGroup) = $shelp->SaveOrganismData($group, $genomeID, $genus, $species, $strain); >>
1940    
1941    Format the name of an organism and the display version of its group name. The incoming
1942    data should be the relevant fields from the B<Genome> record in the database. The
1943    data will also be stored in the genome cache for later use in posting search results.
1944    
1945    =over 4
1946    
1947    =item group
1948    
1949    Name of the genome's group as it appears in the database.
1950    
1951    =item genomeID
1952    
1953    ID of the relevant genome.
1954    
1955    =item genus
1956    
1957    Genus of the genome's organism. If undefined or null, it will be assumed the genome is not
1958    in the database. In this case, the organism name is derived from the genomeID and the group
1959    is automatically the supporting-genomes group.
1960    
1961    =item species
1962    
1963    Species of the genome's organism.
1964    
1965    =item strain
1966    
1967    Strain of the species represented by the genome.
1968    
1969    =item RETURN
1970    
1971    Returns a two-element list. The first element is the formatted genome name. The second
1972    element is the display name of the genome's group.
1973    
1974    =back
1975    
1976    =cut
1977    
1978    sub SaveOrganismData {
1979        # Get the parameters.
1980        my ($self, $group, $genomeID, $genus, $species, $strain) = @_;
1981        # Declare the return values.
1982        my ($name, $displayGroup);
1983        # If the organism does not exist, format an unknown name and a blank group.
1984        if (! defined($genus)) {
1985            $name = "Unknown Genome $genomeID";
1986            $displayGroup = "";
1987        } else {
1988            # It does exist, so format the organism name.
1989            $name = "$genus $species";
1990            if ($strain) {
1991                $name .= " $strain";
1992      }      }
1993            # Compute the display group. This is currently the same as the incoming group
1994            # name unless it's the supporting group, which is nulled out.
1995            $displayGroup = ($group eq $FIG_Config::otherGroup ? "" : $group);
1996        }
1997        # Cache the group and organism data.
1998        my $cache = $self->{orgs};
1999        $cache->{$genomeID} = [$name, $displayGroup];
2000        # Return the result.
2001        return ($name, $displayGroup);
2002    }
2003    
2004    =head2 Virtual Methods
2005    
2006    =head3 Form
2007    
2008    C<< my $html = $shelp->Form(); >>
2009    
2010    Generate the HTML for a form to request a new search.
2011    
2012    =head3 Find
2013    
2014    C<< my $resultCount = $shelp->Find(); >>
2015    
2016    Conduct a search based on the current CGI query parameters. The search results will
2017    be written to the session cache file and the number of results will be
2018    returned. If the search parameters are invalid, a result count of C<undef> will be
2019    returned and a result message will be stored in this object describing the problem.
2020    
2021    =head3 Description
2022    
2023    C<< my $htmlText = $shelp->Description(); >>
2024    
2025    Return a description of this search. The description is used for the table of contents
2026    on the main search tools page. It may contain HTML, but it should be character-level,
2027    not block-level, since the description is going to appear in a list.
2028    
2029    =head3 SortKey
2030    
2031    C<< my $key = $shelp->SortKey($fdata); >>
2032    
2033    Return the sort key for the specified feature data. The default is to sort by feature name,
2034    floating NMPDR organisms to the top. If a full-text search is used, then the default
2035    sort is by relevance followed by feature name. This sort may be overridden by the
2036    search class to provide fancier functionality. This method is called by
2037    B<PutFeature>, so it is only used for feature searches. A non-feature search
2038    would presumably have its own sort logic.
2039    
2040    =over 4
2041    
2042    =item record
2043    
2044    The C<FeatureData> containing the current feature.
2045    
2046    =item RETURN
2047    
2048    Returns a key field that can be used to sort this row in among the results.
2049    
2050    =back
2051    
2052    =cut
2053    
2054    sub SortKey {
2055        # Get the parameters.
2056        my ($self, $fdata) = @_;
2057        # Get the feature ID from the record.
2058        my $fid = $fdata->FID();
2059        # Get the group from the feature ID.
2060        my $group = $self->FeatureGroup($fid);
2061        # Ask the feature query object to form the sort key.
2062        my $retVal = $fdata->SortKey($self, $group);
2063      # Return the result.      # Return the result.
2064      return $retVal;      return $retVal;
2065  }  }

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.13

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3