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

Diff of /Sprout/ERDB.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.5, Tue Apr 5 05:17:01 2005 UTC revision 1.6, Wed May 4 03:24:43 2005 UTC
# Line 1  Line 1 
1  package ERDB;  package ERDB;
2    
3          use strict;          use strict;
         use Carp;  
4          use Tracer;          use Tracer;
5          use DBKernel;          use DBKernel;
6          use Data::Dumper;          use Data::Dumper;
# Line 140  Line 139 
139                                   _metaData => $metaData                                   _metaData => $metaData
140                             };                             };
141          # Bless and return it.          # Bless and return it.
142          bless $self;          bless $self, $class;
143          return $self;          return $self;
144  }  }
145    
# Line 278  Line 277 
277          print HTMLOUT _OpenTable("Join Table", "Source", "Target", "Join Condition");          print HTMLOUT _OpenTable("Join Table", "Source", "Target", "Join Condition");
278          # Loop through the joins.          # Loop through the joins.
279          my $joinTable = $metadata->{Joins};          my $joinTable = $metadata->{Joins};
280          for my $joinKey (sort keys %{$joinTable}) {          my @joinKeys = keys %{$joinTable};
281            for my $joinKey (sort @joinKeys) {
282                  # Separate out the source, the target, and the join clause.                  # Separate out the source, the target, and the join clause.
283                  $joinKey =~ m!([^/]*)/(.*)$!;                  $joinKey =~ m!^([^/]+)/(.+)$!;
284                  my ($source, $target, $clause) = ($self->ComputeObjectSentence($1),                  my ($sourceRelation, $targetRelation) = ($1, $2);
285                                                                                    $self->ComputeObjectSentence($2),                  Trace("Join with key $joinKey is from $sourceRelation to $targetRelation.") if T(4);
286                                                                                    $joinTable->{$joinKey});                  my $source = $self->ComputeObjectSentence($sourceRelation);
287                    my $target = $self->ComputeObjectSentence($targetRelation);
288                    my $clause = $joinTable->{$joinKey};
289                  # Display them in a table row.                  # Display them in a table row.
290                  print HTMLOUT "<tr><td>$source</td><td>$target</td><td>$clause</td></tr>\n";                  print HTMLOUT "<tr><td>$source</td><td>$target</td><td>$clause</td></tr>\n";
291          }          }
# Line 328  Line 330 
330          my $metadata = $self->{_metaData};          my $metadata = $self->{_metaData};
331          my $dbh = $self->{_dbh};          my $dbh = $self->{_dbh};
332          # Loop through the entities.          # Loop through the entities.
333          while (my ($entityName, $entityData) = each %{$metadata->{Entities}}) {          my $entityHash = $metadata->{Entities};
334            for my $entityName (keys %{$entityHash}) {
335                    my $entityData = $entityHash->{$entityName};
336                  # Tell the user what we're doing.                  # Tell the user what we're doing.
337                  Trace("Creating relations for entity $entityName.") if T(1);                  Trace("Creating relations for entity $entityName.") if T(1);
338                  # Loop through the entity's relations.                  # Loop through the entity's relations.
# Line 423  Line 427 
427          # Get the database handle.          # Get the database handle.
428          my $dbh = $self->{_dbh};          my $dbh = $self->{_dbh};
429          # Now we need to create this relation's indexes. We do this by looping through its index table.          # Now we need to create this relation's indexes. We do this by looping through its index table.
430          while (my ($indexName, $indexData) = each %{$relationData->{Indexes}}) {          my $indexHash = $relationData->{Indexes};
431            for my $indexName (keys %{$indexHash}) {
432                    my $indexData = $indexHash->{$indexName};
433                  # Get the index's field list.                  # Get the index's field list.
434                  my @fieldList = _FixNames(@{$indexData->{IndexFields}});                  my @fieldList = _FixNames(@{$indexData->{IndexFields}});
435                  my $flds = join(', ', @fieldList);                  my $flds = join(', ', @fieldList);
# Line 739  Line 745 
745          return $retVal;          return $retVal;
746  }  }
747    
748    =head3 GetList
749    
750    C<< my @dbObjects = $database->GetList(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >>
751    
752    Return a list of object descriptors for the specified objects as determined by the
753    specified filter clause.
754    
755    This method is essentially the same as L</Get> except it returns a list of objects rather
756    that a query object that can be used to get the results one record at a time.
757    
758    =over 4
759    
760    =over 4
761    
762    =item objectNames
763    
764    List containing the names of the entity and relationship objects to be retrieved.
765    
766    =item filterClause
767    
768    WHERE clause (without the WHERE) to be used to filter and sort the query. The WHERE clause can
769    be parameterized with parameter markers (C<?>). Each field used in the WHERE clause must be
770    specified in the standard form B<I<objectName>(I<fieldName>)>. Any parameters specified
771    in the filter clause should be added to the parameter list as additional parameters. The
772    fields in a filter clause can come from primary entity relations, relationship relations,
773    or secondary entity relations; however, all of the entities and relationships involved must
774    be included in the list of object names.
775    
776    The filter clause can also specify a sort order. To do this, simply follow the filter string
777    with an ORDER BY clause. For example, the following filter string gets all genomes for a
778    particular genus and sorts them by species name.
779    
780    C<< "Genome(genus) = ? ORDER BY Genome(species)" >>
781    
782    The rules for field references in a sort order are the same as those for field references in the
783    filter clause in general; however, odd things may happen if a sort field is from a secondary
784    relation.
785    
786    =item param1, param2, ..., paramN
787    
788    Parameter values to be substituted into the filter clause.
789    
790    =item RETURN
791    
792    Returns a list of B<DBObject>s that satisfy the query conditions.
793    
794    =back
795    
796    =cut
797    #: Return Type @%
798    sub GetList {
799        # Get the parameters.
800        my ($self, $objectNames, $filterClause, @params) = @_;
801            # Declare the return variable.
802            my @retVal = ();
803            # Perform the query.
804            my $query = $self->Get($objectNames, $filterClause, @params);
805            # Loop through the results.
806            while (my $object = $query->Fetch) {
807                    push @retVal, $object;
808            }
809        # Return the result.
810        return @retVal;
811    }
812    
813  =head3 ComputeObjectSentence  =head3 ComputeObjectSentence
814    
815  C<< my $sentence = $database->ComputeObjectSentence($objectName); >>  C<< my $sentence = $database->ComputeObjectSentence($objectName); >>
# Line 797  Line 868 
868          # Now we need to run through all the relations. First, we loop through the entities.          # Now we need to run through all the relations. First, we loop through the entities.
869          my $metaData = $self->{_metaData};          my $metaData = $self->{_metaData};
870          my $entities = $metaData->{Entities};          my $entities = $metaData->{Entities};
871          while (my ($entityName, $entityStructure) = each %{$entities}) {          for my $entityName (keys %{$entities}) {
872                    my $entityStructure = $entities->{$entityName};
873                  # Get the entity's relations.                  # Get the entity's relations.
874                  my $relationList = $entityStructure->{Relations};                  my $relationList = $entityStructure->{Relations};
875                  # Loop through the relations, dumping them.                  # Loop through the relations, dumping them.
876                  while (my ($relationName, $relation) = each %{$relationList}) {                  for my $relationName (keys %{$relationList}) {
877                            my $relation = $relationList->{$relationName};
878                          $self->_DumpRelation($outputDirectory, $relationName, $relation);                          $self->_DumpRelation($outputDirectory, $relationName, $relation);
879                  }                  }
880          }          }
881          # Next, we loop through the relationships.          # Next, we loop through the relationships.
882          my $relationships = $metaData->{Relationships};          my $relationships = $metaData->{Relationships};
883          while (my ($relationshipName, $relationshipStructure) = each %{$relationships}) {          for my $relationshipName (keys %{$relationships}) {
884                    my $relationshipStructure = $relationships->{$relationshipName};
885                  # Dump this relationship's relation.                  # Dump this relationship's relation.
886                  $self->_DumpRelation($outputDirectory, $relationshipName, $relationshipStructure->{Relations}->{$relationshipName});                  $self->_DumpRelation($outputDirectory, $relationshipName, $relationshipStructure->{Relations}->{$relationshipName});
887          }          }
# Line 861  Line 935 
935          # Loop through the relations. We'll build insert statements for each one. If a relation is          # Loop through the relations. We'll build insert statements for each one. If a relation is
936          # secondary, we may end up generating multiple insert statements. If an error occurs, we          # secondary, we may end up generating multiple insert statements. If an error occurs, we
937          # stop the loop.          # stop the loop.
938          while ($retVal && (my ($relationName, $relationDefinition) = each %{$relationTable})) {          my @relationList = keys %{$relationTable};
939            for (my $i = 0; $retVal && $i <= $#relationList; $i++) {
940                    my $relationName = $relationList[$i];
941                    my $relationDefinition = $relationTable->{$relationName};
942                  # Get the relation's fields. For each field we will collect a value in the corresponding                  # Get the relation's fields. For each field we will collect a value in the corresponding
943                  # position of the @valueList array. If one of the fields is missing, we will add it to the                  # position of the @valueList array. If one of the fields is missing, we will add it to the
944                  # @missing list.                  # @missing list.
# Line 1123  Line 1200 
1200          return $this;          return $this;
1201  }  }
1202    
1203    =head3 GetEntity
1204    
1205    C<< my $entityObject = $sprout->GetEntity($entityType, $ID); >>
1206    
1207    Return an object describing the entity instance with a specified ID.
1208    
1209    =over 4
1210    
1211    =item entityType
1212    
1213    Entity type name.
1214    
1215    =item ID
1216    
1217    ID of the desired entity.
1218    
1219    =item RETURN
1220    
1221    Returns a B<DBObject> representing the desired entity instance, or an undefined value if no
1222    instance is found with the specified key.
1223    
1224    =back
1225    
1226    =cut
1227    
1228    sub GetEntity {
1229            # Get the parameters.
1230            my ($self, $entityType, $ID) = @_;
1231            # Create a query.
1232            my $query = $self->Get([$entityType], "$entityType(id) = ?", $ID);
1233            # Get the first (and only) object.
1234            my $retVal = $query->Fetch();
1235            # Return the result.
1236            return $retVal;
1237    }
1238    
1239    =head3 GetEntityValues
1240    
1241    C<< my @values = GetEntityValues($entityType, $ID, \@fields); >>
1242    
1243    Return a list of values from a specified entity instance.
1244    
1245    =over 4
1246    
1247    =item entityType
1248    
1249    Entity type name.
1250    
1251    =item ID
1252    
1253    ID of the desired entity.
1254    
1255    =item fields
1256    
1257    List of field names, each of the form I<objectName>C<(>I<fieldName>C<)>.
1258    
1259    =item RETURN
1260    
1261    Returns a flattened list of the values of the specified fields for the specified entity.
1262    
1263    =back
1264    
1265    =cut
1266    
1267    sub GetEntityValues {
1268            # Get the parameters.
1269            my ($self, $entityType, $ID, $fields) = @_;
1270            # Get the specified entity.
1271            my $entity = $self->GetEntity($entityType, $ID);
1272            # Declare the return list.
1273            my @retVal = ();
1274            # If we found the entity, push the values into the return list.
1275            if ($entity) {
1276                    push @retVal, $entity->Values($fields);
1277            }
1278            # Return the result.
1279            return @retVal;
1280    }
1281    
1282  =head2 Internal Utility Methods  =head2 Internal Utility Methods
1283    
# Line 1523  Line 1678 
1678          my %masterRelationTable = ();          my %masterRelationTable = ();
1679          # Loop through the entities.          # Loop through the entities.
1680          my $entityList = $metadata->{Entities};          my $entityList = $metadata->{Entities};
1681          while (my ($entityName, $entityStructure) = each %{$entityList}) {          for my $entityName (keys %{$entityList}) {
1682                    my $entityStructure = $entityList->{$entityName};
1683                  #                  #
1684                  # The first step is to run creating all the entity's default values. For C<Field> elements,                  # The first step is to run creating all the entity's default values. For C<Field> elements,
1685                  # the relation name must be added where it is not specified. For relationships,                  # the relation name must be added where it is not specified. For relationships,
# Line 1571  Line 1727 
1727                  # to a list of fields. First, we need the ID field itself.                  # to a list of fields. First, we need the ID field itself.
1728                  my $idField = $fieldList->{id};                  my $idField = $fieldList->{id};
1729                  # Loop through the relations.                  # Loop through the relations.
1730                  while (my ($relationName, $relation) = each %{$relationTable}) {                  for my $relationName (keys %{$relationTable}) {
1731                            my $relation = $relationTable->{$relationName};
1732                          # Get the relation's field list.                          # Get the relation's field list.
1733                          my $relationFieldList = $relation->{Fields};                          my $relationFieldList = $relation->{Fields};
1734                          # Add the ID field to it. If the field's already there, it will not make any                          # Add the ID field to it. If the field's already there, it will not make any
# Line 1621  Line 1778 
1778                  # The next step is to insure that each relation has at least one index that begins with the ID field.                  # The next step is to insure that each relation has at least one index that begins with the ID field.
1779                  # After that, we convert each relation's index list to an index table. We first need to loop through                  # After that, we convert each relation's index list to an index table. We first need to loop through
1780                  # the relations.                  # the relations.
1781                  while (my ($relationName, $relation) = each %{$relationTable}) {                  for my $relationName (keys %{$relationTable}) {
1782                            my $relation = $relationTable->{$relationName};
1783                          # Get the relation's index list.                          # Get the relation's index list.
1784                          my $indexList = $relation->{Indexes};                          my $indexList = $relation->{Indexes};
1785                          # Insure this relation has an ID index.                          # Insure this relation has an ID index.
# Line 1652  Line 1810 
1810          # Loop through the relationships. Relationships actually turn out to be much simpler than entities.          # Loop through the relationships. Relationships actually turn out to be much simpler than entities.
1811          # For one thing, there is only a single constituent relation.          # For one thing, there is only a single constituent relation.
1812          my $relationshipList = $metadata->{Relationships};          my $relationshipList = $metadata->{Relationships};
1813          while (my ($relationshipName, $relationshipStructure) = each %{$relationshipList}) {          for my $relationshipName (keys %{$relationshipList}) {
1814                    my $relationshipStructure = $relationshipList->{$relationshipName};
1815                  # Fix up this relationship.                  # Fix up this relationship.
1816                  _FixupFields($relationshipStructure, $relationshipName, 2, 3);                  _FixupFields($relationshipStructure, $relationshipName, 2, 3);
1817                  # Format a description for the FROM field.                  # Format a description for the FROM field.
# Line 1701  Line 1860 
1860                  my @fromList = ();                  my @fromList = ();
1861                  my @toList = ();                  my @toList = ();
1862                  my @bothList = ();                  my @bothList = ();
1863                  while (my ($relationshipName, $relationship) = each %{$relationshipList}) {                  Trace("Join table build for $entityName.") if T(3);
1864                    for my $relationshipName (keys %{$relationshipList}) {
1865                            my $relationship = $relationshipList->{$relationshipName};
1866                          # Determine if this relationship has our entity in one of its link fields.                          # Determine if this relationship has our entity in one of its link fields.
1867                          if ($relationship->{from} eq $entityName) {                          my $fromEntity = $relationship->{from};
1868                                  if ($relationship->{to} eq $entityName) {                          my $toEntity = $relationship->{to};
1869                            Trace("Join check for relationship $relationshipName from $fromEntity to $toEntity.") if T(3);
1870                            if ($fromEntity eq $entityName) {
1871                                    if ($toEntity eq $entityName) {
1872                                          # Here the relationship is recursive.                                          # Here the relationship is recursive.
1873                                          push @bothList, $relationshipName;                                          push @bothList, $relationshipName;
1874                                            Trace("Relationship $relationshipName put in both-list.") if T(3);
1875                                  } else {                                  } else {
1876                                          # Here the relationship comes from the entity.                                          # Here the relationship comes from the entity.
1877                                          push @fromList, $relationshipName;                                          push @fromList, $relationshipName;
1878                                            Trace("Relationship $relationshipName put in from-list.") if T(3);
1879                                  }                                  }
1880                          } elsif ($relationship->{to} eq $entityName) {                          } elsif ($toEntity eq $entityName) {
1881                                  # Here the relationship goes to the entity.                                  # Here the relationship goes to the entity.
1882                                  push @toList, $relationshipName;                                  push @toList, $relationshipName;
1883                                    Trace("Relationship $relationshipName put in to-list.") if T(3);
1884                          }                          }
1885                  }                  }
1886                  # Create the nonrecursive joins. Note that we build two hashes for running                  # Create the nonrecursive joins. Note that we build two hashes for running
# Line 1722  Line 1889 
1889                  # hash table at the same time.                  # hash table at the same time.
1890                  my %directRelationships = ( from => \@fromList, to => \@toList );                  my %directRelationships = ( from => \@fromList, to => \@toList );
1891                  my %otherRelationships = ( from => \@fromList, to => \@toList );                  my %otherRelationships = ( from => \@fromList, to => \@toList );
1892                  while (my ($linkType, $relationships) = each %directRelationships) {                  for my $linkType (keys %directRelationships) {
1893                            my $relationships = $directRelationships{$linkType};
1894                          # Loop through all the relationships.                          # Loop through all the relationships.
1895                          for my $relationshipName (@{$relationships}) {                          for my $relationshipName (@{$relationships}) {
1896                                  # Create joins between the entity and this relationship.                                  # Create joins between the entity and this relationship.
1897                                  my $linkField = "$relationshipName.${linkType}_link";                                  my $linkField = "$relationshipName.${linkType}_link";
1898                                  my $joinClause = "$entityName.id = $linkField";                                  my $joinClause = "$entityName.id = $linkField";
1899                                    Trace("Entity join clause is $joinClause for $entityName and $relationshipName.") if T(4);
1900                                  $joinTable{"$entityName/$relationshipName"} = $joinClause;                                  $joinTable{"$entityName/$relationshipName"} = $joinClause;
1901                                  $joinTable{"$relationshipName/$entityName"} = $joinClause;                                  $joinTable{"$relationshipName/$entityName"} = $joinClause;
1902                                  # Create joins between this relationship and the other relationships.                                  # Create joins between this relationship and the other relationships.
1903                                  while (my ($otherType, $otherships) = each %otherRelationships) {                                  for my $otherType (keys %otherRelationships) {
1904                                            my $otherships = $otherRelationships{$otherType};
1905                                          for my $otherName (@{$otherships}) {                                          for my $otherName (@{$otherships}) {
1906                                                  # Get the key for this join.                                                  # Get the key for this join.
1907                                                  my $joinKey = "$otherName/$relationshipName";                                                  my $joinKey = "$otherName/$relationshipName";
# Line 1741  Line 1911 
1911                                                          # path is ambiguous. We delete the join from the join                                                          # path is ambiguous. We delete the join from the join
1912                                                          # table to prevent it from being used.                                                          # table to prevent it from being used.
1913                                                          delete $joinTable{$joinKey};                                                          delete $joinTable{$joinKey};
1914                                                            Trace("Deleting ambiguous join $joinKey.") if T(4);
1915                                                  } elsif ($otherName ne $relationshipName) {                                                  } elsif ($otherName ne $relationshipName) {
1916                                                          # Here we have a valid join. Note that joins between a                                                          # Here we have a valid join. Note that joins between a
1917                                                          # relationship and itself are prohibited.                                                          # relationship and itself are prohibited.
1918                                                          $joinTable{$joinKey} = "$otherName.${otherType}_link = $linkField";                                                          my $relJoinClause = "$otherName.${otherType}_link = $linkField";
1919                                                            $joinTable{$joinKey} = $relJoinClause;
1920                                                            Trace("Relationship join clause is $relJoinClause for $joinKey.") if T(4);
1921                                                  }                                                  }
1922                                          }                                          }
1923                                  }                                  }
# Line 1753  Line 1926 
1926                                  # relationship can only be ambiguous with another recursive relationship,                                  # relationship can only be ambiguous with another recursive relationship,
1927                                  # and the incoming relationship from the outer loop is never recursive.                                  # and the incoming relationship from the outer loop is never recursive.
1928                                  for my $otherName (@bothList) {                                  for my $otherName (@bothList) {
1929                                            Trace("Setting up relationship joins to recursive relationship $otherName with $relationshipName.") if T(3);
1930                                          # Join from the left.                                          # Join from the left.
1931                                          $joinTable{"$relationshipName/$otherName"} =                                          $joinTable{"$relationshipName/$otherName"} =
1932                                                  "$linkField = $otherName.from_link";                                                  "$linkField = $otherName.from_link";
# Line 1767  Line 1941 
1941                  # rise to situations where we can't create the path we want; however, it is always                  # rise to situations where we can't create the path we want; however, it is always
1942                  # possible to get the same effect using multiple queries.                  # possible to get the same effect using multiple queries.
1943                  for my $relationshipName (@bothList) {                  for my $relationshipName (@bothList) {
1944                            Trace("Setting up entity joins to recursive relationship $relationshipName with $entityName.") if T(3);
1945                          # Join to the entity from each direction.                          # Join to the entity from each direction.
1946                          $joinTable{"$entityName/$relationshipName"} =                          $joinTable{"$entityName/$relationshipName"} =
1947                                  "$entityName.id = $relationshipName.from_link";                                  "$entityName.id = $relationshipName.from_link";
# Line 1906  Line 2081 
2081                  $structure->{Fields} = { };                  $structure->{Fields} = { };
2082          } else {          } else {
2083                  # Here we have a field list. Loop through its fields.                  # Here we have a field list. Loop through its fields.
2084                  while (my ($fieldName, $fieldData) = each %{$structure->{Fields}}) {                  my $fieldStructures = $structure->{Fields};
2085                    for my $fieldName (keys %{$fieldStructures}) {
2086                            my $fieldData = $fieldStructures->{$fieldName};
2087                          # Get the field type.                          # Get the field type.
2088                          my $type = $fieldData->{type};                          my $type = $fieldData->{type};
2089                          # Plug in a relation name if it is needed.                          # Plug in a relation name if it is needed.

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3