[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.13, Fri Nov 3 00:40:16 2006 UTC revision 1.26, Sun Feb 4 13:07:24 2007 UTC
# Line 113  Line 113 
113    
114  =item 4  =item 4
115    
116  In the C<SearchSkeleton.cgi> script, add a C<use> statement for your search tool  In the C<SearchSkeleton.cgi> script and add a C<use> statement for your search tool.
 and then put the class name in the C<@advancedClasses> list.  
117    
118  =back  =back
119    
# Line 177  Line 176 
176    
177  =back  =back
178    
179    If you are doing a feature search, you can also change the list of feature
180    columns displayed and their display order by overriding
181    L</DefaultFeatureColumns>.
182    
183  Finally, when generating the code for your controls, be sure to use any incoming  Finally, when generating the code for your controls, be sure to use any incoming
184  query parameters as default values so that the search request is persistent.  query parameters as default values so that the search request is persistent.
185    
# Line 222  Line 225 
225      }      }
226    
227  A Find method is of course much more complicated than generating a form, and there  A Find method is of course much more complicated than generating a form, and there
228  are variations on the above them. For example, you could eschew feature filtering  are variations on the above theme. For example, you could eschew feature filtering
229  entirely in favor of your own custom filtering, you could include extra columns  entirely in favor of your own custom filtering, you could include extra columns
230  in the output, or you could search for something that's not a feature at all. The  in the output, or you could search for something that's not a feature at all. The
231  above code is just a loose framework.  above code is just a loose framework.
# Line 241  Line 244 
244    
245  # This counter is used to insure every form on the page has a unique name.  # This counter is used to insure every form on the page has a unique name.
246  my $formCount = 0;  my $formCount = 0;
247    # This counter is used to generate unique DIV IDs.
248    my $divCount = 0;
249    
250  =head2 Public Methods  =head2 Public Methods
251    
# Line 252  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 262  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            Trace("No session ID found.") if T(3);
276          # 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
277          # store it in the query object.          # store it in the query object.
278          $session_id = NewSessionID();          $session_id = NewSessionID();
279          $type = "new";          $type = "new";
280          $query->param(-name => 'SessionID', -value => $session_id);          $cgi->param(-name => 'SessionID', -value => $session_id);
281        } else {
282            Trace("Session ID is $session_id.") if T(3);
283      }      }
284      # Compute the subclass name.      # Compute the subclass name.
285      $class =~ /SH(.+)$/;      my $subClass;
286      my $subClass = $1;      if ($class =~ /SH(.+)$/) {
287            # Here we have a real search class.
288            $subClass = $1;
289        } else {
290            # Here we have a bare class. The bare class cannot search, but it can
291            # process search results.
292            $subClass = 'SearchHelper';
293        }
294      # Insure everybody knows we're in Sprout mode.      # Insure everybody knows we're in Sprout mode.
295      $query->param(-name => 'SPROUT', -value => 1);      $cgi->param(-name => 'SPROUT', -value => 1);
296      # Generate the form name.      # Generate the form name.
297      my $formName = "$class$formCount";      my $formName = "$class$formCount";
298      $formCount++;      $formCount++;
# Line 285  Line 300 
300      # 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
301      # class name and a placeholder for the Sprout object.      # class name and a placeholder for the Sprout object.
302      my $retVal = {      my $retVal = {
303                    query => $query,                    query => $cgi,
304                    type => $type,                    type => $type,
305                    class => $subClass,                    class => $subClass,
306                    sprout => undef,                    sprout => undef,
# Line 449  Line 464 
464      my ($self, $title) = @_;      my ($self, $title) = @_;
465      # Get the CGI object.      # Get the CGI object.
466      my $cgi = $self->Q();      my $cgi = $self->Q();
467      # Start the form.      # Start the form. Note we use the override option on the Class value, in
468        # case the Advanced button was used.
469      my $retVal = "<div class=\"search\">\n" .      my $retVal = "<div class=\"search\">\n" .
470                   $cgi->start_form(-method => 'POST',                   $cgi->start_form(-method => 'POST',
471                                    -action => $cgi->url(-relative => 1),                                    -action => $cgi->url(-relative => 1),
472                                    -name => $self->FormName()) .                                    -name => $self->FormName()) .
473                   $cgi->hidden(-name => 'Class',                   $cgi->hidden(-name => 'Class',
474                                -value => $self->{class}) .                                -value => $self->{class},
475                                  -override => 1) .
476                   $cgi->hidden(-name => 'SPROUT',                   $cgi->hidden(-name => 'SPROUT',
477                                -value => 1) .                                -value => 1) .
478                   $cgi->h3($title);                   $cgi->h3($title);
# Line 654  Line 671 
671      my $extraCols = $fd->ExtraCols();      my $extraCols = $fd->ExtraCols();
672      # Check for a first-call situation.      # Check for a first-call situation.
673      if (! defined $self->{cols}) {      if (! defined $self->{cols}) {
674          # Here we need to set up the column information. Start with the defaults.          Trace("Setting up the columns.") if T(3);
675          $self->{cols} = $self->DefaultFeatureColumns();          # Here we need to set up the column information. Start with the extras,
676          # Add any additional columns requested by the feature filter.          # sorted by column name.
677          push @{$self->{cols}}, FeatureQuery::AdditionalColumns($self);          my @colNames = ();
         # Append the extras, sorted by column name.  
678          for my $col (sort keys %{$extraCols}) {          for my $col (sort keys %{$extraCols}) {
679              push @{$self->{cols}}, "X=$col";              push @colNames, "X=$col";
680          }          }
681            # Add the default columns.
682            push @colNames, $self->DefaultFeatureColumns();
683            # Add any additional columns requested by the feature filter.
684            push @colNames, FeatureQuery::AdditionalColumns($self);
685            Trace("Full column list determined.") if T(3);
686            # Save the full list.
687            $self->{cols} = \@colNames;
688          # Write out the column headers. This also prepares the cache file to receive          # Write out the column headers. This also prepares the cache file to receive
689          # output.          # output.
690            Trace("Writing column headers.") if T(3);
691          $self->WriteColumnHeaders(map { $self->FeatureColumnTitle($_) } @{$self->{cols}});          $self->WriteColumnHeaders(map { $self->FeatureColumnTitle($_) } @{$self->{cols}});
692            Trace("Column headers written.") if T(3);
693      }      }
694      # Get the feature ID.      # Get the feature ID.
695      my $fid = $fd->FID();      my $fid = $fd->FID();
# Line 937  Line 962 
962    
963  =head3 ComputeFASTA  =head3 ComputeFASTA
964    
965  C<< my $fasta = $shelp->ComputeFASTA($incomingType, $desiredType, $sequence); >>  C<< my $fasta = $shelp->ComputeFASTA($desiredType, $sequence); >>
966    
967  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.  
968    
969  =over 4  =over 4
970    
 =item incomingType  
   
 C<dna> if this is a DNA sequence, C<prot> if this is a protein sequence.  
   
971  =item desiredType  =item desiredType
972    
973  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.  
974    
975  =item sequence  =item sequence
976    
# Line 974  Line 992 
992    
993  sub ComputeFASTA {  sub ComputeFASTA {
994      # Get the parameters.      # Get the parameters.
995      my ($self, $incomingType, $desiredType, $sequence) = @_;      my ($self, $desiredType, $sequence) = @_;
996      # Declare the return variable. If an error occurs, it will remain undefined.      # Declare the return variable. If an error occurs, it will remain undefined.
997      my $retVal;      my $retVal;
998      # This variable will be cleared if an error is detected.      # This variable will be cleared if an error is detected.
999      my $okFlag = 1;      my $okFlag = 1;
1000      # Create variables to hold the FASTA label and data.      # Create variables to hold the FASTA label and data.
1001      my ($fastaLabel, $fastaData);      my ($fastaLabel, $fastaData);
1002      Trace("FASTA incoming type is $incomingType, desired type is $desiredType.") if T(4);      Trace("FASTA desired type is $desiredType.") if T(4);
1003      # Check for a feature specification.      # Check for a feature specification.
1004      if ($sequence =~ /^\s*(\w+\|\S+)\s*$/) {      if ($sequence =~ /^\s*(\w+\|\S+)\s*$/) {
1005          # 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 994  Line 1012 
1012          # exist.          # exist.
1013          my ($figID) = $sprout->FeaturesByAlias($fid);          my ($figID) = $sprout->FeaturesByAlias($fid);
1014          if (! $figID) {          if (! $figID) {
1015              $self->SetMessage("No feature found with the ID \"$fid\".");              $self->SetMessage("No gene found with the ID \"$fid\".");
1016              $okFlag = 0;              $okFlag = 0;
1017          } else {          } else {
1018              # Set the FASTA label.              # Set the FASTA label.
# Line 1011  Line 1029 
1029                  Trace(length $fastaData . " characters returned for DNA of $fastaLabel.") if T(3);                  Trace(length $fastaData . " characters returned for DNA of $fastaLabel.") if T(3);
1030              }              }
1031          }          }
     } 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;  
1032      } else {      } else {
1033          Trace("Analyzing FASTA sequence.") if T(4);          Trace("Analyzing FASTA sequence.") if T(4);
1034          # 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 1027  Line 1041 
1041              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);
1042              # 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
1043              # as data.              # as data.
1044              $fastaLabel = "User-specified $incomingType sequence";              $fastaLabel = "User-specified $desiredType sequence";
1045              $fastaData = $sequence;              $fastaData = $sequence;
1046          }          }
1047          # The next step is to clean the junk out of the sequence.          # The next step is to clean the junk out of the sequence.
1048          $fastaData =~ s/\n//g;          $fastaData =~ s/\n//g;
1049          $fastaData =~ s/\s+//g;          $fastaData =~ s/\s+//g;
1050          # 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.
1051          # we've already prevented a conversion from protein to DNA.          if ($desiredType eq 'dna' && $fastaData =~ /[^agctxn]/i) {
1052          if ($incomingType ne $desiredType) {              $self->SetMessage("Invalid characters detected. Is the input really a DNA sequence?");
             $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) {  
             $self->SetMessage("Invaid characters detected. Is the input really a DNA sequence?");  
1053              $okFlag = 0;              $okFlag = 0;
1054          }          }
1055      }      }
# Line 1062  Line 1068 
1068      return $retVal;      return $retVal;
1069  }  }
1070    
1071    =head3 SubsystemTree
1072    
1073    C<< my $tree = SearchHelper::SubsystemTree($sprout, %options); >>
1074    
1075    This method creates a subsystem selection tree suitable for passing to
1076    L</SelectionTree>. Each leaf node in the tree will have a link to the
1077    subsystem display page. In addition, each node can have a radio button. The
1078    radio button alue is either C<classification=>I<string>, where I<string> is
1079    a classification string, or C<id=>I<string>, where I<string> is a subsystem ID.
1080    Thus, it can either be used to filter by a group of related subsystems or a
1081    single subsystem.
1082    
1083    =over 4
1084    
1085    =item sprout
1086    
1087    Sprout database object used to get the list of subsystems.
1088    
1089    =item options
1090    
1091    Hash containing options for building the tree.
1092    
1093    =item RETURN
1094    
1095    Returns a reference to a tree list suitable for passing to L</SelectionTree>.
1096    
1097    =back
1098    
1099    The supported options are as follows.
1100    
1101    =over 4
1102    
1103    =item radio
1104    
1105    TRUE if the tree should be configured for radio buttons. The default is FALSE.
1106    
1107    =item links
1108    
1109    TRUE if the tree should be configured for links. The default is TRUE.
1110    
1111    =back
1112    
1113    =cut
1114    
1115    sub SubsystemTree {
1116        # Get the parameters.
1117        my ($sprout, %options) = @_;
1118        # Process the options.
1119        my $optionThing = Tracer::GetOptions({ radio => 0, links => 1 }, \%options);
1120        # Read in the subsystems.
1121        my @subs = $sprout->GetAll(['Subsystem'], "ORDER BY Subsystem(classification), Subsystem(id)", [],
1122                                   ['Subsystem(classification)', 'Subsystem(id)']);
1123        # Put any unclassified subsystems at the end. They will always be at the beginning, so if one
1124        # is at the end, ALL subsystems are unclassified and we don't bother.
1125        if ($#subs >= 0 && $subs[$#subs]->[0] ne '') {
1126            while ($subs[0]->[0] eq '') {
1127                my $classLess = shift @subs;
1128                push @subs, $classLess;
1129            }
1130        }
1131        # Declare the return variable.
1132        my @retVal = ();
1133        # Each element in @subs represents a leaf node, so as we loop through it we will be
1134        # producing one leaf node at a time. The leaf node is represented as a 2-tuple. The
1135        # first element is a semi-colon-delimited list of the classifications for the
1136        # subsystem. There will be a stack of currently-active classifications, which we will
1137        # compare to the incoming classifications from the end backward. A new classification
1138        # requires starting a new branch. A different classification requires closing an old
1139        # branch and starting a new one. Each classification in the stack will also contain
1140        # that classification's current branch. We'll add a fake classification at the
1141        # beginning that we can use to represent the tree as a whole.
1142        my $rootName = '<root>';
1143        # Create the classification stack. Note the stack is a pair of parallel lists,
1144        # one containing names and the other containing content.
1145        my @stackNames = ($rootName);
1146        my @stackContents = (\@retVal);
1147        # Add a null entry at the end of the subsystem list to force an unrolling.
1148        push @subs, [' ', undef];
1149        # Loop through the subsystems.
1150        for my $sub (@subs) {
1151            # Pull out the classification list and the subsystem ID.
1152            my ($classString, $id) = @{$sub};
1153            Trace("Processing class \"$classString\" and subsystem $id.") if T(4);
1154            # Convert the classification string to a list with the root classification in
1155            # the front.
1156            my @classList = ($rootName, split($FIG_Config::splitter, $classString));
1157            # Find the leftmost point at which the class list differs from the stack.
1158            my $matchPoint = 0;
1159            while ($matchPoint <= $#stackNames && $matchPoint <= $#classList &&
1160                   $stackNames[$matchPoint] eq $classList[$matchPoint]) {
1161                $matchPoint++;
1162            }
1163            Trace("Match point is $matchPoint. Stack length is " . scalar(@stackNames) .
1164                  ". Class List length is " . scalar(@classList) . ".") if T(4);
1165            # Unroll the stack to the matchpoint.
1166            while ($#stackNames >= $matchPoint) {
1167                my $popped = pop @stackNames;
1168                pop @stackContents;
1169                Trace("\"$popped\" popped from stack.") if T(4);
1170            }
1171            # Start branches for any new classifications.
1172            while ($#stackNames < $#classList) {
1173                # The branch for a new classification contains its radio button
1174                # data and then a list of children. So, at this point, if radio buttons
1175                # are desired, we put them into the content.
1176                my $newLevel = scalar(@stackNames);
1177                my @newClassContent = ();
1178                if ($optionThing->{radio}) {
1179                    my $newClassString = join($FIG_Config::splitter, @classList[1..$newLevel]);
1180                    push @newClassContent, { value => "classification=$newClassString%" };
1181                }
1182                # The new classification node is appended to its parent's content
1183                # and then pushed onto the stack. First, we need the node name.
1184                my $nodeName = $classList[$newLevel];
1185                # Add the classification to its parent. This makes it part of the
1186                # tree we'll be returning to the user.
1187                push @{$stackContents[$#stackNames]}, $nodeName, \@newClassContent;
1188                # Push the classification onto the stack.
1189                push @stackContents, \@newClassContent;
1190                push @stackNames, $nodeName;
1191                Trace("\"$nodeName\" pushed onto stack.") if T(4);
1192            }
1193            # Now the stack contains all our parent branches. We add the subsystem to
1194            # the branch at the top of the stack, but only if it's NOT the dummy node.
1195            if (defined $id) {
1196                # Compute the node name from the ID.
1197                my $nodeName = $id;
1198                $nodeName =~ s/_/ /g;
1199                # Create the node's leaf hash. This depends on the value of the radio
1200                # and link options.
1201                my $nodeContent = {};
1202                if ($optionThing->{links}) {
1203                    # Compute the link value.
1204                    my $linkable = uri_escape($id);
1205                    $nodeContent->{link} = "../FIG/display_subsys.cgi?ssa_name=$linkable;request=show_ssa;sort=by_phylo;SPROUT=1";
1206                }
1207                if ($optionThing->{radio}) {
1208                    # Compute the radio value.
1209                    $nodeContent->{value} = "id=$id";
1210                }
1211                # Push the node into its parent branch.
1212                Trace("\"$nodeName\" added to node list.") if T(4);
1213                push @{$stackContents[$#stackNames]}, $nodeName, $nodeContent;
1214            }
1215        }
1216        # Return the result.
1217        return \@retVal;
1218    }
1219    
1220    
1221  =head3 NmpdrGenomeMenu  =head3 NmpdrGenomeMenu
1222    
1223  C<< my $htmlText = $shelp->NmpdrGenomeMenu($menuName, $multiple, \@selected, $rows); >>  C<< my $htmlText = $shelp->NmpdrGenomeMenu($menuName, $multiple, \@selected, $rows); >>
# Line 1211  Line 1367 
1367      push @lines, "</SELECT>";      push @lines, "</SELECT>";
1368      # Check for multiple selection.      # Check for multiple selection.
1369      if ($multiple) {      if ($multiple) {
1370          # 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
1371            # the search box. This allows the user to type text and have all genomes containing
1372            # the text selected automatically.
1373            my $searchThingName = "${menuName}_SearchThing";
1374            push @lines, "<br />" .
1375                         "<INPUT type=\"button\" name=\"Search\" class=\"button\" value=\"Select genomes containing\" onClick=\"selectViaSearch($menuName, $searchThingName); $showSelect\" />&nbsp;" .
1376                         "<INPUT type=\"text\" name=\"$searchThingName\" size=\"30\" />";
1377            # Next are the buttons to set and clear selections.
1378          push @lines, "<br />";          push @lines, "<br />";
         push @lines, "<INPUT type=\"button\" name=\"SelectAll\" class=\"bigButton\" value=\"Select All\" onClick=\"selectAll($menuName); $showSelect\" />";  
1379          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\" />";
1380            push @lines, "<INPUT type=\"button\" name=\"SelectAll\" class=\"bigButton\" value=\"Select All\" onClick=\"selectAll($menuName); $showSelect\" />";
1381          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\" />";
1382          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\" />";  
1383          # Add the status display, too.          # Add the status display, too.
1384          push @lines, "<DIV id=\"$divID\" class=\"selectStatus\"></DIV>";          push @lines, "<DIV id=\"$divID\" class=\"selectStatus\"></DIV>";
1385          # 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 1340  Line 1498 
1498    
1499  =head3 SubmitRow  =head3 SubmitRow
1500    
1501  C<< my $htmlText = $shelp->SubmitRow(); >>  C<< my $htmlText = $shelp->SubmitRow($caption); >>
1502    
1503  Returns the HTML text for the row containing the page size control  Returns the HTML text for the row containing the page size control
1504  and the submit button. All searches should have this row somewhere  and the submit button. All searches should have this row somewhere
1505  near the top of the form.  near the top of the form.
1506    
1507    =over 4
1508    
1509    =item caption (optional)
1510    
1511    Caption to be put on the search button. The default is C<Go>.
1512    
1513    =item RETURN
1514    
1515    Returns a table row containing the controls for submitting the search
1516    and tuning the results.
1517    
1518    =back
1519    
1520  =cut  =cut
1521    
1522  sub SubmitRow {  sub SubmitRow {
1523      # Get the parameters.      # Get the parameters.
1524      my ($self) = @_;      my ($self, $caption) = @_;
1525      my $cgi = $self->Q();      my $cgi = $self->Q();
1526        # Compute the button caption.
1527        my $realCaption = (defined $caption ? $caption : 'Go');
1528      # Get the current page size.      # Get the current page size.
1529      my $pageSize = $cgi->param('PageSize');      my $pageSize = $cgi->param('PageSize');
1530      # Get the incoming external-link flag.      # Get the incoming external-link flag.
# Line 1360  Line 1533 
1533      my $retVal = $cgi->Tr($cgi->td("Results/Page"),      my $retVal = $cgi->Tr($cgi->td("Results/Page"),
1534                            $cgi->td($cgi->popup_menu(-name => 'PageSize',                            $cgi->td($cgi->popup_menu(-name => 'PageSize',
1535                                                      -values => [10, 25, 50, 100, 1000],                                                      -values => [10, 25, 50, 100, 1000],
1536                                                      -default => $pageSize) . " " .                                                      -default => $pageSize)),
                                    $cgi->checkbox(-name => 'ShowURL',  
                                                   -value => 1,  
                                                   -label => 'Show URL')),  
1537                            $cgi->td($cgi->submit(-class => 'goButton',                            $cgi->td($cgi->submit(-class => 'goButton',
1538                                                  -name => 'Search',                                                  -name => 'Search',
1539                                                  -value => 'Go')));                                                  -value => $realCaption)));
1540      # Return the result.      # Return the result.
1541      return $retVal;      return $retVal;
1542  }  }
# Line 1460  Line 1630 
1630          $seg_id =~ s/:/--/g;          $seg_id =~ s/:/--/g;
1631          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);
1632          # Assemble all the pieces.          # Assemble all the pieces.
1633          $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";
1634      }      }
1635      # Return the result.      # Return the result.
1636      return $retVal;      return $retVal;
# Line 1553  Line 1723 
1723    
1724  =head3 ComputeSearchURL  =head3 ComputeSearchURL
1725    
1726  C<< my $url = $shelp->ComputeSearchURL(); >>  C<< my $url = $shelp->ComputeSearchURL(%overrides); >>
1727    
1728  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
1729  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 1563  Line 1733 
1733  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
1734  remove the parameter entirely from a get-style URL.  remove the parameter entirely from a get-style URL.
1735    
1736    =over 4
1737    
1738    =item overrides
1739    
1740    Hash containing override values for the parameters, where the parameter name is
1741    the key and the parameter value is the override value. If the override value is
1742    C<undef>, the parameter will be deleted from the result.
1743    
1744    =item RETURN
1745    
1746    Returns a GET-style URL for invoking the search with the specified overrides.
1747    
1748    =back
1749    
1750  =cut  =cut
1751    
1752  sub ComputeSearchURL {  sub ComputeSearchURL {
1753      # Get the parameters.      # Get the parameters.
1754      my ($self) = @_;      my ($self, %overrides) = @_;
1755      # Get the database and CGI query object.      # Get the database and CGI query object.
1756      my $cgi = $self->Q();      my $cgi = $self->Q();
1757      my $sprout = $self->DB();      my $sprout = $self->DB();
# Line 1594  Line 1778 
1778          # a singleton list, but that's okay.          # a singleton list, but that's okay.
1779          my @values = split (/\0/, $parms{$parmKey});          my @values = split (/\0/, $parms{$parmKey});
1780          # Check for special cases.          # Check for special cases.
1781          if (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF ShowURL)) {          if (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF)) {
1782              # These are bookkeeping parameters we don't need to start a search.              # These are bookkeeping parameters we don't need to start a search.
1783              @values = ();              @values = ();
1784          } elsif ($parmKey =~ /_SearchThing$/) {          } elsif ($parmKey =~ /_SearchThing$/) {
# Line 1608  Line 1792 
1792              if ($allFlag) {              if ($allFlag) {
1793                  @values = ();                  @values = ();
1794              }              }
1795            } elsif (exists $overrides{$parmKey}) {
1796                # Here the value is being overridden, so we skip it for now.
1797                @values = ();
1798          }          }
1799          # If we still have values, create the URL parameters.          # If we still have values, create the URL parameters.
1800          if (@values) {          if (@values) {
1801              push @urlList, map { "$parmKey=" . uri_escape($_) } @values;              push @urlList, map { "$parmKey=" . uri_escape($_) } @values;
1802          }          }
1803      }      }
1804        # Now do the overrides.
1805        for my $overKey (keys %overrides) {
1806            # Only use this override if it's not a delete marker.
1807            if (defined $overrides{$overKey}) {
1808                push @urlList, "$overKey=" . uri_escape($overrides{$overKey});
1809            }
1810        }
1811      # Add the parameters to the URL.      # Add the parameters to the URL.
1812      $retVal .= "?" . join(";", @urlList);      $retVal .= "?" . join(";", @urlList);
1813      # Return the result.      # Return the result.
# Line 1663  Line 1857 
1857  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
1858  of available searches on the search page.  of available searches on the search page.
1859    
1860  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.  
1861    
1862  =cut  =cut
1863    
1864  sub AdvancedClassList {  sub AdvancedClassList {
1865      return split /\s+/, $FIG_Config::advanced_classes;      my @retVal = map { $_ =~ /^SH(\w+)\.pm/; $1 } grep { $_ =~ /^SH/ } keys %INC;
1866        return @retVal;
1867    }
1868    
1869    =head3 SelectionTree
1870    
1871    C<< my $htmlText = SearchHelper::SelectionTree($cgi, \%tree, %options); >>
1872    
1873    Display a selection tree.
1874    
1875    This method creates the HTML for a tree selection control. The tree is implemented as a set of
1876    nested HTML unordered lists. Each selectable element of the tree will contain a radio button. In
1877    addition, some of the tree nodes can contain hyperlinks.
1878    
1879    The tree itself is passed in as a multi-level list containing node names followed by
1880    contents. Each content element is a reference to a similar list. The first element of
1881    each list may be a hash reference. If so, it should contain one or both of the following
1882    keys.
1883    
1884    =over 4
1885    
1886    =item link
1887    
1888    The navigation URL to be popped up if the user clicks on the node name.
1889    
1890    =item value
1891    
1892    The form value to be returned if the user selects the tree node.
1893    
1894    =back
1895    
1896    The presence of a C<link> key indicates the node name will be hyperlinked. The presence of
1897    a C<value> key indicates the node name will have a radio button. If a node has no children,
1898    you may pass it a hash reference instead of a list reference.
1899    
1900    The following example shows the hash for a three-level tree with links on the second level and
1901    radio buttons on the third.
1902    
1903        [   Objects => [
1904                Entities => [
1905                    {link => "../docs/WhatIsAnEntity.html"},
1906                    Genome => {value => 'GenomeData'},
1907                    Feature => {value => 'FeatureData'},
1908                    Contig => {value => 'ContigData'},
1909                ],
1910                Relationships => [
1911                    {link => "../docs/WhatIsARelationShip.html"},
1912                    HasFeature => {value => 'GenomeToFeature'},
1913                    IsOnContig => {value => 'FeatureToContig'},
1914                ]
1915            ]
1916        ]
1917    
1918    Note how each leaf of the tree has a hash reference for its value, while the branch nodes
1919    all have list references.
1920    
1921    This next example shows how to set up a taxonomy selection field. The value returned
1922    by the tree control will be the taxonomy string for the selected node ready for use
1923    in a LIKE-style SQL filter. Only the single branch ending in campylobacter is shown for
1924    reasons of space.
1925    
1926        [   All => [
1927                {value => "%"},
1928                Bacteria => [
1929                    {value => "Bacteria%"},
1930                    Proteobacteria => [
1931                        {value => "Bacteria; Proteobacteria%"},
1932                        Epsilonproteobacteria => [
1933                            {value => "Bacteria; Proteobacteria;Epsilonproteobacteria%"},
1934                            Campylobacterales => [
1935                                {value => "Bacteria; Proteobacteria; Epsilonproteobacteria; Campylobacterales%"},
1936                                Campylobacteraceae =>
1937                                    {value => "Bacteria; Proteobacteria; Epsilonproteobacteria; Campylobacterales; Campylobacteraceae%"},
1938                                ...
1939                            ]
1940                            ...
1941                        ]
1942                        ...
1943                    ]
1944                    ...
1945                ]
1946                ...
1947            ]
1948        ]
1949    
1950    
1951    This method of tree storage allows the caller to control the order in which the tree nodes
1952    are displayed and to completely control value selection and use of hyperlinks. It is, however
1953    a bit complicated. Eventually, tree-building classes will be provided to simplify things.
1954    
1955    The parameters to this method are as follows.
1956    
1957    =over 4
1958    
1959    =item cgi
1960    
1961    CGI object used to generate the HTML.
1962    
1963    =item tree
1964    
1965    Reference to a hash describing a tree. See the description above.
1966    
1967    =item options
1968    
1969    Hash containing options for the tree display.
1970    
1971    =back
1972    
1973    The allowable options are as follows
1974    
1975    =over 4
1976    
1977    =item nodeImageClosed
1978    
1979    URL of the image to display next to the tree nodes when they are collapsed. Clicking
1980    on the image will expand a section of the tree. The default is C<../FIG/Html/plus.gif>.
1981    
1982    =item nodeImageOpen
1983    
1984    URL of the image to display next to the tree nodes when they are expanded. Clicking
1985    on the image will collapse a section of the tree. The default is C<../FIG/Html/minus.gif>.
1986    
1987    =item style
1988    
1989    Style to use for the tree. The default is C<tree>. Because the tree style is implemented
1990    as nested lists, the key components of this style are the definitions for the C<ul> and
1991    C<li> tags. The default style file contains the following definitions.
1992    
1993        .tree ul {
1994           margin-left: 0; padding-left: 22px
1995        }
1996        .tree li {
1997            list-style-type: none;
1998        }
1999    
2000    The default image is 22 pixels wide, so in the above scheme each tree level is indented from its
2001    parent by the width of the node image. This use of styles limits the things we can do in formatting
2002    the tree, but it has the advantage of vastly simplifying the tree creation.
2003    
2004    =item name
2005    
2006    Field name to give to the radio buttons in the tree. The default is C<selection>.
2007    
2008    =item target
2009    
2010    Frame target for links. The default is C<_self>.
2011    
2012    =item selected
2013    
2014    If specified, the value of the radio button to be pre-selected.
2015    
2016    =back
2017    
2018    =cut
2019    
2020    sub SelectionTree {
2021        # Get the parameters.
2022        my ($cgi, $tree, %options) = @_;
2023        # Get the options.
2024        my $optionThing = Tracer::GetOptions({ name => 'selection',
2025                                               nodeImageClosed => '../FIG/Html/plus.gif',
2026                                               nodeImageOpen => '../FIG/Html/minus.gif',
2027                                               style => 'tree',
2028                                               target => '_self',
2029                                               selected => undef},
2030                                             \%options);
2031        # Declare the return variable. We'll do the standard thing with creating a list
2032        # of HTML lines and rolling them together at the end.
2033        my @retVal = ();
2034        # Only proceed if the tree is present.
2035        if (defined($tree)) {
2036            # Validate the tree.
2037            if (ref $tree ne 'ARRAY') {
2038                Confess("Selection tree is not a list reference.");
2039            } elsif (scalar @{$tree} == 0) {
2040                # The tree is empty, so we do nothing.
2041            } elsif ($tree->[0] eq 'HASH') {
2042                Confess("Hash reference found at start of selection tree. The tree as a whole cannot have attributes, only tree nodes.");
2043            } else {
2044                # Here we have a real tree. Apply the tree style.
2045                push @retVal, $cgi->start_div({ class => $optionThing->{style} });
2046                # Give us a DIV ID.
2047                my $divID = GetDivID($optionThing->{name});
2048                # Show the tree.
2049                push @retVal, ShowBranch($cgi, "(root)", $divID, $tree, $optionThing, 'block');
2050                # Close the DIV block.
2051                push @retVal, $cgi->end_div();
2052            }
2053        }
2054        # Return the result.
2055        return join("\n", @retVal, "");
2056    }
2057    
2058    =head3 ShowBranch
2059    
2060    C<< my @htmlLines = SearchHelper::ShowBranch($cgi, $label, $id, $branch, $options, $displayType); >>
2061    
2062    This is a recursive method that displays a branch of the tree.
2063    
2064    =over 4
2065    
2066    =item cgi
2067    
2068    CGI object used to format HTML.
2069    
2070    =item label
2071    
2072    Label of this tree branch. It is only used in error messages.
2073    
2074    =item id
2075    
2076    ID to be given to this tree branch. The ID is used in the code that expands and collapses
2077    tree nodes.
2078    
2079    =item branch
2080    
2081    Reference to a list containing the content of the tree branch. The list contains an optional
2082    hash reference that is ignored and the list of children, each child represented by a name
2083    and then its contents. The contents could by a hash reference (indicating the attributes
2084    of a leaf node), or another tree branch.
2085    
2086    =item options
2087    
2088    Options from the original call to L</SelectionTree>.
2089    
2090    =item displayType
2091    
2092    C<block> if the contents of this list are to be displayed, C<none> if they are to be
2093    hidden.
2094    
2095    =item RETURN
2096    
2097    Returns one or more HTML lines that can be used to display the tree branch.
2098    
2099    =back
2100    
2101    =cut
2102    
2103    sub ShowBranch {
2104        # Get the parameters.
2105        my ($cgi, $label, $id, $branch, $options, $displayType) = @_;
2106        # Declare the return variable.
2107        my @retVal = ();
2108        # Start the branch.
2109        push @retVal, $cgi->start_ul({ id => $id, style => "display:$displayType" });
2110        # Check for the hash and choose the start location accordingly.
2111        my $i0 = (ref $branch->[0] eq 'HASH' ? 1 : 0);
2112        # Get the list length.
2113        my $i1 = scalar(@{$branch});
2114        # Verify we have an even number of elements.
2115        if (($i1 - $i0) % 2 != 0) {
2116            Trace("Branch elements are from $i0 to $i1.") if T(3);
2117            Confess("Odd number of elements in tree branch $label.");
2118        } else {
2119            # Loop through the elements.
2120            for (my $i = $i0; $i < $i1; $i += 2) {
2121                # Get this node's label and contents.
2122                my ($myLabel, $myContent) = ($branch->[$i], $branch->[$i+1]);
2123                # Get an ID for this node's children (if any).
2124                my $myID = GetDivID($options->{name});
2125                # Now we need to find the list of children and the options hash.
2126                # This is a bit ugly because we allow the shortcut of a hash without an
2127                # enclosing list. First, we need some variables.
2128                my $attrHash = {};
2129                my @childHtml = ();
2130                my $hasChildren = 0;
2131                if (! ref $myContent) {
2132                    Confess("Invalid tree definition. Scalar found as content of node \"$myLabel\".");
2133                } elsif (ref $myContent eq 'HASH') {
2134                    # Here the node is a leaf and its content contains the link/value hash.
2135                    $attrHash = $myContent;
2136                } elsif (ref $myContent eq 'ARRAY') {
2137                    # Here the node may be a branch. Its content is a list.
2138                    my $len = scalar @{$myContent};
2139                    if ($len >= 1) {
2140                        # Here the first element of the list could by the link/value hash.
2141                        if (ref $myContent->[0] eq 'HASH') {
2142                            $attrHash = $myContent->[0];
2143                            # If there's data in the list besides the hash, it's our child list.
2144                            # We can pass the entire thing as the child list, because the hash
2145                            # is ignored.
2146                            if ($len > 1) {
2147                                $hasChildren = 1;
2148                            }
2149                        } else {
2150                            $hasChildren = 1;
2151                        }
2152                        # If we have children, create the child list with a recursive call.
2153                        if ($hasChildren) {
2154                            Trace("Processing children of $myLabel.") if T(4);
2155                            push @childHtml, ShowBranch($cgi, $myLabel, $myID, $myContent, $options, 'none');
2156                        }
2157                    }
2158                }
2159                # Okay, it's time to pause and take stock. We have the label of the current node
2160                # in $myLabel, its attributes in $attrHash, and if it is NOT a leaf node, we
2161                # have a child list in @childHtml. If it IS a leaf node, $hasChildren is 0.
2162                # Compute the image HTML. It's tricky, because we have to deal with the open and
2163                # closed images.
2164                my @images = ($options->{nodeImageOpen}, $options->{nodeImageClosed});
2165                my $image = $images[$hasChildren];
2166                my $prefixHtml = $cgi->img({src => $image, id => "${myID}img"});
2167                if ($hasChildren) {
2168                    # If there are children, we wrap the image in a toggle hyperlink.
2169                    $prefixHtml = $cgi->a({ onClick => "javascript:treeToggle('$myID','$images[0]', '$images[1]')" },
2170                                          $prefixHtml);
2171                }
2172                # Now the radio button, if any. Note we use "defined" in case the user wants the
2173                # value to be 0.
2174                if (defined $attrHash->{value}) {
2175                    # Due to a glitchiness in the CGI stuff, we have to build the attribute
2176                    # hash for the "input" method. If the item is pre-selected, we add
2177                    # "checked => undef" to the hash. Otherwise, we can't have "checked"
2178                    # at all.
2179                    my $radioParms = { type => 'radio',
2180                                       name => $options->{name},
2181                                       value => $attrHash->{value},
2182                                     };
2183                    if (defined $options->{selected} && $options->{selected} eq $attrHash->{value}) {
2184                        $radioParms->{checked} = undef;
2185                    }
2186                    $prefixHtml .= $cgi->input($radioParms);
2187                }
2188                # Next, we format the label.
2189                my $labelHtml = $myLabel;
2190                Trace("Formatting tree node for $myLabel.") if T(4);
2191                # Apply a hyperlink if necessary.
2192                if (defined $attrHash->{link}) {
2193                    $labelHtml = $cgi->a({ href => $attrHash->{link}, target => $options->{target} },
2194                                         $labelHtml);
2195                }
2196                # Finally, roll up the child HTML. If there are no children, we'll get a null string
2197                # here.
2198                my $childHtml = join("\n", @childHtml);
2199                # Now we have all the pieces, so we can put them together.
2200                push @retVal, $cgi->li("$prefixHtml$labelHtml$childHtml");
2201            }
2202        }
2203        # Close the tree branch.
2204        push @retVal, $cgi->end_ul();
2205        # Return the result.
2206        return @retVal;
2207    }
2208    
2209    =head3 GetDivID
2210    
2211    C<< my $idString = SearchHelper::GetDivID($name); >>
2212    
2213    Return a new HTML ID string.
2214    
2215    =over 4
2216    
2217    =item name
2218    
2219    Name to be prefixed to the ID string.
2220    
2221    =item RETURN
2222    
2223    Returns a hopefully-unique ID string.
2224    
2225    =back
2226    
2227    =cut
2228    
2229    sub GetDivID {
2230        # Get the parameters.
2231        my ($name) = @_;
2232        # Compute the ID.
2233        my $retVal = "elt_$name$divCount";
2234        # Increment the counter to make sure this ID is not re-used.
2235        $divCount++;
2236        # Return the result.
2237        return $retVal;
2238  }  }
2239    
2240  =head2 Feature Column Methods  =head2 Feature Column Methods
2241    
2242  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
2243  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
2244  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
2245  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 1692  Line 2257 
2257    
2258  =head3 DefaultFeatureColumns  =head3 DefaultFeatureColumns
2259    
2260  C<< my $colNames = $shelp->DefaultFeatureColumns(); >>  C<< my @colNames = $shelp->DefaultFeatureColumns(); >>
2261    
2262  Return a reference to a list of the default feature column identifiers. These  Return a list of the default feature column identifiers. These identifiers can
2263  identifiers can be passed to L</FeatureColumnTitle> and L</FeatureColumnValue> in  be passed to L</FeatureColumnTitle> and L</FeatureColumnValue> in order to
2264  order to produce the column titles and row values.  produce the column titles and row values.
2265    
2266  =cut  =cut
2267    
# Line 1704  Line 2269 
2269      # Get the parameters.      # Get the parameters.
2270      my ($self) = @_;      my ($self) = @_;
2271      # Return the result.      # Return the result.
2272      return ['orgName', 'function', 'gblink', 'protlink',      return qw(orgName function gblink protlink);
             FeatureQuery::AdditionalColumns($self)];  
2273  }  }
2274    
2275  =head3 FeatureColumnTitle  =head3 FeatureColumnTitle
# Line 1750  Line 2314 
2314      } elsif ($colName =~ /^keyword:(.+)$/) {      } elsif ($colName =~ /^keyword:(.+)$/) {
2315          $retVal = ucfirst $1;          $retVal = ucfirst $1;
2316      } elsif ($colName eq 'orgName') {      } elsif ($colName eq 'orgName') {
2317          $retVal = "Name";          $retVal = "Organism and Gene ID";
2318      } elsif ($colName eq 'protlink') {      } elsif ($colName eq 'protlink') {
2319          $retVal = "NMPDR Protein Page";          $retVal = "NMPDR Protein Page";
2320      } elsif ($colName eq 'subsystem') {      } elsif ($colName eq 'subsystem') {
# Line 1823  Line 2387 
2387          ($retVal) = $record->Value('Feature(assignment)');          ($retVal) = $record->Value('Feature(assignment)');
2388      } elsif ($colName eq 'gblink') {      } elsif ($colName eq 'gblink') {
2389          # 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.
2390          my $gurl = "GetGBrowse.cgi?fid=$fid";          $retVal = FakeButton('GBrowse', "GetGBrowse.cgi", undef,
2391          $retVal = $cgi->a({ href => $gurl, title => "GBrowse for $fid" },                            fid => $fid);
                           $cgi->img({ src => "../images/button-gbrowse.png",  
                                       border => 0 })  
                          );  
2392      } elsif ($colName eq 'group') {      } elsif ($colName eq 'group') {
2393          # Get the NMPDR group name.          # Get the NMPDR group name.
2394          my (undef, $group) = $self->OrganismData($fid);          my (undef, $group) = $self->OrganismData($fid);
# Line 1838  Line 2399 
2399      } elsif ($colName =~ /^keyword:(.+)$/) {      } elsif ($colName =~ /^keyword:(.+)$/) {
2400          # Here we want keyword-related values. This is also expensive, so          # Here we want keyword-related values. This is also expensive, so
2401          # we compute them when the row is displayed.          # we compute them when the row is displayed.
2402          $retVal = "%%colName=$fid";          $retVal = "%%$colName=$fid";
2403      } elsif ($colName eq 'orgName') {      } elsif ($colName eq 'orgName') {
2404          # Here we want the formatted organism name and feature number.          # Here we want the formatted organism name and feature number.
2405          $retVal = $self->FeatureName($fid);          $retVal = $self->FeatureName($fid);
2406      } elsif ($colName eq 'protlink') {      } elsif ($colName eq 'protlink') {
2407          # 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.
2408          my $hurl = HTML::fid_link($cgi, $fid, 0, 1);          $retVal = FakeButton('NMPDR', "protein.cgi", undef,
2409          $retVal = $cgi->a({ href => $hurl, title => "Protein page for $fid" },                            prot => $fid, SPROUT => 1, new_framework => 0,
2410                            $cgi->img({ src => "../images/button-nmpdr.png",                            user => '');
                                      border => 0 })  
                          );  
2411      }elsif ($colName eq 'subsystem') {      }elsif ($colName eq 'subsystem') {
2412          # Another run-time column: subsystem list.          # Another run-time column: subsystem list.
2413          $retVal = "%%subsystem=$fid";          $retVal = "%%subsystem=$fid";
# Line 1890  Line 2449 
2449      # Get the Sprout and CGI objects.      # Get the Sprout and CGI objects.
2450      my $sprout = $self->DB();      my $sprout = $self->DB();
2451      my $cgi = $self->Q();      my $cgi = $self->Q();
2452        Trace("Runtime column $type with text \"$text\" found.") if T(4);
2453      # Separate the text into a type and data.      # Separate the text into a type and data.
2454      if ($type eq 'alias') {      if ($type eq 'alias') {
2455          # Here the caller wants external alias links for a feature. The text          # Here the caller wants external alias links for a feature. The text
# Line 1914  Line 2474 
2474          # Get the subsystems.          # Get the subsystems.
2475          Trace("Generating subsystems for feature $fid.") if T(4);          Trace("Generating subsystems for feature $fid.") if T(4);
2476          my %subs = $sprout->SubsystemsOf($fid);          my %subs = $sprout->SubsystemsOf($fid);
2477          # Convert them to links.          # Extract the subsystem names.
2478          my @links = map { HTML::sub_link($cgi, $_) } sort keys %subs;          my @names = map { HTML::sub_link($cgi, $_) } sort keys %subs;
2479          # String them into a list.          # String them into a list.
2480          $retVal = join(", ", @links);          $retVal = join(", ", @names);
2481      } elsif ($type =~ /^keyword:(.+)$/) {      } elsif ($type =~ /^keyword:(.+)$/) {
2482          # 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
2483          # feature ID.          # feature ID.
# Line 2001  Line 2561 
2561      return ($name, $displayGroup);      return ($name, $displayGroup);
2562  }  }
2563    
2564    =head3 ValidateKeywords
2565    
2566    C<< my $okFlag = $shelp->ValidateKeywords($keywordString, $required); >>
2567    
2568    Insure that a keyword string is reasonably valid. If it is invalid, a message will be
2569    set.
2570    
2571    =over 4
2572    
2573    =item keywordString
2574    
2575    Keyword string specified as a parameter to the current search.
2576    
2577    =item required
2578    
2579    TRUE if there must be at least one keyword specified, else FALSE.
2580    
2581    =item RETURN
2582    
2583    Returns TRUE if the keyword string is valid, else FALSE. Note that a null keyword string
2584    is acceptable if the I<$required> parameter is not specified.
2585    
2586    =back
2587    
2588    =cut
2589    
2590    sub ValidateKeywords {
2591        # Get the parameters.
2592        my ($self, $keywordString, $required) = @_;
2593        # Declare the return variable.
2594        my $retVal = 0;
2595        my @wordList = split /\s+/, $keywordString;
2596        # Right now our only real worry is a list of all minus words. The problem with it is that
2597        # it will return an incorrect result.
2598        my @plusWords = grep { $_ =~ /^[^\-]/ } @wordList;
2599        if (! @wordList) {
2600            if ($required) {
2601                $self->SetMessage("No search words specified.");
2602            } else {
2603                $retVal = 1;
2604            }
2605        } elsif (! @plusWords) {
2606            $self->SetMessage("At least one keyword must be positive. All the keywords entered are preceded by minus signs.");
2607        } else {
2608            $retVal = 1;
2609        }
2610        # Return the result.
2611        return $retVal;
2612    }
2613    
2614    =head3 FakeButton
2615    
2616    C<< my $html = SearchHelper::FakeButton($caption, $url, $target, %parms); >>
2617    
2618    Create a fake button that hyperlinks to the specified URL with the specified parameters.
2619    Unlike a real button, this one won't visibly click, but it will take the user to the
2620    correct place.
2621    
2622    The parameters of this method are deliberately identical to L</Formlet> so that we
2623    can switch easily from real buttons to fake ones in the code.
2624    
2625    =over 4
2626    
2627    =item caption
2628    
2629    Caption to be put on the button.
2630    
2631    =item url
2632    
2633    URL for the target page or script.
2634    
2635    =item target
2636    
2637    Frame or target in which the new page should appear. If C<undef> is specified,
2638    the default target will be used.
2639    
2640    =item parms
2641    
2642    Hash containing the parameter names as keys and the parameter values as values.
2643    These will be appended to the URL.
2644    
2645    =back
2646    
2647    =cut
2648    
2649    sub FakeButton {
2650        # Get the parameters.
2651        my ($caption, $url, $target, %parms) = @_;
2652        # Declare the return variable.
2653        my $retVal;
2654        # Compute the target URL.
2655        my $targetUrl = "$url?" . join(";", map { "$_=" . uri_escape($parms{$_}) } keys %parms);
2656        # Compute the target-frame HTML.
2657        my $targetHtml = ($target ? " target=\"$target\"" : "");
2658        # Assemble the result.
2659        return "<a href=\"$targetUrl\" $targetHtml><div class=\"button2 button\">$caption</div></a>";
2660    }
2661    
2662    =head3 Formlet
2663    
2664    C<< my $html = SearchHelper::Formlet($caption, $url, $target, %parms); >>
2665    
2666    Create a mini-form that posts to the specified URL with the specified parameters. The
2667    parameters will be stored in hidden fields, and the form's only visible control will
2668    be a submit button with the specified caption.
2669    
2670    Note that we don't use B<CGI.pm> services here because they generate forms with extra characters
2671    and tags that we don't want to deal with.
2672    
2673    =over 4
2674    
2675    =item caption
2676    
2677    Caption to be put on the form button.
2678    
2679    =item url
2680    
2681    URL to be put in the form's action parameter.
2682    
2683    =item target
2684    
2685    Frame or target in which the form results should appear. If C<undef> is specified,
2686    the default target will be used.
2687    
2688    =item parms
2689    
2690    Hash containing the parameter names as keys and the parameter values as values.
2691    
2692    =back
2693    
2694    =cut
2695    
2696    sub Formlet {
2697        # Get the parameters.
2698        my ($caption, $url, $target, %parms) = @_;
2699        # Compute the target HTML.
2700        my $targetHtml = ($target ? " target=\"$target\"" : "");
2701        # Start the form.
2702        my $retVal = "<form method=\"POST\" action=\"$url\"$target>";
2703        # Add the parameters.
2704        for my $parm (keys %parms) {
2705            $retVal .= "<input type=\"hidden\" name=\"$parm\" value=\"$parms{$parm}\" />";
2706        }
2707        # Put in the button.
2708        $retVal .= "<input type=\"submit\" name=\"submit\" value=\"$caption\" class=\"button\" />";
2709        # Close the form.
2710        $retVal .= "</form>";
2711        # Return the result.
2712        return $retVal;
2713    }
2714    
2715  =head2 Virtual Methods  =head2 Virtual Methods
2716    
2717  =head3 Form  =head3 Form

Legend:
Removed from v.1.13  
changed lines
  Added in v.1.26

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3