Parent Directory
| 
Revision Log
Revision 1.1 - (view) (download) (as text)
| 1 : | parrello | 1.1 | #!/usr/bin/perl -w |
| 2 : | |||
| 3 : | # | ||
| 4 : | # Copyright (c) 2003-2006 University of Chicago and Fellowship | ||
| 5 : | # for Interpretations of Genomes. All Rights Reserved. | ||
| 6 : | # | ||
| 7 : | # This file is part of the SEED Toolkit. | ||
| 8 : | # | ||
| 9 : | # The SEED Toolkit is free software. You can redistribute | ||
| 10 : | # it and/or modify it under the terms of the SEED Toolkit | ||
| 11 : | # Public License. | ||
| 12 : | # | ||
| 13 : | # You should have received a copy of the SEED Toolkit Public License | ||
| 14 : | # along with this program; if not write to the University of Chicago | ||
| 15 : | # at info@ci.uchicago.edu or the Fellowship for Interpretation of | ||
| 16 : | # Genomes at veronika@thefig.info or download a copy from | ||
| 17 : | # http://www.theseed.org/LICENSE.TXT. | ||
| 18 : | # | ||
| 19 : | |||
| 20 : | package TargetCriterionGeneId; | ||
| 21 : | |||
| 22 : | use strict; | ||
| 23 : | use Tracer; | ||
| 24 : | use Sprout; | ||
| 25 : | use base qw(TargetCriterionQuery); | ||
| 26 : | |||
| 27 : | =head1 GeneId Match Target Search Criterion Object | ||
| 28 : | |||
| 29 : | =head2 Introduction | ||
| 30 : | |||
| 31 : | This is a search criterion object for search criteria involving a search by feature ID. | ||
| 32 : | This is a little different from a normal query-based search because the ID could be a | ||
| 33 : | FIG ID-- which would be in the Feature table-- or an Alias, which would be in the | ||
| 34 : | IsAliasOf table. | ||
| 35 : | |||
| 36 : | =head3 new | ||
| 37 : | |||
| 38 : | my $tc = TargetCriterionGeneId->new($rhelp); | ||
| 39 : | |||
| 40 : | Construct a new TargetCriterionGeneId object. The following parameters are | ||
| 41 : | expected. | ||
| 42 : | |||
| 43 : | =over 4 | ||
| 44 : | |||
| 45 : | =item rhelp | ||
| 46 : | |||
| 47 : | [[ResultHelperPm]] object for the active search. | ||
| 48 : | |||
| 49 : | =item name | ||
| 50 : | |||
| 51 : | Identifying name of this criterion. | ||
| 52 : | |||
| 53 : | =item label | ||
| 54 : | |||
| 55 : | Label to display for this criterion in the type dropdown. | ||
| 56 : | |||
| 57 : | =item hint | ||
| 58 : | |||
| 59 : | The hint tooltip to be displayed for this criterion. | ||
| 60 : | |||
| 61 : | =back | ||
| 62 : | |||
| 63 : | =cut | ||
| 64 : | |||
| 65 : | sub new { | ||
| 66 : | # Get the parameters. | ||
| 67 : | my ($class, $rhelp, $name, $label, $hint) = @_; | ||
| 68 : | # Construct the underlying object. | ||
| 69 : | my $retVal = TargetCriterionQuery::new($class, $rhelp, | ||
| 70 : | { label => $label, hint => $hint, text => 1, | ||
| 71 : | name => $name }, | ||
| 72 : | 'from-link' => qw(Feature IsAliasOf)); | ||
| 73 : | # Return the object. | ||
| 74 : | return $retVal; | ||
| 75 : | } | ||
| 76 : | |||
| 77 : | =head2 Virtual Methods | ||
| 78 : | |||
| 79 : | =head3 Validate | ||
| 80 : | |||
| 81 : | my $okFlag = $tc->Validate($parms); | ||
| 82 : | |||
| 83 : | Return TRUE if the specified parameters are valid for a search criterion of this type | ||
| 84 : | and FALSE otherwise. If an error is detected, the error message can be retrieved using | ||
| 85 : | the L</message> method. | ||
| 86 : | |||
| 87 : | =over 4 | ||
| 88 : | |||
| 89 : | =item parms | ||
| 90 : | |||
| 91 : | A Criterion Parameter Object whose fields are to be validated. | ||
| 92 : | |||
| 93 : | =item RETURN | ||
| 94 : | |||
| 95 : | Returns TRUE if the parameters are valid, else FALSE. | ||
| 96 : | |||
| 97 : | =back | ||
| 98 : | |||
| 99 : | =cut | ||
| 100 : | |||
| 101 : | sub Validate { | ||
| 102 : | # Get the parameters. | ||
| 103 : | my ($self, $parms) = @_; | ||
| 104 : | # Default to valid. | ||
| 105 : | my $retVal = 1; | ||
| 106 : | # Get the string value. | ||
| 107 : | my $value = $parms->{stringValue}; | ||
| 108 : | # It's only invalid if it's blank. | ||
| 109 : | if (! defined $value || $value eq '' || $value =~ /^\s+$/) { | ||
| 110 : | $retVal = 0; | ||
| 111 : | $self->SetMessage("No value specified for $self->{label}."); | ||
| 112 : | } | ||
| 113 : | # Return the validation code. | ||
| 114 : | return $retVal; | ||
| 115 : | } | ||
| 116 : | |||
| 117 : | =head3 GetValueData | ||
| 118 : | |||
| 119 : | my $value = $tc->GetValueData($feature); | ||
| 120 : | |||
| 121 : | Return the value data from the specified feature that is relevant to this | ||
| 122 : | criterion. This method is called when the object cache is empty and the | ||
| 123 : | value is needed in order to call L</PutExtraColumns> or L</CheckValue>. | ||
| 124 : | |||
| 125 : | =over 4 | ||
| 126 : | |||
| 127 : | =item feature | ||
| 128 : | |||
| 129 : | An [[ERDBObjectPm]] describing the current feature. | ||
| 130 : | |||
| 131 : | =item RETURN | ||
| 132 : | |||
| 133 : | Returns a scalar containing the value used to determine whether or not the specified | ||
| 134 : | feature will match a criterion of this type. The object can be a list reference, a hash | ||
| 135 : | reference, or a blessed object, so long as the virtual L</PutExtraColumns> and | ||
| 136 : | L</CheckValue> methods understand it. | ||
| 137 : | |||
| 138 : | =back | ||
| 139 : | |||
| 140 : | =cut | ||
| 141 : | |||
| 142 : | sub GetValueData { | ||
| 143 : | # Get the parameters. | ||
| 144 : | my ($self, $feature) = @_; | ||
| 145 : | # Get the feature ID. | ||
| 146 : | my $fid = $feature->PrimaryValue("Feature(id)"); | ||
| 147 : | # Get the aliases from the database. | ||
| 148 : | my $sprout = $self->DB(); | ||
| 149 : | my @aliases = $sprout->FeatureAliases($fid); | ||
| 150 : | # Put them together. | ||
| 151 : | my $retVal = [ $fid, @aliases ]; | ||
| 152 : | # Return the result. | ||
| 153 : | return $retVal; | ||
| 154 : | } | ||
| 155 : | |||
| 156 : | =head3 ComputeQuery | ||
| 157 : | |||
| 158 : | my ($joins, $filterString, $parms) = $tc->ComputeQuery($criterion); | ||
| 159 : | |||
| 160 : | Compute the SQL filter, join list, and parameter list for this | ||
| 161 : | criterion. If the criterion cannot be processed by SQL, then nothing is | ||
| 162 : | returned, and the criterion must be handled during post-processing. | ||
| 163 : | |||
| 164 : | The join list and the parameter list should both be list references. The | ||
| 165 : | filter string is a true string. | ||
| 166 : | |||
| 167 : | If the filter string only uses the B<Genome> and B<Feature> tables, then the | ||
| 168 : | join list can be left empty. Otherwise, the join list should start with the | ||
| 169 : | particular starting point (B<Genome> or B<Feature>) and list the path through | ||
| 170 : | the other relevant entities and relationships. Each criterion will have its | ||
| 171 : | own separate join path. | ||
| 172 : | |||
| 173 : | =over 4 | ||
| 174 : | |||
| 175 : | =item criterion | ||
| 176 : | |||
| 177 : | Reference to a Criterion Parameter Object. | ||
| 178 : | |||
| 179 : | =item RETURN | ||
| 180 : | |||
| 181 : | Returns a 3-tuple consisting of the join list, the relevant filter string, | ||
| 182 : | and the matching parameters. If the criterion cannot be processed using | ||
| 183 : | SQL, then the return list contains three undefined values. (This is what happens if | ||
| 184 : | you don't override this method.) | ||
| 185 : | |||
| 186 : | =back | ||
| 187 : | |||
| 188 : | =cut | ||
| 189 : | |||
| 190 : | sub ComputeQuery { | ||
| 191 : | # Get the parameters. | ||
| 192 : | my ($self, $criterion) = @_; | ||
| 193 : | # Get the parameter value. | ||
| 194 : | my $parm = $criterion->{stringValue}; | ||
| 195 : | # Declare the join and filter variables. | ||
| 196 : | my ($joins, $filterString); | ||
| 197 : | # Is this a FIG ID? | ||
| 198 : | if ($parm =~ /^fig/) { | ||
| 199 : | # Yes, so use the feature ID. | ||
| 200 : | $joins = []; | ||
| 201 : | $filterString = "Feature(id) = ?"; | ||
| 202 : | } else { | ||
| 203 : | # No, so use the alias join. | ||
| 204 : | $joins = [qw(Feature IsAliasOf)]; | ||
| 205 : | $filterString = 'IsAliasOf(from-link) = ?'; | ||
| 206 : | } | ||
| 207 : | # Return the results. | ||
| 208 : | return ($joins, $filterString, [$parm]); | ||
| 209 : | } | ||
| 210 : | |||
| 211 : | =head3 AddExtraColumns | ||
| 212 : | |||
| 213 : | my $flag = $tc->AddExtraColumns($rhelp); | ||
| 214 : | |||
| 215 : | Add any extra columns relevant to this criterion to the result helper. | ||
| 216 : | If the data used to evaluate this criterion is not shown in the | ||
| 217 : | default feature columns, then this method will call the B<AddExtraColumn> | ||
| 218 : | method of the caller-specified [[ResultHelperPm]] object to reserve space | ||
| 219 : | for the data in the result file. The default is to not add any extra columns. | ||
| 220 : | |||
| 221 : | =over 4 | ||
| 222 : | |||
| 223 : | =item rhelp | ||
| 224 : | |||
| 225 : | Result helper to which the columns should be added. | ||
| 226 : | |||
| 227 : | =item RETURN | ||
| 228 : | |||
| 229 : | Returns TRUE if this criterion requires extra columns in the output, else FALSE. | ||
| 230 : | |||
| 231 : | =back | ||
| 232 : | |||
| 233 : | =cut | ||
| 234 : | |||
| 235 : | sub AddExtraColumns { | ||
| 236 : | # Get the parameters. | ||
| 237 : | my ($self, $rhelp) = @_; | ||
| 238 : | # We don't need extra columns for this. Instead, we add the optional | ||
| 239 : | # alias column at the end. | ||
| 240 : | $rhelp->AddOptionalColumn('alias'); | ||
| 241 : | # Denote there are no extra columns. | ||
| 242 : | return 0; | ||
| 243 : | } | ||
| 244 : | |||
| 245 : | =head3 CheckValue | ||
| 246 : | |||
| 247 : | my $match = $tc->CheckValue($criterion, $valueData); | ||
| 248 : | |||
| 249 : | Return TRUE if the current feature matches this criterion, else FALSE. | ||
| 250 : | |||
| 251 : | =over 4 | ||
| 252 : | |||
| 253 : | =item criterion | ||
| 254 : | |||
| 255 : | Criterion Parameter object describing this criterion's parameters. | ||
| 256 : | |||
| 257 : | =item valueData | ||
| 258 : | |||
| 259 : | Value computed for the current feature by the L</GetValueData> method. | ||
| 260 : | |||
| 261 : | =item RETURN | ||
| 262 : | |||
| 263 : | Returns TRUE if the current feature matches the criterion, else FALSE. | ||
| 264 : | |||
| 265 : | =back | ||
| 266 : | |||
| 267 : | =cut | ||
| 268 : | |||
| 269 : | sub CheckValue { | ||
| 270 : | # Get the parameters. | ||
| 271 : | my ($self, $criterion, $valueData) = @_; | ||
| 272 : | # Get the desired gene ID. | ||
| 273 : | my $geneID = $criterion->{stringValue}; | ||
| 274 : | # Declare the return variable. | ||
| 275 : | my $retVal; | ||
| 276 : | # If it's a FIG ID, we only need to check the first thing in the list. | ||
| 277 : | if ($geneID =~ /^fig/) { | ||
| 278 : | $retVal = ($geneID eq $valueData->[0]); | ||
| 279 : | } else { | ||
| 280 : | # It's an alias, so check the whole list for a match. | ||
| 281 : | $retVal = grep { $_ eq $geneID } @$valueData; | ||
| 282 : | } | ||
| 283 : | # Return the result. | ||
| 284 : | return $retVal; | ||
| 285 : | } | ||
| 286 : | |||
| 287 : | 1; |
| MCS Webmaster | ViewVC Help |
| Powered by ViewVC 1.0.3 |