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

View of /Sprout/ERDBObject.pm

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.2 - (download) (as text) (annotate)
Mon Jun 11 18:52:07 2007 UTC (12 years, 6 months ago) by parrello
Branch: MAIN
Changes since 1.1: +7 -6 lines
Fixed some comments so they will be applicable to the new E-R model.

package ERDBObject;

    use strict;
    use DBKernel;
    use Tracer;

=head1 Entity-Relationship Database Package Instance Object

=head2 Introduction

This package defines the instance object for the Entity-Relationship Database Package.
This object can be created directly, returned by the C<Fetch>
method of the B<DBQuery> object, or returned by the C<Cross> method of this object.
An object created directly is considered I<transient>. An object created by one of the
database methods is considered I<persistent>. A transient object can be made persistent
using the C<Insert> method of the B<ERDB> object.

An instance object allows the user to access the fields in the current instance. The
instance consists of zero or more entity and/or relationship objects and a map of field
names to locations. Some entity fields require additional queries to the database. If
the entity object is present, the additional queries are executed automatically. Otherwise,
the value is treated as missing.

=head2 Public Methods

=head3 new

C<< my $dbObject = ERDBObject::new($name1 => \@list1, $name2 => \@list2, ... $nameN => \@listN); >>

Create a new transient object. A transient object maps fields to values, but is not
associated with a database. The parameter list should be an entity name followed by
a set of key-value pairs. Each key should be in the standard I<objectName>C<(>I<attributeName>C<)>
format used by all of the ERDB methods. All values must be list references. For example,
the following code fragment creates an pseudo-Feature named C<peg.1> with two hyperlinks.

    my $feature = ERDBObject::new('Feature(id)' => ['peg.1'],
                                  'Feature(link)' => ['http://www.undhoople.edu/NC1004.html',


sub new {
    # Create the value list.
    my %values = ();
    # Loop through the parameters.
    my @parms = @_;
    while (@parms > 0) {
        # Get the current key-value pair.
        my $list = pop @parms;
        my $name = pop @parms;
        # Put this key-value pair in the value hash
        $values{$name} = $list;
    # Create this object and bless it.
    my $retVal = { _values => \%values, _newObjectFlag => 1 };
    bless $retVal;
    return $retVal;

=head3 SetDB

C<< my  = $dbObject->SetDB($db, $target); >>

Attach a database to this object. This method is useful if you have to create an
object manually (using L</new>) but want to be able to use the database methods
(e.g. L</Cross>) to retrieve additional data.

=over 4

=item db

B<ERDB> object for the database to use.

=item target

Name of the entity relevant to this object. This parameter is important for cases where
a single B<ERDBObject> actually has data from multiple tables. The parameter indicates
the table from which a relationship crossing should occur. So, for example, a ERDBObject
could contain data from the I<IsLocatedIn> and I<Contig> tables; we would specify a
target of I<Contig> so that the L</Cross> method crosses from there.


#: Return Type ;
sub SetDB {
    # Get the parameters.
    my ($self, $db, $target) = @_;
    # Store the database and target entity data.
    $self->{_db} = $db;
    $self->{_targetEntity} = $target;

=head3 Attributes

C<< my @attrNames = $dbObject->Attributes(); >>

This method will return a sorted list of the attributes present in this object.
The list can be used in the L</Values> method to get all the values stored.

If the ERDBObject was created by a database query, the attributes returned will
only be those which occur on the primary relation. Additional fields may get
loaded into the object if the client has asked for them in a L</Value> or
L</Values> command. Initially, however, only the primary fields-- each of which
has one and only one value-- will be found in the attribute list.

#: Return Type @;
sub Attributes {
    # Get the parameters.
    my ($self) = @_;
    # Get the keys of the value hash.
    my @retVal = sort keys %{$self->{_values}};
    # Return the result.
    return @retVal;

=head3 HasField

C<< my $flag = $dbObject->HasField($fieldSpec); >>

Return TRUE if this object has the specified field available, else FALSE.
This method can be used to determine if a value is available without
requiring an additional database query.

=over 4

=item fieldSpec

A standard field specifier, as is used to specify fields to the B<Get>
method of the B<Sprout> object.

=item RETURN

Returns TRUE if there's a value for the field in this object, else FALSE.



sub HasField {
    # Get the parameters.
    my ($self, $fieldName) = @_;
    # Get the field hash.
    my $fields = $self->{_values};
    # Return the result.
    return exists $fields->{$fieldName};

=head3 AddValues

C<< $dbObject->AddValues($name, @values); >>

Add one or more values to a specified field.

=over 4

=item name

Name of the field to receive the new values. If the field does
not exist, it will be created.

=item values

List of values to put in the field.



sub AddValues {
    # Get the parameters.
    my ($self, $name, @values) = @_;
    # Get the field hash.
    my $fields = $self->{_values};
    # Add the new values.
    Tracer::AddToListMap($fields, $name, @values);

=head3 Value

C<< my @values = $dbObject->Value($attributeName); >>

Return a list of the values for the specified attribute.

=over 4

=item attributeName

Name of the desired attribute, in the form B<I<objectName>(I<fieldName>)>.

=item RETURN

Returns a list of the values for the specified attribute, which may have 0, 1, or
multiple values.



sub Value {
    # Get the parameters.
    my ($self, $attributeName) = @_;
    # Declare the return variable.
    my @retVal = ();
    # Look for the field in the values hash.
    my $fieldHash = $self->{_values};
    my $retValRef = $fieldHash->{$attributeName};
    Trace("retValRef for $attributeName is \"$retValRef\".") if T(Fields => 3);
    if (defined $retValRef) {
        # Here we have the field already, so return it.
        @retVal = @{$retValRef};
    } else {
        # Here the field is not in the hash. If we don't have a database, we are
        # done. The user will automatically get an empty list handed back to him.
        if (exists $self->{_db}) {
            # We have a database, so we can look for the value in a secondary relation.
            # We start by getting the object name and the attribute name. Note
            # that the object must be an entity, since relationships don't have
            # secondary relations.
            $attributeName =~ /^([^(]*)\(([^)]*)\)/;
            my ($entityName, $fieldName) = ($1, $2);
            my $entityData = $self->{_db}->{_metaData}->{Entities}->{$entityName};
            # Determine the name of the relation that contains this field.
            my $relationName = $entityData->{Fields}->{$fieldName}->{relation};
            # Get the actual name of the field.
            my $fixedFieldName = ERDB::_FixName($fieldName);
            # Get the entity instance's ID.
            my $id = $fieldHash->{"$entityName(id)"}->[0];
            # Create the SELECT statement for the desired relation and execute it.
            my $command = "SELECT $fixedFieldName FROM $relationName WHERE id = ?";
            Trace("SQL subquery for '$id': $command") if T(SQL => 4);
            my $sth = $self->{_db}->{_dbh}->prepare_command($command);
            $sth->execute($id) || Confess("Subquery for $attributeName failed: " . $sth->errstr);
            # Loop through the query results creating a list of the values found.
            my $rows = $sth->fetchall_arrayref;
            for my $row (@{$rows}) {
                # Note we un-escape the value before stuffing it in the result list.
                my $realValue = Tracer::UnEscape($row->[0]);
                push @retVal, $row->[0];
            # Put the list in the field hash for future use.
            $fieldHash->{"$entityName($fieldName)"} = \@retVal;
    # Return the field values found.
    return @retVal;

=head3 Values

C<< my @values = $dbObject->Values(\@attributeNames); >>

This method returns a list of all the values for a list of field specifiers. Essentially, it calls
the L</Value> method for each element in the parameter list and returns a flattened list of all
the results.

For example, let us say that C<$feature> contains a feature with two links and a translation.
The following call will put the feature links in C<$link1> and C<$link2> and the translation in

C<< my ($link1, $link2, $translation) = $feature->Values(['Feature(link)', 'Feature(translation)']); >>

=over 4

=item attributeNames

List of attribute names.

=item RETURN

Returns a flattened list of all the results found for each specified field.



sub Values {
    # Get the parameters.
    my ($self, $attributeNames) = @_;
    # Create the return list.
    my @retVal = ();
    # Loop through the specifiers, pushing their values into the return list.
    for my $specifier (@{$attributeNames}) {
        push @retVal, $self->Value($specifier);
    # Return the resulting list.
    return @retVal;

=head3 Cross

C<< my $query = $dbObject->Cross($relationshipName, $filterClause, $param1, $param2, ... $paramN); >>

Return a query object for instances related to this one via a specified relationship.

=over 4

=item relationshipName

Name of the relationship to cross.

=item filterClause

WHERE clause (without the WHERE) to be used to filter the query. The WHERE clause can be
parameterized with parameter markers (C<?>). Each field used in the WHERE clause must be
specified in the standard form B<I<objectName>(I<fieldName>)>.

=item param1, param2, ..., paramN

Parameters for the filter clause.



sub Cross {
    # Get the parameters.
    my ($self, $relationshipName, $filterClause, @params) = @_;
    # Make sure the filter clause is not undefined. Empty is okay, just not undefined.
    if (! defined($filterClause)) {
        $filterClause = "";
    # Get access to the key metadata structures.
    my $db = $self->{_db};
    my $metadata = $db->{_metaData};
    my $entities = $metadata->{Entities};
    my $relationships = $metadata->{Relationships};
    # Determine whether we are using the from-link or the to-link, and get the name of the
    # entity on the other side of the relationship.
    my ($startLinkName, $targetLinkName, $targetEntity);
    my $relationship = $relationships->{$relationshipName};
    my $startingEntity = $self->{_targetEntity};
    if ($relationship->{from} eq $startingEntity) {
        # Here we're starting at the FROM entity.
        $startLinkName = "$relationshipName(from-link)";
        $targetEntity = $relationship->{to};
    } else {
        # Here we're starting at the TO entity.
        $startLinkName = "$relationshipName(to-link)";
        $targetEntity = $relationship->{from};
    # Get the ID of the starting instance.
    my ($id) = $self->Value("$startingEntity(id)");
    # Create the WHERE clause.
    my $superFilter = "$startLinkName = ?";
    # Analyze the filter clause. We need to pull out any strings and put them in parameters.
    # Then we need to look for ORDER BY and LIMIT to position any parentheses we need. This
    # will require a major parse of the filter string. The first step is to find the last
    # single quote. Note that if there are no quotes, this will return -1.
    my $lastQuote = rindex $filterClause, "'";
    # Compute the position in the string after the last quote. All our searches will start
    # from there.
    my $startPos = $lastQuote + 1;
    # Look for ORDER BY.
    my $orderBy = index $filterClause, "ORDER BY", $startPos;
    # Look for LIMIT.
    my $limit = index $filterClause, "LIMIT", $startPos;
    # Choose the first of these two clauses. That's where the real filter ends.
    my $addendaPos = ($orderBy < 0 ? $limit : ($limit < 0 ? $orderBy :
                        ($orderBy < $limit ? $orderBy : $limit)));
    # We have four cases: no ORDER BY or LIMIT, only ORDER BY or LIMIT, no filter at
    # all, or ORDER BY or LIMIT present in the middle of the filter string. If we're
    # only ORDER BY or LIMIT , no additional parentheses are needed. Similarly if there's
    # no filter string at all. Hwever, in the other cases we need to put
    # parentheses around the WHERE part of the filter.
    if ($addendaPos < 0 && length($filterClause) > 0) {
        # No ORDER BY or LIMIT: parentheses surround the whole clause.
        $filterClause = "AND ($filterClause)";
    } elsif ($addendaPos > 0) {
        # Open parentheses at the beginning, and close them right before the ORDER BY
        # or LIMIT part.
        $filterClause = "AND (" . substr($filterClause, 0, $addendaPos) . ") " .
                        substr($filterClause, $addendaPos);
    # Add the incoming filter to the filter we've built.
    $superFilter .= " $filterClause";
    # Create a relation-crossing query and return it.
    Trace("Calling GET from CROSS. Filter is $superFilter.") if T(4);
    my $retVal = $db->Get([$relationshipName, $targetEntity], $superFilter, [$id, @params]);
    return $retVal;

=head3 IsNew

C<< my $boolean = $dbObject->IsNew(); >>

Return TRUE if this is a new object inserted into the database, or FALSE if it was loaded from
the input data files.


sub IsNew {
    # Get the parameters.
    my ($self) = @_;
    return $self->{_newObjectFlag};

=head2 Utility Methods

=head3 _new

Create a new instance object.

This is a static method.

=over 4

=item dbquery

B<DBQuery> object for the relevant query.

=item value, value2, ... valueN

List of values returned by the query for the current object.



sub _new {
    # Get the parameters.
    my ($dbquery, @values) = @_;
    # Pull out the ERDB object and the relationship map.
    my $database = $dbquery->{_db};
    my $relationMap = $dbquery->{_objectNames};
    # Get the metadata.
    my $metadata = $database->{_metaData};
    my $entities = $metadata->{Entities};
    my $relationships = $metadata->{Relationships};
    # This variable will be used to save the name of the last entity in the object list.
    # That entity is the one we'll start from when crossing relationships.
    my $target;
    # Create the field hash table.
    my %fieldHash = ();
    # Check for search relevance.
    if ($dbquery->{_fullText}) {
        # Create the special search relevance field from the first element of the row values.
        # Note that the object name is the value of the _fullText property.
        my $relevanceName = "$dbquery->{_fullText}(search-relevance)";
        $fieldHash{$relevanceName} = [shift @values];
    # Denote that so far this does not appear to be a new object (as opposed to a loaded object).
    my $newObjectFlag = 0;
    # Loop through the object names, extracting its fields. We will strip each field from
    # the value array and add it to the hash table using the ERDB-format field name.
    for my $mappingPair (@{$relationMap}) {
        # Get the real object name for this mapped name.
        my ($mappedObjectName, $objectName) = @{$mappingPair};
        # Declare the variable to hold the field list and the entity flag.
        my ($fieldList, $entityFlag);
        # Get the descriptor for this object.
        my $objectDescriptor = $entities->{$objectName};
        if ($objectDescriptor) {
            # Here we have an entity object.
            $target = $objectName;
            $fieldList = $objectDescriptor->{Relations}->{$objectName}->{Fields};
            $entityFlag = 1;
        } else {
            $objectDescriptor = $relationships->{$objectName};
            if ($objectDescriptor) {
                # Here we have a relationship object.
                $fieldList = $objectDescriptor->{Relations}->{$objectName}->{Fields};
                $entityFlag = 0;
            } else {
                Confess("Object $objectName not found in database.");
        # Loop through the field list.
        for my $field (@{$fieldList}) {
            # Get the current value from the array.
            my $thisValue = shift @values;
            # Un-escape its text.
            my $realValue = Tracer::UnEscape($thisValue);
            # Get the current field's name.
            my $fieldName = $field->{name};
            # Add the field's name and value to the hash table.
            my $fieldKey = "$mappedObjectName($fieldName)";
            $fieldHash{$fieldKey} = [$realValue];
            Trace("$fieldKey = '$thisValue'") if T(Fields => 3);
        # Save the new-object flag.
        $newObjectFlag = shift @values;
    # Create the result object.
    my $self = { _db => $database, _targetEntity => $target, _values => \%fieldHash,
                 _newObjectFlag => $newObjectFlag };
    # Bless and return it.
    bless $self;
    return $self;


MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3