[Bio] / FigKernelPackages / SUP.pm Repository:
ViewVC logotype

View of /FigKernelPackages/SUP.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (download) (as text) (annotate)
Tue Nov 16 19:24:13 2010 UTC (9 years, 3 months ago) by parrello
Branch: MAIN
CVS Tags: mgrast_dev_08112011, mgrast_dev_08022011, myrast_rel40, mgrast_dev_05262011, mgrast_dev_04082011, mgrast_dev_06072011, mgrast_dev_02212011, rast_rel_2010_1206, mgrast_release_3_0, mgrast_dev_03252011, rast_rel_2011_0119, mgrast_release_3_0_4, mgrast_release_3_0_2, mgrast_release_3_0_3, mgrast_release_3_0_1, mgrast_dev_03312011, mgrast_release_3_1_1, mgrast_release_3_1_0, mgrast_dev_04132011, mgrast_dev_04012011, myrast_33, rast_rel_2011_0928, mgrast_dev_04052011, mgrast_dev_02222011, mgrast_dev_10262011
Changes since 1.1: +300 -0 lines
New methods for alignment data.

#
# Copyright (c) 2003-2006 University of Chicago and Fellowship
# for Interpretations of Genomes. All Rights Reserved.
#
# This file is part of the SEED Toolkit.
#
# The SEED Toolkit is free software. You can redistribute
# it and/or modify it under the terms of the SEED Toolkit
# Public License.
#
# You should have received a copy of the SEED Toolkit Public License
# along with this program; if not write to the University of Chicago
# at info@ci.uchicago.edu or the Fellowship for Interpretation of
# Genomes at veronika@thefig.info or download a copy from
# http://www.theseed.org/LICENSE.TXT.
#
package SUP;

    use strict;
    use ERDB;
    use Tracer;
    use SeedUtils;
    use ServerThing;

=head1 Sapling Update Server Function Object

This file contains the functions and utilities used by the Sapling Update Server
(B<sup_server.cgi>). The various methods listed in the sections below represent
function calls direct to the server. These all have a signature similar to the
following.

    my $results = $supObject->function_name($args);

where C<$supObject> is an object created by this module, 
C<$args> is a parameter structure, and C<function_name> is the Sapling
Server function name. The output $results is a scalar, generally a success
indication of some type.

=head2 Constructor

Use

    my $supObject = SUPserver->new();

to create a new sapling server function object. The server function object
is used to invoke the L</Primary Methods> listed below. See L<SUPserver> for
more information on how to create this object and the options available.

=cut

#   
# Actually, if you are using SUP.pm, you should do SUP->new(), not SUPserver->new()
# That comment above is for the benefit of the pod doc stuff on how to use SAPserver 
# that is generated from this file.
#

sub new {
    my ($class) = @_;
    # Create the sapling object.
    my $sap = ERDB::GetDatabase('Sapling');
    # Create the server object.
    my $retVal = { db => $sap };
    # Bless and return it.
    bless $retVal, $class;
    return $retVal;
}

=head3 methods

    my $methodList =        $supObject->methods();

Return a reference to a list of the methods allowed on this object.

=cut

use constant METHODS => [qw(
                         insert_objects
                         insert_project
                         insert_alignment
                         insert_alignment_tree
                         update_entity
                         delete
                         disconnect
                        )];

sub methods {
    # Get the parameters.
    my ($self) = @_;
    # Return the result.
    return METHODS;
}

=head1 Primary Methods

=head2 General Updates

=head3 insert_objects

    my $successFlag =   $supObjects->insert_objects({
                            -type => $objectType,
                            -maps => [
                                { $fld1a => $value1a, $fld1b => $value1b, ... },
                                { $fld2a => $value2a, $fld2b => $value2b, ... },
                                ...
                            ]
                        });

Insert one or more objects of a specific entity or relationship type into the database.

=over 4

=item parameter

The parameter should be a reference to a hash with the following keys.

=over 8

=item -type

The entity or relationship type for the objects to be inserted.

=item -maps

Reference to a list of hashes. Each hash maps field names to values for a single object
to be inserted.

=back

=item RETURN

Returns the number of objects successfully inserted.

=back

=cut

sub insert_objects {
    # Get the parameters.
    my ($self, $args) = @_;
    # Get the Sapling database.
    my $sap = $self->{db};
    # Get the object type.
    my $type = $args->{-type};
    # Get the list of hash maps.
    my $mapList = ServerThing::GetIdList(-maps => $args);
    # We'll count the inserts in here.
    my $retVal = 0;
    # Loop through the maps, inserting.
    for my $map (@$mapList) {
        # Insert the record for this map.
        $sap->InsertObject($type, %$map);
        # Count it.
        $retVal++;
    }
    # Return the insertion count.
    return $retVal;
}


=head3 update_entity

    my $successFlag =   $supObjects->update_entity({
                            -type => $entityType,
                            -updates => {
                                $id1 => { $fld1a => $value1a, $fld1b => $value1b, ... },
                                $id2 => { $fld2a => $value2a, $fld2b => $value2b, ... },
                                ...
                            ]
                        });

Update one or more objects of a specific entity type.

=over 4

=item parameter

The parameter should be a reference to a hash with the following keys.

=over 8

=item -type

The entity type for the objects to be updated.

=item -maps

Reference to a hash of hashes. The main hash Each hash maps field names to values for a single object
to be inserted.

=back

=item RETURN

Returns the number of objects successfully inserted.

=back

=cut

sub update_entity {
    # Get the parameters.
    my ($self, $args) = @_;
    # Get the Sapling database.
    my $sap = $self->{db};
    # Get the object type.
    my $type = $args->{-type};
    # Get the list of hash maps.
    my $mapHash = $args->{-updates};
    Confess("Invalid hash map passed to update_entity.") if ref $mapHash ne 'HASH';
    # We'll count the updates in here.
    my $retVal = 0;
    # Loop through the maps, inserting.
    for my $id (keys %$mapHash) {
        # Update the record for this map.
        $sap->UpdateEntity($type, $id, %{$mapHash->{$id}});
        # Count it.
        $retVal++;
    }
    # Return the insertion count.
    return $retVal;
}


=head3 delete

    my $successFlag =   $supObjects->delete({
                            -type => $entityType,
                            -ids => [$id1, $id2, ...]
                        });

Delete one or more entities and their dependent records.

=over 4

=item parameter

The parameter should be a reference to a hash with the following keys.

=over 8

=item -type

The entity type for the objects to be deleted.

=item -ids

Reference to a list of the IDs for the objects to delete.

=back

=item RETURN

Returns the number of successful deletions.

=back

=cut

sub delete {
    # Get the parameters.
    my ($self, $args) = @_;
    # Get the Sapling database.
    my $sap = $self->{db};
    # Get the object type.
    my $type = $args->{-type};
    # Get the list of hash maps.
    my $ids = ServerThing::GetIdList(-ids => $args);
    # We'll count the deletes in here.
    my $retVal = 0;
    # Loop through the ids, deleting.
    for my $id (@$ids) {
        # Delete this record.
        $sap->Delete($type, $id);
        # Count it.
        $retVal++;
    }
    # Return the insertion count.
    return $retVal;
}


=head3 disconnect

    my $successFlag =   $supObjects->disconnect({
                            -type => $relationshipType,
                            -pairs => [[$from1, $to1], [$from2, $to2], ...]
                        });

Disconnect one or more relationships. 

=over 4

=item parameter

The parameter should be a reference to a hash with the following keys.

=over 8

=item -type

The entity type for the objects to be deleted.

=item -pairs

Reference to a list of ID pairs. Each contains a from-link and a to-link for a relationship
to disconnect.

=back

=item RETURN

Returns the number of successful disconnects.

=back

=cut

sub disconnect {
    # Get the parameters.
    my ($self, $args) = @_;
    # Get the Sapling database.
    my $sap = $self->{db};
    # Get the object type.
    my $type = $args->{-type};
    # Get the list of ID pairs.
    my $ids = $args->{-pairs};
    Confess("Invalid ID pair list for disconnect.") if ref $ids ne 'ARRAY';
    # We'll count the disconnects in here.
    my $retVal = 0;
    # Loop through the ids, deleting.
    for my $pair (@$ids) {
        # Delete this record.
        my ($from, $to) = @$pair;
        $sap->DeleteRow($type, $from, $to);
        # Count it.
        $retVal++;
    }
    # Return the insertion count.
    return $retVal;
}

=head2 Alignment/Tree Updates

=head3 insert_project

    my $successFlag =   $supObject->insert_project({
                            -name => $projectName,
                            -roles => [$role1, $role2, ...],
                            -version => $versionNumber,
                            -attributes => { $attr1 => $value1, $attr2 => $value2, ... }
                        })

Create a new alignment project in the database.

=over 4

=item parameter

The parameter should be a reference to a hash with the following keys.

=over 8

=item -name

Name (ID) of the new project.

=item -roles

Reference to a list of roles that cover the features aligned by the project.

=item -version (optional)

String indicating the current version of the new project. The default is C<1.0>.

=item -attributes

Reference to a hash that maps attribute names to values. The values will be associated
with the new project.

=back

=item RETURN

Returns the number of successful inserts.

=back

=cut

sub insert_project {
    # Get the parameters.
    my ($self, $args) = @_;
    # Get the sapling database.
    my $sap = $self->{db};
    # Get the project name and version.
    my $project = $args->{-name};
    Confess("No project name specified.") if ! defined $project;
    my $version = $args->{-version} || "1.0";
    # Get the list of roles.
    my $roles = ServerThing::GetIdList(-roles => $args);
    # Finally, the attribute hash. If none is specified, we presume no attributes.
    my $attributes = $args->{-attributes} || {};
    # We'll count the number of inserts in here.
    my $retVal = 0;
    # Now we start by creating the project record.
    $sap->InsertObject('ATProject', id => $project, version => $version);
    $retVal++;
    # Next, connect it to all the roles.
    for my $role (@$roles) {
        $sap->InsertObject('IsSelectedBy', from_link => $role, to_link => $project);
        $retVal++;
    }
    # Finally, we must create and connect the attributes.
    for my $attr (keys %$attributes) {
        # Insure the attribute exists.
        if (! $sap->Exists(ATPAttribute => $attr)) {
            $sap->InsertObject('ATPAttribute', id => $attr);
            $retVal++;
        }
        # Make the connection.
        $sap->InsertObject('HasValueOf', from_link => $project, to_link => $attr,
                           value => $attributes->{$attr});
        $retVal++;
    }
    # Return the insertion count.
    return $retVal;
}


=head3 insert_alignment

    my $alignmentID =   $supObject->insert_alignment({
                            -project => $projectName,
                            -fids => [$fid1, $fid2, ...],
                            -fidsDescription => $descriptiveText1,
                            -alignment => [[$id1, $comment1, $seq1], [$id2, $comment2, $seq2],
                                            ...],
                            -alignmentDescription => $descriptiveText2,
                            -trimmed => 0
                        })

Insert a new alignment into an existing alignment project.

=over 4

=item parameter

The parameter should be a reference to a hash with the following keys.

=over 8

=item -project

Name (ID) of the project into which the new alignment should be placed.

=item -fids

Reference to a list of FIG feature IDs for the features roles that cover the features aligned by the project.

=item -fidsDescription

Description of the FIG feature IDs associated with this alignment.

=item -alignment

Reference to a list of 3-tuples (each consisting of (0) a feature ID, (1) a comment, and
(2) a protein sequence) that comprise the alignment.

=item -alignmentDescription

Description of the alignment.

=item -trimmed (optional)

TRUE if this alignment contains subsets of the original sequences, FALSE if it contains
full sequences; the default is FALSE.

=back

=item RETURN

Returns the ID number of the new alignment.

=back

=cut

sub insert_alignment {
    # Get the parameters.
    my ($self, $args) = @_;
    # Get the sapling database.
    my $sap = $self->{db};
    # Get the project name and version.
    my $project = $args->{-project};
    Confess("No project name specified.") if ! defined $project;
    # Get the list of features in the representative set and their description.
    my $fids = ServerThing::GetIdList(-fids => $args);
    my $fidsDescription = $args->{-fidsDescription} || "";
    # Get the alignment and its description.
    my $alignment = ServerThing::GetIdList(-alignment => $args);
    my $alignmentDescription = $args->{-alignmentDescription} || "";
    # Get the trim-flag.
    my $trimmed = ($args->{-trimmed} ? 1 : 0);
    # Compute the ID of the representative set.
    my $repkey = ComputeRepresentativeSet($sap, $fids, $fidsDescription);
    # Create the alignment.
    my $retVal = $sap->InsertNew('Alignment', alignment => $alignment,
                                 description => $alignmentDescription,
                                 trimmed => $trimmed);
    # Connect it to the representative set.
    $sap->InsertObject('ContainsProteinsFor', to_link => $retVal, from_link => $repkey);
    # Connect it to the project.
    $sap->InsertObject('IsProjectFor', from_link => $project, to_link => $retVal);
    # Return the alignment ID.
    return $retVal;
}

=head3 insert_alignment_tree

    my $treeID =        $supObject->insert_alignment_tree({
                            -alignment => $alignmentID,
                            -description => $description,
                            -root => $root,
                            -content => $treeString
                        });

Insert a new tree into an alignment. The tree is represented as a NEWICK string with
additional supporting information.

=over 4

=item parameter

The parameter should be a reference to a hash with the following keys.

=over 8

=item -alignment

Name (ID) of the parent alignment.

=item -description

Description of this tree.

=item -root (optional)

ID of the tree's root node, or an empty string if the tree is rootless. The default is an
empty string.

=item -content

String containing a NEWICK representation of the tree.

=back

=item RETURN

Returns the ID of the newly-inserted tree.

=back

=cut

sub insert_alignment_tree {
    # Get the parameters.
    my ($self, $args) = @_;
    # Get the Sapling database.
    my $sap = $self->{db};
    # Get the parent alignment's ID.
    my $alignmentID = $args->{-alignment};
    Confess("No parent alignment specified when inserting alignment tree.") if ! defined $alignmentID;
    # Get the tree description.
    my $description = $args->{-description} || '';
    # Get the root name.
    my $root = $args->{-root} || '';
    # Get the tree string.
    my $content = $args->{-content};
    Confess("No content string specified when inserting alignment tree.") if ! $content;
    # Create the tree itself.
    my $retVal = $sap->InsertNew('AlignmentTree', tree_text => $content, root => $root,
                                 description => $description);
    # Connect it to the alignment.
    $sap->InsertObject('IsOrganizedBy', from_link => $alignmentID, to_link => $retVal);
    # Return the ID of the new alignment.
    return $retVal;
}

=head2 Internal Utilities

=head3 ComputeRepresentativeSet

    my $repKey = SUP::ComputeRepresentativeSet($sap, \@fids, $description);

Return the key of the representative feature set indicated by the specified list
of FIG feature IDs. If the set is not already in the database, it will be inserted.

=over 4

=item sap

Sapling database object to be used to access the data.

=item fids

Reference to a list of FIG feature IDs for the genes in the set.

=item description

Description of the set to be used if it needs to be inserted into the database.

=item RETURN

Returns an MD5 hash to be used as the key for the set.

=back

=cut

sub ComputeRepresentativeSet {
    # Get the parameters.
    my ($sap, $fids, $description) = @_;
    # Build a string from the sorted feature IDs and digest it into a key.
    my $retVal = ERDB::DigestKey(join(" ", sort @$fids));
    # Look to see if the set is already in the database.
    if (! $sap->Exists(RepresentativeSet => $retVal)) {
        # No, so we must create it.
        $sap->InsertObject('RepresentativeSet', id => $retVal, description => $description);
        # Connect all the features to it.
        for my $fid (@$fids) {
            $sap->InsertObject("HasProteinFor", from_link => $retVal, to_link => $fid);
        }
    }
    # Return the representative set ID.
    return $retVal;
}

1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3