[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.10, Fri Oct 13 21:45:11 2006 UTC
# Line 17  Line 17 
17      use HTML;      use HTML;
18      use BasicLocation;      use BasicLocation;
19      use FeatureQuery;      use FeatureQuery;
20        use URI::Escape;
21        use PageBuilder;
22    
23  =head1 Search Helper Base Class  =head1 Search Helper Base Class
24    
# Line 73  Line 75 
75    
76  List of JavaScript statements to be executed after the form is closed.  List of JavaScript statements to be executed after the form is closed.
77    
78    =item genomeHash
79    
80    Cache of the genome group hash used to build genome selection controls.
81    
82    =item genomeParms
83    
84    List of the parameters that are used to select multiple genomes.
85    
86    =item filtered
87    
88    TRUE if this is a feature-filtered search, else FALSE. B<NOTE> that this
89    field is updated by the B<FeatureQuery> object.
90    
91  =back  =back
92    
93  =head2 Adding a new Search Tool  =head2 Adding a new Search Tool
# Line 139  Line 154 
154    
155  =item 1  =item 1
156    
157  L</NmpdrGenomeMenu> generates a control for selecting one or more genomes.  L</NmpdrGenomeMenu> generates a control for selecting one or more genomes. Use
158    L</GetGenomes> to retrieve all the genomes passed in for a specified parameter
159    name. Note that as an assist to people working with GET-style links, if no
160    genomes are specified and the incoming request style is GET, all genomes will
161    be returned.
162    
163  =item 2  =item 2
164    
# Line 195  Line 214 
214                      }                      }
215                  }                  }
216              }              }
         }  
217          # Close the session file.          # Close the session file.
218          $self->CloseSession();          $self->CloseSession();
219            }
220          # Return the result count.          # Return the result count.
221          return $retVal;          return $retVal;
222      }      }
# Line 218  Line 237 
237  by calling L</SetMessage>. If the parameters are valid, then the method must return  by calling L</SetMessage>. If the parameters are valid, then the method must return
238  the number of items found.  the number of items found.
239    
 =head2 Virtual Methods  
   
 =head3 Form  
   
 C<< my $html = $shelp->Form(); >>  
   
 Generate the HTML for a form to request a new search.  
   
 =head3 Find  
   
 C<< my $resultCount = $shelp->Find(); >>  
   
 Conduct a search based on the current CGI query parameters. The search results will  
 be written to the session cache file and the number of results will be  
 returned. If the search parameters are invalid, a result count of C<undef> will be  
 returned and a result message will be stored in this object describing the problem.  
   
 =head3 Description  
   
 C<< my $htmlText = $shelp->Description(); >>  
   
 Return a description of this search. The description is used for the table of contents  
 on the main search tools page. It may contain HTML, but it should be character-level,  
 not block-level, since the description is going to appear in a list.  
   
240  =cut  =cut
241    
242  # This counter is used to insure every form on the page has a unique name.  # This counter is used to insure every form on the page has a unique name.
# Line 298  Line 292 
292                    orgs => {},                    orgs => {},
293                    name => $formName,                    name => $formName,
294                    scriptQueue => [],                    scriptQueue => [],
295                      genomeList => undef,
296                      genomeParms => [],
297                      filtered => 0,
298                   };                   };
299      # Bless and return it.      # Bless and return it.
300      bless $retVal, $class;      bless $retVal, $class;
# Line 319  Line 316 
316      return $self->{query};      return $self->{query};
317  }  }
318    
319    
320    
321  =head3 DB  =head3 DB
322    
323  C<< my $sprout = $shelp->DB(); >>  C<< my $sprout = $shelp->DB(); >>
# Line 648  Line 647 
647  sub PutFeature {  sub PutFeature {
648      # Get the parameters.      # Get the parameters.
649      my ($self, $fq) = @_;      my ($self, $fq) = @_;
650        # Get the CGI query object.
651        my $cgi = $self->Q();
652      # Get the feature data.      # Get the feature data.
653      my $record = $fq->Feature();      my $record = $fq->Feature();
654      my $extraCols = $fq->ExtraCols();      my $extraCols = $fq->ExtraCols();
# Line 655  Line 656 
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.
660            if ($cgi->param('ShowAliases')) {
661                push @{$self->{cols}}, 'alias';
662            }
663          # Append the extras, sorted by column name.          # Append the extras, sorted by column name.
664          for my $col (sort keys %{$extraCols}) {          for my $col (sort keys %{$extraCols}) {
665              push @{$self->{cols}}, "X=$col";              push @{$self->{cols}}, "X=$col";
# Line 670  Line 675 
675      for my $colName (@{$self->{cols}}) {      for my $colName (@{$self->{cols}}) {
676          push @output, $self->FeatureColumnValue($colName, $record, $extraCols);          push @output, $self->FeatureColumnValue($colName, $record, $extraCols);
677      }      }
678      # 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
679      # top of the return list.      # top of the return list.
680      my $group = $self->FeatureGroup($fid);      my $key = $self->SortKey($record);
     my $key = ($group ? "A$group" : "ZZ");  
681      # Write the feature data.      # Write the feature data.
682      $self->WriteColumnData($key, @output);      $self->WriteColumnData($key, @output);
683  }  }
# Line 754  Line 758 
758      # Check for an open session file.      # Check for an open session file.
759      if (defined $self->{fileHandle}) {      if (defined $self->{fileHandle}) {
760          # We found one, so close it.          # We found one, so close it.
761            Trace("Closing session file.") if T(2);
762          close $self->{fileHandle};          close $self->{fileHandle};
763      }      }
764  }  }
# Line 771  Line 776 
776      my $retVal;      my $retVal;
777      # Get a digest encoder.      # Get a digest encoder.
778      my $md5 = Digest::MD5->new();      my $md5 = Digest::MD5->new();
779      # 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
780      if (open(R, "/dev/urandom")) {      # actually two numbers, and we get them both because we're in list
781          my $b;      # context.
782          read(R, $b, 1024);      $md5->add($$, $ENV{REMOTE_ADDR}, $ENV{REMOTE_PORT}, gettimeofday());
783          $md5->add($b);      # Hash up all this identifying data.
784      }      $retVal = $md5->hexdigest();
785      # 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.  
786      return $retVal;      return $retVal;
787  }  }
788    
# Line 827  Line 826 
826                                                      ['Genome(genus)', 'Genome(species)',                                                      ['Genome(genus)', 'Genome(species)',
827                                                       'Genome(unique-characterization)',                                                       'Genome(unique-characterization)',
828                                                       'Genome(primary-group)']);                                                       'Genome(primary-group)']);
829          # Null out the supporting group.          # Format and cache the name and display group.
830          $group = "" if ($group eq $FIG_Config::otherGroup);          ($orgName, $group) = $self->SaveOrganismData($group, $genomeID, $genus, $species,
831          # 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];  
832      }      }
833      # Return the result.      # Return the result.
834      return ($orgName, $group);      return ($orgName, $group);
# Line 942  Line 930 
930      } else {      } else {
931          # Here we can get its genome data.          # Here we can get its genome data.
932          $retVal = $self->Organism($genomeID);          $retVal = $self->Organism($genomeID);
933          # Append the type and number.          # Append the FIG ID.
934          $retVal .= " [$type $num]";          $retVal .= " [$fid]";
935      }      }
936      # Return the result.      # Return the result.
937      return $retVal;      return $retVal;
# Line 1059  Line 1047 
1047    
1048  =head3 NmpdrGenomeMenu  =head3 NmpdrGenomeMenu
1049    
1050  C<< my $htmlText = $shelp->NmpdrGenomeMenu($menuName, \%options, \@selected); >>  C<< my $htmlText = $shelp->NmpdrGenomeMenu($menuName, $multiple, \@selected, $rows); >>
1051    
1052  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
1053  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 1059 
1059    
1060  Name to give to the menu.  Name to give to the menu.
1061    
1062  =item options  =item multiple
1063    
1064  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.  
1065    
1066  =item selected  =item selected
1067    
# Line 1084  Line 1069 
1069  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
1070  list is empty, nothing will be pre-selected.  list is empty, nothing will be pre-selected.
1071    
1072    =item rows (optional)
1073    
1074    Number of rows to display. If omitted, the default is 1 for a single-select list
1075    and 10 for a multi-select list.
1076    
1077    =item crossMenu (optional)
1078    
1079    If specified, is presumed to be the name of another genome menu whose contents
1080    are to be mutually exclusive with the contents of this menu. As a result, instead
1081    of the standard onChange event, the onChange event will deselect any entries in
1082    the other menu.
1083    
1084  =item RETURN  =item RETURN
1085    
1086  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 1091 
1091    
1092  sub NmpdrGenomeMenu {  sub NmpdrGenomeMenu {
1093      # Get the parameters.      # Get the parameters.
1094      my ($self, $menuName, $options, $selected) = @_;      my ($self, $menuName, $multiple, $selected, $rows, $cross) = @_;
1095      # Get the Sprout and CGI objects.      # Get the Sprout and CGI objects.
1096      my $sprout = $self->DB();      my $sprout = $self->DB();
1097      my $cgi = $self->Q();      my $cgi = $self->Q();
1098        # Compute the row count.
1099        if (! defined $rows) {
1100            $rows = ($multiple ? 10 : 1);
1101        }
1102        # Create the multiple tag.
1103        my $multipleTag = ($multiple ? " multiple" : "");
1104      # Get the form name.      # Get the form name.
1105      my $formName = $self->FormName();      my $formName = $self->FormName();
1106        # Check to see if we already have a genome list in memory.
1107        my $genomes = $self->{genomeList};
1108        my $groupHash;
1109        if (defined $genomes) {
1110            # We have a list ready to use.
1111            $groupHash = $genomes;
1112        } else {
1113      # 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
1114      # 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
1115      # take advantage of an existing index.      # take advantage of an existing index.
# Line 1111  Line 1121 
1121      # 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
1122      # 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
1123      # name.      # name.
1124      my %groupHash = ();          my %gHash = ();
1125      for my $genome (@genomeList) {      for my $genome (@genomeList) {
1126          # Get the genome data.          # Get the genome data.
1127          my ($group, $genomeID, $genus, $species, $strain) = @{$genome};          my ($group, $genomeID, $genus, $species, $strain) = @{$genome};
1128          # Form the genome name.              # Compute and cache its name and display group.
1129          my $name = "$genus $species";              my ($name, $displayGroup) = $self->SaveOrganismData($group, $genomeID, $genus, $species,
1130          if ($strain) {                                                                  $strain);
1131              $name .= " $strain";              # Push the genome into the group's list. Note that we use the real group
1132          }              # name here, not the display group name.
1133          # Push the genome into the group's list.              push @{$gHash{$group}}, [$genomeID, $name];
1134          push @{$groupHash{$group}}, [$genomeID, $name];          }
1135            # Save the genome list for future use.
1136            $self->{genomeList} = \%gHash;
1137            $groupHash = \%gHash;
1138      }      }
1139      # 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
1140      # the supporting-genome group last.      # the supporting-genome group last.
1141      my @groups = sort grep { $_ ne $FIG_Config::otherGroup } keys %groupHash;      my @groups = sort grep { $_ ne $FIG_Config::otherGroup } keys %{$groupHash};
1142      push @groups, $FIG_Config::otherGroup;      push @groups, $FIG_Config::otherGroup;
1143      # 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
1144      my %selectedHash = map { $_ => 1 } @{$selected};      # with the possibility of undefined values in the incoming list.
1145        my %selectedHash = ();
1146        if (defined $selected) {
1147            %selectedHash = map { $_ => 1 } grep { defined($_) } @{$selected};
1148        }
1149      # 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.
1150      # Create the type counters.      # Create the type counters.
1151      my $groupCount = 1;      my $groupCount = 1;
# Line 1138  Line 1155 
1155      my $showSelect = "showSelected($menuName, '$divID', 1000);";      my $showSelect = "showSelected($menuName, '$divID', 1000);";
1156      # If multiple selection is supported, create an onChange event.      # If multiple selection is supported, create an onChange event.
1157      my $onChange = "";      my $onChange = "";
1158      if ($options->{multiple}) {      if ($cross) {
1159            $onChange = " onChange=\"crossUnSelect($menuName, '$divID', $cross, '${formName}_${cross}_status', 1000)\"";
1160        } elsif ($multiple) {
1161          $onChange = " onChange=\"$showSelect\"";          $onChange = " onChange=\"$showSelect\"";
1162      }      }
1163      # Create the SELECT tag and stuff it into the output array.      # Create the SELECT tag and stuff it into the output array.
1164      my $select = "<" . join(" ", "SELECT name=\"$menuName\"$onChange", map { " $_=\"$options->{$_}\"" } keys %{$options}) . ">";      my $select = "<SELECT name=\"$menuName\"$onChange$multipleTag size=\"$rows\">";
1165      my @lines = ($select);      my @lines = ($select);
1166      # Loop through the groups.      # Loop through the groups.
1167      for my $group (@groups) {      for my $group (@groups) {
# Line 1153  Line 1172 
1172          # label option may have functionality in future browsers. If that happens, we'll need          # label option may have functionality in future browsers. If that happens, we'll need
1173          # to modify the genome text so that the "selectSome" method can tell which are NMPDR          # to modify the genome text so that the "selectSome" method can tell which are NMPDR
1174          # organisms and which aren't. Sadly, the OPTGROUP tag is invisible in the DOM Javascript          # organisms and which aren't. Sadly, the OPTGROUP tag is invisible in the DOM Javascript
1175          # hierarchy.          # hierarchy, so we can't use it.
1176          my $label = ($group eq $FIG_Config::otherGroup ? "other" : "nmpdr");          my $label = ($group eq $FIG_Config::otherGroup ? "other" : "nmpdr");
1177          # Get the genomes in the group.          # Get the genomes in the group.
1178          for my $genome (@{$groupHash{$group}}) {          for my $genome (@{$groupHash->{$group}}) {
1179              my ($genomeID, $name) = @{$genome};              my ($genomeID, $name) = @{$genome};
1180              # See if it's selected.              # See if it's selected.
1181              my $select = ($selectedHash{$genomeID} ? " selected" : "");              my $select = ($selectedHash{$genomeID} ? " selected" : "");
# Line 1170  Line 1189 
1189      # Close the SELECT tag.      # Close the SELECT tag.
1190      push @lines, "</SELECT>";      push @lines, "</SELECT>";
1191      # Check for multiple selection.      # Check for multiple selection.
1192      if ($options->{multiple}) {      if ($multiple) {
1193          # Since multi-select is on, we can set up some buttons to set and clear selections.          # Since multi-select is on, we set up some buttons to set and clear selections.
1194          push @lines, "<br />";          push @lines, "<br />";
1195          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\" />";
1196          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\" />";
1197          push @lines, "<INPUT type=\"button\" name=\"NMPDROnly\" class=\"bigButton\"  value=\"Select NMPDR\" onClick=\"selectSome($menuName, 'nmpdr'); $showSelect\" />";          push @lines, "<INPUT type=\"button\" name=\"NMPDROnly\" class=\"bigButton\"  value=\"Select NMPDR\" onClick=\"selectSome($menuName, 'nmpdr'); $showSelect\" />";
1198          push @lines, "<INPUT type=\"button\" name=\"OtherOnly\" class=\"bigButton\" value=\"Select Supporting\" onClick=\"selectSome($menuName, 'other'); $showSelect\" />";          push @lines, "<INPUT type=\"button\" name=\"OtherOnly\" class=\"bigButton\" value=\"Select Supporting\" onClick=\"selectSome($menuName, 'other'); $showSelect\" />";
1199            # Now add the search box. This allows the user to type text and have all genomes containing
1200            # the text selected automatically.
1201            my $searchThingName = "${menuName}_SearchThing";
1202            push @lines, "<br>Select genomes containing <INPUT type=\"text\" name=\"$searchThingName\" size=\"30\" />&nbsp;" .
1203                         "<INPUT type=\"button\" name=\"Select\" class=\"button\" value=\"Search\" onClick=\"selectViaSearch($menuName, $searchThingName); $showSelect\" />";
1204          # Add the status display, too.          # Add the status display, too.
1205          push @lines, "<DIV id=\"$divID\" class=\"selectStatus\"></DIV>";          push @lines, "<DIV id=\"$divID\" class=\"selectStatus\"></DIV>";
1206          # 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 1209 
1209          # in case we decide to twiddle the parameters.          # in case we decide to twiddle the parameters.
1210          $showSelect =~ s/showSelected\(/showSelected\(thisForm\./;          $showSelect =~ s/showSelected\(/showSelected\(thisForm\./;
1211          $self->QueueFormScript($showSelect);          $self->QueueFormScript($showSelect);
1212            # Finally, add this parameter to the list of genome parameters. This enables us to
1213            # easily find all the parameters used to select one or more genomes.
1214            push @{$self->{genomeParms}}, $menuName;
1215      }      }
1216      # Assemble all the lines into a string.      # Assemble all the lines into a string.
1217      my $retVal = join("\n", @lines, "");      my $retVal = join("\n", @lines, "");
# Line 1192  Line 1219 
1219      return $retVal;      return $retVal;
1220  }  }
1221    
1222    =head3 PropertyMenu
1223    
1224    C<< my $htmlText = $shelp->PropertyMenu($menuName, $selected, $force); >>
1225    
1226    Generate a property name dropdown menu.
1227    
1228    =over 4
1229    
1230    =item menuName
1231    
1232    Name to give to the menu.
1233    
1234    =item selected
1235    
1236    Value of the property name to pre-select.
1237    
1238    =item force (optional)
1239    
1240    If TRUE, then the user will be forced to choose a property name. If FALSE,
1241    then an additional menu choice will be provided to select nothing.
1242    
1243    =item RETURN
1244    
1245    Returns a dropdown menu box that allows the user to select a property name. An additional
1246    selection entry will be provided for selecting no property name
1247    
1248    =back
1249    
1250    =cut
1251    
1252    sub PropertyMenu {
1253        # Get the parameters.
1254        my ($self, $menuName, $selected, $force) = @_;
1255        # Get the CGI and Sprout objects.
1256        my $sprout = $self->DB();
1257        my $cgi = $self->Q();
1258        # Create the property name list.
1259        my @propNames = ();
1260        if (! $force) {
1261            push @propNames, "";
1262        }
1263        # Get all the property names, putting them after the null choice if one exists.
1264        push @propNames, $sprout->GetChoices('Property', 'property-name');
1265        # Create a menu from them.
1266        my $retVal = $cgi->popup_menu(-name=> $menuName, -values => \@propNames,
1267                                      -default => $selected);
1268        # Return the result.
1269        return $retVal;
1270    }
1271    
1272  =head3 MakeTable  =head3 MakeTable
1273    
1274  C<< my $htmlText = $shelp->MakeTable(\@rows); >>  C<< my $htmlText = $shelp->MakeTable(\@rows); >>
# Line 1254  Line 1331 
1331      # Get the parameters.      # Get the parameters.
1332      my ($self) = @_;      my ($self) = @_;
1333      my $cgi = $self->Q();      my $cgi = $self->Q();
1334      # Declare the return variable.      # Get the current page size.
1335        my $pageSize = $cgi->param('PageSize');
1336        # Get the incoming external-link flag.
1337        my $aliases = ($cgi->param('ShowAliases') ? 1 : 0);
1338        # Create the row.
1339      my $retVal = $cgi->Tr($cgi->td("Results/Page"),      my $retVal = $cgi->Tr($cgi->td("Results/Page"),
1340                            $cgi->td($cgi->popup_menu(-name => 'PageSize',                            $cgi->td($cgi->popup_menu(-name => 'PageSize',
1341                                                      -values => [10, 25, 45, 100, 1000],                                                      -values => [10, 25, 50, 100, 1000],
1342                                                      -default => $cgi->param('PageSize'))),                                                      -default => $pageSize) . " " .
1343                                       $cgi->checkbox(-name => 'ShowURL',
1344                                                      -value => 1,
1345                                                      -label => 'Show URL')),
1346                            $cgi->td($cgi->submit(-class => 'goButton',                            $cgi->td($cgi->submit(-class => 'goButton',
1347                                                  -name => 'Search',                                                  -name => 'Search',
1348                                                  -value => 'Go')));                                                  -value => 'Go')));
# Line 1322  Line 1406 
1406          # Get the feature location string.          # Get the feature location string.
1407          my $loc = $sprout->FeatureLocation($feat);          my $loc = $sprout->FeatureLocation($feat);
1408          # Compute the contig, start, and stop points.          # Compute the contig, start, and stop points.
1409          my($start, $stop, $contig) = BasicLocation::Parse($loc);          my($contig, $start, $stop) = BasicLocation::Parse($loc);
1410            Trace("Start and stop are ($start,$stop) on contig $contig.") if T(3);
1411          # 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
1412          # big and that we get some surrounding stuff.          # big and that we get some surrounding stuff.
1413          my $mid = int(($start + $stop) / 2);          my $mid = int(($start + $stop) / 2);
# Line 1352  Line 1437 
1437          }          }
1438          my $seg_id = $contig;          my $seg_id = $contig;
1439          $seg_id =~ s/:/--/g;          $seg_id =~ s/:/--/g;
1440            Trace("Show limits are ($show_start,$show_stop) in genome $genomeID with ref $seg_id.") if T(3);
1441          # Assemble all the pieces.          # Assemble all the pieces.
1442          $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";
1443      }      }
# Line 1359  Line 1445 
1445      return $retVal;      return $retVal;
1446  }  }
1447    
1448    =head3 GetGenomes
1449    
1450    C<< my @genomeList = $shelp->GetGenomes($parmName); >>
1451    
1452    Return the list of genomes specified by the specified CGI query parameter.
1453    If the request method is POST, then the list of genome IDs is returned
1454    without preamble. If the request method is GET and the parameter is not
1455    specified, then it is treated as a request for all genomes. This makes it
1456    easier for web pages to link to a search that wants to specify all genomes.
1457    
1458    =over 4
1459    
1460    =item parmName
1461    
1462    Name of the parameter containing the list of genomes. This will be the
1463    first parameter passed to the L</NmpdrGenomeMenu> call that created the
1464    genome selection control on the form.
1465    
1466    =item RETURN
1467    
1468    Returns a list of the genomes to process.
1469    
1470    =back
1471    
1472    =cut
1473    
1474    sub GetGenomes {
1475        # Get the parameters.
1476        my ($self, $parmName) = @_;
1477        # Get the CGI query object.
1478        my $cgi = $self->Q();
1479        # Get the list of genome IDs in the request header.
1480        my @retVal = $cgi->param($parmName);
1481        Trace("Genome list for $parmName is (" . join(", ", @retVal) . ") with method " . $cgi->request_method() . ".") if T(3);
1482        # Check for the special GET case.
1483        if ($cgi->request_method() eq "GET" && ! @retVal) {
1484            # Here the caller wants all the genomes.
1485            my $sprout = $self->DB();
1486            @retVal = $sprout->Genomes();
1487        }
1488        # Return the result.
1489        return @retVal;
1490    }
1491    
1492    =head3 GetHelpText
1493    
1494    C<< my $htmlText = $shelp->GetHelpText(); >>
1495    
1496    Get the help text for this search. The help text is stored in files on the template
1497    server. The help text for a specific search is taken from a file named
1498    C<SearchHelp_>I<class>C<.inc> in the template directory C<$FIG_Config::template_url>.
1499    There are also three standard help files: C<SearchHelp1_Filtering.inc> describes the
1500    feature filtering performed by the B<FeatureQuery> object, C<SearchHelp1_GenomeControl.inc>
1501    describes how to use a multiple-selection genome control, and C<SearchHelp1_Standard.inc>
1502    describes the standard controls for a search, such as page size, URL display, and
1503    external alias display.
1504    
1505    =cut
1506    
1507    sub GetHelpText {
1508        # Get the parameters.
1509        my ($self) = @_;
1510        # Create a list to hold the pieces of the help.
1511        my @helps = ();
1512        # Get the template directory URL.
1513        my $urlBase = $FIG_Config::template_url;
1514        # Start with the specific help.
1515        my $class = $self->{class};
1516        push @helps, PageBuilder::GetPage("$urlBase/SearchHelp_$class.inc");
1517        # Add the genome control help if needed.
1518        if (scalar @{$self->{genomeParms}}) {
1519            push @helps, PageBuilder::GetPage("$urlBase/SearchHelp1_GenomeControl.inc");
1520        }
1521        # Next the filter help.
1522        if ($self->{filtered}) {
1523            push @helps, PageBuilder::GetPage("$urlBase/SearchHelp1_Filtering.inc");
1524        }
1525        # Finally, the standard help.
1526        push @helps, PageBuilder::GetPage("$urlBase/SearchHelp1_Standard.inc");
1527        # Assemble the pieces.
1528        my $retVal = join("\n<p>&nbsp;</p>\n", @helps);
1529        # Return the result.
1530        return $retVal;
1531    }
1532    
1533    =head3 ComputeSearchURL
1534    
1535    C<< my $url = $shelp->ComputeSearchURL(); >>
1536    
1537    Compute the GET-style URL for the current search. In order for this to work, there
1538    must be a copy of the search form on the current page. This will always be the
1539    case if the search is coming from C<SearchSkeleton.cgi>.
1540    
1541    A little expense is involved in order to make the URL as smart as possible. The
1542    main complication is that if the user specified all genomes, we'll want to
1543    remove the parameter entirely from a get-style URL.
1544    
1545    =cut
1546    
1547    sub ComputeSearchURL {
1548        # Get the parameters.
1549        my ($self) = @_;
1550        # Get the database and CGI query object.
1551        my $cgi = $self->Q();
1552        my $sprout = $self->DB();
1553        # Start with the full URL.
1554        my $retVal = $cgi->url(-full => 1);
1555        # Get all the query parameters in a hash.
1556        my %parms = $cgi->Vars();
1557        # Now we need to do some fixing. Each multi-valued parameter is encoded as a string with null
1558        # characters separating the individual values. We have to convert those to lists. In addition,
1559        # the multiple-selection genome parameters and the feature type parameter must be checked to
1560        # determine whether or not they can be removed from the URL. First, we get a list of the
1561        # genome parameters and a list of all genomes. Note that we only need the list if a
1562        # multiple-selection genome parameter has been found on the form.
1563        my %genomeParms = map { $_ => 1 } @{$self->{genomeParms}};
1564        my @genomeList;
1565        if (keys %genomeParms) {
1566            @genomeList = $sprout->Genomes();
1567        }
1568        # Create a list to hold the URL parameters we find.
1569        my @urlList = ();
1570        # Now loop through the parameters in the hash, putting them into the output URL.
1571        for my $parmKey (keys %parms) {
1572            # Get a list of the parameter values. If there's only one, we'll end up with
1573            # a singleton list, but that's okay.
1574            my @values = split (/\0/, $parms{$parmKey});
1575            # Check for special cases.
1576            if ($parmKey eq 'featureTypes') {
1577                # Here we need to see if the user wants all the feature types. If he
1578                # does, we erase all the values so that the parameter is not output.
1579                my %valueCheck = map { $_ => 1 } @values;
1580                my @list = FeatureQuery::AllFeatureTypes();
1581                my $okFlag = 1;
1582                for (my $i = 0; $okFlag && $i <= $#list; $i++) {
1583                    if (! $valueCheck{$list[$i]}) {
1584                        $okFlag = 0;
1585                    }
1586                }
1587                if ($okFlag) {
1588                    @values = ();
1589                }
1590            } elsif (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF ShowURL)) {
1591                # These are bookkeeping parameters we don't need to start a search.
1592                @values = ();
1593            } elsif ($parmKey =~ /_SearchThing$/) {
1594                # Here the value coming in is from a genome control's search thing. It does
1595                # not affect the results of the search, so we clear it.
1596                @values = ();
1597            } elsif ($genomeParms{$parmKey}) {
1598                # Here we need to see if the user wants all the genomes. If he does,
1599                # we erase all the values just like with features.
1600                my $allFlag = $sprout->IsAllGenomes(\@values, \@genomeList);
1601                if ($allFlag) {
1602                    @values = ();
1603                }
1604            }
1605            # If we still have values, create the URL parameters.
1606            if (@values) {
1607                push @urlList, map { "$parmKey=" . uri_escape($_) } @values;
1608            }
1609        }
1610        # Add the parameters to the URL.
1611        $retVal .= "?" . join(";", @urlList);
1612        # Return the result.
1613        return $retVal;
1614    }
1615    
1616    =head3 GetRunTimeValue
1617    
1618    C<< my $htmlText = $shelp->GetRunTimeValue($text); >>
1619    
1620    Compute a run-time column value.
1621    
1622    =over 4
1623    
1624    =item text
1625    
1626    The run-time column text. It consists of 2 percent signs, a column type, an equal
1627    sign, and the data for the current row.
1628    
1629    =item RETURN
1630    
1631    Returns the fully-formatted HTML text to go into the current column of the current row.
1632    
1633    =back
1634    
1635    =cut
1636    
1637    sub GetRunTimeValue {
1638        # Get the parameters.
1639        my ($self, $text) = @_;
1640        # Declare the return variable.
1641        my $retVal;
1642        # Parse the incoming text.
1643        if ($text =~ /^%%([^=]+)=(.*)$/) {
1644            $retVal = $self->RunTimeColumns($1, $2);
1645        } else {
1646            Confess("Invalid run-time column string \"$text\" encountered in session file.");
1647        }
1648        # Return the result.
1649        return $retVal;
1650    }
1651    
1652    =head3 FeatureTypeMap
1653    
1654    C<< my %features = SearchHelper::FeatureTypeMap(); >>
1655    
1656    Return a map of feature types to descriptions. The feature type data is stored
1657    in the B<FIG_Config> file. Currently, it only contains a space-delimited list of
1658    feature types. The map returned by this method is a hash mapping the type codes to
1659    descriptive names.
1660    
1661    The reason we have to convert the list from a string is that the B<NMPDRSetup.pl>
1662    script is only able to insert strings into the generated B<FIG_Config> file.
1663    
1664    =cut
1665    
1666    sub FeatureTypeMap {
1667        my @list = split /\s+/, $FIG_Config::feature_types;
1668        my %retVal = map { $_ => $_ } @list;
1669        return %retVal;
1670    }
1671    
1672    =head3 AdvancedClassList
1673    
1674    C<< my @classes = SearchHelper::AdvancedClassList(); >>
1675    
1676    Return a list of advanced class names. This list is used to generate the directory
1677    of available searches on the search page.
1678    
1679    The reason we have to convert the list from a string is that the B<NMPDRSetup.pl>
1680    script is only able to insert strings into the generated B<FIG_Config> file.
1681    
1682    =cut
1683    
1684    sub AdvancedClassList {
1685        return split /\s+/, $FIG_Config::advanced_classes;
1686    }
1687    
1688  =head2 Feature Column Methods  =head2 Feature Column Methods
1689    
1690  The methods in this column manage feature column data. If you want to provide the  The methods in this column manage feature column data. If you want to provide the
# Line 1391  Line 1717 
1717      # Get the parameters.      # Get the parameters.
1718      my ($self) = @_;      my ($self) = @_;
1719      # Return the result.      # Return the result.
1720      return ['orgName', 'function', 'gblink', 'protlink'];      return ['orgName', 'function', 'gblink', 'protlink',
1721                FeatureQuery::AdditionalColumns($self)];
1722  }  }
1723    
1724  =head3 FeatureColumnTitle  =head3 FeatureColumnTitle
# Line 1500  Line 1827 
1827          $retVal = HTML::set_prot_links($fid);          $retVal = HTML::set_prot_links($fid);
1828      } elsif ($colName eq 'alias') {      } elsif ($colName eq 'alias') {
1829          # 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.
1830          # The complicated part is we have to hyperlink them. First, get the          # These are very expensive, so we compute them when the row is displayed.
1831          # aliases.          $retVal = "%%aliases=$fid";
         my @aliases = $sprout->FeatureAliases($fid);  
         # Only proceed if we found some.  
         if (@aliases) {  
             # Join the aliases into a comma-delimited list.  
             my $aliasList = join(", ", @aliases);  
             # Ask the HTML processor to hyperlink them.  
             $retVal = HTML::set_prot_links($aliasList);  
         }  
1832      } elsif ($colName eq 'function') {      } elsif ($colName eq 'function') {
1833          # The functional assignment is just a matter of getting some text.          # The functional assignment is just a matter of getting some text.
1834          ($retVal) = $record->Value('Feature(assignment)');          ($retVal) = $record->Value('Feature(assignment)');
# Line 1539  Line 1858 
1858      return $retVal;      return $retVal;
1859  }  }
1860    
1861    =head3 RunTimeColumns
1862    
1863    C<< my $htmlText = $shelp->RunTimeColumns($type, $text); >>
1864    
1865    Return the HTML text for a run-time column. Run-time columns are evaluated when the
1866    list is displayed, rather than when it is generated.
1867    
1868    =over 4
1869    
1870    =item type
1871    
1872    Type of column.
1873    
1874    =item text
1875    
1876    Data relevant to this row of the column.
1877    
1878    =item RETURN
1879    
1880    Returns the fully-formatted HTML text to go in the specified column.
1881    
1882    =back
1883    
1884    =cut
1885    
1886    sub RunTimeColumns {
1887        # Get the parameters.
1888        my ($self, $type, $text) = @_;
1889        # Declare the return variable.
1890        my $retVal = "";
1891        # Get the Sprout and CGI objects.
1892        my $sprout = $self->DB();
1893        my $cgi = $self->Q();
1894        # Separate the text into a type and data.
1895        if ($type eq 'aliases') {
1896            # Here the caller wants external alias links for a feature. The text
1897            # is the feature ID.
1898            my $fid = $text;
1899            # The complicated part is we have to hyperlink them. First, get the
1900            # aliases.
1901            Trace("Generating aliases for feature $fid.") if T(4);
1902            my @aliases = $sprout->FeatureAliases($fid);
1903            # Only proceed if we found some.
1904            if (@aliases) {
1905                # Join the aliases into a comma-delimited list.
1906                my $aliasList = join(", ", @aliases);
1907                # Ask the HTML processor to hyperlink them.
1908                $retVal = HTML::set_prot_links($cgi, $aliasList);
1909            }
1910        }
1911        # Return the result.
1912        return $retVal;
1913    }
1914    
1915    =head3 SaveOrganismData
1916    
1917    C<< my ($name, $displayGroup) = $shelp->SaveOrganismData($group, $genomeID, $genus, $species, $strain); >>
1918    
1919    Format the name of an organism and the display version of its group name. The incoming
1920    data should be the relevant fields from the B<Genome> record in the database. The
1921    data will also be stored in the genome cache for later use in posting search results.
1922    
1923    =over 4
1924    
1925    =item group
1926    
1927    Name of the genome's group as it appears in the database.
1928    
1929    =item genomeID
1930    
1931    ID of the relevant genome.
1932    
1933    =item genus
1934    
1935    Genus of the genome's organism. If undefined or null, it will be assumed the genome is not
1936    in the database. In this case, the organism name is derived from the genomeID and the group
1937    is automatically the supporting-genomes group.
1938    
1939    =item species
1940    
1941    Species of the genome's organism.
1942    
1943    =item strain
1944    
1945    Strain of the species represented by the genome.
1946    
1947    =item RETURN
1948    
1949    Returns a two-element list. The first element is the formatted genome name. The second
1950    element is the display name of the genome's group.
1951    
1952    =back
1953    
1954    =cut
1955    
1956    sub SaveOrganismData {
1957        # Get the parameters.
1958        my ($self, $group, $genomeID, $genus, $species, $strain) = @_;
1959        # Declare the return values.
1960        my ($name, $displayGroup);
1961        # If the organism does not exist, format an unknown name and a blank group.
1962        if (! defined($genus)) {
1963            $name = "Unknown Genome $genomeID";
1964            $displayGroup = "";
1965        } else {
1966            # It does exist, so format the organism name.
1967            $name = "$genus $species";
1968            if ($strain) {
1969                $name .= " $strain";
1970            }
1971            # Compute the display group. This is currently the same as the incoming group
1972            # name unless it's the supporting group, which is nulled out.
1973            $displayGroup = ($group eq $FIG_Config::otherGroup ? "" : $group);
1974        }
1975        # Cache the group and organism data.
1976        my $cache = $self->{orgs};
1977        $cache->{$genomeID} = [$name, $displayGroup];
1978        # Return the result.
1979        return ($name, $displayGroup);
1980    }
1981    
1982    =head2 Virtual Methods
1983    
1984    =head3 Form
1985    
1986    C<< my $html = $shelp->Form(); >>
1987    
1988    Generate the HTML for a form to request a new search.
1989    
1990    =head3 Find
1991    
1992    C<< my $resultCount = $shelp->Find(); >>
1993    
1994    Conduct a search based on the current CGI query parameters. The search results will
1995    be written to the session cache file and the number of results will be
1996    returned. If the search parameters are invalid, a result count of C<undef> will be
1997    returned and a result message will be stored in this object describing the problem.
1998    
1999    =head3 Description
2000    
2001    C<< my $htmlText = $shelp->Description(); >>
2002    
2003    Return a description of this search. The description is used for the table of contents
2004    on the main search tools page. It may contain HTML, but it should be character-level,
2005    not block-level, since the description is going to appear in a list.
2006    
2007    =head3 SortKey
2008    
2009    C<< my $key = $shelp->SortKey($record); >>
2010    
2011    Return the sort key for the specified record. The default is to sort by feature name,
2012    floating NMPDR organisms to the top. If a full-text search is used, then the default
2013    sort is by relevance followed by feature name. This sort may be overridden by the
2014    search class to provide fancier functionality. This method is called by
2015    B<PutFeature>, so it is only used for feature searches. A non-feature search
2016    would presumably have its own sort logic.
2017    
2018    =over 4
2019    
2020    =item record
2021    
2022    The C<DBObject> from which the current row of data is derived.
2023    
2024    =item RETURN
2025    
2026    Returns a key field that can be used to sort this row in among the results.
2027    
2028    =back
2029    
2030    =cut
2031    
2032    sub SortKey {
2033        # Get the parameters.
2034        my ($self, $record) = @_;
2035        # Get the feature ID from the record.
2036        my ($fid) = $record->Value('Feature(id)');
2037        # Get the group from the feature ID.
2038        my $group = $self->FeatureGroup($fid);
2039        # Ask the feature query object to form the sort key.
2040        my $retVal = FeatureQuery::SortKey($self, $group, $record);
2041        # Return the result.
2042        return $retVal;
2043    }
2044    
2045  1;  1;

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3