[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.18, Sat Nov 18 20:36:49 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 452  Line 454 
454      my ($self, $title) = @_;      my ($self, $title) = @_;
455      # Get the CGI object.      # Get the CGI object.
456      my $cgi = $self->Q();      my $cgi = $self->Q();
457      # Start the form.      # Start the form. Note we use the override option on the Class value, in
458        # case the Advanced button was used.
459      my $retVal = "<div class=\"search\">\n" .      my $retVal = "<div class=\"search\">\n" .
460                   $cgi->start_form(-method => 'POST',                   $cgi->start_form(-method => 'POST',
461                                    -action => $cgi->url(-relative => 1),                                    -action => $cgi->url(-relative => 1),
462                                    -name => $self->FormName()) .                                    -name => $self->FormName()) .
463                   $cgi->hidden(-name => 'Class',                   $cgi->hidden(-name => 'Class',
464                                -value => $self->{class}) .                                -value => $self->{class},
465                                  -override => 1) .
466                   $cgi->hidden(-name => 'SPROUT',                   $cgi->hidden(-name => 'SPROUT',
467                                -value => 1) .                                -value => 1) .
468                   $cgi->h3($title);                   $cgi->h3($title);
# Line 945  Line 949 
949    
950  =head3 ComputeFASTA  =head3 ComputeFASTA
951    
952  C<< my $fasta = $shelp->ComputeFASTA($incomingType, $desiredType, $sequence); >>  C<< my $fasta = $shelp->ComputeFASTA($desiredType, $sequence); >>
953    
954  Parse a sequence input and convert it into a FASTA string of the desired type. Note  Parse a sequence input and convert it into a FASTA string of the desired type.
 that it is possible to convert a DNA sequence into a protein sequence, but the reverse  
 is not possible.  
955    
956  =over 4  =over 4
957    
 =item incomingType  
   
 C<dna> if this is a DNA sequence, C<prot> if this is a protein sequence.  
   
958  =item desiredType  =item desiredType
959    
960  C<dna> to return a DNA sequence, C<prot> to return a protein sequence. If the  C<dna> to return a DNA sequence, C<prot> to return a protein sequence.
 I<$incomingType> is C<prot> and this value is C<dna>, an error will be thrown.  
961    
962  =item sequence  =item sequence
963    
# Line 989  Line 986 
986      my $okFlag = 1;      my $okFlag = 1;
987      # Create variables to hold the FASTA label and data.      # Create variables to hold the FASTA label and data.
988      my ($fastaLabel, $fastaData);      my ($fastaLabel, $fastaData);
989      Trace("FASTA incoming type is $incomingType, desired type is $desiredType.") if T(4);      Trace("FASTA desired type is $desiredType.") if T(4);
990      # Check for a feature specification.      # Check for a feature specification.
991      if ($sequence =~ /^\s*(\w+\|\S+)\s*$/) {      if ($sequence =~ /^\s*(\w+\|\S+)\s*$/) {
992          # Here we have a feature ID in $1. We'll need the Sprout object to process          # Here we have a feature ID in $1. We'll need the Sprout object to process
# Line 1002  Line 999 
999          # exist.          # exist.
1000          my ($figID) = $sprout->FeaturesByAlias($fid);          my ($figID) = $sprout->FeaturesByAlias($fid);
1001          if (! $figID) {          if (! $figID) {
1002              $self->SetMessage("No feature found with the ID \"$fid\".");              $self->SetMessage("No gene found with the ID \"$fid\".");
1003              $okFlag = 0;              $okFlag = 0;
1004          } else {          } else {
1005              # Set the FASTA label.              # Set the FASTA label.
# Line 1019  Line 1016 
1016                  Trace(length $fastaData . " characters returned for DNA of $fastaLabel.") if T(3);                  Trace(length $fastaData . " characters returned for DNA of $fastaLabel.") if T(3);
1017              }              }
1018          }          }
     } elsif ($incomingType eq 'prot' && $desiredType eq 'dna') {  
         # Here we're being asked to do an impossible conversion.  
         $self->SetMessage("Cannot convert a protein sequence to DNA.");  
         $okFlag = 0;  
1019      } else {      } else {
1020          Trace("Analyzing FASTA sequence.") if T(4);          Trace("Analyzing FASTA sequence.") if T(4);
1021          # Here we are expecting a FASTA. We need to see if there's a label.          # Here we are expecting a FASTA. We need to see if there's a label.
# Line 1035  Line 1028 
1028              Trace("No label found in match to sequence:\n$sequence") if T(4);              Trace("No label found in match to sequence:\n$sequence") if T(4);
1029              # Here we have no label, so we create one and use the entire sequence              # Here we have no label, so we create one and use the entire sequence
1030              # as data.              # as data.
1031              $fastaLabel = "User-specified $incomingType sequence";              $fastaLabel = "User-specified $desiredType sequence";
1032              $fastaData = $sequence;              $fastaData = $sequence;
1033          }          }
1034          # The next step is to clean the junk out of the sequence.          # The next step is to clean the junk out of the sequence.
1035          $fastaData =~ s/\n//g;          $fastaData =~ s/\n//g;
1036          $fastaData =~ s/\s+//g;          $fastaData =~ s/\s+//g;
1037          # Finally, if the user wants to convert to protein, we do it here. Note that          # Finally, verify that it's DNA if we're doing DNA stuff.
1038          # we've already prevented a conversion from protein to DNA.          if ($desiredType eq 'dna' && $fastaData =~ /[^agct]/i) {
         if ($incomingType ne $desiredType) {  
             $fastaData = Sprout::Protein($fastaData);  
             # Check for bad characters.  
             if ($fastaData =~ /X/) {  
                 $self->SetMessage("Invalid characters detected. Is the input really of type $incomingType?");  
                 $okFlag = 0;  
             }  
         } elsif ($desiredType eq 'dna' && $fastaData =~ /[^agct]/i) {  
1039              $self->SetMessage("Invaid characters detected. Is the input really a DNA sequence?");              $self->SetMessage("Invaid characters detected. Is the input really a DNA sequence?");
1040              $okFlag = 0;              $okFlag = 0;
1041          }          }
# Line 1070  Line 1055 
1055      return $retVal;      return $retVal;
1056  }  }
1057    
1058    =head3 SubsystemTree
1059    
1060    C<< my $tree = SearchHelper::SubsystemTree($sprout, %options); >>
1061    
1062    This method creates a subsystem selection tree suitable for passing to
1063    L</SelectionTree>. Each leaf node in the tree will have a link to the
1064    subsystem display page. In addition, each node can have a radio button. The
1065    radio button alue is either C<classification=>I<string>, where I<string> is
1066    a classification string, or C<id=>I<string>, where I<string> is a subsystem ID.
1067    Thus, it can either be used to filter by a group of related subsystems or a
1068    single subsystem.
1069    
1070    =over 4
1071    
1072    =item sprout
1073    
1074    Sprout database object used to get the list of subsystems.
1075    
1076    =item options
1077    
1078    Hash containing options for building the tree.
1079    
1080    =item RETURN
1081    
1082    Returns a reference to a tree list suitable for passing to L</SelectionTree>.
1083    
1084    =back
1085    
1086    The supported options are as follows.
1087    
1088    =over 4
1089    
1090    =item radio
1091    
1092    TRUE if the tree should be configured for radio buttons. The default is FALSE.
1093    
1094    =item links
1095    
1096    TRUE if the tree should be configured for links. The default is TRUE.
1097    
1098    =back
1099    
1100    =cut
1101    
1102    sub SubsystemTree {
1103        # Get the parameters.
1104        my ($sprout, %options) = @_;
1105        # Process the options.
1106        my $optionThing = Tracer::GetOptions({ radio => 0, links => 1 }, \%options);
1107        # Read in the subsystems.
1108        my @subs = $sprout->GetAll(['Subsystem'], "ORDER BY Subsystem(classification), Subsystem(id)", [],
1109                                   ['Subsystem(classification)', 'Subsystem(id)']);
1110        # Declare the return variable.
1111        my @retVal = ();
1112        # Each element in @subs represents a leaf node, so as we loop through it we will be
1113        # producing one leaf node at a time. The leaf node is represented as a 2-tuple. The
1114        # first element is a semi-colon-delimited list of the classifications for the
1115        # subsystem. There will be a stack of currently-active classifications, which we will
1116        # compare to the incoming classifications from the end backward. A new classification
1117        # requires starting a new branch. A different classification requires closing an old
1118        # branch and starting a new one. Each classification in the stack will also contain
1119        # that classification's current branch. We'll add a fake classification at the
1120        # beginning that we can use to represent the tree as a whole.
1121        my $rootName = '<root>';
1122        # Create the classification stack. Note the stack is a pair of parallel lists,
1123        # one containing names and the other containing content.
1124        my @stackNames = ($rootName);
1125        my @stackContents = (\@retVal);
1126        # Add a null entry at the end of the subsystem list to force an unrolling.
1127        push @subs, ['', undef];
1128        # Loop through the subsystems.
1129        for my $sub (@subs) {
1130            # Pull out the classification list and the subsystem ID.
1131            my ($classString, $id) = @{$sub};
1132            Trace("Processing class \"$classString\" and subsystem $id.") if T(4);
1133            # Convert the classification string to a list with the root classification in
1134            # the front.
1135            my @classList = ($rootName, split($FIG_Config::splitter, $classString));
1136            # Find the leftmost point at which the class list differs from the stack.
1137            my $matchPoint = 0;
1138            while ($matchPoint <= $#stackNames && $matchPoint <= $#classList &&
1139                   $stackNames[$matchPoint] eq $classList[$matchPoint]) {
1140                $matchPoint++;
1141            }
1142            Trace("Match point is $matchPoint. Stack length is " . scalar(@stackNames) .
1143                  ". Class List length is " . scalar(@classList) . ".") if T(4);
1144            # Unroll the stack to the matchpoint.
1145            while ($#stackNames >= $matchPoint) {
1146                my $popped = pop @stackNames;
1147                pop @stackContents;
1148                Trace("\"$popped\" popped from stack.") if T(4);
1149            }
1150            # Start branches for any new classifications.
1151            while ($#stackNames < $#classList) {
1152                # The branch for a new classification contains its radio button
1153                # data and then a list of children. So, at this point, if radio buttons
1154                # are desired, we put them into the content.
1155                my $newLevel = scalar(@stackNames);
1156                my @newClassContent = ();
1157                if ($optionThing->{radio}) {
1158                    my $newClassString = join($FIG_Config::splitter, @classList[1..$newLevel]);
1159                    push @newClassContent, { value => "classification=$newClassString%" };
1160                }
1161                # The new classification node is appended to its parent's content
1162                # and then pushed onto the stack. First, we need the node name.
1163                my $nodeName = $classList[$newLevel];
1164                # Add the classification to its parent. This makes it part of the
1165                # tree we'll be returning to the user.
1166                push @{$stackContents[$#stackNames]}, $nodeName, \@newClassContent;
1167                # Push the classification onto the stack.
1168                push @stackContents, \@newClassContent;
1169                push @stackNames, $nodeName;
1170                Trace("\"$nodeName\" pushed onto stack.") if T(4);
1171            }
1172            # Now the stack contains all our parent branches. We add the subsystem to
1173            # the branch at the top of the stack, but only if it's NOT the dummy node.
1174            if (defined $id) {
1175                # Compute the node name from the ID.
1176                my $nodeName = $id;
1177                $nodeName =~ s/_/ /g;
1178                # Create the node's leaf hash. This depends on the value of the radio
1179                # and link options.
1180                my $nodeContent = {};
1181                if ($optionThing->{links}) {
1182                    # Compute the link value.
1183                    my $linkable = uri_escape($id);
1184                    $nodeContent->{link} = "../FIG/display_subsys.cgi?ssa_name=$linkable;request=show_ssa;sort=by_phylo;SPROUT=1";
1185                }
1186                if ($optionThing->{radio}) {
1187                    # Compute the radio value.
1188                    $nodeContent->{value} = "id=$id";
1189                }
1190                # Push the node into its parent branch.
1191                Trace("\"$nodeName\" added to node list.") if T(4);
1192                push @{$stackContents[$#stackNames]}, $nodeName, $nodeContent;
1193            }
1194        }
1195        # Return the result.
1196        return \@retVal;
1197    }
1198    
1199    
1200  =head3 NmpdrGenomeMenu  =head3 NmpdrGenomeMenu
1201    
1202  C<< my $htmlText = $shelp->NmpdrGenomeMenu($menuName, $multiple, \@selected, $rows); >>  C<< my $htmlText = $shelp->NmpdrGenomeMenu($menuName, $multiple, \@selected, $rows); >>
# Line 1223  Line 1350 
1350          # the search box. This allows the user to type text and have all genomes containing          # the search box. This allows the user to type text and have all genomes containing
1351          # the text selected automatically.          # the text selected automatically.
1352          my $searchThingName = "${menuName}_SearchThing";          my $searchThingName = "${menuName}_SearchThing";
1353          push @lines, "<br>Select genomes containing <INPUT type=\"text\" name=\"$searchThingName\" " .          push @lines, "<br />" .
1354                       "size=\"30\" onBlur=\"selectViaSearch($menuName, $searchThingName); $showSelect\" />";                       "<INPUT type=\"button\" name=\"Search\" class=\"button\" value=\"Select genomes containing\" onClick=\"selectViaSearch($menuName, $searchThingName); $showSelect\" />&nbsp;" .
1355                         "<INPUT type=\"text\" name=\"$searchThingName\" size=\"30\" />";
1356          # Next are the buttons to set and clear selections.          # Next are the buttons to set and clear selections.
1357          push @lines, "<br />";          push @lines, "<br />";
1358          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\" />";
# Line 1349  Line 1477 
1477    
1478  =head3 SubmitRow  =head3 SubmitRow
1479    
1480  C<< my $htmlText = $shelp->SubmitRow(); >>  C<< my $htmlText = $shelp->SubmitRow($caption); >>
1481    
1482  Returns the HTML text for the row containing the page size control  Returns the HTML text for the row containing the page size control
1483  and the submit button. All searches should have this row somewhere  and the submit button. All searches should have this row somewhere
1484  near the top of the form.  near the top of the form.
1485    
1486    =over 4
1487    
1488    =item caption (optional)
1489    
1490    Caption to be put on the search button. The default is C<Go>.
1491    
1492    =item RETURN
1493    
1494    Returns a table row containing the controls for submitting the search
1495    and tuning the results.
1496    
1497    =back
1498    
1499  =cut  =cut
1500    
1501  sub SubmitRow {  sub SubmitRow {
1502      # Get the parameters.      # Get the parameters.
1503      my ($self) = @_;      my ($self, $caption) = @_;
1504      my $cgi = $self->Q();      my $cgi = $self->Q();
1505        # Compute the button caption.
1506        my $realCaption = (defined $caption ? $caption : 'Go');
1507      # Get the current page size.      # Get the current page size.
1508      my $pageSize = $cgi->param('PageSize');      my $pageSize = $cgi->param('PageSize');
1509      # Get the incoming external-link flag.      # Get the incoming external-link flag.
# Line 1375  Line 1518 
1518                                                    -label => 'Show URL')),                                                    -label => 'Show URL')),
1519                            $cgi->td($cgi->submit(-class => 'goButton',                            $cgi->td($cgi->submit(-class => 'goButton',
1520                                                  -name => 'Search',                                                  -name => 'Search',
1521                                                  -value => 'Go')));                                                  -value => $realCaption)));
1522      # Return the result.      # Return the result.
1523      return $retVal;      return $retVal;
1524  }  }
# Line 1469  Line 1612 
1612          $seg_id =~ s/:/--/g;          $seg_id =~ s/:/--/g;
1613          Trace("Show limits are ($show_start,$show_stop) in genome $genomeID with ref $seg_id.") if T(3);          Trace("Show limits are ($show_start,$show_stop) in genome $genomeID with ref $seg_id.") if T(3);
1614          # Assemble all the pieces.          # Assemble all the pieces.
1615          $retVal = "gbrowse.cgi/GB_$genomeID?ref=$seg_id&start=$show_start&stop=$show_stop";          $retVal = "gbrowse.cgi/GB_$genomeID?ref=$seg_id;start=$show_start;stop=$show_stop";
1616      }      }
1617      # Return the result.      # Return the result.
1618      return $retVal;      return $retVal;
# Line 1681  Line 1824 
1824      return @retVal;      return @retVal;
1825  }  }
1826    
1827    =head3 SelectionTree
1828    
1829    C<< my $htmlText = SearchHelper::SelectionTree($cgi, \%tree, %options); >>
1830    
1831    Display a selection tree.
1832    
1833    This method creates the HTML for a tree selection control. The tree is implemented as a set of
1834    nested HTML unordered lists. Each selectable element of the tree will contain a radio button. In
1835    addition, some of the tree nodes can contain hyperlinks.
1836    
1837    The tree itself is passed in as a multi-level list containing node names followed by
1838    contents. Each content element is a reference to a similar list. The first element of
1839    each list may be a hash reference. If so, it should contain one or both of the following
1840    keys.
1841    
1842    =over 4
1843    
1844    =item link
1845    
1846    The navigation URL to be popped up if the user clicks on the node name.
1847    
1848    =item value
1849    
1850    The form value to be returned if the user selects the tree node.
1851    
1852    =back
1853    
1854    The presence of a C<link> key indicates the node name will be hyperlinked. The presence of
1855    a C<value> key indicates the node name will have a radio button. If a node has no children,
1856    you may pass it a hash reference instead of a list reference.
1857    
1858    The following example shows the hash for a three-level tree with links on the second level and
1859    radio buttons on the third.
1860    
1861        [   Objects => [
1862                Entities => [
1863                    {link => "../docs/WhatIsAnEntity.html"},
1864                    Genome => {value => 'GenomeData'},
1865                    Feature => {value => 'FeatureData'},
1866                    Contig => {value => 'ContigData'},
1867                ],
1868                Relationships => [
1869                    {link => "../docs/WhatIsARelationShip.html"},
1870                    HasFeature => {value => 'GenomeToFeature'},
1871                    IsOnContig => {value => 'FeatureToContig'},
1872                ]
1873            ]
1874        ]
1875    
1876    Note how each leaf of the tree has a hash reference for its value, while the branch nodes
1877    all have list references.
1878    
1879    This next example shows how to set up a taxonomy selection field. The value returned
1880    by the tree control will be the taxonomy string for the selected node ready for use
1881    in a LIKE-style SQL filter. Only the single branch ending in campylobacter is shown for
1882    reasons of space.
1883    
1884        [   All => [
1885                {value => "%"},
1886                Bacteria => [
1887                    {value => "Bacteria%"},
1888                    Proteobacteria => [
1889                        {value => "Bacteria; Proteobacteria%"},
1890                        Epsilonproteobacteria => [
1891                            {value => "Bacteria; Proteobacteria;Epsilonproteobacteria%"},
1892                            Campylobacterales => [
1893                                {value => "Bacteria; Proteobacteria; Epsilonproteobacteria; Campylobacterales%"},
1894                                Campylobacteraceae =>
1895                                    {value => "Bacteria; Proteobacteria; Epsilonproteobacteria; Campylobacterales; Campylobacteraceae%"},
1896                                ...
1897                            ]
1898                            ...
1899                        ]
1900                        ...
1901                    ]
1902                    ...
1903                ]
1904                ...
1905            ]
1906        ]
1907    
1908    
1909    This method of tree storage allows the caller to control the order in which the tree nodes
1910    are displayed and to completely control value selection and use of hyperlinks. It is, however
1911    a bit complicated. Eventually, tree-building classes will be provided to simplify things.
1912    
1913    The parameters to this method are as follows.
1914    
1915    =over 4
1916    
1917    =item cgi
1918    
1919    CGI object used to generate the HTML.
1920    
1921    =item tree
1922    
1923    Reference to a hash describing a tree. See the description above.
1924    
1925    =item options
1926    
1927    Hash containing options for the tree display.
1928    
1929    =back
1930    
1931    The allowable options are as follows
1932    
1933    =over 4
1934    
1935    =item nodeImageClosed
1936    
1937    URL of the image to display next to the tree nodes when they are collapsed. Clicking
1938    on the image will expand a section of the tree. The default is C<../FIG/Html/plus.gif>.
1939    
1940    =item nodeImageOpen
1941    
1942    URL of the image to display next to the tree nodes when they are expanded. Clicking
1943    on the image will collapse a section of the tree. The default is C<../FIG/Html/minus.gif>.
1944    
1945    =item style
1946    
1947    Style to use for the tree. The default is C<tree>. Because the tree style is implemented
1948    as nested lists, the key components of this style are the definitions for the C<ul> and
1949    C<li> tags. The default style file contains the following definitions.
1950    
1951        .tree ul {
1952           margin-left: 0; padding-left: 22px
1953        }
1954        .tree li {
1955            list-style-type: none;
1956        }
1957    
1958    The default image is 22 pixels wide, so in the above scheme each tree level is indented from its
1959    parent by the width of the node image. This use of styles limits the things we can do in formatting
1960    the tree, but it has the advantage of vastly simplifying the tree creation.
1961    
1962    =item name
1963    
1964    Field name to give to the radio buttons in the tree. The default is C<selection>.
1965    
1966    =item target
1967    
1968    Frame target for links. The default is C<_self>.
1969    
1970    =item selected
1971    
1972    If specified, the value of the radio button to be pre-selected.
1973    
1974    =back
1975    
1976    =cut
1977    
1978    sub SelectionTree {
1979        # Get the parameters.
1980        my ($cgi, $tree, %options) = @_;
1981        # Get the options.
1982        my $optionThing = Tracer::GetOptions({ name => 'selection',
1983                                               nodeImageClosed => '../FIG/Html/plus.gif',
1984                                               nodeImageOpen => '../FIG/Html/minus.gif',
1985                                               style => 'tree',
1986                                               target => '_self',
1987                                               selected => undef},
1988                                             \%options);
1989        # Declare the return variable. We'll do the standard thing with creating a list
1990        # of HTML lines and rolling them together at the end.
1991        my @retVal = ();
1992        # Only proceed if the tree is present.
1993        if (defined($tree)) {
1994            # Validate the tree.
1995            if (ref $tree ne 'ARRAY') {
1996                Confess("Selection tree is not a list reference.");
1997            } elsif (scalar @{$tree} == 0) {
1998                # The tree is empty, so we do nothing.
1999            } elsif ($tree->[0] eq 'HASH') {
2000                Confess("Hash reference found at start of selection tree. The tree as a whole cannot have attributes, only tree nodes.");
2001            } else {
2002                # Here we have a real tree. Apply the tree style.
2003                push @retVal, $cgi->start_div({ class => $optionThing->{style} });
2004                # Give us a DIV ID.
2005                my $divID = GetDivID($optionThing->{name});
2006                # Show the tree.
2007                push @retVal, ShowBranch($cgi, "(root)", $divID, $tree, $optionThing, 'block');
2008                # Close the DIV block.
2009                push @retVal, $cgi->end_div();
2010            }
2011        }
2012        # Return the result.
2013        return join("\n", @retVal, "");
2014    }
2015    
2016    =head3 ShowBranch
2017    
2018    C<< my @htmlLines = SearchHelper::ShowBranch($cgi, $label, $id, $branch, $options, $displayType); >>
2019    
2020    This is a recursive method that displays a branch of the tree.
2021    
2022    =over 4
2023    
2024    =item cgi
2025    
2026    CGI object used to format HTML.
2027    
2028    =item label
2029    
2030    Label of this tree branch. It is only used in error messages.
2031    
2032    =item id
2033    
2034    ID to be given to this tree branch. The ID is used in the code that expands and collapses
2035    tree nodes.
2036    
2037    =item branch
2038    
2039    Reference to a list containing the content of the tree branch. The list contains an optional
2040    hash reference that is ignored and the list of children, each child represented by a name
2041    and then its contents. The contents could by a hash reference (indicating the attributes
2042    of a leaf node), or another tree branch.
2043    
2044    =item options
2045    
2046    Options from the original call to L</SelectionTree>.
2047    
2048    =item displayType
2049    
2050    C<block> if the contents of this list are to be displayed, C<none> if they are to be
2051    hidden.
2052    
2053    =item RETURN
2054    
2055    Returns one or more HTML lines that can be used to display the tree branch.
2056    
2057    =back
2058    
2059    =cut
2060    
2061    sub ShowBranch {
2062        # Get the parameters.
2063        my ($cgi, $label, $id, $branch, $options, $displayType) = @_;
2064        # Declare the return variable.
2065        my @retVal = ();
2066        # Start the branch.
2067        push @retVal, $cgi->start_ul({ id => $id, style => "display:$displayType" });
2068        # Check for the hash and choose the start location accordingly.
2069        my $i0 = (ref $branch->[0] eq 'HASH' ? 1 : 0);
2070        # Get the list length.
2071        my $i1 = scalar(@{$branch});
2072        # Verify we have an even number of elements.
2073        if (($i1 - $i0) % 2 != 0) {
2074            Trace("Branch elements are from $i0 to $i1.") if T(3);
2075            Confess("Odd number of elements in tree branch $label.");
2076        } else {
2077            # Loop through the elements.
2078            for (my $i = $i0; $i < $i1; $i += 2) {
2079                # Get this node's label and contents.
2080                my ($myLabel, $myContent) = ($branch->[$i], $branch->[$i+1]);
2081                # Get an ID for this node's children (if any).
2082                my $myID = GetDivID($options->{name});
2083                # Now we need to find the list of children and the options hash.
2084                # This is a bit ugly because we allow the shortcut of a hash without an
2085                # enclosing list. First, we need some variables.
2086                my $attrHash = {};
2087                my @childHtml = ();
2088                my $hasChildren = 0;
2089                if (! ref $myContent) {
2090                    Confess("Invalid tree definition. Scalar found as content of node \"$myLabel\".");
2091                } elsif (ref $myContent eq 'HASH') {
2092                    # Here the node is a leaf and its content contains the link/value hash.
2093                    $attrHash = $myContent;
2094                } elsif (ref $myContent eq 'ARRAY') {
2095                    # Here the node may be a branch. Its content is a list.
2096                    my $len = scalar @{$myContent};
2097                    if ($len >= 1) {
2098                        # Here the first element of the list could by the link/value hash.
2099                        if (ref $myContent->[0] eq 'HASH') {
2100                            $attrHash = $myContent->[0];
2101                            # If there's data in the list besides the hash, it's our child list.
2102                            # We can pass the entire thing as the child list, because the hash
2103                            # is ignored.
2104                            if ($len > 1) {
2105                                $hasChildren = 1;
2106                            }
2107                        } else {
2108                            $hasChildren = 1;
2109                        }
2110                        # If we have children, create the child list with a recursive call.
2111                        if ($hasChildren) {
2112                            Trace("Processing children of $myLabel.") if T(4);
2113                            push @childHtml, ShowBranch($cgi, $myLabel, $myID, $myContent, $options, 'none');
2114                        }
2115                    }
2116                }
2117                # Okay, it's time to pause and take stock. We have the label of the current node
2118                # in $myLabel, its attributes in $attrHash, and if it is NOT a leaf node, we
2119                # have a child list in @childHtml. If it IS a leaf node, $hasChildren is 0.
2120                # Compute the image HTML. It's tricky, because we have to deal with the open and
2121                # closed images.
2122                my @images = ($options->{nodeImageOpen}, $options->{nodeImageClosed});
2123                my $image = $images[$hasChildren];
2124                my $prefixHtml = $cgi->img({src => $image, id => "${myID}img"});
2125                if ($hasChildren) {
2126                    # If there are children, we wrap the image in a toggle hyperlink.
2127                    $prefixHtml = $cgi->a({ onClick => "javascript:treeToggle('$myID','$images[0]', '$images[1]')" },
2128                                          $prefixHtml);
2129                }
2130                # Now the radio button, if any. Note we use "defined" in case the user wants the
2131                # value to be 0.
2132                if (defined $attrHash->{value}) {
2133                    # Due to a glitchiness in the CGI stuff, we have to build the attribute
2134                    # hash for the "input" method. If the item is pre-selected, we add
2135                    # "checked => undef" to the hash. Otherwise, we can't have "checked"
2136                    # at all.
2137                    my $radioParms = { type => 'radio',
2138                                       name => $options->{name},
2139                                       value => $attrHash->{value},
2140                                     };
2141                    if (defined $options->{selected} && $options->{selected} eq $attrHash->{value}) {
2142                        $radioParms->{checked} = undef;
2143                    }
2144                    $prefixHtml .= $cgi->input($radioParms);
2145                }
2146                # Next, we format the label.
2147                my $labelHtml = $myLabel;
2148                Trace("Formatting tree node for $myLabel.") if T(4);
2149                # Apply a hyperlink if necessary.
2150                if (defined $attrHash->{link}) {
2151                    $labelHtml = $cgi->a({ href => $attrHash->{link}, target => $options->{target} },
2152                                         $labelHtml);
2153                }
2154                # Finally, roll up the child HTML. If there are no children, we'll get a null string
2155                # here.
2156                my $childHtml = join("\n", @childHtml);
2157                # Now we have all the pieces, so we can put them together.
2158                push @retVal, $cgi->li("$prefixHtml$labelHtml$childHtml");
2159            }
2160        }
2161        # Close the tree branch.
2162        push @retVal, $cgi->end_ul();
2163        # Return the result.
2164        return @retVal;
2165    }
2166    
2167    =head3 GetDivID
2168    
2169    C<< my $idString = SearchHelper::GetDivID($name); >>
2170    
2171    Return a new HTML ID string.
2172    
2173    =over 4
2174    
2175    =item name
2176    
2177    Name to be prefixed to the ID string.
2178    
2179    =item RETURN
2180    
2181    Returns a hopefully-unique ID string.
2182    
2183    =back
2184    
2185    =cut
2186    
2187    sub GetDivID {
2188        # Get the parameters.
2189        my ($name) = @_;
2190        # Compute the ID.
2191        my $retVal = "elt_$name$divCount";
2192        # Increment the counter to make sure this ID is not re-used.
2193        $divCount++;
2194        # Return the result.
2195        return $retVal;
2196    }
2197    
2198  =head2 Feature Column Methods  =head2 Feature Column Methods
2199    
2200  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 1758  Line 2272 
2272      } elsif ($colName =~ /^keyword:(.+)$/) {      } elsif ($colName =~ /^keyword:(.+)$/) {
2273          $retVal = ucfirst $1;          $retVal = ucfirst $1;
2274      } elsif ($colName eq 'orgName') {      } elsif ($colName eq 'orgName') {
2275          $retVal = "Feature Name";          $retVal = "Gene Name";
2276      } elsif ($colName eq 'protlink') {      } elsif ($colName eq 'protlink') {
2277          $retVal = "NMPDR Protein Page";          $retVal = "NMPDR Protein Page";
2278      } elsif ($colName eq 'subsystem') {      } elsif ($colName eq 'subsystem') {
# Line 1831  Line 2345 
2345          ($retVal) = $record->Value('Feature(assignment)');          ($retVal) = $record->Value('Feature(assignment)');
2346      } elsif ($colName eq 'gblink') {      } elsif ($colName eq 'gblink') {
2347          # Here we want a link to the GBrowse page using the official GBrowse button.          # Here we want a link to the GBrowse page using the official GBrowse button.
2348          my $gurl = "GetGBrowse.cgi?fid=$fid";          $retVal = Formlet('GBrowse', "GetGBrowse.cgi", undef,
2349          $retVal = $cgi->a({ href => $gurl, title => "GBrowse for $fid" },                            fid => $fid);
                           $cgi->img({ src => "../images/button-gbrowse.png",  
                                       border => 0 })  
                          );  
2350      } elsif ($colName eq 'group') {      } elsif ($colName eq 'group') {
2351          # Get the NMPDR group name.          # Get the NMPDR group name.
2352          my (undef, $group) = $self->OrganismData($fid);          my (undef, $group) = $self->OrganismData($fid);
# Line 1852  Line 2363 
2363          $retVal = $self->FeatureName($fid);          $retVal = $self->FeatureName($fid);
2364      } elsif ($colName eq 'protlink') {      } elsif ($colName eq 'protlink') {
2365          # Here we want a link to the protein page using the official NMPDR button.          # Here we want a link to the protein page using the official NMPDR button.
2366          my $hurl = HTML::fid_link($cgi, $fid, 0, 1);          $retVal = Formlet('NMPDR', "protein.cgi", undef,
2367          $retVal = $cgi->a({ href => $hurl, title => "Protein page for $fid" },                            prot => $fid, SPROUT => 1, new_framework => 0,
2368                            $cgi->img({ src => "../images/button-nmpdr.png",                            user => '');
                                      border => 0 })  
                          );  
2369      }elsif ($colName eq 'subsystem') {      }elsif ($colName eq 'subsystem') {
2370          # Another run-time column: subsystem list.          # Another run-time column: subsystem list.
2371          $retVal = "%%subsystem=$fid";          $retVal = "%%subsystem=$fid";
# Line 2010  Line 2519 
2519      return ($name, $displayGroup);      return ($name, $displayGroup);
2520  }  }
2521    
2522    =head3 ValidateKeywords
2523    
2524    C<< my $okFlag = $shelp->ValidateKeywords($keywordString, $required); >>
2525    
2526    Insure that a keyword string is reasonably valid. If it is invalid, a message will be
2527    set.
2528    
2529    =over 4
2530    
2531    =item keywordString
2532    
2533    Keyword string specified as a parameter to the current search.
2534    
2535    =item required
2536    
2537    TRUE if there must be at least one keyword specified, else FALSE.
2538    
2539    =item RETURN
2540    
2541    Returns TRUE if the keyword string is valid, else FALSE. Note that a null keyword string
2542    is acceptable if the I<$required> parameter is not specified.
2543    
2544    =back
2545    
2546    =cut
2547    
2548    sub ValidateKeywords {
2549        # Get the parameters.
2550        my ($self, $keywordString, $required) = @_;
2551        # Declare the return variable.
2552        my $retVal = 0;
2553        my @wordList = split /\s+/, $keywordString;
2554        # Right now our only real worry is a list of all minus words. The problem with it is that
2555        # it will return an incorrect result.
2556        my @plusWords = grep { $_ =~ /^[^\-]/ } @wordList;
2557        if (! @wordList) {
2558            if ($required) {
2559                $self->SetMessage("No search words specified.");
2560            }
2561        } elsif (! @plusWords) {
2562            $self->SetMessage("At least one keyword must be positive. All the keywords entered are preceded by minus signs.");
2563        } else {
2564            $retVal = 1;
2565        }
2566        # Return the result.
2567        return $retVal;
2568    }
2569    
2570    =head3 Formlet
2571    
2572    C<< my $html = SearchHelper::Formlet($caption, $url, $target, %parms); >>
2573    
2574    Create a mini-form that posts to the specified URL with the specified parameters. The
2575    parameters will be stored in hidden fields, and the form's only visible control will
2576    be a submit button with the specified caption.
2577    
2578    Note that we don't use B<CGI.pm> services here because they generate forms with extra characters
2579    and tags that we don't want to deal with.
2580    
2581    =over 4
2582    
2583    =item caption
2584    
2585    Caption to be put on the form button.
2586    
2587    =item url
2588    
2589    URL to be put in the form's action parameter.
2590    
2591    =item target
2592    
2593    Frame or target in which the form results should appear. If C<undef> is specified,
2594    the default target will be used.
2595    
2596    =item parms
2597    
2598    Hash containing the parameter names as keys and the parameter values as values.
2599    
2600    =back
2601    
2602    =cut
2603    
2604    sub Formlet {
2605        # Get the parameters.
2606        my ($caption, $url, $target, %parms) = @_;
2607        # Compute the target HTML.
2608        my $targetHtml = ($target ? " target=\"$target\"" : "");
2609        # Start the form.
2610        my $retVal = "<form method=\"POST\" action=\"$url\"$target>";
2611        # Add the parameters.
2612        for my $parm (keys %parms) {
2613            $retVal .= "<input type=\"hidden\" name=\"$parm\" value=\"$parms{$parm}\" />";
2614        }
2615        # Put in the button.
2616        $retVal .= "<input type=\"submit\" name=\"submit\" value=\"$caption\" class=\"button\" />";
2617        # Close the form.
2618        $retVal .= "</form>";
2619        # Return the result.
2620        return $retVal;
2621    }
2622    
2623  =head2 Virtual Methods  =head2 Virtual Methods
2624    
2625  =head3 Form  =head3 Form

Legend:
Removed from v.1.15  
changed lines
  Added in v.1.18

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3