[Bio] / Sprout / FeatureData.pm Repository:
ViewVC logotype

View of /Sprout/FeatureData.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (download) (as text) (annotate)
Mon Jul 16 20:06:30 2007 UTC (12 years, 8 months ago) by parrello
Branch: MAIN
CVS Tags: HEAD
Changes since 1.4: +0 -0 lines
FILE REMOVED
Obsolete modules, replaced by RHFeatures and SHToolSearch.

#!/usr/bin/perl -w

package FeatureData;

    use strict;
    use Tracer;

=head1 Search Helper Feature Data Object

=head2 Introduction

This is the base class for objects used by the search helpers that store feature
data. For ordinary feature handling this method is adequate; however, if the features
are to be returned via a filtered query, the B<FeatureQuery> class is better.

=over 4

=item shelp

Parent search helper object.

=item sprout

Sprout object for accessing the database.

=item extraCols

Recommended extra columns to use for C<PutFeature>.

=item featureData

C<ERDBObject> for the current feature.

=back

=head2 Public Methods

=head3 new

C<< my $fdata = FeatureData->new($shelp); >>

Construct a new FeatureData object for a specified search helper.

=over 4

=item shelp

Search helper being serviced by this feature data object.

=back

=cut

sub new {
    # Get the parameters.
    my ($class, $shelp) = @_;
    # Create the $fdata object.
    my $retVal = {
                  shelp => $shelp,
                  sprout => $shelp->DB(),
                  extraCols => {},
                  featureData => undef,
                 };
    # Bless and return it.
    bless $retVal, $class;
    return $retVal;
}

=head3 FID

C<< my $fid = $fdata->FID(); >>

Return the ID of the current feature.

=cut

sub FID {
    # Get the parameters.
    my ($self) = @_;
    # Get the feature ID.
    my ($retVal) = $self->{featureData}->Value('Feature(id)');
    # Return it.
    return $retVal;
}

=head3 ExtraCols

C<< my $extraCols = $fdata->ExtraCols(); >>

Return the extra column hash for the current feature. The hash is returned as
a reference.

=cut

sub ExtraCols {
    # Get the parameters.
    my ($self) = @_;
    # Return the result.
    return $self->{extraCols};
}

=head3 Feature

C<< my $featureData = $fdata->Feature(); >>

Return the current feature data. The feature data is returned as a
B<ERDBObject>.

=cut

sub Feature {
    # Get the parameters.
    my ($self) = @_;
    # Return the result.
    return $self->{featureData};
}

=head3 AddExtraColumns

C<< $fdata->AddExtraColumns(%nameValuePairs); >>

Add extra columns to the extra column cache. Extra columns appear in the
search results output. The pairs can be coded in hash notation.

    $fdata->AddExtraColumns(evidence => $evidenceCode, score => $sc);

=over 4

=item nameValuePairs

A hash mapping extra column names to extra column values. The names
should be suitable for column headings and the values must be
fully-formatted HTML.

=back

=cut

sub AddExtraColumns {
    # Get the parameters.
    my ($self, %nameValuePairs) = @_;
    # Loop through the pairs.
    for my $name (keys %nameValuePairs) {
        $self->{extraCols}->{$name} = $nameValuePairs{$name};
    }
}

=head3 GetExtraColumn

C<< my $value = $fdata->GetExtraColumn($colName); >>

Return the value of the named extra column. The extra column should have been created
by a preceding call to L</AddExtraColumns>. If not, then the column value will be an
empty string.

=over 4

=item colName

Name of the desired extra column.

=item RETURN

Returns the value of the named column as taken from the extra columns hash, or
a null string if the column is not present.

=back

=cut

sub GetExtraColumn {
    # Get the parameters.
    my ($self, $colName) = @_;
    # Declare the return variable.
    my $retVal = "";
    # Get the extra columns hash.
    my $extraCols = $self->ExtraCols();
    # We must be careful here that we don't accidentally create new columns.
    if (exists $extraCols->{$colName}) {
        $retVal = $extraCols->{$colName};
    }
    # Return the result.
    return $retVal;
}

=head3 Helper

C<< my $shelp = $fdata->Helper(); >>

Return this feature data object's parent search helper.

=cut

sub Helper {
    # Get the parameters.
    my ($self) = @_;
    # Return the result.
    return $self->{shelp};
}

=head3 DB

C<< my $sprout = $fdata->DB(); >>

Return the Sprout datbase relevant to this feature data object.

=cut

sub DB {
    # Get the parameters.
    my ($self) = @_;
    # Return the result.
    return $self->{sprout};
}

=head3 Store

C<< $fdata->Store($record); >>

Store a feature in this feature data object.

=over 4

=item record

A B<ERDBObject> containing the feature data.

=back

=cut

sub Store {
    # Get the parameters.
    my ($self, $record) = @_;
    Trace("New feature stored.") if T(4);
    # Store the feature.
    $self->{featureData} = $record;
    # Clear the extra-columns list.
    $self->{extraCols} = {};
}

=head3 SortKey

C<< my $key = $fquery->SortKey($shelp, $group); >>

Return the sort key for the current feature. The sort key floats NMPDR
organisms to the top. If a keyword search is in progress, then the search
relevance will be in the feature record, and this becomes the second
criterion. Finally, the NMPDR group name is used.

=over 4

=item shelp

Current search helper object.

=item group

Name of the NMPDR group containing this feature.

=item RETURN

Returns a string that can be used to sort the specified feature into the
correct position.

=back

=cut

sub SortKey {
    # Get the parameters.
    my ($self, $shelp, $group) = @_;
    # Get the feature record.
    my $record = $self->Feature();
    # Our first objective is to float NMPDR organisms to the top.
    my $retVal = ($group ? "A" : "Z");
    # Append the search relevance, if any.
    if ($record->HasField("Feature(search-relevance)")) {
        my ($relevance) = $record->Value('Feature(search-relevance)');
        # We must do some padding here because the relevance is a
        # floating-point number and we're doing a character sort.
        my ($r1, $r2);
        if ($relevance =~ /(\d+)\.(\d+)/) {
            ($r1, $r2) = ($1, $2)
        } else {
            ($r1, $r2) = ($relevance, "0");
        }
        $r1 = " $r1" until (length $r1 >= 5);
        $r2 .= "0"   until (length $r2 >= 10);
        # Append the relevance.
        $retVal .= "$r1.$r2=";
    }
    # Now tack on the group name. This means we sort by NMPDR group on NMPDR
    # features of equal relevance. (Of course, if there's no keyword search
    # active, everything has equal relevance.)
    $retVal .= $group;
    Trace("Sort key is \"$retVal\".") if T(4);
    # Return the result.
    return $retVal;
}

1;


MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3