[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.15, Fri Nov 10 22:01:36 2006 UTC revision 1.16, Wed Nov 15 12:02:46 2006 UTC
# Line 244  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 1070  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 1681  Line 1825 
1825      return @retVal;      return @retVal;
1826  }  }
1827    
1828    =head3 SelectionTree
1829    
1830    C<< my $htmlText = SearchHelper::SelectionTree($cgi, \%tree, %options); >>
1831    
1832    Display a selection tree.
1833    
1834    This method creates the HTML for a tree selection control. The tree is implemented as a set of
1835    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
1978    
1979    sub SelectionTree {
1980        # 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
2200    
2201  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 2010  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.15  
changed lines
  Added in v.1.16

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3