[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.3, Fri Sep 29 15:10:05 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 298  Line 317 
317                    orgs => {},                    orgs => {},
318                    name => $formName,                    name => $formName,
319                    scriptQueue => [],                    scriptQueue => [],
320                      genomeList => undef,
321                      genomeParms => [],
322                      filtered => 0,
323                   };                   };
324      # Bless and return it.      # Bless and return it.
325      bless $retVal, $class;      bless $retVal, $class;
# Line 648  Line 670 
670  sub PutFeature {  sub PutFeature {
671      # Get the parameters.      # Get the parameters.
672      my ($self, $fq) = @_;      my ($self, $fq) = @_;
673        # Get the CGI query object.
674        my $cgi = $self->Q();
675      # Get the feature data.      # Get the feature data.
676      my $record = $fq->Feature();      my $record = $fq->Feature();
677      my $extraCols = $fq->ExtraCols();      my $extraCols = $fq->ExtraCols();
# Line 655  Line 679 
679      if (! defined $self->{cols}) {      if (! defined $self->{cols}) {
680          # 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.
681          $self->{cols} = $self->DefaultFeatureColumns();          $self->{cols} = $self->DefaultFeatureColumns();
682            # Add the externals if they were requested.
683            if ($cgi->param('ShowAliases')) {
684                push @{$self->{cols}}, 'alias';
685            }
686          # Append the extras, sorted by column name.          # Append the extras, sorted by column name.
687          for my $col (sort keys %{$extraCols}) {          for my $col (sort keys %{$extraCols}) {
688              push @{$self->{cols}}, "X=$col";              push @{$self->{cols}}, "X=$col";
# Line 1059  Line 1087 
1087    
1088  =head3 NmpdrGenomeMenu  =head3 NmpdrGenomeMenu
1089    
1090  C<< my $htmlText = $shelp->NmpdrGenomeMenu($menuName, \%options, \@selected); >>  C<< my $htmlText = $shelp->NmpdrGenomeMenu($menuName, $multiple, \@selected, $rows); >>
1091    
1092  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
1093  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 1099 
1099    
1100  Name to give to the menu.  Name to give to the menu.
1101    
1102  =item options  =item multiple
1103    
1104  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.  
1105    
1106  =item selected  =item selected
1107    
# Line 1084  Line 1109 
1109  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
1110  list is empty, nothing will be pre-selected.  list is empty, nothing will be pre-selected.
1111    
1112    =item rows (optional)
1113    
1114    Number of rows to display. If omitted, the default is 1 for a single-select list
1115    and 10 for a multi-select list.
1116    
1117  =item RETURN  =item RETURN
1118    
1119  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 1124 
1124    
1125  sub NmpdrGenomeMenu {  sub NmpdrGenomeMenu {
1126      # Get the parameters.      # Get the parameters.
1127      my ($self, $menuName, $options, $selected) = @_;      my ($self, $menuName, $multiple, $selected, $rows) = @_;
1128      # Get the Sprout and CGI objects.      # Get the Sprout and CGI objects.
1129      my $sprout = $self->DB();      my $sprout = $self->DB();
1130      my $cgi = $self->Q();      my $cgi = $self->Q();
1131        # Compute the row count.
1132        if (! defined $rows) {
1133            $rows = ($multiple ? 10 : 1);
1134        }
1135        # Create the multiple tag.
1136        my $multipleTag = ($multiple ? " multiple" : "");
1137      # Get the form name.      # Get the form name.
1138      my $formName = $self->FormName();      my $formName = $self->FormName();
1139        # Check to see if we already have a genome list in memory.
1140        my $genomes = $self->{genomeList};
1141        my $groupHash;
1142        if (defined $genomes) {
1143            # We have a list ready to use.
1144            $groupHash = $genomes;
1145        } else {
1146      # 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
1147      # 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
1148      # take advantage of an existing index.      # take advantage of an existing index.
# Line 1111  Line 1154 
1154      # 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
1155      # 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
1156      # name.      # name.
1157      my %groupHash = ();          my %gHash = ();
1158      for my $genome (@genomeList) {      for my $genome (@genomeList) {
1159          # Get the genome data.          # Get the genome data.
1160          my ($group, $genomeID, $genus, $species, $strain) = @{$genome};          my ($group, $genomeID, $genus, $species, $strain) = @{$genome};
# Line 1121  Line 1164 
1164              $name .= " $strain";              $name .= " $strain";
1165          }          }
1166          # Push the genome into the group's list.          # Push the genome into the group's list.
1167          push @{$groupHash{$group}}, [$genomeID, $name];              push @{$gHash{$group}}, [$genomeID, $name];
1168            }
1169            # Save the genome list for future use.
1170            $self->{genomeList} = \%gHash;
1171            $groupHash = \%gHash;
1172      }      }
1173      # 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
1174      # the supporting-genome group last.      # the supporting-genome group last.
1175      my @groups = sort grep { $_ ne $FIG_Config::otherGroup } keys %groupHash;      my @groups = sort grep { $_ ne $FIG_Config::otherGroup } keys %{$groupHash};
1176      push @groups, $FIG_Config::otherGroup;      push @groups, $FIG_Config::otherGroup;
1177      # 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
1178      my %selectedHash = map { $_ => 1 } @{$selected};      # with the possibility of undefined values in the incoming list.
1179        my %selectedHash = ();
1180        if (defined $selected) {
1181            %selectedHash = map { $_ => 1 } grep { defined($_) } @{$selected};
1182        }
1183      # 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.
1184      # Create the type counters.      # Create the type counters.
1185      my $groupCount = 1;      my $groupCount = 1;
# Line 1138  Line 1189 
1189      my $showSelect = "showSelected($menuName, '$divID', 1000);";      my $showSelect = "showSelected($menuName, '$divID', 1000);";
1190      # If multiple selection is supported, create an onChange event.      # If multiple selection is supported, create an onChange event.
1191      my $onChange = "";      my $onChange = "";
1192      if ($options->{multiple}) {      if ($multiple) {
1193          $onChange = " onChange=\"$showSelect\"";          $onChange = " onChange=\"$showSelect\"";
1194      }      }
1195      # Create the SELECT tag and stuff it into the output array.      # Create the SELECT tag and stuff it into the output array.
1196      my $select = "<" . join(" ", "SELECT name=\"$menuName\"$onChange", map { " $_=\"$options->{$_}\"" } keys %{$options}) . ">";      my $select = "<SELECT name=\"$menuName\"$onChange$multipleTag size=\"$rows\">";
1197      my @lines = ($select);      my @lines = ($select);
1198      # Loop through the groups.      # Loop through the groups.
1199      for my $group (@groups) {      for my $group (@groups) {
# Line 1153  Line 1204 
1204          # 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
1205          # 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
1206          # 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
1207          # hierarchy.          # hierarchy, so we can't use it.
1208          my $label = ($group eq $FIG_Config::otherGroup ? "other" : "nmpdr");          my $label = ($group eq $FIG_Config::otherGroup ? "other" : "nmpdr");
1209          # Get the genomes in the group.          # Get the genomes in the group.
1210          for my $genome (@{$groupHash{$group}}) {          for my $genome (@{$groupHash->{$group}}) {
1211              my ($genomeID, $name) = @{$genome};              my ($genomeID, $name) = @{$genome};
1212              # See if it's selected.              # See if it's selected.
1213              my $select = ($selectedHash{$genomeID} ? " selected" : "");              my $select = ($selectedHash{$genomeID} ? " selected" : "");
# Line 1170  Line 1221 
1221      # Close the SELECT tag.      # Close the SELECT tag.
1222      push @lines, "</SELECT>";      push @lines, "</SELECT>";
1223      # Check for multiple selection.      # Check for multiple selection.
1224      if ($options->{multiple}) {      if ($multiple) {
1225          # 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.
1226          push @lines, "<br />";          push @lines, "<br />";
1227          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\" />";
1228          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\" />";
1229          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\" />";
1230          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\" />";
1231            # Now add the search box. This allows the user to type text and have all genomes containing
1232            # the text selected automatically.
1233            my $searchThingName = "${menuName}_SearchThing";
1234            push @lines, "<br>Select genomes containing <INPUT type=\"text\" name=\"$searchThingName\" size=\"30\" />&nbsp;" .
1235                         "<INPUT type=\"button\" name=\"Select\" class=\"button\" value=\"Search\" onClick=\"selectViaSearch($menuName, $searchThingName); $showSelect\" />";
1236          # Add the status display, too.          # Add the status display, too.
1237          push @lines, "<DIV id=\"$divID\" class=\"selectStatus\"></DIV>";          push @lines, "<DIV id=\"$divID\" class=\"selectStatus\"></DIV>";
1238          # 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 1241 
1241          # in case we decide to twiddle the parameters.          # in case we decide to twiddle the parameters.
1242          $showSelect =~ s/showSelected\(/showSelected\(thisForm\./;          $showSelect =~ s/showSelected\(/showSelected\(thisForm\./;
1243          $self->QueueFormScript($showSelect);          $self->QueueFormScript($showSelect);
1244            # Finally, add this parameter to the list of genome parameters. This enables us to
1245            # easily find all the parameters used to select one or more genomes.
1246            push @{$self->{genomeParms}}, $menuName;
1247      }      }
1248      # Assemble all the lines into a string.      # Assemble all the lines into a string.
1249      my $retVal = join("\n", @lines, "");      my $retVal = join("\n", @lines, "");
# Line 1192  Line 1251 
1251      return $retVal;      return $retVal;
1252  }  }
1253    
1254    =head3 PropertyMenu
1255    
1256    C<< my $htmlText = $shelp->PropertyMenu($menuName, $selected, $force); >>
1257    
1258    Generate a property name dropdown menu.
1259    
1260    =over 4
1261    
1262    =item menuName
1263    
1264    Name to give to the menu.
1265    
1266    =item selected
1267    
1268    Value of the property name to pre-select.
1269    
1270    =item force (optional)
1271    
1272    If TRUE, then the user will be forced to choose a property name. If FALSE,
1273    then an additional menu choice will be provided to select nothing.
1274    
1275    =item RETURN
1276    
1277    Returns a dropdown menu box that allows the user to select a property name. An additional
1278    selection entry will be provided for selecting no property name
1279    
1280    =back
1281    
1282    =cut
1283    
1284    sub PropertyMenu {
1285        # Get the parameters.
1286        my ($self, $menuName, $selected, $force) = @_;
1287        # Get the CGI and Sprout objects.
1288        my $sprout = $self->DB();
1289        my $cgi = $self->Q();
1290        # Create the property name list.
1291        my @propNames = ();
1292        if (! $force) {
1293            push @propNames, "";
1294        }
1295        # Get all the property names, putting them after the null choice if one exists.
1296        push @propNames, $sprout->GetChoices('Property', 'property-name');
1297        # Create a menu from them.
1298        my $retVal = $cgi->popup_menu(-name=> $menuName, -values => \@propNames,
1299                                      -default => $selected);
1300        # Return the result.
1301        return $retVal;
1302    }
1303    
1304  =head3 MakeTable  =head3 MakeTable
1305    
1306  C<< my $htmlText = $shelp->MakeTable(\@rows); >>  C<< my $htmlText = $shelp->MakeTable(\@rows); >>
# Line 1254  Line 1363 
1363      # Get the parameters.      # Get the parameters.
1364      my ($self) = @_;      my ($self) = @_;
1365      my $cgi = $self->Q();      my $cgi = $self->Q();
1366      # Declare the return variable.      # Get the current page size.
1367        my $pageSize = $cgi->param('PageSize');
1368        # Get the incoming external-link flag.
1369        my $aliases = ($cgi->param('ShowAliases') ? 1 : 0);
1370        # Create the row.
1371      my $retVal = $cgi->Tr($cgi->td("Results/Page"),      my $retVal = $cgi->Tr($cgi->td("Results/Page"),
1372                            $cgi->td($cgi->popup_menu(-name => 'PageSize',                            $cgi->td($cgi->popup_menu(-name => 'PageSize',
1373                                                      -values => [10, 25, 45, 100, 1000],                                                      -values => [10, 25, 45, 100, 1000],
1374                                                      -default => $cgi->param('PageSize'))),                                                      -default => $pageSize) . " " .
1375                                       $cgi->checkbox(-name => 'ShowAliases',
1376                                                      -value => 1,
1377                                                      -label => 'Show Alias Links',
1378                                                      -default => $aliases),
1379                                       $cgi->checkbox(-name => 'ShowURL',
1380                                                      -value => 1,
1381                                                      -label => 'Show URL')),
1382                            $cgi->td($cgi->submit(-class => 'goButton',                            $cgi->td($cgi->submit(-class => 'goButton',
1383                                                  -name => 'Search',                                                  -name => 'Search',
1384                                                  -value => 'Go')));                                                  -value => 'Go')));
# Line 1359  Line 1479 
1479      return $retVal;      return $retVal;
1480  }  }
1481    
1482    =head3 GetGenomes
1483    
1484    C<< my @genomeList = $shelp->GetGenomes($parmName); >>
1485    
1486    Return the list of genomes specified by the specified CGI query parameter.
1487    If the request method is POST, then the list of genome IDs is returned
1488    without preamble. If the request method is GET and the parameter is not
1489    specified, then it is treated as a request for all genomes. This makes it
1490    easier for web pages to link to a search that wants to specify all genomes.
1491    
1492    =over 4
1493    
1494    =item parmName
1495    
1496    Name of the parameter containing the list of genomes. This will be the
1497    first parameter passed to the L</NmpdrGenomeMenu> call that created the
1498    genome selection control on the form.
1499    
1500    =item RETURN
1501    
1502    Returns a list of the genomes to process.
1503    
1504    =back
1505    
1506    =cut
1507    
1508    sub GetGenomes {
1509        # Get the parameters.
1510        my ($self, $parmName) = @_;
1511        # Get the CGI query object.
1512        my $cgi = $self->Q();
1513        # Get the list of genome IDs in the request header.
1514        my @retVal = $cgi->param($parmName);
1515        Trace("Genome list for $parmName is (" . join(", ", @retVal) . ") with method " . $cgi->request_method() . ".") if T(3);
1516        # Check for the special GET case.
1517        if ($cgi->request_method() eq "GET" && ! @retVal) {
1518            # Here the caller wants all the genomes.
1519            my $sprout = $self->DB();
1520            @retVal = $sprout->Genomes();
1521        }
1522        # Return the result.
1523        return @retVal;
1524    }
1525    
1526    =head3 GetHelpText
1527    
1528    C<< my $htmlText = $shelp->GetHelpText(); >>
1529    
1530    Get the help text for this search. The help text is stored in files on the template
1531    server. The help text for a specific search is taken from a file named
1532    C<SearchHelp_>I<class>C<.inc> in the template directory C<$FIG_Config::template_url>.
1533    There are also three standard help files: C<SearchHelp1_Filtering.inc> describes the
1534    feature filtering performed by the B<FeatureQuery> object, C<SearchHelp1_GenomeControl.inc>
1535    describes how to use a multiple-selection genome control, and C<SearchHelp1_Standard.inc>
1536    describes the standard controls for a search, such as page size, URL display, and
1537    external alias display.
1538    
1539    =cut
1540    
1541    sub GetHelpText {
1542        # Get the parameters.
1543        my ($self) = @_;
1544        # Create a list to hold the pieces of the help.
1545        my @helps = ();
1546        # Get the template directory URL.
1547        my $urlBase = $FIG_Config::template_url;
1548        # Start with the specific help.
1549        my $class = $self->{class};
1550        push @helps, PageBuilder::GetPage("$urlBase/SearchHelp_$class.inc");
1551        # Add the genome control help if needed.
1552        if (scalar @{$self->{genomeParms}}) {
1553            push @helps, PageBuilder::GetPage("$urlBase/SearchHelp1_GenomeControl.inc");
1554        }
1555        # Next the filter help.
1556        if ($self->{filtered}) {
1557            push @helps, PageBuilder::GetPage("$urlBase/SearchHelp1_Filtering.inc");
1558        }
1559        # Finally, the standard help.
1560        push @helps, PageBuilder::GetPage("$urlBase/SearchHelp1_Standard.inc");
1561        # Assemble the pieces.
1562        my $retVal = join("\n<p>&nbsp;</p>\n", @helps);
1563        # Return the result.
1564        return $retVal;
1565    }
1566    
1567    =head3 ComputeSearchURL
1568    
1569    C<< my $url = $shelp->ComputeSearchURL(); >>
1570    
1571    Compute the GET-style URL for the current search. In order for this to work, there
1572    must be a copy of the search form on the current page. This will always be the
1573    case if the search is coming from C<SearchSkeleton.cgi>.
1574    
1575    A little expense is involved in order to make the URL as smart as possible. The
1576    main complication is that if the user specified all genomes, we'll want to
1577    remove the parameter entirely from a get-style URL.
1578    
1579    =cut
1580    
1581    sub ComputeSearchURL {
1582        # Get the parameters.
1583        my ($self) = @_;
1584        # Get the database and CGI query object.
1585        my $cgi = $self->Q();
1586        my $sprout = $self->DB();
1587        # Start with the full URL.
1588        my $retVal = $cgi->url(-full => 1);
1589        # Get all the query parameters in a hash.
1590        my %parms = $cgi->Vars();
1591        # Now we need to do some fixing. Each multi-valued parameter is encoded as a string with null
1592        # characters separating the individual values. We have to convert those to lists. In addition,
1593        # the multiple-selection genome parameters and the feature type parameter must be checked to
1594        # determine whether or not they can be removed from the URL. First, we get a list of the
1595        # genome parameters and a list of all genomes. Note that we only need the list if a
1596        # multiple-selection genome parameter has been found on the form.
1597        my %genomeParms = map { $_ => 1 } @{$self->{genomeParms}};
1598        my @genomeList;
1599        if (keys %genomeParms) {
1600            @genomeList = $sprout->Genomes();
1601        }
1602        # Create a list to hold the URL parameters we find.
1603        my @urlList = ();
1604        # Now loop through the parameters in the hash, putting them into the output URL.
1605        for my $parmKey (keys %parms) {
1606            # Get a list of the parameter values. If there's only one, we'll end up with
1607            # a singleton list, but that's okay.
1608            my @values = split (/\0/, $parms{$parmKey});
1609            # Check for special cases.
1610            if ($parmKey eq 'featureTypes') {
1611                # Here we need to see if the user wants all the feature types. If he
1612                # does, we erase all the values so that the parameter is not output.
1613                my %valueCheck = map { $_ => 1 } @values;
1614                my @list = FeatureQuery::AllFeatureTypes();
1615                my $okFlag = 1;
1616                for (my $i = 0; $okFlag && $i <= $#list; $i++) {
1617                    if (! $valueCheck{$list[$i]}) {
1618                        $okFlag = 0;
1619                    }
1620                }
1621                if ($okFlag) {
1622                    @values = ();
1623                }
1624            } elsif (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF ShowURL)) {
1625                # These are bookkeeping parameters we don't need to start a search.
1626                @values = ();
1627            } elsif ($parmKey =~ /_SearchThing$/) {
1628                # Here the value coming in is from a genome control's search thing. It does
1629                # not affect the results of the search, so we clear it.
1630                @values = ();
1631            } elsif ($genomeParms{$parmKey}) {
1632                # Here we need to see if the user wants all the genomes. If he does,
1633                # we erase all the values just like with features.
1634                my $allFlag = $sprout->IsAllGenomes(\@values, \@genomeList);
1635                if ($allFlag) {
1636                    @values = ();
1637                }
1638            }
1639            # If we still have values, create the URL parameters.
1640            if (@values) {
1641                push @urlList, map { "$parmKey=" . uri_escape($_) } @values;
1642            }
1643        }
1644        # Add the parameters to the URL.
1645        $retVal .= "?" . join(";", @urlList);
1646        # Return the result.
1647        return $retVal;
1648    }
1649    
1650    =head3 GetRunTimeValue
1651    
1652    C<< my $htmlText = $shelp->GetRunTimeValue($text); >>
1653    
1654    Compute a run-time column value.
1655    
1656    =over 4
1657    
1658    =item text
1659    
1660    The run-time column text. It consists of 2 percent signs, a column type, an equal
1661    sign, and the data for the current row.
1662    
1663    =item RETURN
1664    
1665    Returns the fully-formatted HTML text to go into the current column of the current row.
1666    
1667    =back
1668    
1669    =cut
1670    
1671    sub GetRunTimeValue {
1672        # Get the parameters.
1673        my ($self, $text) = @_;
1674        # Declare the return variable.
1675        my $retVal;
1676        # Parse the incoming text.
1677        if ($text =~ /^%%([^=]+)=(.*)$/) {
1678            $retVal = $self->RunTimeColumns($1, $2);
1679        } else {
1680            Confess("Invalid run-time column string \"$text\" encountered in session file.");
1681        }
1682        # Return the result.
1683        return $retVal;
1684    }
1685    
1686  =head2 Feature Column Methods  =head2 Feature Column Methods
1687    
1688  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 1500  Line 1824 
1824          $retVal = HTML::set_prot_links($fid);          $retVal = HTML::set_prot_links($fid);
1825      } elsif ($colName eq 'alias') {      } elsif ($colName eq 'alias') {
1826          # 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.
1827          # 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.
1828          # 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);  
         }  
1829      } elsif ($colName eq 'function') {      } elsif ($colName eq 'function') {
1830          # The functional assignment is just a matter of getting some text.          # The functional assignment is just a matter of getting some text.
1831          ($retVal) = $record->Value('Feature(assignment)');          ($retVal) = $record->Value('Feature(assignment)');
# Line 1539  Line 1855 
1855      return $retVal;      return $retVal;
1856  }  }
1857    
1858    =head3 RunTimeColumns
1859    
1860    C<< my $htmlText = $shelp->RunTimeColumns($type, $text); >>
1861    
1862    Return the HTML text for a run-time column. Run-time columns are evaluated when the
1863    list is displayed, rather than when it is generated.
1864    
1865    =over 4
1866    
1867    =item type
1868    
1869    Type of column.
1870    
1871    =item text
1872    
1873    Data relevant to this row of the column.
1874    
1875    =item RETURN
1876    
1877    Returns the fully-formatted HTML text to go in the specified column.
1878    
1879    =back
1880    
1881    =cut
1882    
1883    sub RunTimeColumns {
1884        # Get the parameters.
1885        my ($self, $type, $text) = @_;
1886        # Declare the return variable.
1887        my $retVal = "";
1888        # Get the Sprout and CGI objects.
1889        my $sprout = $self->DB();
1890        my $cgi = $self->Q();
1891        # Separate the text into a type and data.
1892        if ($type eq 'aliases') {
1893            # Here the caller wants external alias links for a feature. The text
1894            # is the feature ID.
1895            my $fid = $text;
1896            # The complicated part is we have to hyperlink them. First, get the
1897            # aliases.
1898            Trace("Generating aliases for feature $fid.") if T(4);
1899            my @aliases = $sprout->FeatureAliases($fid);
1900            # Only proceed if we found some.
1901            if (@aliases) {
1902                # Join the aliases into a comma-delimited list.
1903                my $aliasList = join(", ", @aliases);
1904                # Ask the HTML processor to hyperlink them.
1905                $retVal = HTML::set_prot_links($cgi, $aliasList);
1906            }
1907        }
1908        # Return the result.
1909        return $retVal;
1910    }
1911    
1912  1;  1;

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3