[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.29, Sat Apr 14 21:41:25 2007 UTC revision 1.31, Fri May 11 06:28:21 2007 UTC
# Line 90  Line 90 
90    
91  =item extraPos  =item extraPos
92    
93  C<0> if the extra columns are to be at the beginning, else C<1>. The  Hash indicating which extra columns should be put at the end. Extra columns
94  default is zero; use the L</SetExtraPos> method to change this option.  not mentioned in this hash are put at the beginning. Use the L</SetExtraPos>
95    method to change this option.
96    
97  =back  =back
98    
# Line 325  Line 326 
326                    genomeList => undef,                    genomeList => undef,
327                    genomeParms => [],                    genomeParms => [],
328                    filtered => 0,                    filtered => 0,
329                    extraPos => 0,                    extraPos => {},
330                   };                   };
331      # Bless and return it.      # Bless and return it.
332      bless $retVal, $class;      bless $retVal, $class;
# Line 388  Line 389 
389    
390  =head3 SetExtraPos  =head3 SetExtraPos
391    
392  C<< $shelp->SetExtraPos($newValue); >>  C<< $shelp->SetExtraPos(@columnMap); >>
393    
394  Indicate whether the extra columns should be in the front (C<0>) or end (C<1>) columns of the results.  Indicate whether the extra columns should be in the front (C<0>) or end (C<1>) columns of the results.
395    
396  =over 4  =over 4
397    
398  =item newValue  =item columnMap
399    
400  C<1> if the extra columns should be displayed at the end, else C<0>.  A list of extra columns to display at the end.
401    
402  =back  =back
403    
404  =cut  =cut
405    
406  sub SetExtraPos {  sub SetExtraPos {
407      my ($self, $newValue) = @_;      # Get the parameters.
408      $self->{extraPos} = $newValue;      my ($self, @columnMap) = @_;
409        # Convert the column map to a hash.
410        my %map = map { $_ => 1 } @columnMap;
411        # Save a reference to it.
412        $self->{extraPos} = \%map;
413  }  }
414    
415  =head3 ID  =head3 ID
# Line 712  Line 717 
717          # Tell the user what's happening.          # Tell the user what's happening.
718          $self->PrintLine("Creating output columns.<br />");          $self->PrintLine("Creating output columns.<br />");
719          # Here we need to set up the column information. First we accumulate the extras,          # Here we need to set up the column information. First we accumulate the extras,
720          # sorted by column name.          # sorted by column name and separate by whether they go in the beginning or the
721          my @xtraNames = ();          # end.
722            my @xtraNamesFront = ();
723            my @xtraNamesEnd = ();
724            my $xtraPosMap = $self->{extraPos};
725          for my $col (sort keys %{$extraCols}) {          for my $col (sort keys %{$extraCols}) {
726              push @xtraNames, "X=$col";              if ($xtraPosMap->{$col}) {
727                    push @xtraNamesEnd, "X=$col";
728                } else {
729                    push @xtraNamesFront, "X=$col";
730                }
731          }          }
732          # Set up the column name array.          # Set up the column name array.
733          my @colNames = ();          my @colNames = ();
734          # If extras go at the beginning, put them in first.          # Put in the extra columns that go in the beginning.
735          if (! $self->{extraPos}) {          push @colNames, @xtraNamesFront;
             push @colNames, @xtraNames;  
         }  
736          # Add the default columns.          # Add the default columns.
737          push @colNames, $self->DefaultFeatureColumns();          push @colNames, $self->DefaultFeatureColumns();
738          # Add any additional columns requested by the feature filter.          # Add any additional columns requested by the feature filter.
739          push @colNames, FeatureQuery::AdditionalColumns($self);          push @colNames, FeatureQuery::AdditionalColumns($self);
740          # If extras go at the end, put them in here.          # If extras go at the end, put them in here.
741          if ($self->{extraPos}) {          push @colNames, @xtraNamesEnd;
             push @colNames, @xtraNames;  
         }  
742          Trace("Full column list determined.") if T(3);          Trace("Full column list determined.") if T(3);
743          # Save the full list.          # Save the full list.
744          $self->{cols} = \@colNames;          $self->{cols} = \@colNames;
# Line 1955  Line 1963 
1963    
1964  sub AdvancedClassList {  sub AdvancedClassList {
1965      my @retVal = map { $_ =~ /^SH(\w+)\.pm/; $1 } grep { $_ =~ /^SH/ } keys %INC;      my @retVal = map { $_ =~ /^SH(\w+)\.pm/; $1 } grep { $_ =~ /^SH/ } keys %INC;
1966      return @retVal;      return sort @retVal;
1967  }  }
1968    
1969  =head3 SelectionTree  =head3 SelectionTree
# Line 2330  Line 2338 
2338      return $retVal;      return $retVal;
2339  }  }
2340    
2341    
2342    =head3 PrintLine
2343    
2344    C<< $shelp->PrintLine($message); >>
2345    
2346    Print a line of CGI output. This is used during the operation of the B<Find> method while
2347    searching, so the user sees progress in real-time.
2348    
2349    =over 4
2350    
2351    =item message
2352    
2353    HTML text to display.
2354    
2355    =back
2356    
2357    =cut
2358    
2359    sub PrintLine {
2360        # Get the parameters.
2361        my ($self, $message) = @_;
2362        # Send them to the output.
2363        print "$message\n";
2364    }
2365    
2366  =head2 Feature Column Methods  =head2 Feature Column Methods
2367    
2368  The methods in this section 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
# Line 2420  Line 2453 
2453          $retVal = "Annotation Page";          $retVal = "Annotation Page";
2454      } elsif ($colName eq 'subsystem') {      } elsif ($colName eq 'subsystem') {
2455          $retVal = "Subsystems";          $retVal = "Subsystems";
2456        } elsif ($colName eq 'pdb') {
2457            $retVal = "Best PDB Match";
2458      }      }
2459      # Return the result.      # Return the result.
2460      return $retVal;      return $retVal;
# Line 2548  Line 2583 
2583      } elsif ($colName eq 'subsystem') {      } elsif ($colName eq 'subsystem') {
2584          # Another run-time column: subsystem list.          # Another run-time column: subsystem list.
2585          $retVal = "%%subsystem=$fid";          $retVal = "%%subsystem=$fid";
2586        } elsif ($colName eq 'pdb') {
2587            $retVal = "%%pdb=$fid";
2588      }      }
2589      # Return the result.      # Return the result.
2590      return $retVal;      return $retVal;
# Line 2639  Line 2676 
2676                                        "Feature($keywordName)");                                        "Feature($keywordName)");
2677          # String them into a list.          # String them into a list.
2678          $retVal = join(", ", @values);          $retVal = join(", ", @values);
2679        } elsif ($type eq 'pdb') {
2680            # Here the caller wants the best PDB match to this feature. The text
2681            # is the feature ID. We will display the PDB with a link to the
2682            # PDB page along with the match score. If there are docking results we
2683            # will display a link to the docking result search.
2684            my $fid = $text;
2685            # Ask for the best PDB.
2686            my ($bestPDB) = $sprout->GetAll(['IsProteinForFeature', 'PDB'],
2687                                            "IsProteinForFeature(from-link) = ? ORDER BY IsProteinForFeature(score) LIMIT 1",
2688                                            [$fid], ['PDB(id)', 'PDB(docking-count)', 'IsProteinForFeature(score)']);
2689            # Only proceed if there is a PDB.
2690            if ($bestPDB) {
2691                my ($pdbID, $dockingCount, $score) = @{$bestPDB};
2692                # Convert the PDB ID to a hyperlink.
2693                my $pdbLink = SHDrugSearch::PDBLink($cgi, $pdbID);
2694                # Append the score.
2695                $retVal = "$pdbLink ($score)";
2696                # If there are docking results, append a docking results link.
2697                if ($dockingCount > 0) {
2698                    my $dockString = "$dockingCount docking results";
2699                    my $dockLink = $cgi->a({ href =>  $cgi->url() . "?Class=DrugSearch;PDB=$pdbID;NoForm=1",
2700                                             alt =>   "View computed docking results for $pdbID",
2701                                             title => "View computed docking results for $pdbID",
2702                                             target => "_blank"},
2703                                           $dockString);
2704                }
2705            }
2706      }      }
2707      # Return the result.      # Return the result.
2708      return $retVal;      return $retVal;
# Line 2862  Line 2926 
2926      return $retVal;      return $retVal;
2927  }  }
2928    
2929    =head3 TuningParameters
2930    
2931    C<< my $options = $shelp->TuningParameters(%parmHash); >>
2932    
2933    Retrieve tuning parameters from the CGI query object. The parameter is a hash that maps parameter names
2934    to their default values. The parameters and their values will be returned as a hash reference.
2935    
2936    =over 4
2937    
2938    =item parmHash
2939    
2940    Hash mapping parameter names to their default values.
2941    
2942    =item RETURN
2943    
2944    Returns a reference to a hash containing the parameter names mapped to their actual values.
2945    
2946    =back
2947    
2948    =cut
2949    
2950    sub TuningParameters {
2951        # Get the parameters.
2952        my ($self, %parmHash) = @_;
2953        # Declare the return variable.
2954        my $retVal = {};
2955        # Get the CGI Query Object.
2956        my $cgi = $self->Q();
2957        # Loop through the parameter names.
2958        for my $parm (keys %parmHash) {
2959            # Get the incoming value for this parameter.
2960            my $value = $cgi->param($parm);
2961            # Zero might be a valid value, so we do an is-defined check rather than an OR.
2962            if (defined($value)) {
2963                $retVal->{$parm} = $value;
2964            } else {
2965                $retVal->{$parm} = $parmHash{$parm};
2966            }
2967        }
2968        # Return the result.
2969        return $retVal;
2970    }
2971    
2972  =head2 Virtual Methods  =head2 Virtual Methods
2973    
2974  =head3 Form  =head3 Form
# Line 2925  Line 3032 
3032      return $retVal;      return $retVal;
3033  }  }
3034    
3035  =head3 PrintLine  =head3 SearchTitle
3036    
3037  C<< $shelp->PrintLine($message); >>  C<< my $titleHtml = $shelp->SearchTitle(); >>
3038    
3039  Print a line of CGI output. This is used during the operation of the B<Find> method while  Return the display title for this search. The display title appears above the search results.
3040  searching, so the user sees progress in real-time.  If no result is returned, no title will be displayed. The result should be an html string
3041    that can be legally put inside a block tag such as C<h3> or C<p>.
3042    
3043    =cut
3044    
3045    sub SearchTitle {
3046        # Get the parameters.
3047        my ($self) = @_;
3048        # Declare the return variable.
3049        my $retVal;
3050        # Return it.
3051        return $retVal;
3052    }
3053    
3054    =head3 DownloadFormatAvailable
3055    
3056    C<< my $okFlag = $shelp->DownloadFormatAvailable($format); >>
3057    
3058    This method returns TRUE if a specified download format is legal for this type of search
3059    and FALSE otherwise. For any feature-based search, there is no need to override this
3060    method.
3061    
3062  =over 4  =over 4
3063    
3064  =item message  =item format
3065    
3066  HTML text to display.  Download format type code.
3067    
3068    =item RETURN
3069    
3070    Returns TRUE if the download format is legal for this search and FALSE otherwise.
3071    
3072  =back  =back
3073    
3074  =cut  =cut
3075    
3076  sub PrintLine {  sub DownloadFormatAvailable {
3077      # Get the parameters.      # Get the parameters.
3078      my ($self, $message) = @_;      my ($self, $format) = @_;
3079      # Send them to the output.      # Declare the return variable.
3080      print "$message\n";      my $retVal = 1;
3081        # Return the result.
3082        return $retVal;
3083  }  }
3084    
   
3085  1;  1;

Legend:
Removed from v.1.29  
changed lines
  Added in v.1.31

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3