[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.8, Wed Oct 4 16:03:35 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 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 648  Line 645 
645  sub PutFeature {  sub PutFeature {
646      # Get the parameters.      # Get the parameters.
647      my ($self, $fq) = @_;      my ($self, $fq) = @_;
648        # Get the CGI query object.
649        my $cgi = $self->Q();
650      # Get the feature data.      # Get the feature data.
651      my $record = $fq->Feature();      my $record = $fq->Feature();
652      my $extraCols = $fq->ExtraCols();      my $extraCols = $fq->ExtraCols();
# Line 655  Line 654 
654      if (! defined $self->{cols}) {      if (! defined $self->{cols}) {
655          # 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.
656          $self->{cols} = $self->DefaultFeatureColumns();          $self->{cols} = $self->DefaultFeatureColumns();
657            # Add the externals if they were requested.
658            if ($cgi->param('ShowAliases')) {
659                push @{$self->{cols}}, 'alias';
660            }
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 672  Line 675 
675      }      }
676      # Compute the sort key. The sort key floats NMPDR organism features to the      # Compute the sort key. The sort key 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($record);
     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 771  Line 773 
773      my $retVal;      my $retVal;
774      # Get a digest encoder.      # Get a digest encoder.
775      my $md5 = Digest::MD5->new();      my $md5 = Digest::MD5->new();
776      # 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
777      if (open(R, "/dev/urandom")) {      # actually two numbers, and we get them both because we're in list
778          my $b;      # context.
779          read(R, $b, 1024);      $md5->add($$, $ENV{REMOTE_ADDR}, $ENV{REMOTE_PORT}, gettimeofday());
780          $md5->add($b);      # Hash up all this identifying data.
781      }      $retVal = $md5->hexdigest();
782      # 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.  
783      return $retVal;      return $retVal;
784  }  }
785    
# Line 942  Line 938 
938      } else {      } else {
939          # Here we can get its genome data.          # Here we can get its genome data.
940          $retVal = $self->Organism($genomeID);          $retVal = $self->Organism($genomeID);
941          # Append the type and number.          # Append the FIG ID.
942          $retVal .= " [$type $num]";          $retVal .= " [$fid]";
943      }      }
944      # Return the result.      # Return the result.
945      return $retVal;      return $retVal;
# Line 1059  Line 1055 
1055    
1056  =head3 NmpdrGenomeMenu  =head3 NmpdrGenomeMenu
1057    
1058  C<< my $htmlText = $shelp->NmpdrGenomeMenu($menuName, \%options, \@selected); >>  C<< my $htmlText = $shelp->NmpdrGenomeMenu($menuName, $multiple, \@selected, $rows); >>
1059    
1060  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
1061  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 1067 
1067    
1068  Name to give to the menu.  Name to give to the menu.
1069    
1070  =item options  =item multiple
1071    
1072  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.  
1073    
1074  =item selected  =item selected
1075    
# Line 1084  Line 1077 
1077  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
1078  list is empty, nothing will be pre-selected.  list is empty, nothing will be pre-selected.
1079    
1080    =item rows (optional)
1081    
1082    Number of rows to display. If omitted, the default is 1 for a single-select list
1083    and 10 for a multi-select list.
1084    
1085    =item crossMenu (optional)
1086    
1087    If specified, is presumed to be the name of another genome menu whose contents
1088    are to be mutually exclusive with the contents of this menu. As a result, instead
1089    of the standard onChange event, the onChange event will deselect any entries in
1090    the other menu.
1091    
1092  =item RETURN  =item RETURN
1093    
1094  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 1099 
1099    
1100  sub NmpdrGenomeMenu {  sub NmpdrGenomeMenu {
1101      # Get the parameters.      # Get the parameters.
1102      my ($self, $menuName, $options, $selected) = @_;      my ($self, $menuName, $multiple, $selected, $rows, $cross) = @_;
1103      # Get the Sprout and CGI objects.      # Get the Sprout and CGI objects.
1104      my $sprout = $self->DB();      my $sprout = $self->DB();
1105      my $cgi = $self->Q();      my $cgi = $self->Q();
1106        # Compute the row count.
1107        if (! defined $rows) {
1108            $rows = ($multiple ? 10 : 1);
1109        }
1110        # Create the multiple tag.
1111        my $multipleTag = ($multiple ? " multiple" : "");
1112      # Get the form name.      # Get the form name.
1113      my $formName = $self->FormName();      my $formName = $self->FormName();
1114        # Check to see if we already have a genome list in memory.
1115        my $genomes = $self->{genomeList};
1116        my $groupHash;
1117        if (defined $genomes) {
1118            # We have a list ready to use.
1119            $groupHash = $genomes;
1120        } else {
1121      # 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
1122      # 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
1123      # take advantage of an existing index.      # take advantage of an existing index.
# Line 1111  Line 1129 
1129      # 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
1130      # 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
1131      # name.      # name.
1132      my %groupHash = ();          my %gHash = ();
1133      for my $genome (@genomeList) {      for my $genome (@genomeList) {
1134          # Get the genome data.          # Get the genome data.
1135          my ($group, $genomeID, $genus, $species, $strain) = @{$genome};          my ($group, $genomeID, $genus, $species, $strain) = @{$genome};
# Line 1121  Line 1139 
1139              $name .= " $strain";              $name .= " $strain";
1140          }          }
1141          # Push the genome into the group's list.          # Push the genome into the group's list.
1142          push @{$groupHash{$group}}, [$genomeID, $name];              push @{$gHash{$group}}, [$genomeID, $name];
1143            }
1144            # Save the genome list for future use.
1145            $self->{genomeList} = \%gHash;
1146            $groupHash = \%gHash;
1147      }      }
1148      # 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
1149      # the supporting-genome group last.      # the supporting-genome group last.
1150      my @groups = sort grep { $_ ne $FIG_Config::otherGroup } keys %groupHash;      my @groups = sort grep { $_ ne $FIG_Config::otherGroup } keys %{$groupHash};
1151      push @groups, $FIG_Config::otherGroup;      push @groups, $FIG_Config::otherGroup;
1152      # 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
1153      my %selectedHash = map { $_ => 1 } @{$selected};      # with the possibility of undefined values in the incoming list.
1154        my %selectedHash = ();
1155        if (defined $selected) {
1156            %selectedHash = map { $_ => 1 } grep { defined($_) } @{$selected};
1157        }
1158      # 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.
1159      # Create the type counters.      # Create the type counters.
1160      my $groupCount = 1;      my $groupCount = 1;
# Line 1138  Line 1164 
1164      my $showSelect = "showSelected($menuName, '$divID', 1000);";      my $showSelect = "showSelected($menuName, '$divID', 1000);";
1165      # If multiple selection is supported, create an onChange event.      # If multiple selection is supported, create an onChange event.
1166      my $onChange = "";      my $onChange = "";
1167      if ($options->{multiple}) {      if ($cross) {
1168            $onChange = " onChange=\"crossUnSelect($menuName, '$divID', $cross, '${formName}_${cross}_status', 1000)\"";
1169        } elsif ($multiple) {
1170          $onChange = " onChange=\"$showSelect\"";          $onChange = " onChange=\"$showSelect\"";
1171      }      }
1172      # Create the SELECT tag and stuff it into the output array.      # Create the SELECT tag and stuff it into the output array.
1173      my $select = "<" . join(" ", "SELECT name=\"$menuName\"$onChange", map { " $_=\"$options->{$_}\"" } keys %{$options}) . ">";      my $select = "<SELECT name=\"$menuName\"$onChange$multipleTag size=\"$rows\">";
1174      my @lines = ($select);      my @lines = ($select);
1175      # Loop through the groups.      # Loop through the groups.
1176      for my $group (@groups) {      for my $group (@groups) {
# Line 1153  Line 1181 
1181          # 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
1182          # 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
1183          # 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
1184          # hierarchy.          # hierarchy, so we can't use it.
1185          my $label = ($group eq $FIG_Config::otherGroup ? "other" : "nmpdr");          my $label = ($group eq $FIG_Config::otherGroup ? "other" : "nmpdr");
1186          # Get the genomes in the group.          # Get the genomes in the group.
1187          for my $genome (@{$groupHash{$group}}) {          for my $genome (@{$groupHash->{$group}}) {
1188              my ($genomeID, $name) = @{$genome};              my ($genomeID, $name) = @{$genome};
1189              # See if it's selected.              # See if it's selected.
1190              my $select = ($selectedHash{$genomeID} ? " selected" : "");              my $select = ($selectedHash{$genomeID} ? " selected" : "");
# Line 1170  Line 1198 
1198      # Close the SELECT tag.      # Close the SELECT tag.
1199      push @lines, "</SELECT>";      push @lines, "</SELECT>";
1200      # Check for multiple selection.      # Check for multiple selection.
1201      if ($options->{multiple}) {      if ($multiple) {
1202          # 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.
1203          push @lines, "<br />";          push @lines, "<br />";
1204          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\" />";
1205          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\" />";
1206          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\" />";
1207          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\" />";
1208            # Now add the search box. This allows the user to type text and have all genomes containing
1209            # the text selected automatically.
1210            my $searchThingName = "${menuName}_SearchThing";
1211            push @lines, "<br>Select genomes containing <INPUT type=\"text\" name=\"$searchThingName\" size=\"30\" />&nbsp;" .
1212                         "<INPUT type=\"button\" name=\"Select\" class=\"button\" value=\"Search\" onClick=\"selectViaSearch($menuName, $searchThingName); $showSelect\" />";
1213          # Add the status display, too.          # Add the status display, too.
1214          push @lines, "<DIV id=\"$divID\" class=\"selectStatus\"></DIV>";          push @lines, "<DIV id=\"$divID\" class=\"selectStatus\"></DIV>";
1215          # 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 1218 
1218          # in case we decide to twiddle the parameters.          # in case we decide to twiddle the parameters.
1219          $showSelect =~ s/showSelected\(/showSelected\(thisForm\./;          $showSelect =~ s/showSelected\(/showSelected\(thisForm\./;
1220          $self->QueueFormScript($showSelect);          $self->QueueFormScript($showSelect);
1221            # Finally, add this parameter to the list of genome parameters. This enables us to
1222            # easily find all the parameters used to select one or more genomes.
1223            push @{$self->{genomeParms}}, $menuName;
1224      }      }
1225      # Assemble all the lines into a string.      # Assemble all the lines into a string.
1226      my $retVal = join("\n", @lines, "");      my $retVal = join("\n", @lines, "");
# Line 1192  Line 1228 
1228      return $retVal;      return $retVal;
1229  }  }
1230    
1231    =head3 PropertyMenu
1232    
1233    C<< my $htmlText = $shelp->PropertyMenu($menuName, $selected, $force); >>
1234    
1235    Generate a property name dropdown menu.
1236    
1237    =over 4
1238    
1239    =item menuName
1240    
1241    Name to give to the menu.
1242    
1243    =item selected
1244    
1245    Value of the property name to pre-select.
1246    
1247    =item force (optional)
1248    
1249    If TRUE, then the user will be forced to choose a property name. If FALSE,
1250    then an additional menu choice will be provided to select nothing.
1251    
1252    =item RETURN
1253    
1254    Returns a dropdown menu box that allows the user to select a property name. An additional
1255    selection entry will be provided for selecting no property name
1256    
1257    =back
1258    
1259    =cut
1260    
1261    sub PropertyMenu {
1262        # Get the parameters.
1263        my ($self, $menuName, $selected, $force) = @_;
1264        # Get the CGI and Sprout objects.
1265        my $sprout = $self->DB();
1266        my $cgi = $self->Q();
1267        # Create the property name list.
1268        my @propNames = ();
1269        if (! $force) {
1270            push @propNames, "";
1271        }
1272        # Get all the property names, putting them after the null choice if one exists.
1273        push @propNames, $sprout->GetChoices('Property', 'property-name');
1274        # Create a menu from them.
1275        my $retVal = $cgi->popup_menu(-name=> $menuName, -values => \@propNames,
1276                                      -default => $selected);
1277        # Return the result.
1278        return $retVal;
1279    }
1280    
1281  =head3 MakeTable  =head3 MakeTable
1282    
1283  C<< my $htmlText = $shelp->MakeTable(\@rows); >>  C<< my $htmlText = $shelp->MakeTable(\@rows); >>
# Line 1254  Line 1340 
1340      # Get the parameters.      # Get the parameters.
1341      my ($self) = @_;      my ($self) = @_;
1342      my $cgi = $self->Q();      my $cgi = $self->Q();
1343      # Declare the return variable.      # Get the current page size.
1344        my $pageSize = $cgi->param('PageSize');
1345        # Get the incoming external-link flag.
1346        my $aliases = ($cgi->param('ShowAliases') ? 1 : 0);
1347        # Create the row.
1348      my $retVal = $cgi->Tr($cgi->td("Results/Page"),      my $retVal = $cgi->Tr($cgi->td("Results/Page"),
1349                            $cgi->td($cgi->popup_menu(-name => 'PageSize',                            $cgi->td($cgi->popup_menu(-name => 'PageSize',
1350                                                      -values => [10, 25, 45, 100, 1000],                                                      -values => [10, 25, 50, 100, 1000],
1351                                                      -default => $cgi->param('PageSize'))),                                                      -default => $pageSize) . " " .
1352                                       $cgi->checkbox(-name => 'ShowURL',
1353                                                      -value => 1,
1354                                                      -label => 'Show URL')),
1355                            $cgi->td($cgi->submit(-class => 'goButton',                            $cgi->td($cgi->submit(-class => 'goButton',
1356                                                  -name => 'Search',                                                  -name => 'Search',
1357                                                  -value => 'Go')));                                                  -value => 'Go')));
# Line 1322  Line 1415 
1415          # Get the feature location string.          # Get the feature location string.
1416          my $loc = $sprout->FeatureLocation($feat);          my $loc = $sprout->FeatureLocation($feat);
1417          # Compute the contig, start, and stop points.          # Compute the contig, start, and stop points.
1418          my($start, $stop, $contig) = BasicLocation::Parse($loc);          my($contig, $start, $stop) = BasicLocation::Parse($loc);
1419            Trace("Start and stop are ($start,$stop) on contig $contig.") if T(3);
1420          # 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
1421          # big and that we get some surrounding stuff.          # big and that we get some surrounding stuff.
1422          my $mid = int(($start + $stop) / 2);          my $mid = int(($start + $stop) / 2);
# Line 1352  Line 1446 
1446          }          }
1447          my $seg_id = $contig;          my $seg_id = $contig;
1448          $seg_id =~ s/:/--/g;          $seg_id =~ s/:/--/g;
1449            Trace("Show limits are ($show_start,$show_stop) in genome $genomeID with ref $seg_id.") if T(3);
1450          # Assemble all the pieces.          # Assemble all the pieces.
1451          $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";
1452      }      }
# Line 1359  Line 1454 
1454      return $retVal;      return $retVal;
1455  }  }
1456    
1457    =head3 GetGenomes
1458    
1459    C<< my @genomeList = $shelp->GetGenomes($parmName); >>
1460    
1461    Return the list of genomes specified by the specified CGI query parameter.
1462    If the request method is POST, then the list of genome IDs is returned
1463    without preamble. If the request method is GET and the parameter is not
1464    specified, then it is treated as a request for all genomes. This makes it
1465    easier for web pages to link to a search that wants to specify all genomes.
1466    
1467    =over 4
1468    
1469    =item parmName
1470    
1471    Name of the parameter containing the list of genomes. This will be the
1472    first parameter passed to the L</NmpdrGenomeMenu> call that created the
1473    genome selection control on the form.
1474    
1475    =item RETURN
1476    
1477    Returns a list of the genomes to process.
1478    
1479    =back
1480    
1481    =cut
1482    
1483    sub GetGenomes {
1484        # Get the parameters.
1485        my ($self, $parmName) = @_;
1486        # Get the CGI query object.
1487        my $cgi = $self->Q();
1488        # Get the list of genome IDs in the request header.
1489        my @retVal = $cgi->param($parmName);
1490        Trace("Genome list for $parmName is (" . join(", ", @retVal) . ") with method " . $cgi->request_method() . ".") if T(3);
1491        # Check for the special GET case.
1492        if ($cgi->request_method() eq "GET" && ! @retVal) {
1493            # Here the caller wants all the genomes.
1494            my $sprout = $self->DB();
1495            @retVal = $sprout->Genomes();
1496        }
1497        # Return the result.
1498        return @retVal;
1499    }
1500    
1501    =head3 GetHelpText
1502    
1503    C<< my $htmlText = $shelp->GetHelpText(); >>
1504    
1505    Get the help text for this search. The help text is stored in files on the template
1506    server. The help text for a specific search is taken from a file named
1507    C<SearchHelp_>I<class>C<.inc> in the template directory C<$FIG_Config::template_url>.
1508    There are also three standard help files: C<SearchHelp1_Filtering.inc> describes the
1509    feature filtering performed by the B<FeatureQuery> object, C<SearchHelp1_GenomeControl.inc>
1510    describes how to use a multiple-selection genome control, and C<SearchHelp1_Standard.inc>
1511    describes the standard controls for a search, such as page size, URL display, and
1512    external alias display.
1513    
1514    =cut
1515    
1516    sub GetHelpText {
1517        # Get the parameters.
1518        my ($self) = @_;
1519        # Create a list to hold the pieces of the help.
1520        my @helps = ();
1521        # Get the template directory URL.
1522        my $urlBase = $FIG_Config::template_url;
1523        # Start with the specific help.
1524        my $class = $self->{class};
1525        push @helps, PageBuilder::GetPage("$urlBase/SearchHelp_$class.inc");
1526        # Add the genome control help if needed.
1527        if (scalar @{$self->{genomeParms}}) {
1528            push @helps, PageBuilder::GetPage("$urlBase/SearchHelp1_GenomeControl.inc");
1529        }
1530        # Next the filter help.
1531        if ($self->{filtered}) {
1532            push @helps, PageBuilder::GetPage("$urlBase/SearchHelp1_Filtering.inc");
1533        }
1534        # Finally, the standard help.
1535        push @helps, PageBuilder::GetPage("$urlBase/SearchHelp1_Standard.inc");
1536        # Assemble the pieces.
1537        my $retVal = join("\n<p>&nbsp;</p>\n", @helps);
1538        # Return the result.
1539        return $retVal;
1540    }
1541    
1542    =head3 ComputeSearchURL
1543    
1544    C<< my $url = $shelp->ComputeSearchURL(); >>
1545    
1546    Compute the GET-style URL for the current search. In order for this to work, there
1547    must be a copy of the search form on the current page. This will always be the
1548    case if the search is coming from C<SearchSkeleton.cgi>.
1549    
1550    A little expense is involved in order to make the URL as smart as possible. The
1551    main complication is that if the user specified all genomes, we'll want to
1552    remove the parameter entirely from a get-style URL.
1553    
1554    =cut
1555    
1556    sub ComputeSearchURL {
1557        # Get the parameters.
1558        my ($self) = @_;
1559        # Get the database and CGI query object.
1560        my $cgi = $self->Q();
1561        my $sprout = $self->DB();
1562        # Start with the full URL.
1563        my $retVal = $cgi->url(-full => 1);
1564        # Get all the query parameters in a hash.
1565        my %parms = $cgi->Vars();
1566        # Now we need to do some fixing. Each multi-valued parameter is encoded as a string with null
1567        # characters separating the individual values. We have to convert those to lists. In addition,
1568        # the multiple-selection genome parameters and the feature type parameter must be checked to
1569        # determine whether or not they can be removed from the URL. First, we get a list of the
1570        # genome parameters and a list of all genomes. Note that we only need the list if a
1571        # multiple-selection genome parameter has been found on the form.
1572        my %genomeParms = map { $_ => 1 } @{$self->{genomeParms}};
1573        my @genomeList;
1574        if (keys %genomeParms) {
1575            @genomeList = $sprout->Genomes();
1576        }
1577        # Create a list to hold the URL parameters we find.
1578        my @urlList = ();
1579        # Now loop through the parameters in the hash, putting them into the output URL.
1580        for my $parmKey (keys %parms) {
1581            # Get a list of the parameter values. If there's only one, we'll end up with
1582            # a singleton list, but that's okay.
1583            my @values = split (/\0/, $parms{$parmKey});
1584            # Check for special cases.
1585            if ($parmKey eq 'featureTypes') {
1586                # Here we need to see if the user wants all the feature types. If he
1587                # does, we erase all the values so that the parameter is not output.
1588                my %valueCheck = map { $_ => 1 } @values;
1589                my @list = FeatureQuery::AllFeatureTypes();
1590                my $okFlag = 1;
1591                for (my $i = 0; $okFlag && $i <= $#list; $i++) {
1592                    if (! $valueCheck{$list[$i]}) {
1593                        $okFlag = 0;
1594                    }
1595                }
1596                if ($okFlag) {
1597                    @values = ();
1598                }
1599            } elsif (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF ShowURL)) {
1600                # These are bookkeeping parameters we don't need to start a search.
1601                @values = ();
1602            } elsif ($parmKey =~ /_SearchThing$/) {
1603                # Here the value coming in is from a genome control's search thing. It does
1604                # not affect the results of the search, so we clear it.
1605                @values = ();
1606            } elsif ($genomeParms{$parmKey}) {
1607                # Here we need to see if the user wants all the genomes. If he does,
1608                # we erase all the values just like with features.
1609                my $allFlag = $sprout->IsAllGenomes(\@values, \@genomeList);
1610                if ($allFlag) {
1611                    @values = ();
1612                }
1613            }
1614            # If we still have values, create the URL parameters.
1615            if (@values) {
1616                push @urlList, map { "$parmKey=" . uri_escape($_) } @values;
1617            }
1618        }
1619        # Add the parameters to the URL.
1620        $retVal .= "?" . join(";", @urlList);
1621        # Return the result.
1622        return $retVal;
1623    }
1624    
1625    =head3 GetRunTimeValue
1626    
1627    C<< my $htmlText = $shelp->GetRunTimeValue($text); >>
1628    
1629    Compute a run-time column value.
1630    
1631    =over 4
1632    
1633    =item text
1634    
1635    The run-time column text. It consists of 2 percent signs, a column type, an equal
1636    sign, and the data for the current row.
1637    
1638    =item RETURN
1639    
1640    Returns the fully-formatted HTML text to go into the current column of the current row.
1641    
1642    =back
1643    
1644    =cut
1645    
1646    sub GetRunTimeValue {
1647        # Get the parameters.
1648        my ($self, $text) = @_;
1649        # Declare the return variable.
1650        my $retVal;
1651        # Parse the incoming text.
1652        if ($text =~ /^%%([^=]+)=(.*)$/) {
1653            $retVal = $self->RunTimeColumns($1, $2);
1654        } else {
1655            Confess("Invalid run-time column string \"$text\" encountered in session file.");
1656        }
1657        # Return the result.
1658        return $retVal;
1659    }
1660    
1661  =head2 Feature Column Methods  =head2 Feature Column Methods
1662    
1663  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 1690 
1690      # Get the parameters.      # Get the parameters.
1691      my ($self) = @_;      my ($self) = @_;
1692      # Return the result.      # Return the result.
1693      return ['orgName', 'function', 'gblink', 'protlink'];      return ['orgName', 'function', 'gblink', 'protlink',
1694                FeatureQuery::AdditionalColumns($self)];
1695  }  }
1696    
1697  =head3 FeatureColumnTitle  =head3 FeatureColumnTitle
# Line 1500  Line 1800 
1800          $retVal = HTML::set_prot_links($fid);          $retVal = HTML::set_prot_links($fid);
1801      } elsif ($colName eq 'alias') {      } elsif ($colName eq 'alias') {
1802          # 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.
1803          # 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.
1804          # 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);  
         }  
1805      } elsif ($colName eq 'function') {      } elsif ($colName eq 'function') {
1806          # The functional assignment is just a matter of getting some text.          # The functional assignment is just a matter of getting some text.
1807          ($retVal) = $record->Value('Feature(assignment)');          ($retVal) = $record->Value('Feature(assignment)');
# Line 1539  Line 1831 
1831      return $retVal;      return $retVal;
1832  }  }
1833    
1834    =head3 RunTimeColumns
1835    
1836    C<< my $htmlText = $shelp->RunTimeColumns($type, $text); >>
1837    
1838    Return the HTML text for a run-time column. Run-time columns are evaluated when the
1839    list is displayed, rather than when it is generated.
1840    
1841    =over 4
1842    
1843    =item type
1844    
1845    Type of column.
1846    
1847    =item text
1848    
1849    Data relevant to this row of the column.
1850    
1851    =item RETURN
1852    
1853    Returns the fully-formatted HTML text to go in the specified column.
1854    
1855    =back
1856    
1857    =cut
1858    
1859    sub RunTimeColumns {
1860        # Get the parameters.
1861        my ($self, $type, $text) = @_;
1862        # Declare the return variable.
1863        my $retVal = "";
1864        # Get the Sprout and CGI objects.
1865        my $sprout = $self->DB();
1866        my $cgi = $self->Q();
1867        # Separate the text into a type and data.
1868        if ($type eq 'aliases') {
1869            # Here the caller wants external alias links for a feature. The text
1870            # is the feature ID.
1871            my $fid = $text;
1872            # The complicated part is we have to hyperlink them. First, get the
1873            # aliases.
1874            Trace("Generating aliases for feature $fid.") if T(4);
1875            my @aliases = $sprout->FeatureAliases($fid);
1876            # Only proceed if we found some.
1877            if (@aliases) {
1878                # Join the aliases into a comma-delimited list.
1879                my $aliasList = join(", ", @aliases);
1880                # Ask the HTML processor to hyperlink them.
1881                $retVal = HTML::set_prot_links($cgi, $aliasList);
1882            }
1883        }
1884        # Return the result.
1885        return $retVal;
1886    }
1887    
1888    =head2 Virtual Methods
1889    
1890    =head3 Form
1891    
1892    C<< my $html = $shelp->Form(); >>
1893    
1894    Generate the HTML for a form to request a new search.
1895    
1896    =head3 Find
1897    
1898    C<< my $resultCount = $shelp->Find(); >>
1899    
1900    Conduct a search based on the current CGI query parameters. The search results will
1901    be written to the session cache file and the number of results will be
1902    returned. If the search parameters are invalid, a result count of C<undef> will be
1903    returned and a result message will be stored in this object describing the problem.
1904    
1905    =head3 Description
1906    
1907    C<< my $htmlText = $shelp->Description(); >>
1908    
1909    Return a description of this search. The description is used for the table of contents
1910    on the main search tools page. It may contain HTML, but it should be character-level,
1911    not block-level, since the description is going to appear in a list.
1912    
1913    =head3 SortKey
1914    
1915    C<< my $key = $shelp->SortKey($record); >>
1916    
1917    Return the sort key for the specified record. The default is to sort by feature name,
1918    floating NMPDR organisms to the top. This sort may be overridden by the search class
1919    to provide fancier functionality. This method is called by B<PutFeature>, so it
1920    is only used for feature searches. A non-feature search would presumably have its
1921    own sort logic.
1922    
1923    =over 4
1924    
1925    =item record
1926    
1927    The C<DBObject> from which the current row of data is derived.
1928    
1929    =item RETURN
1930    
1931    Returns a key field that can be used to sort this row in among the results.
1932    
1933    =back
1934    
1935    =cut
1936    
1937    sub SortKey {
1938        # Get the parameters.
1939        my ($self, $record) = @_;
1940        # Get the feature ID from the record.
1941        my ($fid) = $record->Value('Feature(id)');
1942        # Get the group from the feature ID.
1943        my $group = $self->FeatureGroup($fid);
1944        # Ask the feature query object to form the sort key.
1945        my $retVal = FeatureQuery::SortKey($self, $group, $record);
1946        # Return the result.
1947        return $retVal;
1948    }
1949  1;  1;

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3