[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.17, Wed Nov 15 22:34:50 2006 UTC revision 1.19, Mon Nov 20 05:54:09 2006 UTC
# Line 257  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 267  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 290  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 454  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 947  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 991  Line 993 
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 1021  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 1037  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 1367  Line 1357 
1357          # the search box. This allows the user to type text and have all genomes containing          # the search box. This allows the user to type text and have all genomes containing
1358          # the text selected automatically.          # the text selected automatically.
1359          my $searchThingName = "${menuName}_SearchThing";          my $searchThingName = "${menuName}_SearchThing";
1360          push @lines, "<br>Select genomes containing <INPUT type=\"text\" name=\"$searchThingName\" " .          push @lines, "<br />" .
1361                       "size=\"30\" onBlur=\"selectViaSearch($menuName, $searchThingName); $showSelect\" />";                       "<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.          # Next are the buttons to set and clear selections.
1364          push @lines, "<br />";          push @lines, "<br />";
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\" />";
# Line 1493  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 1519  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 1613  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 1706  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 1716  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 1761  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 2198  Line 2228 
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 2346  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 2367  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 2438  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 2573  Line 2598 
2598      return $retVal;      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.17  
changed lines
  Added in v.1.19

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3