[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.11, Mon Oct 16 07:44:13 2006 UTC revision 1.17, Wed Nov 15 22:34:50 2006 UTC
# Line 113  Line 113 
113    
114  =item 4  =item 4
115    
116  In the C<SearchSkeleton.cgi> script, add a C<use> statement for your search tool  In the C<SearchSkeleton.cgi> script and add a C<use> statement for your search tool.
 and then put the class name in the C<@advancedClasses> list.  
117    
118  =back  =back
119    
# Line 177  Line 176 
176    
177  =back  =back
178    
179    If you are doing a feature search, you can also change the list of feature
180    columns displayed and their display order by overriding
181    L</DefaultFeatureColumns>.
182    
183  Finally, when generating the code for your controls, be sure to use any incoming  Finally, when generating the code for your controls, be sure to use any incoming
184  query parameters as default values so that the search request is persistent.  query parameters as default values so that the search request is persistent.
185    
# Line 222  Line 225 
225      }      }
226    
227  A Find method is of course much more complicated than generating a form, and there  A Find method is of course much more complicated than generating a form, and there
228  are variations on the above them. For example, you could eschew feature filtering  are variations on the above theme. For example, you could eschew feature filtering
229  entirely in favor of your own custom filtering, you could include extra columns  entirely in favor of your own custom filtering, you could include extra columns
230  in the output, or you could search for something that's not a feature at all. The  in the output, or you could search for something that's not a feature at all. The
231  above code is just a loose framework.  above code is just a loose framework.
# Line 241  Line 244 
244    
245  # This counter is used to insure every form on the page has a unique name.  # This counter is used to insure every form on the page has a unique name.
246  my $formCount = 0;  my $formCount = 0;
247    # This counter is used to generate unique DIV IDs.
248    my $divCount = 0;
249    
250  =head2 Public Methods  =head2 Public Methods
251    
# Line 654  Line 659 
659      my $extraCols = $fd->ExtraCols();      my $extraCols = $fd->ExtraCols();
660      # Check for a first-call situation.      # Check for a first-call situation.
661      if (! defined $self->{cols}) {      if (! defined $self->{cols}) {
662          # Here we need to set up the column information. Start with the defaults.          Trace("Setting up the columns.") if T(3);
663          $self->{cols} = $self->DefaultFeatureColumns();          # Here we need to set up the column information. Start with the extras,
664          # Add any additional columns requested by the feature filter.          # sorted by column name.
665          push @{$self->{cols}}, FeatureQuery::AdditionalColumns($self);          my @colNames = ();
         # Append the extras, sorted by column name.  
666          for my $col (sort keys %{$extraCols}) {          for my $col (sort keys %{$extraCols}) {
667              push @{$self->{cols}}, "X=$col";              push @colNames, "X=$col";
668          }          }
669            # Add the default columns.
670            push @colNames, $self->DefaultFeatureColumns();
671            # Add any additional columns requested by the feature filter.
672            push @colNames, FeatureQuery::AdditionalColumns($self);
673            # Save the full list.
674            $self->{cols} = \@colNames;
675          # Write out the column headers. This also prepares the cache file to receive          # Write out the column headers. This also prepares the cache file to receive
676          # output.          # output.
677          $self->WriteColumnHeaders(map { $self->FeatureColumnTitle($_) } @{$self->{cols}});          $self->WriteColumnHeaders(map { $self->FeatureColumnTitle($_) } @{$self->{cols}});
# Line 994  Line 1004 
1004          # exist.          # exist.
1005          my ($figID) = $sprout->FeaturesByAlias($fid);          my ($figID) = $sprout->FeaturesByAlias($fid);
1006          if (! $figID) {          if (! $figID) {
1007              $self->SetMessage("No feature found with the ID \"$fid\".");              $self->SetMessage("No gene found with the ID \"$fid\".");
1008              $okFlag = 0;              $okFlag = 0;
1009          } else {          } else {
1010              # Set the FASTA label.              # Set the FASTA label.
# Line 1062  Line 1072 
1072      return $retVal;      return $retVal;
1073  }  }
1074    
1075    =head3 SubsystemTree
1076    
1077    C<< my $tree = SearchHelper::SubsystemTree($sprout, %options); >>
1078    
1079    This method creates a subsystem selection tree suitable for passing to
1080    L</SelectionTree>. Each leaf node in the tree will have a link to the
1081    subsystem display page. In addition, each node can have a radio button. The
1082    radio button alue is either C<classification=>I<string>, where I<string> is
1083    a classification string, or C<id=>I<string>, where I<string> is a subsystem ID.
1084    Thus, it can either be used to filter by a group of related subsystems or a
1085    single subsystem.
1086    
1087    =over 4
1088    
1089    =item sprout
1090    
1091    Sprout database object used to get the list of subsystems.
1092    
1093    =item options
1094    
1095    Hash containing options for building the tree.
1096    
1097    =item RETURN
1098    
1099    Returns a reference to a tree list suitable for passing to L</SelectionTree>.
1100    
1101    =back
1102    
1103    The supported options are as follows.
1104    
1105    =over 4
1106    
1107    =item radio
1108    
1109    TRUE if the tree should be configured for radio buttons. The default is FALSE.
1110    
1111    =item links
1112    
1113    TRUE if the tree should be configured for links. The default is TRUE.
1114    
1115    =back
1116    
1117    =cut
1118    
1119    sub SubsystemTree {
1120        # Get the parameters.
1121        my ($sprout, %options) = @_;
1122        # Process the options.
1123        my $optionThing = Tracer::GetOptions({ radio => 0, links => 1 }, \%options);
1124        # Read in the subsystems.
1125        my @subs = $sprout->GetAll(['Subsystem'], "ORDER BY Subsystem(classification), Subsystem(id)", [],
1126                                   ['Subsystem(classification)', 'Subsystem(id)']);
1127        # Declare the return variable.
1128        my @retVal = ();
1129        # Each element in @subs represents a leaf node, so as we loop through it we will be
1130        # producing one leaf node at a time. The leaf node is represented as a 2-tuple. The
1131        # first element is a semi-colon-delimited list of the classifications for the
1132        # subsystem. There will be a stack of currently-active classifications, which we will
1133        # compare to the incoming classifications from the end backward. A new classification
1134        # requires starting a new branch. A different classification requires closing an old
1135        # branch and starting a new one. Each classification in the stack will also contain
1136        # that classification's current branch. We'll add a fake classification at the
1137        # beginning that we can use to represent the tree as a whole.
1138        my $rootName = '<root>';
1139        # Create the classification stack. Note the stack is a pair of parallel lists,
1140        # one containing names and the other containing content.
1141        my @stackNames = ($rootName);
1142        my @stackContents = (\@retVal);
1143        # Add a null entry at the end of the subsystem list to force an unrolling.
1144        push @subs, ['', undef];
1145        # Loop through the subsystems.
1146        for my $sub (@subs) {
1147            # Pull out the classification list and the subsystem ID.
1148            my ($classString, $id) = @{$sub};
1149            Trace("Processing class \"$classString\" and subsystem $id.") if T(4);
1150            # Convert the classification string to a list with the root classification in
1151            # the front.
1152            my @classList = ($rootName, split($FIG_Config::splitter, $classString));
1153            # Find the leftmost point at which the class list differs from the stack.
1154            my $matchPoint = 0;
1155            while ($matchPoint <= $#stackNames && $matchPoint <= $#classList &&
1156                   $stackNames[$matchPoint] eq $classList[$matchPoint]) {
1157                $matchPoint++;
1158            }
1159            Trace("Match point is $matchPoint. Stack length is " . scalar(@stackNames) .
1160                  ". Class List length is " . scalar(@classList) . ".") if T(4);
1161            # Unroll the stack to the matchpoint.
1162            while ($#stackNames >= $matchPoint) {
1163                my $popped = pop @stackNames;
1164                pop @stackContents;
1165                Trace("\"$popped\" popped from stack.") if T(4);
1166            }
1167            # Start branches for any new classifications.
1168            while ($#stackNames < $#classList) {
1169                # The branch for a new classification contains its radio button
1170                # data and then a list of children. So, at this point, if radio buttons
1171                # are desired, we put them into the content.
1172                my $newLevel = scalar(@stackNames);
1173                my @newClassContent = ();
1174                if ($optionThing->{radio}) {
1175                    my $newClassString = join($FIG_Config::splitter, @classList[1..$newLevel]);
1176                    push @newClassContent, { value => "classification=$newClassString%" };
1177                }
1178                # The new classification node is appended to its parent's content
1179                # and then pushed onto the stack. First, we need the node name.
1180                my $nodeName = $classList[$newLevel];
1181                # Add the classification to its parent. This makes it part of the
1182                # tree we'll be returning to the user.
1183                push @{$stackContents[$#stackNames]}, $nodeName, \@newClassContent;
1184                # Push the classification onto the stack.
1185                push @stackContents, \@newClassContent;
1186                push @stackNames, $nodeName;
1187                Trace("\"$nodeName\" pushed onto stack.") if T(4);
1188            }
1189            # Now the stack contains all our parent branches. We add the subsystem to
1190            # the branch at the top of the stack, but only if it's NOT the dummy node.
1191            if (defined $id) {
1192                # Compute the node name from the ID.
1193                my $nodeName = $id;
1194                $nodeName =~ s/_/ /g;
1195                # Create the node's leaf hash. This depends on the value of the radio
1196                # and link options.
1197                my $nodeContent = {};
1198                if ($optionThing->{links}) {
1199                    # Compute the link value.
1200                    my $linkable = uri_escape($id);
1201                    $nodeContent->{link} = "../FIG/display_subsys.cgi?ssa_name=$linkable;request=show_ssa;sort=by_phylo;SPROUT=1";
1202                }
1203                if ($optionThing->{radio}) {
1204                    # Compute the radio value.
1205                    $nodeContent->{value} = "id=$id";
1206                }
1207                # Push the node into its parent branch.
1208                Trace("\"$nodeName\" added to node list.") if T(4);
1209                push @{$stackContents[$#stackNames]}, $nodeName, $nodeContent;
1210            }
1211        }
1212        # Return the result.
1213        return \@retVal;
1214    }
1215    
1216    
1217  =head3 NmpdrGenomeMenu  =head3 NmpdrGenomeMenu
1218    
1219  C<< my $htmlText = $shelp->NmpdrGenomeMenu($menuName, $multiple, \@selected, $rows); >>  C<< my $htmlText = $shelp->NmpdrGenomeMenu($menuName, $multiple, \@selected, $rows); >>
# Line 1163  Line 1315 
1315      if (defined $selected) {      if (defined $selected) {
1316          %selectedHash = map { $_ => 1 } grep { defined($_) } @{$selected};          %selectedHash = map { $_ => 1 } grep { defined($_) } @{$selected};
1317      }      }
1318      # Now it gets complicated. We need a way to mark all the NMPDR genomes.      # Now it gets complicated. We need a way to mark all the NMPDR genomes. We take advantage
1319        # of the fact they come first in the list. We'll accumulate a count of the NMPDR genomes
1320        # and use that to make the selections.
1321        my $nmpdrCount = 0;
1322      # Create the type counters.      # Create the type counters.
1323      my $groupCount = 1;      my $groupCount = 1;
1324      # Compute the ID for the status display.      # Compute the ID for the status display.
# Line 1173  Line 1328 
1328      # If multiple selection is supported, create an onChange event.      # If multiple selection is supported, create an onChange event.
1329      my $onChange = "";      my $onChange = "";
1330      if ($cross) {      if ($cross) {
1331            # Here we have a paired menu. Selecting something in our menu unselects it in the
1332            # other and redisplays the status of both.
1333          $onChange = " onChange=\"crossUnSelect($menuName, '$divID', $cross, '${formName}_${cross}_status', 1000)\"";          $onChange = " onChange=\"crossUnSelect($menuName, '$divID', $cross, '${formName}_${cross}_status', 1000)\"";
1334      } elsif ($multiple) {      } elsif ($multiple) {
1335            # This is an unpaired menu, so all we do is redisplay our status.
1336          $onChange = " onChange=\"$showSelect\"";          $onChange = " onChange=\"$showSelect\"";
1337      }      }
1338      # Create the SELECT tag and stuff it into the output array.      # Create the SELECT tag and stuff it into the output array.
1339      my $select = "<SELECT name=\"$menuName\"$onChange$multipleTag size=\"$rows\">";      my @lines = ("<SELECT name=\"$menuName\"$onChange$multipleTag size=\"$rows\">");
     my @lines = ($select);  
1340      # Loop through the groups.      # Loop through the groups.
1341      for my $group (@groups) {      for my $group (@groups) {
1342          # Create the option group tag.          # Create the option group tag.
1343          my $tag = "<OPTGROUP label=\"$group\">";          my $tag = "<OPTGROUP label=\"$group\">";
1344          push @lines, "  $tag";          push @lines, "  $tag";
         # Compute the label for this group's options. This is seriously dirty stuff, as the  
         # label option may have functionality in future browsers. If that happens, we'll need  
         # to modify the genome text so that the "selectSome" method can tell which are NMPDR  
         # organisms and which aren't. Sadly, the OPTGROUP tag is invisible in the DOM Javascript  
         # hierarchy, so we can't use it.  
         my $label = ($group eq $FIG_Config::otherGroup ? "other" : "nmpdr");  
1345          # Get the genomes in the group.          # Get the genomes in the group.
1346          for my $genome (@{$groupHash->{$group}}) {          for my $genome (@{$groupHash->{$group}}) {
1347                # Count this organism if it's NMPDR.
1348                if ($group ne $FIG_Config::otherGroup) {
1349                    $nmpdrCount++;
1350                }
1351                # Get the organism ID and name.
1352              my ($genomeID, $name) = @{$genome};              my ($genomeID, $name) = @{$genome};
1353              # See if it's selected.              # See if it's selected.
1354              my $select = ($selectedHash{$genomeID} ? " selected" : "");              my $select = ($selectedHash{$genomeID} ? " selected" : "");
1355              # Generate the option tag.              # Generate the option tag.
1356              my $optionTag = "<OPTION value=\"$genomeID\" label=\"$label\"$select>$name <em>($genomeID)</em></OPTION>";              my $optionTag = "<OPTION value=\"$genomeID\"$select>$name <em>($genomeID)</em></OPTION>";
1357              push @lines, "    $optionTag";              push @lines, "    $optionTag";
1358          }          }
1359          # Close the option group.          # Close the option group.
# Line 1207  Line 1363 
1363      push @lines, "</SELECT>";      push @lines, "</SELECT>";
1364      # Check for multiple selection.      # Check for multiple selection.
1365      if ($multiple) {      if ($multiple) {
1366          # Since multi-select is on, we set up some buttons to set and clear selections.          # Multi-select is on, so we need to add some selection helpers. First is
1367          push @lines, "<br />";          # the search box. This allows the user to type text and have all genomes containing
         push @lines, "<INPUT type=\"button\" name=\"SelectAll\" class=\"bigButton\" value=\"Select All\" onClick=\"selectAll($menuName); $showSelect\" />";  
         push @lines, "<INPUT type=\"button\" name=\"ClearAll\" class=\"bigButton\"  value=\"Clear All\" onClick=\"clearAll($menuName); $showSelect\" />";  
         push @lines, "<INPUT type=\"button\" name=\"NMPDROnly\" class=\"bigButton\"  value=\"Select NMPDR\" onClick=\"selectSome($menuName, 'nmpdr'); $showSelect\" />";  
         push @lines, "<INPUT type=\"button\" name=\"OtherOnly\" class=\"bigButton\" value=\"Select Supporting\" onClick=\"selectSome($menuName, 'other'); $showSelect\" />";  
         # Now add the search box. This allows the user to type text and have all genomes containing  
1368          # the text selected automatically.          # the text selected automatically.
1369          my $searchThingName = "${menuName}_SearchThing";          my $searchThingName = "${menuName}_SearchThing";
1370          push @lines, "<br>Select genomes containing <INPUT type=\"text\" name=\"$searchThingName\" size=\"30\" />&nbsp;" .          push @lines, "<br>Select genomes containing <INPUT type=\"text\" name=\"$searchThingName\" " .
1371                       "<INPUT type=\"button\" name=\"Select\" class=\"button\" value=\"Search\" onClick=\"selectViaSearch($menuName, $searchThingName); $showSelect\" />";                       "size=\"30\" onBlur=\"selectViaSearch($menuName, $searchThingName); $showSelect\" />";
1372            # Next are the buttons to set and clear selections.
1373            push @lines, "<br />";
1374            push @lines, "<INPUT type=\"button\" name=\"ClearAll\" class=\"bigButton\"  value=\"Clear All\" onClick=\"clearAll($menuName); $showSelect\" />";
1375            push @lines, "<INPUT type=\"button\" name=\"SelectAll\" class=\"bigButton\" value=\"Select All\" onClick=\"selectAll($menuName); $showSelect\" />";
1376            push @lines, "<INPUT type=\"button\" name=\"NMPDROnly\" class=\"bigButton\"  value=\"Select NMPDR\" onClick=\"selectSome($menuName, $nmpdrCount, true); $showSelect\" />";
1377            push @lines, "<INPUT type=\"button\" name=\"OtherOnly\" class=\"bigButton\" value=\"Select Supporting\" onClick=\"selectSome($menuName, $nmpdrCount, false); $showSelect\" />";
1378          # Add the status display, too.          # Add the status display, too.
1379          push @lines, "<DIV id=\"$divID\" class=\"selectStatus\"></DIV>";          push @lines, "<DIV id=\"$divID\" class=\"selectStatus\"></DIV>";
1380          # 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 1590  Line 1747 
1747          # a singleton list, but that's okay.          # a singleton list, but that's okay.
1748          my @values = split (/\0/, $parms{$parmKey});          my @values = split (/\0/, $parms{$parmKey});
1749          # Check for special cases.          # Check for special cases.
1750          if ($parmKey eq 'featureTypes') {          if (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF ShowURL)) {
             # Here we need to see if the user wants all the feature types. If he  
             # does, we erase all the values so that the parameter is not output.  
             my %valueCheck = map { $_ => 1 } @values;  
             my @list = FeatureQuery::AllFeatureTypes();  
             my $okFlag = 1;  
             for (my $i = 0; $okFlag && $i <= $#list; $i++) {  
                 if (! $valueCheck{$list[$i]}) {  
                     $okFlag = 0;  
                 }  
             }  
             if ($okFlag) {  
                 @values = ();  
             }  
         } elsif (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF ShowURL)) {  
1751              # These are bookkeeping parameters we don't need to start a search.              # These are bookkeeping parameters we don't need to start a search.
1752              @values = ();              @values = ();
1753          } elsif ($parmKey =~ /_SearchThing$/) {          } elsif ($parmKey =~ /_SearchThing$/) {
# Line 1666  Line 1809 
1809      return $retVal;      return $retVal;
1810  }  }
1811    
1812  =head3 FeatureTypeMap  =head3 AdvancedClassList
1813    
1814  C<< my %features = SearchHelper::FeatureTypeMap(); >>  C<< my @classes = SearchHelper::AdvancedClassList(); >>
1815    
1816  Return a map of feature types to descriptions. The feature type data is stored  Return a list of advanced class names. This list is used to generate the directory
1817  in the B<FIG_Config> file. Currently, it only contains a space-delimited list of  of available searches on the search page.
 feature types. The map returned by this method is a hash mapping the type codes to  
 descriptive names.  
1818    
1819  The reason we have to convert the list from a string is that the B<NMPDRSetup.pl>  We use the %INC variable to accomplish this.
 script is only able to insert strings into the generated B<FIG_Config> file.  
1820    
1821  =cut  =cut
1822    
1823  sub FeatureTypeMap {  sub AdvancedClassList {
1824      my @list = split /\s+/, $FIG_Config::feature_types;      my @retVal = map { $_ =~ /^SH(\w+)\.pm/; $1 } grep { $_ =~ /^SH/ } keys %INC;
1825      my %retVal = map { $_ => $_ } @list;      return @retVal;
     return %retVal;  
1826  }  }
1827    
1828  =head3 AdvancedClassList  =head3 SelectionTree
1829    
1830  C<< my @classes = SearchHelper::AdvancedClassList(); >>  C<< my $htmlText = SearchHelper::SelectionTree($cgi, \%tree, %options); >>
1831    
1832  Return a list of advanced class names. This list is used to generate the directory  Display a selection tree.
 of available searches on the search page.  
1833    
1834  The reason we have to convert the list from a string is that the B<NMPDRSetup.pl>  This method creates the HTML for a tree selection control. The tree is implemented as a set of
1835  script is only able to insert strings into the generated B<FIG_Config> file.  nested HTML unordered lists. Each selectable element of the tree will contain a radio button. In
1836    addition, some of the tree nodes can contain hyperlinks.
1837    
1838    The tree itself is passed in as a multi-level list containing node names followed by
1839    contents. Each content element is a reference to a similar list. The first element of
1840    each list may be a hash reference. If so, it should contain one or both of the following
1841    keys.
1842    
1843    =over 4
1844    
1845    =item link
1846    
1847    The navigation URL to be popped up if the user clicks on the node name.
1848    
1849    =item value
1850    
1851    The form value to be returned if the user selects the tree node.
1852    
1853    =back
1854    
1855    The presence of a C<link> key indicates the node name will be hyperlinked. The presence of
1856    a C<value> key indicates the node name will have a radio button. If a node has no children,
1857    you may pass it a hash reference instead of a list reference.
1858    
1859    The following example shows the hash for a three-level tree with links on the second level and
1860    radio buttons on the third.
1861    
1862        [   Objects => [
1863                Entities => [
1864                    {link => "../docs/WhatIsAnEntity.html"},
1865                    Genome => {value => 'GenomeData'},
1866                    Feature => {value => 'FeatureData'},
1867                    Contig => {value => 'ContigData'},
1868                ],
1869                Relationships => [
1870                    {link => "../docs/WhatIsARelationShip.html"},
1871                    HasFeature => {value => 'GenomeToFeature'},
1872                    IsOnContig => {value => 'FeatureToContig'},
1873                ]
1874            ]
1875        ]
1876    
1877    Note how each leaf of the tree has a hash reference for its value, while the branch nodes
1878    all have list references.
1879    
1880    This next example shows how to set up a taxonomy selection field. The value returned
1881    by the tree control will be the taxonomy string for the selected node ready for use
1882    in a LIKE-style SQL filter. Only the single branch ending in campylobacter is shown for
1883    reasons of space.
1884    
1885        [   All => [
1886                {value => "%"},
1887                Bacteria => [
1888                    {value => "Bacteria%"},
1889                    Proteobacteria => [
1890                        {value => "Bacteria; Proteobacteria%"},
1891                        Epsilonproteobacteria => [
1892                            {value => "Bacteria; Proteobacteria;Epsilonproteobacteria%"},
1893                            Campylobacterales => [
1894                                {value => "Bacteria; Proteobacteria; Epsilonproteobacteria; Campylobacterales%"},
1895                                Campylobacteraceae =>
1896                                    {value => "Bacteria; Proteobacteria; Epsilonproteobacteria; Campylobacterales; Campylobacteraceae%"},
1897                                ...
1898                            ]
1899                            ...
1900                        ]
1901                        ...
1902                    ]
1903                    ...
1904                ]
1905                ...
1906            ]
1907        ]
1908    
1909    
1910    This method of tree storage allows the caller to control the order in which the tree nodes
1911    are displayed and to completely control value selection and use of hyperlinks. It is, however
1912    a bit complicated. Eventually, tree-building classes will be provided to simplify things.
1913    
1914    The parameters to this method are as follows.
1915    
1916    =over 4
1917    
1918    =item cgi
1919    
1920    CGI object used to generate the HTML.
1921    
1922    =item tree
1923    
1924    Reference to a hash describing a tree. See the description above.
1925    
1926    =item options
1927    
1928    Hash containing options for the tree display.
1929    
1930    =back
1931    
1932    The allowable options are as follows
1933    
1934    =over 4
1935    
1936    =item nodeImageClosed
1937    
1938    URL of the image to display next to the tree nodes when they are collapsed. Clicking
1939    on the image will expand a section of the tree. The default is C<../FIG/Html/plus.gif>.
1940    
1941    =item nodeImageOpen
1942    
1943    URL of the image to display next to the tree nodes when they are expanded. Clicking
1944    on the image will collapse a section of the tree. The default is C<../FIG/Html/minus.gif>.
1945    
1946    =item style
1947    
1948    Style to use for the tree. The default is C<tree>. Because the tree style is implemented
1949    as nested lists, the key components of this style are the definitions for the C<ul> and
1950    C<li> tags. The default style file contains the following definitions.
1951    
1952        .tree ul {
1953           margin-left: 0; padding-left: 22px
1954        }
1955        .tree li {
1956            list-style-type: none;
1957        }
1958    
1959    The default image is 22 pixels wide, so in the above scheme each tree level is indented from its
1960    parent by the width of the node image. This use of styles limits the things we can do in formatting
1961    the tree, but it has the advantage of vastly simplifying the tree creation.
1962    
1963    =item name
1964    
1965    Field name to give to the radio buttons in the tree. The default is C<selection>.
1966    
1967    =item target
1968    
1969    Frame target for links. The default is C<_self>.
1970    
1971    =item selected
1972    
1973    If specified, the value of the radio button to be pre-selected.
1974    
1975    =back
1976    
1977  =cut  =cut
1978    
1979  sub AdvancedClassList {  sub SelectionTree {
1980      return split /\s+/, $FIG_Config::advanced_classes;      # Get the parameters.
1981        my ($cgi, $tree, %options) = @_;
1982        # Get the options.
1983        my $optionThing = Tracer::GetOptions({ name => 'selection',
1984                                               nodeImageClosed => '../FIG/Html/plus.gif',
1985                                               nodeImageOpen => '../FIG/Html/minus.gif',
1986                                               style => 'tree',
1987                                               target => '_self',
1988                                               selected => undef},
1989                                             \%options);
1990        # Declare the return variable. We'll do the standard thing with creating a list
1991        # of HTML lines and rolling them together at the end.
1992        my @retVal = ();
1993        # Only proceed if the tree is present.
1994        if (defined($tree)) {
1995            # Validate the tree.
1996            if (ref $tree ne 'ARRAY') {
1997                Confess("Selection tree is not a list reference.");
1998            } elsif (scalar @{$tree} == 0) {
1999                # The tree is empty, so we do nothing.
2000            } elsif ($tree->[0] eq 'HASH') {
2001                Confess("Hash reference found at start of selection tree. The tree as a whole cannot have attributes, only tree nodes.");
2002            } else {
2003                # Here we have a real tree. Apply the tree style.
2004                push @retVal, $cgi->start_div({ class => $optionThing->{style} });
2005                # Give us a DIV ID.
2006                my $divID = GetDivID($optionThing->{name});
2007                # Show the tree.
2008                push @retVal, ShowBranch($cgi, "(root)", $divID, $tree, $optionThing, 'block');
2009                # Close the DIV block.
2010                push @retVal, $cgi->end_div();
2011            }
2012        }
2013        # Return the result.
2014        return join("\n", @retVal, "");
2015    }
2016    
2017    =head3 ShowBranch
2018    
2019    C<< my @htmlLines = SearchHelper::ShowBranch($cgi, $label, $id, $branch, $options, $displayType); >>
2020    
2021    This is a recursive method that displays a branch of the tree.
2022    
2023    =over 4
2024    
2025    =item cgi
2026    
2027    CGI object used to format HTML.
2028    
2029    =item label
2030    
2031    Label of this tree branch. It is only used in error messages.
2032    
2033    =item id
2034    
2035    ID to be given to this tree branch. The ID is used in the code that expands and collapses
2036    tree nodes.
2037    
2038    =item branch
2039    
2040    Reference to a list containing the content of the tree branch. The list contains an optional
2041    hash reference that is ignored and the list of children, each child represented by a name
2042    and then its contents. The contents could by a hash reference (indicating the attributes
2043    of a leaf node), or another tree branch.
2044    
2045    =item options
2046    
2047    Options from the original call to L</SelectionTree>.
2048    
2049    =item displayType
2050    
2051    C<block> if the contents of this list are to be displayed, C<none> if they are to be
2052    hidden.
2053    
2054    =item RETURN
2055    
2056    Returns one or more HTML lines that can be used to display the tree branch.
2057    
2058    =back
2059    
2060    =cut
2061    
2062    sub ShowBranch {
2063        # Get the parameters.
2064        my ($cgi, $label, $id, $branch, $options, $displayType) = @_;
2065        # Declare the return variable.
2066        my @retVal = ();
2067        # Start the branch.
2068        push @retVal, $cgi->start_ul({ id => $id, style => "display:$displayType" });
2069        # Check for the hash and choose the start location accordingly.
2070        my $i0 = (ref $branch->[0] eq 'HASH' ? 1 : 0);
2071        # Get the list length.
2072        my $i1 = scalar(@{$branch});
2073        # Verify we have an even number of elements.
2074        if (($i1 - $i0) % 2 != 0) {
2075            Trace("Branch elements are from $i0 to $i1.") if T(3);
2076            Confess("Odd number of elements in tree branch $label.");
2077        } else {
2078            # Loop through the elements.
2079            for (my $i = $i0; $i < $i1; $i += 2) {
2080                # Get this node's label and contents.
2081                my ($myLabel, $myContent) = ($branch->[$i], $branch->[$i+1]);
2082                # Get an ID for this node's children (if any).
2083                my $myID = GetDivID($options->{name});
2084                # Now we need to find the list of children and the options hash.
2085                # This is a bit ugly because we allow the shortcut of a hash without an
2086                # enclosing list. First, we need some variables.
2087                my $attrHash = {};
2088                my @childHtml = ();
2089                my $hasChildren = 0;
2090                if (! ref $myContent) {
2091                    Confess("Invalid tree definition. Scalar found as content of node \"$myLabel\".");
2092                } elsif (ref $myContent eq 'HASH') {
2093                    # Here the node is a leaf and its content contains the link/value hash.
2094                    $attrHash = $myContent;
2095                } elsif (ref $myContent eq 'ARRAY') {
2096                    # Here the node may be a branch. Its content is a list.
2097                    my $len = scalar @{$myContent};
2098                    if ($len >= 1) {
2099                        # Here the first element of the list could by the link/value hash.
2100                        if (ref $myContent->[0] eq 'HASH') {
2101                            $attrHash = $myContent->[0];
2102                            # If there's data in the list besides the hash, it's our child list.
2103                            # We can pass the entire thing as the child list, because the hash
2104                            # is ignored.
2105                            if ($len > 1) {
2106                                $hasChildren = 1;
2107                            }
2108                        } else {
2109                            $hasChildren = 1;
2110                        }
2111                        # If we have children, create the child list with a recursive call.
2112                        if ($hasChildren) {
2113                            Trace("Processing children of $myLabel.") if T(4);
2114                            push @childHtml, ShowBranch($cgi, $myLabel, $myID, $myContent, $options, 'none');
2115                        }
2116                    }
2117                }
2118                # Okay, it's time to pause and take stock. We have the label of the current node
2119                # in $myLabel, its attributes in $attrHash, and if it is NOT a leaf node, we
2120                # have a child list in @childHtml. If it IS a leaf node, $hasChildren is 0.
2121                # Compute the image HTML. It's tricky, because we have to deal with the open and
2122                # closed images.
2123                my @images = ($options->{nodeImageOpen}, $options->{nodeImageClosed});
2124                my $image = $images[$hasChildren];
2125                my $prefixHtml = $cgi->img({src => $image, id => "${myID}img"});
2126                if ($hasChildren) {
2127                    # If there are children, we wrap the image in a toggle hyperlink.
2128                    $prefixHtml = $cgi->a({ onClick => "javascript:treeToggle('$myID','$images[0]', '$images[1]')" },
2129                                          $prefixHtml);
2130                }
2131                # Now the radio button, if any. Note we use "defined" in case the user wants the
2132                # value to be 0.
2133                if (defined $attrHash->{value}) {
2134                    # Due to a glitchiness in the CGI stuff, we have to build the attribute
2135                    # hash for the "input" method. If the item is pre-selected, we add
2136                    # "checked => undef" to the hash. Otherwise, we can't have "checked"
2137                    # at all.
2138                    my $radioParms = { type => 'radio',
2139                                       name => $options->{name},
2140                                       value => $attrHash->{value},
2141                                     };
2142                    if (defined $options->{selected} && $options->{selected} eq $attrHash->{value}) {
2143                        $radioParms->{checked} = undef;
2144                    }
2145                    $prefixHtml .= $cgi->input($radioParms);
2146                }
2147                # Next, we format the label.
2148                my $labelHtml = $myLabel;
2149                Trace("Formatting tree node for $myLabel.") if T(4);
2150                # Apply a hyperlink if necessary.
2151                if (defined $attrHash->{link}) {
2152                    $labelHtml = $cgi->a({ href => $attrHash->{link}, target => $options->{target} },
2153                                         $labelHtml);
2154                }
2155                # Finally, roll up the child HTML. If there are no children, we'll get a null string
2156                # here.
2157                my $childHtml = join("\n", @childHtml);
2158                # Now we have all the pieces, so we can put them together.
2159                push @retVal, $cgi->li("$prefixHtml$labelHtml$childHtml");
2160            }
2161        }
2162        # Close the tree branch.
2163        push @retVal, $cgi->end_ul();
2164        # Return the result.
2165        return @retVal;
2166    }
2167    
2168    =head3 GetDivID
2169    
2170    C<< my $idString = SearchHelper::GetDivID($name); >>
2171    
2172    Return a new HTML ID string.
2173    
2174    =over 4
2175    
2176    =item name
2177    
2178    Name to be prefixed to the ID string.
2179    
2180    =item RETURN
2181    
2182    Returns a hopefully-unique ID string.
2183    
2184    =back
2185    
2186    =cut
2187    
2188    sub GetDivID {
2189        # Get the parameters.
2190        my ($name) = @_;
2191        # Compute the ID.
2192        my $retVal = "elt_$name$divCount";
2193        # Increment the counter to make sure this ID is not re-used.
2194        $divCount++;
2195        # Return the result.
2196        return $retVal;
2197  }  }
2198    
2199  =head2 Feature Column Methods  =head2 Feature Column Methods
# Line 1722  Line 2216 
2216    
2217  =head3 DefaultFeatureColumns  =head3 DefaultFeatureColumns
2218    
2219  C<< my $colNames = $shelp->DefaultFeatureColumns(); >>  C<< my @colNames = $shelp->DefaultFeatureColumns(); >>
2220    
2221  Return a reference to a list of the default feature column identifiers. These  Return a list of the default feature column identifiers. These identifiers can
2222  identifiers can be passed to L</FeatureColumnTitle> and L</FeatureColumnValue> in  be passed to L</FeatureColumnTitle> and L</FeatureColumnValue> in order to
2223  order to produce the column titles and row values.  produce the column titles and row values.
2224    
2225  =cut  =cut
2226    
# Line 1734  Line 2228 
2228      # Get the parameters.      # Get the parameters.
2229      my ($self) = @_;      my ($self) = @_;
2230      # Return the result.      # Return the result.
2231      return ['orgName', 'function', 'gblink', 'protlink',      return qw(orgName function gblink protlink);
             FeatureQuery::AdditionalColumns($self)];  
2232  }  }
2233    
2234  =head3 FeatureColumnTitle  =head3 FeatureColumnTitle
# Line 1767  Line 2260 
2260      if ($colName =~ /^X=(.+)$/) {      if ($colName =~ /^X=(.+)$/) {
2261          # Here we have an extra column.          # Here we have an extra column.
2262          $retVal = $1;          $retVal = $1;
     } elsif ($colName eq 'orgName') {  
         $retVal = "Name";  
     } elsif ($colName eq 'fid') {  
         $retVal = "FIG ID";  
2263      } elsif ($colName eq 'alias') {      } elsif ($colName eq 'alias') {
2264          $retVal = "External Aliases";          $retVal = "External Aliases";
2265        } elsif ($colName eq 'fid') {
2266            $retVal = "FIG ID";
2267      } elsif ($colName eq 'function') {      } elsif ($colName eq 'function') {
2268          $retVal = "Functional Assignment";          $retVal = "Functional Assignment";
2269      } elsif ($colName eq 'gblink') {      } elsif ($colName eq 'gblink') {
2270          $retVal = "GBrowse";          $retVal = "GBrowse";
     } elsif ($colName eq 'protlink') {  
         $retVal = "NMPDR Protein Page";  
2271      } elsif ($colName eq 'group') {      } elsif ($colName eq 'group') {
2272          $retVal = "NMDPR Group";          $retVal = "NMDPR Group";
2273        } elsif ($colName =~ /^keyword:(.+)$/) {
2274            $retVal = ucfirst $1;
2275        } elsif ($colName eq 'orgName') {
2276            $retVal = "Gene Name";
2277        } elsif ($colName eq 'protlink') {
2278            $retVal = "NMPDR Protein Page";
2279        } elsif ($colName eq 'subsystem') {
2280            $retVal = "Subsystems";
2281      }      }
2282      # Return the result.      # Return the result.
2283      return $retVal;      return $retVal;
2284  }  }
2285    
2286    
2287  =head3 FeatureColumnValue  =head3 FeatureColumnValue
2288    
2289  C<< my $value = $shelp->FeatureColumnValue($colName, $fid, \%extraCols); >>  C<< my $value = $shelp->FeatureColumnValue($colName, $fid, \%extraCols); >>
# Line 1836  Line 2334 
2334          if (defined $extraCols->{$1}) {          if (defined $extraCols->{$1}) {
2335              $retVal = $extraCols->{$1};              $retVal = $extraCols->{$1};
2336          }          }
     } elsif ($colName eq 'orgName') {  
         # Here we want the formatted organism name and feature number.  
         $retVal = $self->FeatureName($fid);  
     } elsif ($colName eq 'fid') {  
         # Here we have the raw feature ID. We hyperlink it to the protein page.  
         $retVal = HTML::set_prot_links($fid);  
2337      } elsif ($colName eq 'alias') {      } elsif ($colName eq 'alias') {
2338          # 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.
2339          # These are very expensive, so we compute them when the row is displayed.          # These are very expensive, so we compute them when the row is displayed.
2340          $retVal = "%%aliases=$fid";          $retVal = "%%alias=$fid";
2341        } elsif ($colName eq 'fid') {
2342            # Here we have the raw feature ID. We hyperlink it to the protein page.
2343            $retVal = HTML::set_prot_links($fid);
2344      } elsif ($colName eq 'function') {      } elsif ($colName eq 'function') {
2345          # The functional assignment is just a matter of getting some text.          # The functional assignment is just a matter of getting some text.
2346          ($retVal) = $record->Value('Feature(assignment)');          ($retVal) = $record->Value('Feature(assignment)');
# Line 1856  Line 2351 
2351                            $cgi->img({ src => "../images/button-gbrowse.png",                            $cgi->img({ src => "../images/button-gbrowse.png",
2352                                        border => 0 })                                        border => 0 })
2353                           );                           );
     } elsif ($colName eq 'protlink') {  
         # Here we want a link to the protein page using the official NMPDR button.  
         my $hurl = HTML::fid_link($cgi, $fid, 0, 1);  
         $retVal = $cgi->a({ href => $hurl, title => "Protein page for $fid" },  
                           $cgi->img({ src => "../images/button-nmpdr.png",  
                                      border => 0 })  
                          );  
2354      } elsif ($colName eq 'group') {      } elsif ($colName eq 'group') {
2355          # Get the NMPDR group name.          # Get the NMPDR group name.
2356          my (undef, $group) = $self->OrganismData($fid);          my (undef, $group) = $self->OrganismData($fid);
# Line 1870  Line 2358 
2358          my $nurl = $sprout->GroupPageName($group);          my $nurl = $sprout->GroupPageName($group);
2359          $retVal = $cgi->a({ href => $nurl, title => "$group summary" },          $retVal = $cgi->a({ href => $nurl, title => "$group summary" },
2360                            $group);                            $group);
2361        } elsif ($colName =~ /^keyword:(.+)$/) {
2362            # Here we want keyword-related values. This is also expensive, so
2363            # we compute them when the row is displayed.
2364            $retVal = "%%$colName=$fid";
2365        } elsif ($colName eq 'orgName') {
2366            # Here we want the formatted organism name and feature number.
2367            $retVal = $self->FeatureName($fid);
2368        } elsif ($colName eq 'protlink') {
2369            # Here we want a link to the protein page using the official NMPDR button.
2370            my $hurl = HTML::fid_link($cgi, $fid, 0, 1);
2371            $retVal = $cgi->a({ href => $hurl, title => "Protein page for $fid" },
2372                              $cgi->img({ src => "../images/button-nmpdr.png",
2373                                         border => 0 })
2374                             );
2375        }elsif ($colName eq 'subsystem') {
2376            # Another run-time column: subsystem list.
2377            $retVal = "%%subsystem=$fid";
2378      }      }
2379      # Return the result.      # Return the result.
2380      return $retVal;      return $retVal;
# Line 1908  Line 2413 
2413      # Get the Sprout and CGI objects.      # Get the Sprout and CGI objects.
2414      my $sprout = $self->DB();      my $sprout = $self->DB();
2415      my $cgi = $self->Q();      my $cgi = $self->Q();
2416        Trace("Runtime column $type with text \"$text\" found.") if T(4);
2417      # Separate the text into a type and data.      # Separate the text into a type and data.
2418      if ($type eq 'aliases') {      if ($type eq 'alias') {
2419          # Here the caller wants external alias links for a feature. The text          # Here the caller wants external alias links for a feature. The text
2420          # is the feature ID.          # is the feature ID.
2421          my $fid = $text;          my $fid = $text;
# Line 1924  Line 2430 
2430              # Ask the HTML processor to hyperlink them.              # Ask the HTML processor to hyperlink them.
2431              $retVal = HTML::set_prot_links($cgi, $aliasList);              $retVal = HTML::set_prot_links($cgi, $aliasList);
2432          }          }
2433        } elsif ($type eq 'subsystem') {
2434            # Here the caller wants the subsystems in which this feature participates.
2435            # The text is the feature ID. We will list the subsystem names with links
2436            # to the subsystem's summary page.
2437            my $fid = $text;
2438            # Get the subsystems.
2439            Trace("Generating subsystems for feature $fid.") if T(4);
2440            my %subs = $sprout->SubsystemsOf($fid);
2441            # Convert them to links.
2442            my @links = map { HTML::sub_link($cgi, $_) } sort keys %subs;
2443            # String them into a list.
2444            $retVal = join(", ", @links);
2445        } elsif ($type =~ /^keyword:(.+)$/) {
2446            # Here the caller wants the value of the named keyword. The text is the
2447            # feature ID.
2448            my $keywordName = $1;
2449            my $fid = $text;
2450            # Get the attribute values.
2451            Trace("Getting $keywordName values for feature $fid.") if T(4);
2452            my @values = $sprout->GetFlat(['Feature'], "Feature(id) = ?", [$fid],
2453                                          "Feature($keywordName)");
2454            # String them into a list.
2455            $retVal = join(", ", @values);
2456      }      }
2457      # Return the result.      # Return the result.
2458      return $retVal;      return $retVal;
# Line 1996  Line 2525 
2525      return ($name, $displayGroup);      return ($name, $displayGroup);
2526  }  }
2527    
2528    =head3 ValidateKeywords
2529    
2530    C<< my $okFlag = $shelp->ValidateKeywords($keywordString, $required); >>
2531    
2532    Insure that a keyword string is reasonably valid. If it is invalid, a message will be
2533    set.
2534    
2535    =over 4
2536    
2537    =item keywordString
2538    
2539    Keyword string specified as a parameter to the current search.
2540    
2541    =item required
2542    
2543    TRUE if there must be at least one keyword specified, else FALSE.
2544    
2545    =item RETURN
2546    
2547    Returns TRUE if the keyword string is valid, else FALSE. Note that a null keyword string
2548    is acceptable if the I<$required> parameter is not specified.
2549    
2550    =back
2551    
2552    =cut
2553    
2554    sub ValidateKeywords {
2555        # Get the parameters.
2556        my ($self, $keywordString, $required) = @_;
2557        # Declare the return variable.
2558        my $retVal = 0;
2559        my @wordList = split /\s+/, $keywordString;
2560        # Right now our only real worry is a list of all minus words. The problem with it is that
2561        # it will return an incorrect result.
2562        my @plusWords = grep { $_ =~ /^[^\-]/ } @wordList;
2563        if (! @wordList) {
2564            if ($required) {
2565                $self->SetMessage("No search words specified.");
2566            }
2567        } elsif (! @plusWords) {
2568            $self->SetMessage("At least one keyword must be positive. All the keywords entered are preceded by minus signs.");
2569        } else {
2570            $retVal = 1;
2571        }
2572        # Return the result.
2573        return $retVal;
2574    }
2575    
2576  =head2 Virtual Methods  =head2 Virtual Methods
2577    
2578  =head3 Form  =head3 Form

Legend:
Removed from v.1.11  
changed lines
  Added in v.1.17

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3