[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.14, Wed Nov 8 23:18:24 2006 UTC revision 1.21, Thu Nov 30 23:04:37 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 245  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 256  Line 257 
257    
258  =over 4  =over 4
259    
260  =item query  =item cgi
261    
262  The CGI query object for the current script.  The CGI query object for the current script.
263    
# Line 266  Line 267 
267    
268  sub new {  sub new {
269      # Get the parameters.      # Get the parameters.
270      my ($class, $query) = @_;      my ($class, $cgi) = @_;
271      # Check for a session ID.      # Check for a session ID.
272      my $session_id = $query->param("SessionID");      my $session_id = $cgi->param("SessionID");
273      my $type = "old";      my $type = "old";
274      if (! $session_id) {      if (! $session_id) {
275          # Here we're starting a new session. We create the session ID and          # Here we're starting a new session. We create the session ID and
276          # store it in the query object.          # store it in the query object.
277          $session_id = NewSessionID();          $session_id = NewSessionID();
278          $type = "new";          $type = "new";
279          $query->param(-name => 'SessionID', -value => $session_id);          $cgi->param(-name => 'SessionID', -value => $session_id);
280      }      }
281      # Compute the subclass name.      # Compute the subclass name.
282      $class =~ /SH(.+)$/;      my $subClass;
283      my $subClass = $1;      if ($class =~ /SH(.+)$/) {
284            # Here we have a real search class.
285            $subClass = $1;
286        } else {
287            # Here we have a bare class. The bare class cannot search, but it can
288            # process search results.
289            $subClass = 'SearchHelper';
290        }
291      # Insure everybody knows we're in Sprout mode.      # Insure everybody knows we're in Sprout mode.
292      $query->param(-name => 'SPROUT', -value => 1);      $cgi->param(-name => 'SPROUT', -value => 1);
293      # Generate the form name.      # Generate the form name.
294      my $formName = "$class$formCount";      my $formName = "$class$formCount";
295      $formCount++;      $formCount++;
# Line 289  Line 297 
297      # as well as an indicator as to whether or not the session is new, plus the      # as well as an indicator as to whether or not the session is new, plus the
298      # class name and a placeholder for the Sprout object.      # class name and a placeholder for the Sprout object.
299      my $retVal = {      my $retVal = {
300                    query => $query,                    query => $cgi,
301                    type => $type,                    type => $type,
302                    class => $subClass,                    class => $subClass,
303                    sprout => undef,                    sprout => undef,
# Line 453  Line 461 
461      my ($self, $title) = @_;      my ($self, $title) = @_;
462      # Get the CGI object.      # Get the CGI object.
463      my $cgi = $self->Q();      my $cgi = $self->Q();
464      # Start the form.      # Start the form. Note we use the override option on the Class value, in
465        # case the Advanced button was used.
466      my $retVal = "<div class=\"search\">\n" .      my $retVal = "<div class=\"search\">\n" .
467                   $cgi->start_form(-method => 'POST',                   $cgi->start_form(-method => 'POST',
468                                    -action => $cgi->url(-relative => 1),                                    -action => $cgi->url(-relative => 1),
469                                    -name => $self->FormName()) .                                    -name => $self->FormName()) .
470                   $cgi->hidden(-name => 'Class',                   $cgi->hidden(-name => 'Class',
471                                -value => $self->{class}) .                                -value => $self->{class},
472                                  -override => 1) .
473                   $cgi->hidden(-name => 'SPROUT',                   $cgi->hidden(-name => 'SPROUT',
474                                -value => 1) .                                -value => 1) .
475                   $cgi->h3($title);                   $cgi->h3($title);
# Line 946  Line 956 
956    
957  =head3 ComputeFASTA  =head3 ComputeFASTA
958    
959  C<< my $fasta = $shelp->ComputeFASTA($incomingType, $desiredType, $sequence); >>  C<< my $fasta = $shelp->ComputeFASTA($desiredType, $sequence); >>
960    
961  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.  
962    
963  =over 4  =over 4
964    
 =item incomingType  
   
 C<dna> if this is a DNA sequence, C<prot> if this is a protein sequence.  
   
965  =item desiredType  =item desiredType
966    
967  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.  
968    
969  =item sequence  =item sequence
970    
# Line 983  Line 986 
986    
987  sub ComputeFASTA {  sub ComputeFASTA {
988      # Get the parameters.      # Get the parameters.
989      my ($self, $incomingType, $desiredType, $sequence) = @_;      my ($self, $desiredType, $sequence) = @_;
990      # Declare the return variable. If an error occurs, it will remain undefined.      # Declare the return variable. If an error occurs, it will remain undefined.
991      my $retVal;      my $retVal;
992      # This variable will be cleared if an error is detected.      # This variable will be cleared if an error is detected.
993      my $okFlag = 1;      my $okFlag = 1;
994      # Create variables to hold the FASTA label and data.      # Create variables to hold the FASTA label and data.
995      my ($fastaLabel, $fastaData);      my ($fastaLabel, $fastaData);
996      Trace("FASTA incoming type is $incomingType, desired type is $desiredType.") if T(4);      Trace("FASTA desired type is $desiredType.") if T(4);
997      # Check for a feature specification.      # Check for a feature specification.
998      if ($sequence =~ /^\s*(\w+\|\S+)\s*$/) {      if ($sequence =~ /^\s*(\w+\|\S+)\s*$/) {
999          # 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 1003  Line 1006 
1006          # exist.          # exist.
1007          my ($figID) = $sprout->FeaturesByAlias($fid);          my ($figID) = $sprout->FeaturesByAlias($fid);
1008          if (! $figID) {          if (! $figID) {
1009              $self->SetMessage("No feature found with the ID \"$fid\".");              $self->SetMessage("No gene found with the ID \"$fid\".");
1010              $okFlag = 0;              $okFlag = 0;
1011          } else {          } else {
1012              # Set the FASTA label.              # Set the FASTA label.
# Line 1020  Line 1023 
1023                  Trace(length $fastaData . " characters returned for DNA of $fastaLabel.") if T(3);                  Trace(length $fastaData . " characters returned for DNA of $fastaLabel.") if T(3);
1024              }              }
1025          }          }
     } 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;  
1026      } else {      } else {
1027          Trace("Analyzing FASTA sequence.") if T(4);          Trace("Analyzing FASTA sequence.") if T(4);
1028          # 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 1036  Line 1035 
1035              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);
1036              # 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
1037              # as data.              # as data.
1038              $fastaLabel = "User-specified $incomingType sequence";              $fastaLabel = "User-specified $desiredType sequence";
1039              $fastaData = $sequence;              $fastaData = $sequence;
1040          }          }
1041          # The next step is to clean the junk out of the sequence.          # The next step is to clean the junk out of the sequence.
1042          $fastaData =~ s/\n//g;          $fastaData =~ s/\n//g;
1043          $fastaData =~ s/\s+//g;          $fastaData =~ s/\s+//g;
1044          # 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.
1045          # 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) {  
1046              $self->SetMessage("Invaid characters detected. Is the input really a DNA sequence?");              $self->SetMessage("Invaid characters detected. Is the input really a DNA sequence?");
1047              $okFlag = 0;              $okFlag = 0;
1048          }          }
# Line 1071  Line 1062 
1062      return $retVal;      return $retVal;
1063  }  }
1064    
1065    =head3 SubsystemTree
1066    
1067    C<< my $tree = SearchHelper::SubsystemTree($sprout, %options); >>
1068    
1069    This method creates a subsystem selection tree suitable for passing to
1070    L</SelectionTree>. Each leaf node in the tree will have a link to the
1071    subsystem display page. In addition, each node can have a radio button. The
1072    radio button alue is either C<classification=>I<string>, where I<string> is
1073    a classification string, or C<id=>I<string>, where I<string> is a subsystem ID.
1074    Thus, it can either be used to filter by a group of related subsystems or a
1075    single subsystem.
1076    
1077    =over 4
1078    
1079    =item sprout
1080    
1081    Sprout database object used to get the list of subsystems.
1082    
1083    =item options
1084    
1085    Hash containing options for building the tree.
1086    
1087    =item RETURN
1088    
1089    Returns a reference to a tree list suitable for passing to L</SelectionTree>.
1090    
1091    =back
1092    
1093    The supported options are as follows.
1094    
1095    =over 4
1096    
1097    =item radio
1098    
1099    TRUE if the tree should be configured for radio buttons. The default is FALSE.
1100    
1101    =item links
1102    
1103    TRUE if the tree should be configured for links. The default is TRUE.
1104    
1105    =back
1106    
1107    =cut
1108    
1109    sub SubsystemTree {
1110        # Get the parameters.
1111        my ($sprout, %options) = @_;
1112        # Process the options.
1113        my $optionThing = Tracer::GetOptions({ radio => 0, links => 1 }, \%options);
1114        # Read in the subsystems.
1115        my @subs = $sprout->GetAll(['Subsystem'], "ORDER BY Subsystem(classification), Subsystem(id)", [],
1116                                   ['Subsystem(classification)', 'Subsystem(id)']);
1117        # Declare the return variable.
1118        my @retVal = ();
1119        # Each element in @subs represents a leaf node, so as we loop through it we will be
1120        # producing one leaf node at a time. The leaf node is represented as a 2-tuple. The
1121        # first element is a semi-colon-delimited list of the classifications for the
1122        # subsystem. There will be a stack of currently-active classifications, which we will
1123        # compare to the incoming classifications from the end backward. A new classification
1124        # requires starting a new branch. A different classification requires closing an old
1125        # branch and starting a new one. Each classification in the stack will also contain
1126        # that classification's current branch. We'll add a fake classification at the
1127        # beginning that we can use to represent the tree as a whole.
1128        my $rootName = '<root>';
1129        # Create the classification stack. Note the stack is a pair of parallel lists,
1130        # one containing names and the other containing content.
1131        my @stackNames = ($rootName);
1132        my @stackContents = (\@retVal);
1133        # Add a null entry at the end of the subsystem list to force an unrolling.
1134        push @subs, ['', undef];
1135        # Loop through the subsystems.
1136        for my $sub (@subs) {
1137            # Pull out the classification list and the subsystem ID.
1138            my ($classString, $id) = @{$sub};
1139            Trace("Processing class \"$classString\" and subsystem $id.") if T(4);
1140            # Convert the classification string to a list with the root classification in
1141            # the front.
1142            my @classList = ($rootName, split($FIG_Config::splitter, $classString));
1143            # Find the leftmost point at which the class list differs from the stack.
1144            my $matchPoint = 0;
1145            while ($matchPoint <= $#stackNames && $matchPoint <= $#classList &&
1146                   $stackNames[$matchPoint] eq $classList[$matchPoint]) {
1147                $matchPoint++;
1148            }
1149            Trace("Match point is $matchPoint. Stack length is " . scalar(@stackNames) .
1150                  ". Class List length is " . scalar(@classList) . ".") if T(4);
1151            # Unroll the stack to the matchpoint.
1152            while ($#stackNames >= $matchPoint) {
1153                my $popped = pop @stackNames;
1154                pop @stackContents;
1155                Trace("\"$popped\" popped from stack.") if T(4);
1156            }
1157            # Start branches for any new classifications.
1158            while ($#stackNames < $#classList) {
1159                # The branch for a new classification contains its radio button
1160                # data and then a list of children. So, at this point, if radio buttons
1161                # are desired, we put them into the content.
1162                my $newLevel = scalar(@stackNames);
1163                my @newClassContent = ();
1164                if ($optionThing->{radio}) {
1165                    my $newClassString = join($FIG_Config::splitter, @classList[1..$newLevel]);
1166                    push @newClassContent, { value => "classification=$newClassString%" };
1167                }
1168                # The new classification node is appended to its parent's content
1169                # and then pushed onto the stack. First, we need the node name.
1170                my $nodeName = $classList[$newLevel];
1171                # Add the classification to its parent. This makes it part of the
1172                # tree we'll be returning to the user.
1173                push @{$stackContents[$#stackNames]}, $nodeName, \@newClassContent;
1174                # Push the classification onto the stack.
1175                push @stackContents, \@newClassContent;
1176                push @stackNames, $nodeName;
1177                Trace("\"$nodeName\" pushed onto stack.") if T(4);
1178            }
1179            # Now the stack contains all our parent branches. We add the subsystem to
1180            # the branch at the top of the stack, but only if it's NOT the dummy node.
1181            if (defined $id) {
1182                # Compute the node name from the ID.
1183                my $nodeName = $id;
1184                $nodeName =~ s/_/ /g;
1185                # Create the node's leaf hash. This depends on the value of the radio
1186                # and link options.
1187                my $nodeContent = {};
1188                if ($optionThing->{links}) {
1189                    # Compute the link value.
1190                    my $linkable = uri_escape($id);
1191                    $nodeContent->{link} = "../FIG/display_subsys.cgi?ssa_name=$linkable;request=show_ssa;sort=by_phylo;SPROUT=1";
1192                }
1193                if ($optionThing->{radio}) {
1194                    # Compute the radio value.
1195                    $nodeContent->{value} = "id=$id";
1196                }
1197                # Push the node into its parent branch.
1198                Trace("\"$nodeName\" added to node list.") if T(4);
1199                push @{$stackContents[$#stackNames]}, $nodeName, $nodeContent;
1200            }
1201        }
1202        # Return the result.
1203        return \@retVal;
1204    }
1205    
1206    
1207  =head3 NmpdrGenomeMenu  =head3 NmpdrGenomeMenu
1208    
1209  C<< my $htmlText = $shelp->NmpdrGenomeMenu($menuName, $multiple, \@selected, $rows); >>  C<< my $htmlText = $shelp->NmpdrGenomeMenu($menuName, $multiple, \@selected, $rows); >>
# Line 1220  Line 1353 
1353      push @lines, "</SELECT>";      push @lines, "</SELECT>";
1354      # Check for multiple selection.      # Check for multiple selection.
1355      if ($multiple) {      if ($multiple) {
1356          # 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
1357            # the search box. This allows the user to type text and have all genomes containing
1358            # the text selected automatically.
1359            my $searchThingName = "${menuName}_SearchThing";
1360            push @lines, "<br />" .
1361                         "<INPUT type=\"button\" name=\"Search\" class=\"button\" value=\"Select genomes containing\" onClick=\"selectViaSearch($menuName, $searchThingName); $showSelect\" />&nbsp;" .
1362                         "<INPUT type=\"text\" name=\"$searchThingName\" size=\"30\" />";
1363            # Next are the buttons to set and clear selections.
1364          push @lines, "<br />";          push @lines, "<br />";
         push @lines, "<INPUT type=\"button\" name=\"SelectAll\" class=\"bigButton\" value=\"Select All\" onClick=\"selectAll($menuName); $showSelect\" />";  
1365          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\" />";
1366            push @lines, "<INPUT type=\"button\" name=\"SelectAll\" class=\"bigButton\" value=\"Select All\" onClick=\"selectAll($menuName); $showSelect\" />";
1367          push @lines, "<INPUT type=\"button\" name=\"NMPDROnly\" class=\"bigButton\"  value=\"Select NMPDR\" onClick=\"selectSome($menuName, $nmpdrCount, true); $showSelect\" />";          push @lines, "<INPUT type=\"button\" name=\"NMPDROnly\" class=\"bigButton\"  value=\"Select NMPDR\" onClick=\"selectSome($menuName, $nmpdrCount, true); $showSelect\" />";
1368          push @lines, "<INPUT type=\"button\" name=\"OtherOnly\" class=\"bigButton\" value=\"Select Supporting\" onClick=\"selectSome($menuName, $nmpdrCount, false); $showSelect\" />";          push @lines, "<INPUT type=\"button\" name=\"OtherOnly\" class=\"bigButton\" value=\"Select Supporting\" onClick=\"selectSome($menuName, $nmpdrCount, false); $showSelect\" />";
         # Now add the search box. This allows the user to type text and have all genomes containing  
         # the text selected automatically.  
         my $searchThingName = "${menuName}_SearchThing";  
         push @lines, "<br>Select genomes containing <INPUT type=\"text\" name=\"$searchThingName\" size=\"30\" />&nbsp;" .  
                      "<INPUT type=\"button\" name=\"Select\" class=\"button\" value=\"Search\" onClick=\"selectViaSearch($menuName, $searchThingName); $showSelect\" />";  
1369          # Add the status display, too.          # Add the status display, too.
1370          push @lines, "<DIV id=\"$divID\" class=\"selectStatus\"></DIV>";          push @lines, "<DIV id=\"$divID\" class=\"selectStatus\"></DIV>";
1371          # 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 1349  Line 1484 
1484    
1485  =head3 SubmitRow  =head3 SubmitRow
1486    
1487  C<< my $htmlText = $shelp->SubmitRow(); >>  C<< my $htmlText = $shelp->SubmitRow($caption); >>
1488    
1489  Returns the HTML text for the row containing the page size control  Returns the HTML text for the row containing the page size control
1490  and the submit button. All searches should have this row somewhere  and the submit button. All searches should have this row somewhere
1491  near the top of the form.  near the top of the form.
1492    
1493    =over 4
1494    
1495    =item caption (optional)
1496    
1497    Caption to be put on the search button. The default is C<Go>.
1498    
1499    =item RETURN
1500    
1501    Returns a table row containing the controls for submitting the search
1502    and tuning the results.
1503    
1504    =back
1505    
1506  =cut  =cut
1507    
1508  sub SubmitRow {  sub SubmitRow {
1509      # Get the parameters.      # Get the parameters.
1510      my ($self) = @_;      my ($self, $caption) = @_;
1511      my $cgi = $self->Q();      my $cgi = $self->Q();
1512        # Compute the button caption.
1513        my $realCaption = (defined $caption ? $caption : 'Go');
1514      # Get the current page size.      # Get the current page size.
1515      my $pageSize = $cgi->param('PageSize');      my $pageSize = $cgi->param('PageSize');
1516      # Get the incoming external-link flag.      # Get the incoming external-link flag.
# Line 1375  Line 1525 
1525                                                    -label => 'Show URL')),                                                    -label => 'Show URL')),
1526                            $cgi->td($cgi->submit(-class => 'goButton',                            $cgi->td($cgi->submit(-class => 'goButton',
1527                                                  -name => 'Search',                                                  -name => 'Search',
1528                                                  -value => 'Go')));                                                  -value => $realCaption)));
1529      # Return the result.      # Return the result.
1530      return $retVal;      return $retVal;
1531  }  }
# Line 1469  Line 1619 
1619          $seg_id =~ s/:/--/g;          $seg_id =~ s/:/--/g;
1620          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);
1621          # Assemble all the pieces.          # Assemble all the pieces.
1622          $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";
1623      }      }
1624      # Return the result.      # Return the result.
1625      return $retVal;      return $retVal;
# Line 1562  Line 1712 
1712    
1713  =head3 ComputeSearchURL  =head3 ComputeSearchURL
1714    
1715  C<< my $url = $shelp->ComputeSearchURL(); >>  C<< my $url = $shelp->ComputeSearchURL(%overrides); >>
1716    
1717  Compute the GET-style URL for the current search. In order for this to work, there  Compute the GET-style URL for the current search. In order for this to work, there
1718  must be a copy of the search form on the current page. This will always be the  must be a copy of the search form on the current page. This will always be the
# Line 1572  Line 1722 
1722  main complication is that if the user specified all genomes, we'll want to  main complication is that if the user specified all genomes, we'll want to
1723  remove the parameter entirely from a get-style URL.  remove the parameter entirely from a get-style URL.
1724    
1725    =over 4
1726    
1727    =item overrides
1728    
1729    Hash containing override values for the parameters, where the parameter name is
1730    the key and the parameter value is the override value. If the override value is
1731    C<undef>, the parameter will be deleted from the result.
1732    
1733    =item RETURN
1734    
1735    Returns a GET-style URL for invoking the search with the specified overrides.
1736    
1737    =back
1738    
1739  =cut  =cut
1740    
1741  sub ComputeSearchURL {  sub ComputeSearchURL {
1742      # Get the parameters.      # Get the parameters.
1743      my ($self) = @_;      my ($self, %overrides) = @_;
1744      # Get the database and CGI query object.      # Get the database and CGI query object.
1745      my $cgi = $self->Q();      my $cgi = $self->Q();
1746      my $sprout = $self->DB();      my $sprout = $self->DB();
# Line 1617  Line 1781 
1781              if ($allFlag) {              if ($allFlag) {
1782                  @values = ();                  @values = ();
1783              }              }
1784            } elsif (exists $overrides{$parmKey}) {
1785                # Here the value is being overridden, so we skip it for now.
1786                @values = ();
1787          }          }
1788          # If we still have values, create the URL parameters.          # If we still have values, create the URL parameters.
1789          if (@values) {          if (@values) {
1790              push @urlList, map { "$parmKey=" . uri_escape($_) } @values;              push @urlList, map { "$parmKey=" . uri_escape($_) } @values;
1791          }          }
1792      }      }
1793        # Now do the overrides.
1794        for my $overKey (keys %overrides) {
1795            # Only use this override if it's not a delete marker.
1796            if (defined $overrides{$overKey}) {
1797                push @urlList, "$overKey=" . uri_escape($overrides{$overKey});
1798            }
1799        }
1800      # Add the parameters to the URL.      # Add the parameters to the URL.
1801      $retVal .= "?" . join(";", @urlList);      $retVal .= "?" . join(";", @urlList);
1802      # Return the result.      # Return the result.
# Line 1672  Line 1846 
1846  Return a list of advanced class names. This list is used to generate the directory  Return a list of advanced class names. This list is used to generate the directory
1847  of available searches on the search page.  of available searches on the search page.
1848    
1849  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.  
1850    
1851  =cut  =cut
1852    
1853  sub AdvancedClassList {  sub AdvancedClassList {
1854      return split /\s+/, $FIG_Config::advanced_classes;      my @retVal = map { $_ =~ /^SH(\w+)\.pm/; $1 } grep { $_ =~ /^SH/ } keys %INC;
1855        return @retVal;
1856    }
1857    
1858    =head3 SelectionTree
1859    
1860    C<< my $htmlText = SearchHelper::SelectionTree($cgi, \%tree, %options); >>
1861    
1862    Display a selection tree.
1863    
1864    This method creates the HTML for a tree selection control. The tree is implemented as a set of
1865    nested HTML unordered lists. Each selectable element of the tree will contain a radio button. In
1866    addition, some of the tree nodes can contain hyperlinks.
1867    
1868    The tree itself is passed in as a multi-level list containing node names followed by
1869    contents. Each content element is a reference to a similar list. The first element of
1870    each list may be a hash reference. If so, it should contain one or both of the following
1871    keys.
1872    
1873    =over 4
1874    
1875    =item link
1876    
1877    The navigation URL to be popped up if the user clicks on the node name.
1878    
1879    =item value
1880    
1881    The form value to be returned if the user selects the tree node.
1882    
1883    =back
1884    
1885    The presence of a C<link> key indicates the node name will be hyperlinked. The presence of
1886    a C<value> key indicates the node name will have a radio button. If a node has no children,
1887    you may pass it a hash reference instead of a list reference.
1888    
1889    The following example shows the hash for a three-level tree with links on the second level and
1890    radio buttons on the third.
1891    
1892        [   Objects => [
1893                Entities => [
1894                    {link => "../docs/WhatIsAnEntity.html"},
1895                    Genome => {value => 'GenomeData'},
1896                    Feature => {value => 'FeatureData'},
1897                    Contig => {value => 'ContigData'},
1898                ],
1899                Relationships => [
1900                    {link => "../docs/WhatIsARelationShip.html"},
1901                    HasFeature => {value => 'GenomeToFeature'},
1902                    IsOnContig => {value => 'FeatureToContig'},
1903                ]
1904            ]
1905        ]
1906    
1907    Note how each leaf of the tree has a hash reference for its value, while the branch nodes
1908    all have list references.
1909    
1910    This next example shows how to set up a taxonomy selection field. The value returned
1911    by the tree control will be the taxonomy string for the selected node ready for use
1912    in a LIKE-style SQL filter. Only the single branch ending in campylobacter is shown for
1913    reasons of space.
1914    
1915        [   All => [
1916                {value => "%"},
1917                Bacteria => [
1918                    {value => "Bacteria%"},
1919                    Proteobacteria => [
1920                        {value => "Bacteria; Proteobacteria%"},
1921                        Epsilonproteobacteria => [
1922                            {value => "Bacteria; Proteobacteria;Epsilonproteobacteria%"},
1923                            Campylobacterales => [
1924                                {value => "Bacteria; Proteobacteria; Epsilonproteobacteria; Campylobacterales%"},
1925                                Campylobacteraceae =>
1926                                    {value => "Bacteria; Proteobacteria; Epsilonproteobacteria; Campylobacterales; Campylobacteraceae%"},
1927                                ...
1928                            ]
1929                            ...
1930                        ]
1931                        ...
1932                    ]
1933                    ...
1934                ]
1935                ...
1936            ]
1937        ]
1938    
1939    
1940    This method of tree storage allows the caller to control the order in which the tree nodes
1941    are displayed and to completely control value selection and use of hyperlinks. It is, however
1942    a bit complicated. Eventually, tree-building classes will be provided to simplify things.
1943    
1944    The parameters to this method are as follows.
1945    
1946    =over 4
1947    
1948    =item cgi
1949    
1950    CGI object used to generate the HTML.
1951    
1952    =item tree
1953    
1954    Reference to a hash describing a tree. See the description above.
1955    
1956    =item options
1957    
1958    Hash containing options for the tree display.
1959    
1960    =back
1961    
1962    The allowable options are as follows
1963    
1964    =over 4
1965    
1966    =item nodeImageClosed
1967    
1968    URL of the image to display next to the tree nodes when they are collapsed. Clicking
1969    on the image will expand a section of the tree. The default is C<../FIG/Html/plus.gif>.
1970    
1971    =item nodeImageOpen
1972    
1973    URL of the image to display next to the tree nodes when they are expanded. Clicking
1974    on the image will collapse a section of the tree. The default is C<../FIG/Html/minus.gif>.
1975    
1976    =item style
1977    
1978    Style to use for the tree. The default is C<tree>. Because the tree style is implemented
1979    as nested lists, the key components of this style are the definitions for the C<ul> and
1980    C<li> tags. The default style file contains the following definitions.
1981    
1982        .tree ul {
1983           margin-left: 0; padding-left: 22px
1984        }
1985        .tree li {
1986            list-style-type: none;
1987        }
1988    
1989    The default image is 22 pixels wide, so in the above scheme each tree level is indented from its
1990    parent by the width of the node image. This use of styles limits the things we can do in formatting
1991    the tree, but it has the advantage of vastly simplifying the tree creation.
1992    
1993    =item name
1994    
1995    Field name to give to the radio buttons in the tree. The default is C<selection>.
1996    
1997    =item target
1998    
1999    Frame target for links. The default is C<_self>.
2000    
2001    =item selected
2002    
2003    If specified, the value of the radio button to be pre-selected.
2004    
2005    =back
2006    
2007    =cut
2008    
2009    sub SelectionTree {
2010        # Get the parameters.
2011        my ($cgi, $tree, %options) = @_;
2012        # Get the options.
2013        my $optionThing = Tracer::GetOptions({ name => 'selection',
2014                                               nodeImageClosed => '../FIG/Html/plus.gif',
2015                                               nodeImageOpen => '../FIG/Html/minus.gif',
2016                                               style => 'tree',
2017                                               target => '_self',
2018                                               selected => undef},
2019                                             \%options);
2020        # Declare the return variable. We'll do the standard thing with creating a list
2021        # of HTML lines and rolling them together at the end.
2022        my @retVal = ();
2023        # Only proceed if the tree is present.
2024        if (defined($tree)) {
2025            # Validate the tree.
2026            if (ref $tree ne 'ARRAY') {
2027                Confess("Selection tree is not a list reference.");
2028            } elsif (scalar @{$tree} == 0) {
2029                # The tree is empty, so we do nothing.
2030            } elsif ($tree->[0] eq 'HASH') {
2031                Confess("Hash reference found at start of selection tree. The tree as a whole cannot have attributes, only tree nodes.");
2032            } else {
2033                # Here we have a real tree. Apply the tree style.
2034                push @retVal, $cgi->start_div({ class => $optionThing->{style} });
2035                # Give us a DIV ID.
2036                my $divID = GetDivID($optionThing->{name});
2037                # Show the tree.
2038                push @retVal, ShowBranch($cgi, "(root)", $divID, $tree, $optionThing, 'block');
2039                # Close the DIV block.
2040                push @retVal, $cgi->end_div();
2041            }
2042        }
2043        # Return the result.
2044        return join("\n", @retVal, "");
2045    }
2046    
2047    =head3 ShowBranch
2048    
2049    C<< my @htmlLines = SearchHelper::ShowBranch($cgi, $label, $id, $branch, $options, $displayType); >>
2050    
2051    This is a recursive method that displays a branch of the tree.
2052    
2053    =over 4
2054    
2055    =item cgi
2056    
2057    CGI object used to format HTML.
2058    
2059    =item label
2060    
2061    Label of this tree branch. It is only used in error messages.
2062    
2063    =item id
2064    
2065    ID to be given to this tree branch. The ID is used in the code that expands and collapses
2066    tree nodes.
2067    
2068    =item branch
2069    
2070    Reference to a list containing the content of the tree branch. The list contains an optional
2071    hash reference that is ignored and the list of children, each child represented by a name
2072    and then its contents. The contents could by a hash reference (indicating the attributes
2073    of a leaf node), or another tree branch.
2074    
2075    =item options
2076    
2077    Options from the original call to L</SelectionTree>.
2078    
2079    =item displayType
2080    
2081    C<block> if the contents of this list are to be displayed, C<none> if they are to be
2082    hidden.
2083    
2084    =item RETURN
2085    
2086    Returns one or more HTML lines that can be used to display the tree branch.
2087    
2088    =back
2089    
2090    =cut
2091    
2092    sub ShowBranch {
2093        # Get the parameters.
2094        my ($cgi, $label, $id, $branch, $options, $displayType) = @_;
2095        # Declare the return variable.
2096        my @retVal = ();
2097        # Start the branch.
2098        push @retVal, $cgi->start_ul({ id => $id, style => "display:$displayType" });
2099        # Check for the hash and choose the start location accordingly.
2100        my $i0 = (ref $branch->[0] eq 'HASH' ? 1 : 0);
2101        # Get the list length.
2102        my $i1 = scalar(@{$branch});
2103        # Verify we have an even number of elements.
2104        if (($i1 - $i0) % 2 != 0) {
2105            Trace("Branch elements are from $i0 to $i1.") if T(3);
2106            Confess("Odd number of elements in tree branch $label.");
2107        } else {
2108            # Loop through the elements.
2109            for (my $i = $i0; $i < $i1; $i += 2) {
2110                # Get this node's label and contents.
2111                my ($myLabel, $myContent) = ($branch->[$i], $branch->[$i+1]);
2112                # Get an ID for this node's children (if any).
2113                my $myID = GetDivID($options->{name});
2114                # Now we need to find the list of children and the options hash.
2115                # This is a bit ugly because we allow the shortcut of a hash without an
2116                # enclosing list. First, we need some variables.
2117                my $attrHash = {};
2118                my @childHtml = ();
2119                my $hasChildren = 0;
2120                if (! ref $myContent) {
2121                    Confess("Invalid tree definition. Scalar found as content of node \"$myLabel\".");
2122                } elsif (ref $myContent eq 'HASH') {
2123                    # Here the node is a leaf and its content contains the link/value hash.
2124                    $attrHash = $myContent;
2125                } elsif (ref $myContent eq 'ARRAY') {
2126                    # Here the node may be a branch. Its content is a list.
2127                    my $len = scalar @{$myContent};
2128                    if ($len >= 1) {
2129                        # Here the first element of the list could by the link/value hash.
2130                        if (ref $myContent->[0] eq 'HASH') {
2131                            $attrHash = $myContent->[0];
2132                            # If there's data in the list besides the hash, it's our child list.
2133                            # We can pass the entire thing as the child list, because the hash
2134                            # is ignored.
2135                            if ($len > 1) {
2136                                $hasChildren = 1;
2137                            }
2138                        } else {
2139                            $hasChildren = 1;
2140                        }
2141                        # If we have children, create the child list with a recursive call.
2142                        if ($hasChildren) {
2143                            Trace("Processing children of $myLabel.") if T(4);
2144                            push @childHtml, ShowBranch($cgi, $myLabel, $myID, $myContent, $options, 'none');
2145                        }
2146                    }
2147                }
2148                # Okay, it's time to pause and take stock. We have the label of the current node
2149                # in $myLabel, its attributes in $attrHash, and if it is NOT a leaf node, we
2150                # have a child list in @childHtml. If it IS a leaf node, $hasChildren is 0.
2151                # Compute the image HTML. It's tricky, because we have to deal with the open and
2152                # closed images.
2153                my @images = ($options->{nodeImageOpen}, $options->{nodeImageClosed});
2154                my $image = $images[$hasChildren];
2155                my $prefixHtml = $cgi->img({src => $image, id => "${myID}img"});
2156                if ($hasChildren) {
2157                    # If there are children, we wrap the image in a toggle hyperlink.
2158                    $prefixHtml = $cgi->a({ onClick => "javascript:treeToggle('$myID','$images[0]', '$images[1]')" },
2159                                          $prefixHtml);
2160                }
2161                # Now the radio button, if any. Note we use "defined" in case the user wants the
2162                # value to be 0.
2163                if (defined $attrHash->{value}) {
2164                    # Due to a glitchiness in the CGI stuff, we have to build the attribute
2165                    # hash for the "input" method. If the item is pre-selected, we add
2166                    # "checked => undef" to the hash. Otherwise, we can't have "checked"
2167                    # at all.
2168                    my $radioParms = { type => 'radio',
2169                                       name => $options->{name},
2170                                       value => $attrHash->{value},
2171                                     };
2172                    if (defined $options->{selected} && $options->{selected} eq $attrHash->{value}) {
2173                        $radioParms->{checked} = undef;
2174                    }
2175                    $prefixHtml .= $cgi->input($radioParms);
2176                }
2177                # Next, we format the label.
2178                my $labelHtml = $myLabel;
2179                Trace("Formatting tree node for $myLabel.") if T(4);
2180                # Apply a hyperlink if necessary.
2181                if (defined $attrHash->{link}) {
2182                    $labelHtml = $cgi->a({ href => $attrHash->{link}, target => $options->{target} },
2183                                         $labelHtml);
2184                }
2185                # Finally, roll up the child HTML. If there are no children, we'll get a null string
2186                # here.
2187                my $childHtml = join("\n", @childHtml);
2188                # Now we have all the pieces, so we can put them together.
2189                push @retVal, $cgi->li("$prefixHtml$labelHtml$childHtml");
2190            }
2191        }
2192        # Close the tree branch.
2193        push @retVal, $cgi->end_ul();
2194        # Return the result.
2195        return @retVal;
2196    }
2197    
2198    =head3 GetDivID
2199    
2200    C<< my $idString = SearchHelper::GetDivID($name); >>
2201    
2202    Return a new HTML ID string.
2203    
2204    =over 4
2205    
2206    =item name
2207    
2208    Name to be prefixed to the ID string.
2209    
2210    =item RETURN
2211    
2212    Returns a hopefully-unique ID string.
2213    
2214    =back
2215    
2216    =cut
2217    
2218    sub GetDivID {
2219        # Get the parameters.
2220        my ($name) = @_;
2221        # Compute the ID.
2222        my $retVal = "elt_$name$divCount";
2223        # Increment the counter to make sure this ID is not re-used.
2224        $divCount++;
2225        # Return the result.
2226        return $retVal;
2227  }  }
2228    
2229  =head2 Feature Column Methods  =head2 Feature Column Methods
2230    
2231  The methods in this column manage feature column data. If you want to provide the  The methods in this section manage feature column data. If you want to provide the
2232  capability to include new types of data in feature columns, then all the changes  capability to include new types of data in feature columns, then all the changes
2233  are made to this section of the source file. Technically, this should be implemented  are made to this section of the source file. Technically, this should be implemented
2234  using object-oriented methods, but this is simpler for non-programmers to maintain.  using object-oriented methods, but this is simpler for non-programmers to maintain.
# Line 1758  Line 2303 
2303      } elsif ($colName =~ /^keyword:(.+)$/) {      } elsif ($colName =~ /^keyword:(.+)$/) {
2304          $retVal = ucfirst $1;          $retVal = ucfirst $1;
2305      } elsif ($colName eq 'orgName') {      } elsif ($colName eq 'orgName') {
2306          $retVal = "Feature Name";          $retVal = "Organism and Gene ID";
2307      } elsif ($colName eq 'protlink') {      } elsif ($colName eq 'protlink') {
2308          $retVal = "NMPDR Protein Page";          $retVal = "NMPDR Protein Page";
2309      } elsif ($colName eq 'subsystem') {      } elsif ($colName eq 'subsystem') {
# Line 1831  Line 2376 
2376          ($retVal) = $record->Value('Feature(assignment)');          ($retVal) = $record->Value('Feature(assignment)');
2377      } elsif ($colName eq 'gblink') {      } elsif ($colName eq 'gblink') {
2378          # 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.
2379          my $gurl = "GetGBrowse.cgi?fid=$fid";          $retVal = Formlet('GBrowse', "GetGBrowse.cgi", undef,
2380          $retVal = $cgi->a({ href => $gurl, title => "GBrowse for $fid" },                            fid => $fid);
                           $cgi->img({ src => "../images/button-gbrowse.png",  
                                       border => 0 })  
                          );  
2381      } elsif ($colName eq 'group') {      } elsif ($colName eq 'group') {
2382          # Get the NMPDR group name.          # Get the NMPDR group name.
2383          my (undef, $group) = $self->OrganismData($fid);          my (undef, $group) = $self->OrganismData($fid);
# Line 1852  Line 2394 
2394          $retVal = $self->FeatureName($fid);          $retVal = $self->FeatureName($fid);
2395      } elsif ($colName eq 'protlink') {      } elsif ($colName eq 'protlink') {
2396          # 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.
2397          my $hurl = HTML::fid_link($cgi, $fid, 0, 1);          $retVal = Formlet('NMPDR', "protein.cgi", undef,
2398          $retVal = $cgi->a({ href => $hurl, title => "Protein page for $fid" },                            prot => $fid, SPROUT => 1, new_framework => 0,
2399                            $cgi->img({ src => "../images/button-nmpdr.png",                            user => '');
                                      border => 0 })  
                          );  
2400      }elsif ($colName eq 'subsystem') {      }elsif ($colName eq 'subsystem') {
2401          # Another run-time column: subsystem list.          # Another run-time column: subsystem list.
2402          $retVal = "%%subsystem=$fid";          $retVal = "%%subsystem=$fid";
# Line 1923  Line 2463 
2463          # Get the subsystems.          # Get the subsystems.
2464          Trace("Generating subsystems for feature $fid.") if T(4);          Trace("Generating subsystems for feature $fid.") if T(4);
2465          my %subs = $sprout->SubsystemsOf($fid);          my %subs = $sprout->SubsystemsOf($fid);
2466          # Convert them to links.          # Extract the subsystem names.
2467          my @links = map { HTML::sub_link($cgi, $_) } sort keys %subs;          my @names = map { HTML::sub_link($cgi, $_) } sort keys %subs;
2468          # String them into a list.          # String them into a list.
2469          $retVal = join(", ", @links);          $retVal = join(", ", @names);
2470      } elsif ($type =~ /^keyword:(.+)$/) {      } elsif ($type =~ /^keyword:(.+)$/) {
2471          # Here the caller wants the value of the named keyword. The text is the          # Here the caller wants the value of the named keyword. The text is the
2472          # feature ID.          # feature ID.
# Line 2010  Line 2550 
2550      return ($name, $displayGroup);      return ($name, $displayGroup);
2551  }  }
2552    
2553    =head3 ValidateKeywords
2554    
2555    C<< my $okFlag = $shelp->ValidateKeywords($keywordString, $required); >>
2556    
2557    Insure that a keyword string is reasonably valid. If it is invalid, a message will be
2558    set.
2559    
2560    =over 4
2561    
2562    =item keywordString
2563    
2564    Keyword string specified as a parameter to the current search.
2565    
2566    =item required
2567    
2568    TRUE if there must be at least one keyword specified, else FALSE.
2569    
2570    =item RETURN
2571    
2572    Returns TRUE if the keyword string is valid, else FALSE. Note that a null keyword string
2573    is acceptable if the I<$required> parameter is not specified.
2574    
2575    =back
2576    
2577    =cut
2578    
2579    sub ValidateKeywords {
2580        # Get the parameters.
2581        my ($self, $keywordString, $required) = @_;
2582        # Declare the return variable.
2583        my $retVal = 0;
2584        my @wordList = split /\s+/, $keywordString;
2585        # Right now our only real worry is a list of all minus words. The problem with it is that
2586        # it will return an incorrect result.
2587        my @plusWords = grep { $_ =~ /^[^\-]/ } @wordList;
2588        if (! @wordList) {
2589            if ($required) {
2590                $self->SetMessage("No search words specified.");
2591            }
2592        } elsif (! @plusWords) {
2593            $self->SetMessage("At least one keyword must be positive. All the keywords entered are preceded by minus signs.");
2594        } else {
2595            $retVal = 1;
2596        }
2597        # Return the result.
2598        return $retVal;
2599    }
2600    
2601    =head3 Formlet
2602    
2603    C<< my $html = SearchHelper::Formlet($caption, $url, $target, %parms); >>
2604    
2605    Create a mini-form that posts to the specified URL with the specified parameters. The
2606    parameters will be stored in hidden fields, and the form's only visible control will
2607    be a submit button with the specified caption.
2608    
2609    Note that we don't use B<CGI.pm> services here because they generate forms with extra characters
2610    and tags that we don't want to deal with.
2611    
2612    =over 4
2613    
2614    =item caption
2615    
2616    Caption to be put on the form button.
2617    
2618    =item url
2619    
2620    URL to be put in the form's action parameter.
2621    
2622    =item target
2623    
2624    Frame or target in which the form results should appear. If C<undef> is specified,
2625    the default target will be used.
2626    
2627    =item parms
2628    
2629    Hash containing the parameter names as keys and the parameter values as values.
2630    
2631    =back
2632    
2633    =cut
2634    
2635    sub Formlet {
2636        # Get the parameters.
2637        my ($caption, $url, $target, %parms) = @_;
2638        # Compute the target HTML.
2639        my $targetHtml = ($target ? " target=\"$target\"" : "");
2640        # Start the form.
2641        my $retVal = "<form method=\"POST\" action=\"$url\"$target>";
2642        # Add the parameters.
2643        for my $parm (keys %parms) {
2644            $retVal .= "<input type=\"hidden\" name=\"$parm\" value=\"$parms{$parm}\" />";
2645        }
2646        # Put in the button.
2647        $retVal .= "<input type=\"submit\" name=\"submit\" value=\"$caption\" class=\"button\" />";
2648        # Close the form.
2649        $retVal .= "</form>";
2650        # Return the result.
2651        return $retVal;
2652    }
2653    
2654  =head2 Virtual Methods  =head2 Virtual Methods
2655    
2656  =head3 Form  =head3 Form

Legend:
Removed from v.1.14  
changed lines
  Added in v.1.21

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3