[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.2, Tue Jan 25 01:00:20 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 67  Line 66 
66  was inserted by the L</InsertObject> method.  was inserted by the L</InsertObject> method.
67    
68  To facilitate testing, the ERDB module supports automatic generation of test data. This process  To facilitate testing, the ERDB module supports automatic generation of test data. This process
69  is described in the L</GenerateEntity> and L</GenerateConnection> methods.  is described in the L</GenerateEntity> and L</GenerateConnection> methods, though it is not yet
70    fully implemented.
71    
72  =cut  =cut
73    
# Line 111  Line 111 
111    
112  =head3 new  =head3 new
113    
114  C<< my $database = ERDB::new($dbh, $metaFileName); >>  C<< my $database = ERDB->new($dbh, $metaFileName); >>
115    
116  Create a new ERDB object.  Create a new ERDB object.
117    
# Line 136  Line 136 
136          my $metaData = _LoadMetaData($metaFileName);          my $metaData = _LoadMetaData($metaFileName);
137          # Create the object.          # Create the object.
138          my $self = { _dbh => $dbh,          my $self = { _dbh => $dbh,
139                                   _metaData => $metaData,                                   _metaData => $metaData
                                  _options => $options,  
140                             };                             };
141          # Bless and return it.          # Bless and return it.
142          bless $self;          bless $self, $class;
143          return $self;          return $self;
144  }  }
145    
# Line 163  Line 162 
162    
163  sub ShowMetaData {  sub ShowMetaData {
164          # Get the parameters.          # Get the parameters.
165          my $self = shift @_;          my ($self, $filename) = @_;
         my ($filename) = @_;  
166          # Get the metadata and the title string.          # Get the metadata and the title string.
167          my $metadata = $self->{_metaData};          my $metadata = $self->{_metaData};
168          # Get the title string.          # Get the title string.
# Line 174  Line 172 
172          my $relationshipList = $metadata->{Relationships};          my $relationshipList = $metadata->{Relationships};
173          # Open the output file.          # Open the output file.
174          open(HTMLOUT, ">$filename") || Confess("Could not open MetaData display file $filename: $!");          open(HTMLOUT, ">$filename") || Confess("Could not open MetaData display file $filename: $!");
175            Trace("Building MetaData table of contents.") if T(4);
176          # Write the HTML heading stuff.          # Write the HTML heading stuff.
177          print HTMLOUT "<html>\n<head>\n<title>$title</title>\n";          print HTMLOUT "<html>\n<head>\n<title>$title</title>\n";
178          print HTMLOUT "</head>\n<body>\n";          print HTMLOUT "</head>\n<body>\n";
# Line 201  Line 200 
200          print HTMLOUT "<a name=\"EntitiesSection\"></a><h2>Entities</h2>\n";          print HTMLOUT "<a name=\"EntitiesSection\"></a><h2>Entities</h2>\n";
201          # Loop through the entities.          # Loop through the entities.
202          for my $key (sort keys %{$entityList}) {          for my $key (sort keys %{$entityList}) {
203                    Trace("Building MetaData entry for $key entity.") if T(4);
204                  # Create the entity header. It contains a bookmark and the entity name.                  # Create the entity header. It contains a bookmark and the entity name.
205                  print HTMLOUT "<a name=\"$key\"></a><h3>$key</h3>\n";                  print HTMLOUT "<a name=\"$key\"></a><h3>$key</h3>\n";
206                  # Get the entity data.                  # Get the entity data.
# Line 239  Line 239 
239          print HTMLOUT "<a name=\"RelationshipsSection\"></a><h2>Relationships</h2>\n";          print HTMLOUT "<a name=\"RelationshipsSection\"></a><h2>Relationships</h2>\n";
240          # Loop through the relationships.          # Loop through the relationships.
241          for my $key (sort keys %{$relationshipList}) {          for my $key (sort keys %{$relationshipList}) {
242                    Trace("Building MetaData entry for $key relationship.") if T(4);
243                  # Get the relationship's structure.                  # Get the relationship's structure.
244                  my $relationshipStructure = $relationshipList->{$key};                  my $relationshipStructure = $relationshipList->{$key};
245                  # Create the relationship header.                  # Create the relationship header.
# Line 269  Line 270 
270                  my $htmlString = _ShowRelationTable($key, $relationshipStructure->{Relations}->{$key});                  my $htmlString = _ShowRelationTable($key, $relationshipStructure->{Relations}->{$key});
271                  print HTMLOUT $htmlString;                  print HTMLOUT $htmlString;
272          }          }
273            Trace("Building MetaData join table.") if T(4);
274          # Denote we're starting the join table.          # Denote we're starting the join table.
275          print HTMLOUT "<a name=\"JoinTable\"></a><h3>Join Table</h3>\n";          print HTMLOUT "<a name=\"JoinTable\"></a><h3>Join Table</h3>\n";
276          # Create a table header.          # Create a table header.
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 290  Line 295 
295          print HTMLOUT "</body>\n</html>\n";          print HTMLOUT "</body>\n</html>\n";
296          # Close the file.          # Close the file.
297          close HTMLOUT;          close HTMLOUT;
298            Trace("Built MetaData web page.") if T(3);
299  }  }
300    
301  =head3 DumpMetaData  =head3 DumpMetaData
# Line 302  Line 308 
308    
309  sub DumpMetaData {  sub DumpMetaData {
310          # Get the parameters.          # Get the parameters.
311          my $self = shift @_;          my ($self) = @_;
312          # Dump the meta-data.          # Dump the meta-data.
313          return Data::Dumper::Dumper($self->{_metaData});          return Data::Dumper::Dumper($self->{_metaData});
314  }  }
# Line 320  Line 326 
326    
327  sub CreateTables {  sub CreateTables {
328          # Get the parameters.          # Get the parameters.
329          my $self = shift @_;          my ($self) = @_;
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 366  Line 374 
374    
375  sub CreateTable {  sub CreateTable {
376          # Get the parameters.          # Get the parameters.
377          my $self = shift @_;          my ($self, $relationName, $indexFlag) = @_;
         my ($relationName, $indexFlag) = @_;  
378          # Get the database handle.          # Get the database handle.
379          my $dbh = $self->{_dbh};          my $dbh = $self->{_dbh};
380          # Get the relation data and determine whether or not the relation is primary.          # Get the relation data and determine whether or not the relation is primary.
# Line 414  Line 421 
421    
422  sub CreateIndex {  sub CreateIndex {
423          # Get the parameters.          # Get the parameters.
424          my $self = shift @_;          my ($self, $relationName) = @_;
         my ($relationName) = @_;  
425          # Get the relation's descriptor.          # Get the relation's descriptor.
426          my $relationData = $self->_FindRelation($relationName);          my $relationData = $self->_FindRelation($relationName);
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 471  Line 479 
479    
480  sub LoadTables {  sub LoadTables {
481          # Get the parameters.          # Get the parameters.
482          my $self = shift @_;          my ($self, $directoryName, $rebuild) = @_;
         my ($directoryName, $rebuild) = @_;  
483          # Start the timer.          # Start the timer.
484          my $startTime = gettimeofday;          my $startTime = gettimeofday;
485          # Clean any trailing slash from the directory name.          # Clean any trailing slash from the directory name.
# Line 514  Line 521 
521    
522  sub GetTableNames {  sub GetTableNames {
523          # Get the parameters.          # Get the parameters.
524          my $self = shift @_;          my ($self) = @_;
525          # Get the relation list from the metadata.          # Get the relation list from the metadata.
526          my $relationTable = $self->{_metaData}->{RelationTable};          my $relationTable = $self->{_metaData}->{RelationTable};
527          # Return the relation names.          # Return the relation names.
# Line 531  Line 538 
538    
539  sub GetEntityTypes {  sub GetEntityTypes {
540          # Get the database object.          # Get the database object.
541          my $self = shift @_;          my ($self) = @_;
542          # Get the entity list from the metadata object.          # Get the entity list from the metadata object.
543          my $entityList = $self->{_metaData}->{Entities};          my $entityList = $self->{_metaData}->{Entities};
544          # Return the list of entity names in alphabetical order.          # Return the list of entity names in alphabetical order.
# Line 616  Line 623 
623    
624  sub Get {  sub Get {
625          # Get the parameters.          # Get the parameters.
626          my $self = shift @_;          my ($self, $objectNames, $filterClause, @params) = @_;
         my ($objectNames, $filterClause, @params) = @_;  
627          # Construct the SELECT statement. The general pattern is          # Construct the SELECT statement. The general pattern is
628          #          #
629          # SELECT name1.*, name2.*, ... nameN.* FROM name1, name2, ... nameN          # SELECT name1.*, name2.*, ... nameN.* FROM name1, name2, ... nameN
# 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 761  Line 832 
832    
833  sub ComputeObjectSentence {  sub ComputeObjectSentence {
834          # Get the parameters.          # Get the parameters.
835          my $self = shift @_;          my ($self, $objectName) = @_;
         my ($objectName) = @_;  
836          # Set the default return value.          # Set the default return value.
837          my $retVal = $objectName;          my $retVal = $objectName;
838          # Look for the object as a relationship.          # Look for the object as a relationship.
# Line 794  Line 864 
864    
865  sub DumpRelations {  sub DumpRelations {
866          # Get the parameters.          # Get the parameters.
867          my $self = shift @_;          my ($self, $outputDirectory) = @_;
         my ($outputDirectory) = @_;  
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 853  Line 925 
925    
926  sub InsertObject {  sub InsertObject {
927          # Get the parameters.          # Get the parameters.
928          my $self = shift @_;          my ($self, $newObjectType, $fieldHash) = @_;
         my ($newObjectType, $fieldHash) = @_;  
929          # Denote that so far we appear successful.          # Denote that so far we appear successful.
930          my $retVal = 1;          my $retVal = 1;
931          # Get the database handle.          # Get the database handle.
# Line 864  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 981  Line 1055 
1055  =cut  =cut
1056  sub LoadTable {  sub LoadTable {
1057          # Get the parameters.          # Get the parameters.
1058          my $self = shift @_;          my ($self, $fileName, $relationName, $truncateFlag) = @_;
         my ($fileName, $relationName, $truncateFlag) = @_;  
1059          # Create the statistical return object.          # Create the statistical return object.
1060          my $retVal = _GetLoadStats();          my $retVal = _GetLoadStats();
1061          # Trace the fact of the load.          # Trace the fact of the load.
# Line 1031  Line 1104 
1104              print TABLEOUT "$record\n";              print TABLEOUT "$record\n";
1105              # Count the record read.              # Count the record read.
1106              my $count = $retVal->Add('records');              my $count = $retVal->Add('records');
1107                my $len = length $record;
1108                Trace("Record $count written with $len characters.") if T(4);
1109          }          }
1110          }          }
1111          # Close the files.          # Close the files.
1112          close TABLEIN;          close TABLEIN;
1113          close TABLEOUT;          close TABLEOUT;
1114        Trace("Temporary file $tempName created.") if T(4);
1115          # Load the table.          # Load the table.
1116          my $rv;          my $rv;
1117          eval {          eval {
1118                  $rv = $dbh->load_table(file => $tempName, tbl => $relationName);                  $rv = $dbh->load_table(file => $tempName, tbl => $relationName);
1119          };          };
1120          if (!defined $rv) {          if (!defined $rv) {
1121                  $retVal->AddMessage("Table load failed for $relationName.");          $retVal->AddMessage($@) if ($@);
1122            $retVal->AddMessage("Table load failed for $relationName using $tempName.");
1123                  Trace("Table load failed for $relationName.") if T(1);                  Trace("Table load failed for $relationName.") if T(1);
1124          } else {          } else {
1125                  # Here we successfully loaded the table. Trace the number of records loaded.                  # Here we successfully loaded the table. Trace the number of records loaded.
# Line 1105  Line 1182 
1182    
1183  sub GenerateEntity {  sub GenerateEntity {
1184          # Get the parameters.          # Get the parameters.
1185          my $self = shift @_;          my ($self, $id, $type, $values) = @_;
         my ($id, $type, $values) = @_;  
1186          # Create the return hash.          # Create the return hash.
1187          my $this = { id => $id };          my $this = { id => $id };
1188          # Get the metadata structure.          # Get the metadata structure.
# Line 1124  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 1239  Line 1393 
1393    
1394  sub _DumpRelation {  sub _DumpRelation {
1395          # Get the parameters.          # Get the parameters.
1396          my $self = shift @_;          my ($self, $outputDirectory, $relationName, $relation) = @_;
         my ($outputDirectory, $relationName, $relation) = @_;  
1397          # Open the output file.          # Open the output file.
1398          my $fileName = "$outputDirectory/$relationName.dtx";          my $fileName = "$outputDirectory/$relationName.dtx";
1399          open(DTXOUT, ">$fileName") || Confess("Could not open dump file $fileName: $!");          open(DTXOUT, ">$fileName") || Confess("Could not open dump file $fileName: $!");
# Line 1286  Line 1439 
1439    
1440  sub _GetStructure {  sub _GetStructure {
1441          # Get the parameters.          # Get the parameters.
1442          my $self = shift @_;          my ($self, $objectName) = @_;
         my ($objectName) = @_;  
1443          # Get the metadata structure.          # Get the metadata structure.
1444          my $metadata = $self->{_metaData};          my $metadata = $self->{_metaData};
1445          # Declare the variable to receive the descriptor.          # Declare the variable to receive the descriptor.
# Line 1326  Line 1478 
1478    
1479  sub _GetRelationTable {  sub _GetRelationTable {
1480          # Get the parameters.          # Get the parameters.
1481          my $self = shift @_;          my ($self, $objectName) = @_;
         my ($objectName) = @_;  
1482          # Get the descriptor from the metadata.          # Get the descriptor from the metadata.
1483          my $objectData = $self->_GetStructure($objectName);          my $objectData = $self->_GetStructure($objectName);
1484          # Return the object's relation list.          # Return the object's relation list.
# Line 1356  Line 1507 
1507    
1508  sub _GetFieldTable {  sub _GetFieldTable {
1509          # Get the parameters.          # Get the parameters.
1510          my $self = shift @_;          my ($self, $objectName) = @_;
         my ($objectName) = @_;  
1511          # Get the descriptor from the metadata.          # Get the descriptor from the metadata.
1512          my $objectData = $self->_GetStructure($objectName);          my $objectData = $self->_GetStructure($objectName);
1513          # Return the object's field table.          # Return the object's field table.
# Line 1454  Line 1604 
1604    
1605  sub _LoadRelation {  sub _LoadRelation {
1606          # Get the parameters.          # Get the parameters.
1607          my $self = shift @_;          my ($self, $directoryName, $relationName, $rebuild) = @_;
         my ($directoryName, $relationName, $rebuild) = @_;  
1608          # Create the file name.          # Create the file name.
1609          my $fileName = "$directoryName/$relationName";          my $fileName = "$directoryName/$relationName";
1610          # If the file doesn't exist, try adding the .dtx suffix.          # If the file doesn't exist, try adding the .dtx suffix.
# Line 1529  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 1577  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 1627  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 1658  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 1707  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 1728  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 1747  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 1759  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 1773  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 1912  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.
# Line 2109  Line 2280 
2280    
2281  sub _IsPrimary {  sub _IsPrimary {
2282          # Get the parameters.          # Get the parameters.
2283          my $self = shift @_;          my ($self, $relationName) = @_;
         my ($relationName) = @_;  
2284          # Check for the relation in the entity table.          # Check for the relation in the entity table.
2285          my $entityTable = $self->{_metaData}->{Entities};          my $entityTable = $self->{_metaData}->{Entities};
2286          my $retVal = exists $entityTable->{$relationName};          my $retVal = exists $entityTable->{$relationName};
# Line 2144  Line 2314 
2314  =cut  =cut
2315  sub _FindRelation {  sub _FindRelation {
2316          # Get the parameters.          # Get the parameters.
2317          my $self = shift @_;          my ($self, $relationName) = @_;
         my ($relationName) = @_;  
2318          # Get the relation's structure from the master relation table in the metadata structure.          # Get the relation's structure from the master relation table in the metadata structure.
2319          my $metaData = $self->{_metaData};          my $metaData = $self->{_metaData};
2320          my $retVal = $metaData->{RelationTable}->{$relationName};          my $retVal = $metaData->{RelationTable}->{$relationName};
# Line 2273  Line 2442 
2442                  my $indexData = $indexTable->{$indexName};                  my $indexData = $indexTable->{$indexName};
2443                  # Determine whether or not the index is unique.                  # Determine whether or not the index is unique.
2444                  my $fullName = $indexName;                  my $fullName = $indexName;
2445                  if ($indexData->{Unique} eq "true") {                  if (exists $indexData->{Unique} && $indexData->{Unique} eq "true") {
2446                          $fullName .= " (unique)";                          $fullName .= " (unique)";
2447                  }                  }
2448                  # Start an HTML list item for this index.                  # Start an HTML list item for this index.

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3