--- ERDB.pm 2005/06/09 19:06:55 1.8 +++ ERDB.pm 2006/01/28 09:36:47 1.33 @@ -1,14 +1,15 @@ package ERDB; - use strict; - use Tracer; - use DBKernel; - use Data::Dumper; - use XML::Simple; - use DBQuery; - use DBObject; - use Stats; - use Time::HiRes qw(gettimeofday); + use strict; + use Tracer; + use DBrtns; + use Data::Dumper; + use XML::Simple; + use DBQuery; + use DBObject; + use Stats; + use Time::HiRes qw(gettimeofday); + use FIG; =head1 Entity-Relationship Database Package @@ -134,15 +135,15 @@ relationships are listed inside the B and B tags, respectively. None of these tags have attributes. - - ... display title here... - - ... entity definitions here ... - - - ... relationship definitions here... - - + + ... display title here... + + ... entity definitions here ... + + + ... relationship definitions here... + + Entities, relationships, indexes, and fields all allow a text tag called B. The text inside the B tag contains comments that will appear when the database @@ -155,11 +156,11 @@ tag can have B associated with it. The complete set of B tags for an object mus be inside B tags. - - - ... Field tags ... - - + + + ... Field tags ... + + The attributes for the B tag are as follows. @@ -300,36 +301,37 @@ # Table of information about our datatypes. "sqlType" is the corresponding SQL datatype string. # "maxLen" is the maximum permissible length of the incoming string data used to populate a field # of the specified type. "dataGen" is PERL string that will be evaluated if no test data generation - #string is specified in the field definition. -my %TypeTable = ( char => { sqlType => 'CHAR(1)', maxLen => 1, dataGen => "StringGen('A')" }, - int => { sqlType => 'INTEGER', maxLen => 20, dataGen => "IntGen(0, 99999999)" }, - string => { sqlType => 'VARCHAR(255)', maxLen => 255, dataGen => "StringGen(IntGen(10,250))" }, - text => { sqlType => 'TEXT', maxLen => 1000000000, dataGen => "StringGen(IntGen(80,1000))" }, - date => { sqlType => 'BIGINT', maxLen => 80, dataGen => "DateGen(-7, 7, IntGen(0,1400))" }, - float => { sqlType => 'DOUBLE PRECISION', maxLen => 40, dataGen => "FloatGen(0.0, 100.0)" }, - boolean => { sqlType => 'SMALLINT', maxLen => 1, dataGen => "IntGen(0, 1)" }, - 'key-string' => - { sqlType => 'VARCHAR(40)', maxLen => 40, dataGen => "StringGen(IntGen(10,40))" }, - 'name-string' => - { sqlType => 'VARCHAR(80)', maxLen => 80, dataGen => "StringGen(IntGen(10,80))" }, - 'medium-string' => - { sqlType => 'VARCHAR(160)', maxLen => 160, dataGen => "StringGen(IntGen(10,160))" }, - ); +# string is specified in the field definition. "avgLen" is the average byte length for estimating +# record sizes. +my %TypeTable = ( char => { sqlType => 'CHAR(1)', maxLen => 1, avgLen => 1, dataGen => "StringGen('A')" }, + int => { sqlType => 'INTEGER', maxLen => 20, avgLen => 4, dataGen => "IntGen(0, 99999999)" }, + string => { sqlType => 'VARCHAR(255)', maxLen => 255, avgLen => 100, dataGen => "StringGen(IntGen(10,250))" }, + text => { sqlType => 'TEXT', maxLen => 1000000000, avgLen => 500, dataGen => "StringGen(IntGen(80,1000))" }, + date => { sqlType => 'BIGINT', maxLen => 80, avgLen => 8, dataGen => "DateGen(-7, 7, IntGen(0,1400))" }, + float => { sqlType => 'DOUBLE PRECISION', maxLen => 40, avgLen => 8, dataGen => "FloatGen(0.0, 100.0)" }, + boolean => { sqlType => 'SMALLINT', maxLen => 1, avgLen => 1, dataGen => "IntGen(0, 1)" }, + 'key-string' => + { sqlType => 'VARCHAR(40)', maxLen => 40, avgLen => 10, dataGen => "StringGen(IntGen(10,40))" }, + 'name-string' => + { sqlType => 'VARCHAR(80)', maxLen => 80, avgLen => 40, dataGen => "StringGen(IntGen(10,80))" }, + 'medium-string' => + { sqlType => 'VARCHAR(160)', maxLen => 160, avgLen => 40, dataGen => "StringGen(IntGen(10,160))" }, + ); # Table translating arities into natural language. my %ArityTable = ( '11' => 'one-to-one', - '1M' => 'one-to-many', - 'MM' => 'many-to-many' - ); + '1M' => 'one-to-many', + 'MM' => 'many-to-many' + ); # Table for interpreting string patterns. my %PictureTable = ( 'A' => "abcdefghijklmnopqrstuvwxyz", - '9' => "0123456789", - 'X' => "abcdefghijklmnopqrstuvwxyz0123456789", - 'V' => "aeiou", - 'K' => "bcdfghjklmnoprstvwxyz" - ); + '9' => "0123456789", + 'X' => "abcdefghijklmnopqrstuvwxyz0123456789", + 'V' => "aeiou", + 'K' => "bcdfghjklmnoprstvwxyz" + ); =head2 Public Methods @@ -354,22 +356,22 @@ =cut sub new { - # Get the parameters. - my ($class, $dbh, $metaFileName, $options) = @_; - # Load the meta-data. - my $metaData = _LoadMetaData($metaFileName); - # Create the object. - my $self = { _dbh => $dbh, - _metaData => $metaData - }; - # Bless and return it. - bless $self, $class; - return $self; + # Get the parameters. + my ($class, $dbh, $metaFileName, $options) = @_; + # Load the meta-data. + my $metaData = _LoadMetaData($metaFileName); + # Create the object. + my $self = { _dbh => $dbh, + _metaData => $metaData + }; + # Bless and return it. + bless $self, $class; + return $self; } =head3 ShowMetaData -C<< $database->ShowMetaData($fileName); >> +C<< $erdb->ShowMetaData($fileName); >> This method outputs a description of the database. This description can be used to help users create the data to be loaded into the relations. @@ -385,161 +387,161 @@ =cut sub ShowMetaData { - # Get the parameters. - my ($self, $filename) = @_; - # Get the metadata and the title string. - my $metadata = $self->{_metaData}; - # Get the title string. - my $title = $metadata->{Title}; - # Get the entity and relationship lists. - my $entityList = $metadata->{Entities}; - my $relationshipList = $metadata->{Relationships}; - # Open the output file. - open(HTMLOUT, ">$filename") || Confess("Could not open MetaData display file $filename: $!"); - Trace("Building MetaData table of contents.") if T(4); - # Write the HTML heading stuff. - print HTMLOUT "\n\n$title\n"; - print HTMLOUT "\n\n"; - # Here we do the table of contents. It starts as an unordered list of section names. Each - # section contains an ordered list of entity or relationship subsections. - print HTMLOUT "
    \n
  • Entities\n
      \n"; - # Loop through the Entities, displaying a list item for each. - foreach my $key (sort keys %{$entityList}) { - # Display this item. - print HTMLOUT "
    1. $key
    2. \n"; - } - # Close off the entity section and start the relationship section. - print HTMLOUT "
  • \n
  • Relationships\n
      \n"; - # Loop through the Relationships. - foreach my $key (sort keys %{$relationshipList}) { - # Display this item. - my $relationshipTitle = _ComputeRelationshipSentence($key, $relationshipList->{$key}); - print HTMLOUT "
    1. $relationshipTitle
    2. \n"; - } - # Close off the relationship section and list the join table section. - print HTMLOUT "
  • \n
  • Join Table
  • \n"; - # Close off the table of contents itself. - print HTMLOUT "
\n"; - # Now we start with the actual data. Denote we're starting the entity section. - print HTMLOUT "

Entities

\n"; - # Loop through the entities. - for my $key (sort keys %{$entityList}) { - Trace("Building MetaData entry for $key entity.") if T(4); - # Create the entity header. It contains a bookmark and the entity name. - print HTMLOUT "

$key

\n"; - # Get the entity data. - my $entityData = $entityList->{$key}; - # If there's descriptive text, display it. - if (my $notes = $entityData->{Notes}) { - print HTMLOUT "

" . _HTMLNote($notes->{content}) . "

\n"; - } - # Now we want a list of the entity's relationships. First, we set up the relationship subsection. - print HTMLOUT "

Relationships for $key

\n
    \n"; - # Loop through the relationships. - for my $relationship (sort keys %{$relationshipList}) { - # Get the relationship data. - my $relationshipStructure = $relationshipList->{$relationship}; - # Only use the relationship if if has this entity in its FROM or TO fields. - if ($relationshipStructure->{from} eq $key || $relationshipStructure->{to} eq $key) { - # Get the relationship sentence and append the arity. - my $relationshipDescription = _ComputeRelationshipSentence($relationship, $relationshipStructure); - # Display the relationship data. - print HTMLOUT "
  • $relationshipDescription
  • \n"; - } - } - # Close off the relationship list. - print HTMLOUT "
\n"; - # Get the entity's relations. - my $relationList = $entityData->{Relations}; - # Create a header for the relation subsection. - print HTMLOUT "

Relations for $key

\n"; - # Loop through the relations, displaying them. - for my $relation (sort keys %{$relationList}) { - my $htmlString = _ShowRelationTable($relation, $relationList->{$relation}); - print HTMLOUT $htmlString; - } - } - # Denote we're starting the relationship section. - print HTMLOUT "

Relationships

\n"; - # Loop through the relationships. - for my $key (sort keys %{$relationshipList}) { - Trace("Building MetaData entry for $key relationship.") if T(4); - # Get the relationship's structure. - my $relationshipStructure = $relationshipList->{$key}; - # Create the relationship header. - my $headerText = _ComputeRelationshipHeading($key, $relationshipStructure); - print HTMLOUT "

$headerText

\n"; - # Get the entity names. - my $fromEntity = $relationshipStructure->{from}; - my $toEntity = $relationshipStructure->{to}; - # Describe the relationship arity. Note there's a bit of trickiness involving recursive - # many-to-many relationships. In a normal many-to-many we use two sentences to describe - # the arity (one for each direction). This is a bad idea for a recursive relationship, - # since both sentences will say the same thing. - my $arity = $relationshipStructure->{arity}; - if ($arity eq "11") { - print HTMLOUT "

Each $fromEntity relates to at most one $toEntity.\n"; - } else { - print HTMLOUT "

Each $fromEntity relates to multiple $toEntitys.\n"; - if ($arity eq "MM" && $fromEntity ne $toEntity) { - print HTMLOUT "Each $toEntity relates to multiple $fromEntitys.\n"; - } - } - print HTMLOUT "

\n"; - # If there are notes on this relationship, display them. - if (my $notes = $relationshipStructure->{Notes}) { - print HTMLOUT "

" . _HTMLNote($notes->{content}) . "

\n"; - } - # Generate the relationship's relation table. - my $htmlString = _ShowRelationTable($key, $relationshipStructure->{Relations}->{$key}); - print HTMLOUT $htmlString; - } - Trace("Building MetaData join table.") if T(4); - # Denote we're starting the join table. - print HTMLOUT "

Join Table

\n"; - # Create a table header. - print HTMLOUT _OpenTable("Join Table", "Source", "Target", "Join Condition"); - # Loop through the joins. - my $joinTable = $metadata->{Joins}; - my @joinKeys = keys %{$joinTable}; - for my $joinKey (sort @joinKeys) { - # Separate out the source, the target, and the join clause. - $joinKey =~ m!^([^/]+)/(.+)$!; - my ($sourceRelation, $targetRelation) = ($1, $2); - Trace("Join with key $joinKey is from $sourceRelation to $targetRelation.") if T(4); - my $source = $self->ComputeObjectSentence($sourceRelation); - my $target = $self->ComputeObjectSentence($targetRelation); - my $clause = $joinTable->{$joinKey}; - # Display them in a table row. - print HTMLOUT "$source$target$clause\n"; - } - # Close the table. - print HTMLOUT _CloseTable(); - # Close the document. - print HTMLOUT "\n\n"; - # Close the file. - close HTMLOUT; - Trace("Built MetaData web page.") if T(3); + # Get the parameters. + my ($self, $filename) = @_; + # Get the metadata and the title string. + my $metadata = $self->{_metaData}; + # Get the title string. + my $title = $metadata->{Title}; + # Get the entity and relationship lists. + my $entityList = $metadata->{Entities}; + my $relationshipList = $metadata->{Relationships}; + # Open the output file. + open(HTMLOUT, ">$filename") || Confess("Could not open MetaData display file $filename: $!"); + Trace("Building MetaData table of contents.") if T(4); + # Write the HTML heading stuff. + print HTMLOUT "\n\n$title\n"; + print HTMLOUT "\n\n"; + # Here we do the table of contents. It starts as an unordered list of section names. Each + # section contains an ordered list of entity or relationship subsections. + print HTMLOUT "
    \n
  • Entities\n
      \n"; + # Loop through the Entities, displaying a list item for each. + foreach my $key (sort keys %{$entityList}) { + # Display this item. + print HTMLOUT "
    1. $key
    2. \n"; + } + # Close off the entity section and start the relationship section. + print HTMLOUT "
  • \n
  • Relationships\n
      \n"; + # Loop through the Relationships. + foreach my $key (sort keys %{$relationshipList}) { + # Display this item. + my $relationshipTitle = _ComputeRelationshipSentence($key, $relationshipList->{$key}); + print HTMLOUT "
    1. $relationshipTitle
    2. \n"; + } + # Close off the relationship section and list the join table section. + print HTMLOUT "
  • \n
  • Join Table
  • \n"; + # Close off the table of contents itself. + print HTMLOUT "
\n"; + # Now we start with the actual data. Denote we're starting the entity section. + print HTMLOUT "

Entities

\n"; + # Loop through the entities. + for my $key (sort keys %{$entityList}) { + Trace("Building MetaData entry for $key entity.") if T(4); + # Create the entity header. It contains a bookmark and the entity name. + print HTMLOUT "

$key

\n"; + # Get the entity data. + my $entityData = $entityList->{$key}; + # If there's descriptive text, display it. + if (my $notes = $entityData->{Notes}) { + print HTMLOUT "

" . _HTMLNote($notes->{content}) . "

\n"; + } + # Now we want a list of the entity's relationships. First, we set up the relationship subsection. + print HTMLOUT "

Relationships for $key

\n
    \n"; + # Loop through the relationships. + for my $relationship (sort keys %{$relationshipList}) { + # Get the relationship data. + my $relationshipStructure = $relationshipList->{$relationship}; + # Only use the relationship if if has this entity in its FROM or TO fields. + if ($relationshipStructure->{from} eq $key || $relationshipStructure->{to} eq $key) { + # Get the relationship sentence and append the arity. + my $relationshipDescription = _ComputeRelationshipSentence($relationship, $relationshipStructure); + # Display the relationship data. + print HTMLOUT "
  • $relationshipDescription
  • \n"; + } + } + # Close off the relationship list. + print HTMLOUT "
\n"; + # Get the entity's relations. + my $relationList = $entityData->{Relations}; + # Create a header for the relation subsection. + print HTMLOUT "

Relations for $key

\n"; + # Loop through the relations, displaying them. + for my $relation (sort keys %{$relationList}) { + my $htmlString = _ShowRelationTable($relation, $relationList->{$relation}); + print HTMLOUT $htmlString; + } + } + # Denote we're starting the relationship section. + print HTMLOUT "

Relationships

\n"; + # Loop through the relationships. + for my $key (sort keys %{$relationshipList}) { + Trace("Building MetaData entry for $key relationship.") if T(4); + # Get the relationship's structure. + my $relationshipStructure = $relationshipList->{$key}; + # Create the relationship header. + my $headerText = _ComputeRelationshipHeading($key, $relationshipStructure); + print HTMLOUT "

$headerText

\n"; + # Get the entity names. + my $fromEntity = $relationshipStructure->{from}; + my $toEntity = $relationshipStructure->{to}; + # Describe the relationship arity. Note there's a bit of trickiness involving recursive + # many-to-many relationships. In a normal many-to-many we use two sentences to describe + # the arity (one for each direction). This is a bad idea for a recursive relationship, + # since both sentences will say the same thing. + my $arity = $relationshipStructure->{arity}; + if ($arity eq "11") { + print HTMLOUT "

Each $fromEntity relates to at most one $toEntity.\n"; + } else { + print HTMLOUT "

Each $fromEntity relates to multiple $toEntitys.\n"; + if ($arity eq "MM" && $fromEntity ne $toEntity) { + print HTMLOUT "Each $toEntity relates to multiple $fromEntitys.\n"; + } + } + print HTMLOUT "

\n"; + # If there are notes on this relationship, display them. + if (my $notes = $relationshipStructure->{Notes}) { + print HTMLOUT "

" . _HTMLNote($notes->{content}) . "

\n"; + } + # Generate the relationship's relation table. + my $htmlString = _ShowRelationTable($key, $relationshipStructure->{Relations}->{$key}); + print HTMLOUT $htmlString; + } + Trace("Building MetaData join table.") if T(4); + # Denote we're starting the join table. + print HTMLOUT "

Join Table

\n"; + # Create a table header. + print HTMLOUT _OpenTable("Join Table", "Source", "Target", "Join Condition"); + # Loop through the joins. + my $joinTable = $metadata->{Joins}; + my @joinKeys = keys %{$joinTable}; + for my $joinKey (sort @joinKeys) { + # Separate out the source, the target, and the join clause. + $joinKey =~ m!^([^/]+)/(.+)$!; + my ($sourceRelation, $targetRelation) = ($1, $2); + Trace("Join with key $joinKey is from $sourceRelation to $targetRelation.") if T(Joins => 4); + my $source = $self->ComputeObjectSentence($sourceRelation); + my $target = $self->ComputeObjectSentence($targetRelation); + my $clause = $joinTable->{$joinKey}; + # Display them in a table row. + print HTMLOUT "$source$target$clause\n"; + } + # Close the table. + print HTMLOUT _CloseTable(); + # Close the document. + print HTMLOUT "\n\n"; + # Close the file. + close HTMLOUT; + Trace("Built MetaData web page.") if T(3); } =head3 DumpMetaData -C<< $database->DumpMetaData(); >> +C<< $erdb->DumpMetaData(); >> Return a dump of the metadata structure. =cut sub DumpMetaData { - # Get the parameters. - my ($self) = @_; - # Dump the meta-data. - return Data::Dumper::Dumper($self->{_metaData}); + # Get the parameters. + my ($self) = @_; + # Dump the meta-data. + return Data::Dumper::Dumper($self->{_metaData}); } =head3 CreateTables -C<< $datanase->CreateTables(); >> +C<< $erdb->CreateTables(); >> This method creates the tables for the database from the metadata structure loaded by the constructor. It is expected this function will only be used on rare occasions, when the @@ -549,35 +551,21 @@ =cut sub CreateTables { - # Get the parameters. - my ($self) = @_; - my $metadata = $self->{_metaData}; - my $dbh = $self->{_dbh}; - # Loop through the entities. - my $entityHash = $metadata->{Entities}; - for my $entityName (keys %{$entityHash}) { - my $entityData = $entityHash->{$entityName}; - # Tell the user what we're doing. - Trace("Creating relations for entity $entityName.") if T(1); - # Loop through the entity's relations. - for my $relationName (keys %{$entityData->{Relations}}) { - # Create a table for this relation. - $self->CreateTable($relationName); - Trace("Relation $relationName created.") if T(1); - } - } - # Loop through the relationships. - my $relationshipTable = $metadata->{Relationships}; - for my $relationshipName (keys %{$metadata->{Relationships}}) { - # Create a table for this relationship. - Trace("Creating relationship $relationshipName.") if T(1); - $self->CreateTable($relationshipName); - } + # Get the parameters. + my ($self) = @_; + # Get the relation names. + my @relNames = $self->GetTableNames(); + # Loop through the relations. + for my $relationName (@relNames) { + # Create a table for this relation. + $self->CreateTable($relationName); + Trace("Relation $relationName created.") if T(2); + } } =head3 CreateTable -C<< $database->CreateTable($tableName, $indexFlag); >> +C<< $erdb->CreateTable($tableName, $indexFlag, $estimatedRows); >> Create the table for a relation and optionally create its indexes. @@ -587,87 +575,159 @@ Name of the relation (which will also be the table name). -=item $indexFlag +=item indexFlag TRUE if the indexes for the relation should be created, else FALSE. If FALSE, L must be called later to bring the indexes into existence. +=item estimatedRows (optional) + +If specified, the estimated maximum number of rows for the relation. This +information allows the creation of tables using storage engines that are +faster but require size estimates, such as MyISAM. + =back =cut sub CreateTable { - # Get the parameters. - my ($self, $relationName, $indexFlag) = @_; - # Get the database handle. - my $dbh = $self->{_dbh}; - # Get the relation data and determine whether or not the relation is primary. - my $relationData = $self->_FindRelation($relationName); - my $rootFlag = $self->_IsPrimary($relationName); - # Create a list of the field data. - my @fieldList; - for my $fieldData (@{$relationData->{Fields}}) { - # Assemble the field name and type. - my $fieldName = _FixName($fieldData->{name}); - my $fieldString = "$fieldName $TypeTable{$fieldData->{type}}->{sqlType} NOT NULL "; - # Push the result into the field list. - push @fieldList, $fieldString; - } - # If this is a root table, add the "new_record" flag. It defaults to 0, so - if ($rootFlag) { - push @fieldList, "new_record $TypeTable{boolean}->{sqlType} NOT NULL DEFAULT 0"; - } - # Convert the field list into a comma-delimited string. - my $fieldThing = join(', ', @fieldList); - # Insure the table is not already there. - $dbh->drop_table(tbl => $relationName); - Trace("Table $relationName dropped.") if T(2); - # Create the table. - Trace("Creating table $relationName: $fieldThing") if T(2); - $dbh->create_table(tbl => $relationName, flds => $fieldThing); - Trace("Relation $relationName created in database.") if T(2); - # If we want to build the indexes, we do it here. - if ($indexFlag) { - $self->CreateIndex($relationName); - } + # Get the parameters. + my ($self, $relationName, $indexFlag, $estimatedRows) = @_; + # Get the database handle. + my $dbh = $self->{_dbh}; + # Get the relation data and determine whether or not the relation is primary. + my $relationData = $self->_FindRelation($relationName); + my $rootFlag = $self->_IsPrimary($relationName); + # Create a list of the field data. + my @fieldList; + for my $fieldData (@{$relationData->{Fields}}) { + # Assemble the field name and type. + my $fieldName = _FixName($fieldData->{name}); + my $fieldString = "$fieldName $TypeTable{$fieldData->{type}}->{sqlType} NOT NULL "; + # Push the result into the field list. + push @fieldList, $fieldString; + } + # If this is a root table, add the "new_record" flag. It defaults to 0, so + if ($rootFlag) { + push @fieldList, "new_record $TypeTable{boolean}->{sqlType} NOT NULL DEFAULT 0"; + } + # Convert the field list into a comma-delimited string. + my $fieldThing = join(', ', @fieldList); + # Insure the table is not already there. + $dbh->drop_table(tbl => $relationName); + Trace("Table $relationName dropped.") if T(2); + # If there are estimated rows, create an estimate so we can take advantage of + # faster DB technologies. + my $estimation = undef; + if ($estimatedRows) { + $estimation = [$self->EstimateRowSize($relationName), $estimatedRows]; + } + # Create the table. + Trace("Creating table $relationName: $fieldThing") if T(2); + $dbh->create_table(tbl => $relationName, flds => $fieldThing, estimates => $estimation); + Trace("Relation $relationName created in database.") if T(2); + # If we want to build the indexes, we do it here. + if ($indexFlag) { + $self->CreateIndex($relationName); + } +} + +=head3 VerifyFields + +C<< my $count = $erdb->VerifyFields($relName, \@fieldList); >> + +Run through the list of proposed field values, insuring that all the character fields are +below the maximum length. If any fields are too long, they will be truncated in place. + +=over 4 + +=item relName + +Name of the relation for which the specified fields are destined. + +=item fieldList + +Reference to a list, in order, of the fields to be put into the relation. + +=item RETURN + +Returns the number of fields truncated. + +=back + +=cut + +sub VerifyFields { + # Get the parameters. + my ($self, $relName, $fieldList) = @_; + # Initialize the return value. + my $retVal = 0; + # Get the relation definition. + my $relData = $self->_FindRelation($relName); + # Get the list of field descriptors. + my $fieldTypes = $relData->{Fields}; + my $fieldCount = scalar @{$fieldTypes}; + # Loop through the two lists. + for (my $i = 0; $i < $fieldCount; $i++) { + # Get the type of the current field. + my $fieldType = $fieldTypes->[$i]->{type}; + # If it's a character field, verify the length. + if ($fieldType =~ /string/) { + my $maxLen = $TypeTable{$fieldType}->{maxLen}; + my $oldString = $fieldList->[$i]; + if (length($oldString) > $maxLen) { + # Here it's too big, so we truncate it. + Trace("Truncating field $i in relation $relName to $maxLen characters from \"$oldString\".") if T(1); + $fieldList->[$i] = substr $oldString, 0, $maxLen; + $retVal++; + } + } + } + # Return the truncation count. + return $retVal; } =head3 CreateIndex -C<< $database->CreateIndex($relationName); >> +C<< $erdb->CreateIndex($relationName); >> Create the indexes for a relation. If a table is being loaded from a large source file (as -is the case in L), it is best to create the indexes after the load. If that is -the case, then L should be called with the index flag set to FALSE, and this -method used after the load to create the indexes for the table. +is the case in L), it is sometimes best to create the indexes after the load. +If that is the case, then L should be called with the index flag set to +FALSE, and this method used after the load to create the indexes for the table. =cut sub CreateIndex { - # Get the parameters. - my ($self, $relationName) = @_; - # Get the relation's descriptor. - my $relationData = $self->_FindRelation($relationName); - # Get the database handle. - my $dbh = $self->{_dbh}; - # Now we need to create this relation's indexes. We do this by looping through its index table. - my $indexHash = $relationData->{Indexes}; - for my $indexName (keys %{$indexHash}) { - my $indexData = $indexHash->{$indexName}; - # Get the index's field list. - my @fieldList = _FixNames(@{$indexData->{IndexFields}}); - my $flds = join(', ', @fieldList); - # Get the index's uniqueness flag. - my $unique = (exists $indexData->{Unique} ? $indexData->{Unique} : 'false'); - # Create the index. - $dbh->create_index(idx => $indexName, tbl => $relationName, flds => $flds, unique => $unique); - Trace("Index created: $indexName for $relationName ($flds)") if T(1); - } + # Get the parameters. + my ($self, $relationName) = @_; + # Get the relation's descriptor. + my $relationData = $self->_FindRelation($relationName); + # Get the database handle. + my $dbh = $self->{_dbh}; + # Now we need to create this relation's indexes. We do this by looping through its index table. + my $indexHash = $relationData->{Indexes}; + for my $indexName (keys %{$indexHash}) { + my $indexData = $indexHash->{$indexName}; + # Get the index's field list. + my @fieldList = _FixNames(@{$indexData->{IndexFields}}); + my $flds = join(', ', @fieldList); + # Get the index's uniqueness flag. + my $unique = (exists $indexData->{Unique} ? $indexData->{Unique} : 'false'); + # Create the index. + my $rv = $dbh->create_index(idx => $indexName, tbl => $relationName, + flds => $flds, unique => $unique); + if ($rv) { + Trace("Index created: $indexName for $relationName ($flds)") if T(1); + } else { + Confess("Error creating index $indexName for $relationName using ($flds): " . $dbh->error_message()); + } + } } =head3 LoadTables -C<< my $stats = $database->LoadTables($directoryName, $rebuild); >> +C<< my $stats = $erdb->LoadTables($directoryName, $rebuild); >> This method will load the database tables from a directory. The tables must already have been created in the database. (This can be done by calling L.) The caller passes in a directory name; @@ -702,76 +762,93 @@ =cut sub LoadTables { - # Get the parameters. - my ($self, $directoryName, $rebuild) = @_; - # Start the timer. - my $startTime = gettimeofday; - # Clean any trailing slash from the directory name. - $directoryName =~ s!/\\$!!; - # Declare the return variable. - my $retVal = Stats->new(); - # Get the metadata structure. - my $metaData = $self->{_metaData}; - # Loop through the entities. - for my $entity (values %{$metaData->{Entities}}) { - # Loop through the entity's relations. - for my $relationName (keys %{$entity->{Relations}}) { - # Try to load this relation. - my $result = $self->_LoadRelation($directoryName, $relationName, $rebuild); - # Accumulate the statistics. - $retVal->Accumulate($result); - } - } - # Loop through the relationships. - for my $relationshipName (keys %{$metaData->{Relationships}}) { - # Try to load this relationship's relation. - my $result = $self->_LoadRelation($directoryName, $relationshipName, $rebuild); - # Accumulate the statistics. - $retVal->Accumulate($result); - } - # Add the duration of the load to the statistical object. - $retVal->Add('duration', gettimeofday - $startTime); - # Return the accumulated statistics. - return $retVal; + # Get the parameters. + my ($self, $directoryName, $rebuild) = @_; + # Start the timer. + my $startTime = gettimeofday; + # Clean any trailing slash from the directory name. + $directoryName =~ s!/\\$!!; + # Declare the return variable. + my $retVal = Stats->new(); + # Get the relation names. + my @relNames = $self->GetTableNames(); + for my $relationName (@relNames) { + # Try to load this relation. + my $result = $self->_LoadRelation($directoryName, $relationName, $rebuild); + # Accumulate the statistics. + $retVal->Accumulate($result); + } + # Add the duration of the load to the statistical object. + $retVal->Add('duration', gettimeofday - $startTime); + # Return the accumulated statistics. + return $retVal; } + =head3 GetTableNames -C<< my @names = $database->GetTableNames; >> +C<< my @names = $erdb->GetTableNames; >> Return a list of the relations required to implement this database. =cut sub GetTableNames { - # Get the parameters. - my ($self) = @_; - # Get the relation list from the metadata. - my $relationTable = $self->{_metaData}->{RelationTable}; - # Return the relation names. - return keys %{$relationTable}; + # Get the parameters. + my ($self) = @_; + # Get the relation list from the metadata. + my $relationTable = $self->{_metaData}->{RelationTable}; + # Return the relation names. + return keys %{$relationTable}; } =head3 GetEntityTypes -C<< my @names = $database->GetEntityTypes; >> +C<< my @names = $erdb->GetEntityTypes; >> Return a list of the entity type names. =cut sub GetEntityTypes { - # Get the database object. - my ($self) = @_; - # Get the entity list from the metadata object. - my $entityList = $self->{_metaData}->{Entities}; - # Return the list of entity names in alphabetical order. - return sort keys %{$entityList}; + # Get the database object. + my ($self) = @_; + # Get the entity list from the metadata object. + my $entityList = $self->{_metaData}->{Entities}; + # Return the list of entity names in alphabetical order. + return sort keys %{$entityList}; +} + +=head3 IsEntity + +C<< my $flag = $erdb->IsEntity($entityName); >> + +Return TRUE if the parameter is an entity name, else FALSE. + +=over 4 + +=item entityName + +Object name to be tested. + +=item RETURN + +Returns TRUE if the specified string is an entity name, else FALSE. + +=back + +=cut + +sub IsEntity { + # Get the parameters. + my ($self, $entityName) = @_; + # Test to see if it's an entity. + return exists $self->{_metaData}->{Entities}->{$entityName}; } =head3 Get -C<< my $query = $database->Get(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >> +C<< my $query = $erdb->Get(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >> This method returns a query object for entities of a specified type using a specified filter. The filter is a standard WHERE/ORDER BY clause with question marks as parameter markers and each @@ -779,12 +856,12 @@ following call requests all B objects for the genus specified in the variable $genus. -C<< $query = $sprout->Get(['Genome'], "Genome(genus) = ?", $genus); >> +C<< $query = $erdb->Get(['Genome'], "Genome(genus) = ?", $genus); >> The WHERE clause contains a single question mark, so there is a single additional parameter representing the parameter value. It would also be possible to code -C<< $query = $sprout->Get(['Genome'], "Genome(genus) = \'$genus\'"); >> +C<< $query = $erdb->Get(['Genome'], "Genome(genus) = \'$genus\'"); >> however, this version of the call would generate a syntax error if there were any quote characters inside the variable C<$genus>. @@ -796,7 +873,7 @@ It is possible to specify multiple entity and relationship names in order to retrieve more than one object's data at the same time, which allows highly complex joined queries. For example, -C<< $query = $sprout->Get(['Genome', 'ComesFrom', 'Source'], "Genome(genus) = ?", $genus); >> +C<< $query = $erdb->Get(['Genome', 'ComesFrom', 'Source'], "Genome(genus) = ?", $genus); >> If multiple names are specified, then the query processor will automatically determine a join path between the entities and relationships. The algorithm used is very simplistic. @@ -829,6 +906,9 @@ C<< "Genome(genus) = ? ORDER BY Genome(species)" >> +Note that the case is important. Only an uppercase "ORDER BY" with a single space will +be processed. The idea is to make it less likely to find the verb by accident. + The rules for field references in a sort order are the same as those for field references in the filter clause in general; however, odd things may happen if a sort field is from a secondary relation. @@ -846,132 +926,302 @@ =cut sub Get { - # Get the parameters. - my ($self, $objectNames, $filterClause, @params) = @_; - # Construct the SELECT statement. The general pattern is - # - # SELECT name1.*, name2.*, ... nameN.* FROM name1, name2, ... nameN - # - my $dbh = $self->{_dbh}; - my $command = "SELECT DISTINCT " . join('.*, ', @{$objectNames}) . ".* FROM " . - join(', ', @{$objectNames}); - # Check for a filter clause. - if ($filterClause) { - # Here we have one, so we convert its field names and add it to the query. First, - # We create a copy of the filter string we can work with. - my $filterString = $filterClause; - # Next, we sort the object names by length. This helps protect us from finding - # object names inside other object names when we're doing our search and replace. - my @sortedNames = sort { length($b) - length($a) } @{$objectNames}; - # We will also keep a list of conditions to add to the WHERE clause in order to link - # entities and relationships as well as primary relations to secondary ones. - my @joinWhere = (); - # The final preparatory step is to create a hash table of relation names. The - # table begins with the relation names already in the SELECT command. - my %fromNames = (); - for my $objectName (@sortedNames) { - $fromNames{$objectName} = 1; - } - # We are ready to begin. We loop through the object names, replacing each - # object name's field references by the corresponding SQL field reference. - # Along the way, if we find a secondary relation, we will need to add it - # to the FROM clause. - for my $objectName (@sortedNames) { - # Get the length of the object name plus 2. This is the value we add to the - # size of the field name to determine the size of the field reference as a - # whole. - my $nameLength = 2 + length $objectName; - # Get the object's field list. - my $fieldList = $self->_GetFieldTable($objectName); - # Find the field references for this object. - while ($filterString =~ m/$objectName\(([^)]*)\)/g) { - # At this point, $1 contains the field name, and the current position - # is set immediately after the final parenthesis. We pull out the name of - # the field and the position and length of the field reference as a whole. - my $fieldName = $1; - my $len = $nameLength + length $fieldName; - my $pos = pos($filterString) - $len; - # Insure the field exists. - if (!exists $fieldList->{$fieldName}) { - Confess("Field $fieldName not found for object $objectName."); - } else { - # Get the field's relation. - my $relationName = $fieldList->{$fieldName}->{relation}; - # Insure the relation is in the FROM clause. - if (!exists $fromNames{$relationName}) { - # Add the relation to the FROM clause. - $command .= ", $relationName"; - # Create its join sub-clause. - push @joinWhere, "$objectName.id = $relationName.id"; - # Denote we have it available for future fields. - $fromNames{$relationName} = 1; - } - # Form an SQL field reference from the relation name and the field name. - my $sqlReference = "$relationName." . _FixName($fieldName); - # Put it into the filter string in place of the old value. - substr($filterString, $pos, $len) = $sqlReference; - # Reposition the search. - pos $filterString = $pos + length $sqlReference; - } - } - } - # The next step is to join the objects together. We only need to do this if there - # is more than one object in the object list. We start with the first object and - # run through the objects after it. Note also that we make a safety copy of the - # list before running through it. - my @objectList = @{$objectNames}; - my $lastObject = shift @objectList; - # Get the join table. - my $joinTable = $self->{_metaData}->{Joins}; - # Loop through the object list. - for my $thisObject (@objectList) { - # Look for a join. - my $joinKey = "$lastObject/$thisObject"; - if (!exists $joinTable->{$joinKey}) { - # Here there's no join, so we throw an error. - Confess("No join exists to connect from $lastObject to $thisObject."); - } else { - # Get the join clause and add it to the WHERE list. - push @joinWhere, $joinTable->{$joinKey}; - # Save this object as the last object for the next iteration. - $lastObject = $thisObject; - } - } - # Now we need to handle the whole ORDER BY thing. We'll put the order by clause - # in the following variable. - my $orderClause = ""; - # Locate the ORDER BY verb (if any). - if ($filterString =~ m/^(.*)ORDER BY/g) { - # Here we have an ORDER BY verb. Split it off of the filter string. - my $pos = pos $filterString; - $orderClause = substr($filterString, $pos); - $filterString = $1; - } - # Add the filter and the join clauses (if any) to the SELECT command. - if ($filterString) { - push @joinWhere, "($filterString)"; - } - if (@joinWhere) { - $command .= " WHERE " . join(' AND ', @joinWhere); - } - # Add the sort clause (if any) to the SELECT command. - if ($orderClause) { - $command .= " ORDER BY $orderClause"; - } - } - Trace("SQL query: $command") if T(2); - Trace("PARMS: '" . (join "', '", @params) . "'") if (T(3) && (@params > 0)); - my $sth = $dbh->prepare_command($command); - # Execute it with the parameters bound in. - $sth->execute(@params) || Confess("SELECT error" . $sth->errstr()); - # Return the statement object. - my $retVal = DBQuery::_new($self, $sth, @{$objectNames}); - return $retVal; + # Get the parameters. + my ($self, $objectNames, $filterClause, @params) = @_; + # Construct the SELECT statement. The general pattern is + # + # SELECT name1.*, name2.*, ... nameN.* FROM name1, name2, ... nameN + # + my $dbh = $self->{_dbh}; + my $command = "SELECT DISTINCT " . join('.*, ', @{$objectNames}) . ".* FROM " . + join(', ', @{$objectNames}); + # Check for a filter clause. + if ($filterClause) { + # Here we have one, so we convert its field names and add it to the query. First, + # We create a copy of the filter string we can work with. + my $filterString = $filterClause; + # Next, we sort the object names by length. This helps protect us from finding + # object names inside other object names when we're doing our search and replace. + my @sortedNames = sort { length($b) - length($a) } @{$objectNames}; + # We will also keep a list of conditions to add to the WHERE clause in order to link + # entities and relationships as well as primary relations to secondary ones. + my @joinWhere = (); + # The final preparatory step is to create a hash table of relation names. The + # table begins with the relation names already in the SELECT command. + my %fromNames = (); + for my $objectName (@sortedNames) { + $fromNames{$objectName} = 1; + } + # We are ready to begin. We loop through the object names, replacing each + # object name's field references by the corresponding SQL field reference. + # Along the way, if we find a secondary relation, we will need to add it + # to the FROM clause. + for my $objectName (@sortedNames) { + # Get the length of the object name plus 2. This is the value we add to the + # size of the field name to determine the size of the field reference as a + # whole. + my $nameLength = 2 + length $objectName; + # Get the object's field list. + my $fieldList = $self->_GetFieldTable($objectName); + # Find the field references for this object. + while ($filterString =~ m/$objectName\(([^)]*)\)/g) { + # At this point, $1 contains the field name, and the current position + # is set immediately after the final parenthesis. We pull out the name of + # the field and the position and length of the field reference as a whole. + my $fieldName = $1; + my $len = $nameLength + length $fieldName; + my $pos = pos($filterString) - $len; + # Insure the field exists. + if (!exists $fieldList->{$fieldName}) { + Confess("Field $fieldName not found for object $objectName."); + } else { + # Get the field's relation. + my $relationName = $fieldList->{$fieldName}->{relation}; + # Insure the relation is in the FROM clause. + if (!exists $fromNames{$relationName}) { + # Add the relation to the FROM clause. + $command .= ", $relationName"; + # Create its join sub-clause. + push @joinWhere, "$objectName.id = $relationName.id"; + # Denote we have it available for future fields. + $fromNames{$relationName} = 1; + } + # Form an SQL field reference from the relation name and the field name. + my $sqlReference = "$relationName." . _FixName($fieldName); + # Put it into the filter string in place of the old value. + substr($filterString, $pos, $len) = $sqlReference; + # Reposition the search. + pos $filterString = $pos + length $sqlReference; + } + } + } + # The next step is to join the objects together. We only need to do this if there + # is more than one object in the object list. We start with the first object and + # run through the objects after it. Note also that we make a safety copy of the + # list before running through it. + my @objectList = @{$objectNames}; + my $lastObject = shift @objectList; + # Get the join table. + my $joinTable = $self->{_metaData}->{Joins}; + # Loop through the object list. + for my $thisObject (@objectList) { + # Look for a join. + my $joinKey = "$lastObject/$thisObject"; + if (!exists $joinTable->{$joinKey}) { + # Here there's no join, so we throw an error. + Confess("No join exists to connect from $lastObject to $thisObject."); + } else { + # Get the join clause and add it to the WHERE list. + push @joinWhere, $joinTable->{$joinKey}; + # Save this object as the last object for the next iteration. + $lastObject = $thisObject; + } + } + # Now we need to handle the whole ORDER BY / LIMIT thing. The important part + # here is we want the filter clause to be empty if there's no WHERE filter. + # We'll put the ORDER BY / LIMIT clauses in the following variable. + my $orderClause = ""; + # Locate the ORDER BY or LIMIT verbs (if any). We use a non-greedy + # operator so that we find the first occurrence of either verb. + if ($filterString =~ m/^(.*?)\s*(ORDER BY|LIMIT)/g) { + # Here we have an ORDER BY or LIMIT verb. Split it off of the filter string. + my $pos = pos $filterString; + $orderClause = $2 . substr($filterString, $pos); + $filterString = $1; + } + # Add the filter and the join clauses (if any) to the SELECT command. + if ($filterString) { + push @joinWhere, "($filterString)"; + } + if (@joinWhere) { + $command .= " WHERE " . join(' AND ', @joinWhere); + } + # Add the sort or limit clause (if any) to the SELECT command. + if ($orderClause) { + $command .= " $orderClause"; + } + } + Trace("SQL query: $command") if T(SQL => 4); + Trace("PARMS: '" . (join "', '", @params) . "'") if (T(SQL => 4) && (@params > 0)); + my $sth = $dbh->prepare_command($command); + # Execute it with the parameters bound in. + $sth->execute(@params) || Confess("SELECT error" . $sth->errstr()); + # Return the statement object. + my $retVal = DBQuery::_new($self, $sth, @{$objectNames}); + return $retVal; +} + +=head3 Delete + +C<< my $stats = $erdb->Delete($entityName, $objectID); >> + +Delete an entity instance from the database. The instance is deleted along with all entity and +relationship instances dependent on it. The idea of dependence here is recursive. An object is +always dependent on itself. An object is dependent if it is a 1-to-many or many-to-many +relationship connected to a dependent entity or the "to" entity connected to a 1-to-many +dependent relationship. + +=over 4 + +=item entityName + +Name of the entity type for the instance being deleted. + +=item objectID + +ID of the entity instance to be deleted. If the ID contains a wild card character (C<%>), +then it is presumed to by a LIKE pattern. + +=item testFlag + +If TRUE, the delete statements will be traced without being executed. + +=item RETURN + +Returns a statistics object indicating how many records of each particular table were +deleted. + +=back + +=cut +#: Return Type $%; +sub Delete { + # Get the parameters. + my ($self, $entityName, $objectID, $testFlag) = @_; + # Declare the return variable. + my $retVal = Stats->new(); + # Get the DBKernel object. + my $db = $self->{_dbh}; + # We're going to generate all the paths branching out from the starting entity. One of + # the things we have to be careful about is preventing loops. We'll use a hash to + # determine if we've hit a loop. + my %alreadyFound = (); + # These next lists will serve as our result stack. We start by pushing object lists onto + # the stack, and then popping them off to do the deletes. This means the deletes will + # start with the longer paths before getting to the shorter ones. That, in turn, makes + # sure we don't delete records that might be needed to forge relationships back to the + # original item. We have two lists-- one for TO-relationships, and one for + # FROM-relationships and entities. + my @fromPathList = (); + my @toPathList = (); + # This final hash is used to remember what work still needs to be done. We push paths + # onto the list, then pop them off to extend the paths. We prime it with the starting + # point. Note that we will work hard to insure that the last item on a path in the + # TODO list is always an entity. + my @todoList = ([$entityName]); + while (@todoList) { + # Get the current path. + my $current = pop @todoList; + # Copy it into a list. + my @stackedPath = @{$current}; + # Pull off the last item on the path. It will always be an entity. + my $entityName = pop @stackedPath; + # Add it to the alreadyFound list. + $alreadyFound{$entityName} = 1; + # Get the entity data. + my $entityData = $self->_GetStructure($entityName); + # The first task is to loop through the entity's relation. A DELETE command will + # be needed for each of them. + my $relations = $entityData->{Relations}; + for my $relation (keys %{$relations}) { + my @augmentedList = (@stackedPath, $relation); + push @fromPathList, \@augmentedList; + } + # Now we need to look for relationships connected to this entity. + my $relationshipList = $self->{_metaData}->{Relationships}; + for my $relationshipName (keys %{$relationshipList}) { + my $relationship = $relationshipList->{$relationshipName}; + # Check the FROM field. We're only interested if it's us. + if ($relationship->{from} eq $entityName) { + # Add the path to this relationship. + my @augmentedList = (@stackedPath, $entityName, $relationshipName); + push @fromPathList, \@augmentedList; + # Check the arity. If it's MM we're done. If it's 1M + # and the target hasn't been seen yet, we want to + # stack the entity for future processing. + if ($relationship->{arity} eq '1M') { + my $toEntity = $relationship->{to}; + if (! exists $alreadyFound{$toEntity}) { + # Here we have a new entity that's dependent on + # the current entity, so we need to stack it. + my @stackList = (@augmentedList, $toEntity); + push @fromPathList, \@stackList; + } + } + } + # Now check the TO field. In this case only the relationship needs + # deletion. + if ($relationship->{to} eq $entityName) { + my @augmentedList = (@stackedPath, $entityName, $relationshipName); + push @toPathList, \@augmentedList; + } + } + } + # Create the first qualifier for the WHERE clause. This selects the + # keys of the primary entity records to be deleted. When we're deleting + # from a dependent table, we construct a join page from the first qualifier + # to the table containing the dependent records to delete. + my $qualifier = ($objectID =~ /%/ ? "LIKE ?" : "= ?"); + # We need to make two passes. The first is through the to-list, and + # the second through the from-list. The from-list is second because + # the to-list may need to pass through some of the entities the + # from-list would delete. + my %stackList = ( from_link => \@fromPathList, to_link => \@toPathList ); + # Now it's time to do the deletes. We do it in two passes. + for my $keyName ('to_link', 'from_link') { + # Get the list for this key. + my @pathList = @{$stackList{$keyName}}; + # Loop through this list. + while (my $path = pop @pathList) { + # Get the table whose rows are to be deleted. + my @pathTables = @{$path}; + # Start the DELETE statement. + my $target = $pathTables[$#pathTables]; + my $stmt = "DELETE FROM $target"; + # If there's more than just the one table, we need a USING clause. + if (@pathTables > 1) { + $stmt .= " USING " . join(", ", @pathTables[0 .. ($#pathTables - 1)]); + } + # Now start the WHERE. The first thing is the ID field from the starting table. That + # starting table will either be the entity relation or one of the entity's + # sub-relations. + $stmt .= " WHERE $pathTables[0].id $qualifier"; + # Now we run through the remaining entities in the path, connecting them up. + for (my $i = 1; $i <= $#pathTables; $i += 2) { + # Connect the current relationship to the preceding entity. + my ($entity, $rel) = @pathTables[$i-1,$i]; + # The style of connection depends on the direction of the relationship. + $stmt .= " AND $entity.id = $rel.from_link"; + if ($i + 1 <= $#pathTables) { + # Here there's a next entity, so connect that to the relationship's + # to-link. + my $entity2 = $pathTables[$i+1]; + $stmt .= " AND $rel.$keyName = $entity2.id"; + } + } + # Now we have our desired DELETE statement. + if ($testFlag) { + # Here the user wants to trace without executing. + Trace($stmt) if T(0); + } else { + # Here we can delete. Note that the SQL method dies with a confessing + # if an error occurs, so we just go ahead and do it. + Trace("Executing delete: $stmt") if T(3); + my $rv = $db->SQL($stmt, 0, [$objectID]); + # Accumulate the statistics for this delete. The only rows deleted + # are from the target table, so we use its name to record the + # statistic. + $retVal->Add($target, $rv); + } + } + } + # Return the result. + return $retVal; } =head3 GetList -C<< my @dbObjects = $database->GetList(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >> +C<< my @dbObjects = $erdb->GetList(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >> Return a list of object descriptors for the specified objects as determined by the specified filter clause. @@ -1020,21 +1270,21 @@ sub GetList { # Get the parameters. my ($self, $objectNames, $filterClause, @params) = @_; - # Declare the return variable. - my @retVal = (); - # Perform the query. - my $query = $self->Get($objectNames, $filterClause, @params); - # Loop through the results. - while (my $object = $query->Fetch) { - push @retVal, $object; - } + # Declare the return variable. + my @retVal = (); + # Perform the query. + my $query = $self->Get($objectNames, $filterClause, @params); + # Loop through the results. + while (my $object = $query->Fetch) { + push @retVal, $object; + } # Return the result. return @retVal; } =head3 ComputeObjectSentence -C<< my $sentence = $database->ComputeObjectSentence($objectName); >> +C<< my $sentence = $erdb->ComputeObjectSentence($objectName); >> Check an object name, and if it is a relationship convert it to a relationship sentence. @@ -1053,23 +1303,23 @@ =cut sub ComputeObjectSentence { - # Get the parameters. - my ($self, $objectName) = @_; - # Set the default return value. - my $retVal = $objectName; - # Look for the object as a relationship. - my $relTable = $self->{_metaData}->{Relationships}; - if (exists $relTable->{$objectName}) { - # Get the relationship sentence. - $retVal = _ComputeRelationshipSentence($objectName, $relTable->{$objectName}); - } - # Return the result. - return $retVal; + # Get the parameters. + my ($self, $objectName) = @_; + # Set the default return value. + my $retVal = $objectName; + # Look for the object as a relationship. + my $relTable = $self->{_metaData}->{Relationships}; + if (exists $relTable->{$objectName}) { + # Get the relationship sentence. + $retVal = _ComputeRelationshipSentence($objectName, $relTable->{$objectName}); + } + # Return the result. + return $retVal; } =head3 DumpRelations -C<< $database->DumpRelations($outputDirectory); >> +C<< $erdb->DumpRelations($outputDirectory); >> Write the contents of all the relations to tab-delimited files in the specified directory. Each file will have the same name as the relation dumped, with an extension of DTX. @@ -1085,33 +1335,33 @@ =cut sub DumpRelations { - # Get the parameters. - my ($self, $outputDirectory) = @_; - # Now we need to run through all the relations. First, we loop through the entities. - my $metaData = $self->{_metaData}; - my $entities = $metaData->{Entities}; - for my $entityName (keys %{$entities}) { - my $entityStructure = $entities->{$entityName}; - # Get the entity's relations. - my $relationList = $entityStructure->{Relations}; - # Loop through the relations, dumping them. - for my $relationName (keys %{$relationList}) { - my $relation = $relationList->{$relationName}; - $self->_DumpRelation($outputDirectory, $relationName, $relation); - } - } - # Next, we loop through the relationships. - my $relationships = $metaData->{Relationships}; - for my $relationshipName (keys %{$relationships}) { - my $relationshipStructure = $relationships->{$relationshipName}; - # Dump this relationship's relation. - $self->_DumpRelation($outputDirectory, $relationshipName, $relationshipStructure->{Relations}->{$relationshipName}); - } + # Get the parameters. + my ($self, $outputDirectory) = @_; + # Now we need to run through all the relations. First, we loop through the entities. + my $metaData = $self->{_metaData}; + my $entities = $metaData->{Entities}; + for my $entityName (keys %{$entities}) { + my $entityStructure = $entities->{$entityName}; + # Get the entity's relations. + my $relationList = $entityStructure->{Relations}; + # Loop through the relations, dumping them. + for my $relationName (keys %{$relationList}) { + my $relation = $relationList->{$relationName}; + $self->_DumpRelation($outputDirectory, $relationName, $relation); + } + } + # Next, we loop through the relationships. + my $relationships = $metaData->{Relationships}; + for my $relationshipName (keys %{$relationships}) { + my $relationshipStructure = $relationships->{$relationshipName}; + # Dump this relationship's relation. + $self->_DumpRelation($outputDirectory, $relationshipName, $relationshipStructure->{Relations}->{$relationshipName}); + } } =head3 InsertObject -C<< my $ok = $database->InsertObject($objectType, \%fieldHash); >> +C<< my $ok = $erdb->InsertObject($objectType, \%fieldHash); >> Insert an object into the database. The object is defined by a type name and then a hash of field names to values. Field values in the primary relation are represented by scalars. @@ -1120,12 +1370,12 @@ example, the following line inserts an inactive PEG feature named C with aliases C and C. -C<< $database->InsertObject('Feature', { id => 'fig|188.1.peg.1', active => 0, feature-type => 'peg', alias => ['ZP_00210270.1', 'gi|46206278']}); >> +C<< $erdb->InsertObject('Feature', { id => 'fig|188.1.peg.1', active => 0, feature-type => 'peg', alias => ['ZP_00210270.1', 'gi|46206278']}); >> The next statement inserts a C relationship between feature C and property C<4> with an evidence URL of C. -C<< $database->InsertObject('HasProperty', { 'from-link' => 'fig|158879.1.peg.1', 'to-link' => 4, evidence = 'http://seedu.uchicago.edu/query.cgi?article_id=142'}); >> +C<< $erdb->InsertObject('HasProperty', { 'from-link' => 'fig|158879.1.peg.1', 'to-link' => 4, evidence = 'http://seedu.uchicago.edu/query.cgi?article_id=142'}); >> =over 4 @@ -1146,113 +1396,114 @@ =cut sub InsertObject { - # Get the parameters. - my ($self, $newObjectType, $fieldHash) = @_; - # Denote that so far we appear successful. - my $retVal = 1; - # Get the database handle. - my $dbh = $self->{_dbh}; - # Get the relation list. - my $relationTable = $self->_GetRelationTable($newObjectType); - # Loop through the relations. We'll build insert statements for each one. If a relation is - # secondary, we may end up generating multiple insert statements. If an error occurs, we - # stop the loop. - my @relationList = keys %{$relationTable}; - for (my $i = 0; $retVal && $i <= $#relationList; $i++) { - my $relationName = $relationList[$i]; - my $relationDefinition = $relationTable->{$relationName}; - # Get the relation's fields. For each field we will collect a value in the corresponding - # position of the @valueList array. If one of the fields is missing, we will add it to the - # @missing list. - my @fieldList = @{$relationDefinition->{Fields}}; - my @fieldNameList = (); - my @valueList = (); - my @missing = (); - my $recordCount = 1; - for my $fieldDescriptor (@fieldList) { - # Get the field name and save it. Note we need to fix it up so the hyphens - # are converted to underscores. - my $fieldName = $fieldDescriptor->{name}; - push @fieldNameList, _FixName($fieldName); - # Look for the named field in the incoming structure. Note that we are looking - # for the real field name, not the fixed-up one! - if (exists $fieldHash->{$fieldName}) { - # Here we found the field. Stash it in the value list. - my $value = $fieldHash->{$fieldName}; - push @valueList, $value; - # If the value is a list, we may need to increment the record count. - if (ref $value eq "ARRAY") { - my $thisCount = @{$value}; - if ($recordCount == 1) { - # Here we have our first list, so we save its count. - $recordCount = $thisCount; - } elsif ($recordCount != $thisCount) { - # Here we have a second list, so its length has to match the - # previous lists. - Trace("Field $value in new $newObjectType object has an invalid list length $thisCount. Expected $recordCount.") if T(0); - $retVal = 0; - } - } - } else { - # Here the field is not present. Flag it as missing. - push @missing, $fieldName; - } - } - # If we are the primary relation, add the new-record flag. - if ($relationName eq $newObjectType) { - push @valueList, 1; - push @fieldNameList, "new_record"; - } - # Only proceed if there are no missing fields. - if (@missing > 0) { - Trace("Relation $relationName for $newObjectType skipped due to missing fields: " . - join(' ', @missing)) if T(1); - } else { - # Build the INSERT statement. - my $statement = "INSERT INTO $relationName (" . join (', ', @fieldNameList) . - ") VALUES ("; - # Create a marker list of the proper size and put it in the statement. - my @markers = (); - while (@markers < @fieldNameList) { push @markers, '?'; } - $statement .= join(', ', @markers) . ")"; - # We have the insert statement, so prepare it. - my $sth = $dbh->prepare_command($statement); - Trace("Insert statement prepared: $statement") if T(3); - # Now we loop through the values. If a value is scalar, we use it unmodified. If it's - # a list, we use the current element. The values are stored in the @parameterList array. - my $done = 0; - for (my $i = 0; $i < $recordCount; $i++) { - # Clear the parameter list array. - my @parameterList = (); - # Loop through the values. - for my $value (@valueList) { - # Check to see if this is a scalar value. - if (ref $value eq "ARRAY") { - # Here we have a list value. Pull the current entry. - push @parameterList, $value->[$i]; - } else { - # Here we have a scalar value. Use it unmodified. - push @parameterList, $value; - } - } - # Execute the INSERT statement with the specified parameter list. - $retVal = $sth->execute(@parameterList); - if (!$retVal) { - my $errorString = $sth->errstr(); - Trace("Insert error: $errorString.") if T(0); - } - } - } - } - # Return the success indicator. - return $retVal; + # Get the parameters. + my ($self, $newObjectType, $fieldHash) = @_; + # Denote that so far we appear successful. + my $retVal = 1; + # Get the database handle. + my $dbh = $self->{_dbh}; + # Get the relation list. + my $relationTable = $self->_GetRelationTable($newObjectType); + # Loop through the relations. We'll build insert statements for each one. If a relation is + # secondary, we may end up generating multiple insert statements. If an error occurs, we + # stop the loop. + my @relationList = keys %{$relationTable}; + for (my $i = 0; $retVal && $i <= $#relationList; $i++) { + my $relationName = $relationList[$i]; + my $relationDefinition = $relationTable->{$relationName}; + # Get the relation's fields. For each field we will collect a value in the corresponding + # position of the @valueList array. If one of the fields is missing, we will add it to the + # @missing list. + my @fieldList = @{$relationDefinition->{Fields}}; + my @fieldNameList = (); + my @valueList = (); + my @missing = (); + my $recordCount = 1; + for my $fieldDescriptor (@fieldList) { + # Get the field name and save it. Note we need to fix it up so the hyphens + # are converted to underscores. + my $fieldName = $fieldDescriptor->{name}; + push @fieldNameList, _FixName($fieldName); + # Look for the named field in the incoming structure. Note that we are looking + # for the real field name, not the fixed-up one! + if (exists $fieldHash->{$fieldName}) { + # Here we found the field. Stash it in the value list. + my $value = $fieldHash->{$fieldName}; + push @valueList, $value; + # If the value is a list, we may need to increment the record count. + if (ref $value eq "ARRAY") { + my $thisCount = @{$value}; + if ($recordCount == 1) { + # Here we have our first list, so we save its count. + $recordCount = $thisCount; + } elsif ($recordCount != $thisCount) { + # Here we have a second list, so its length has to match the + # previous lists. + Trace("Field $value in new $newObjectType object has an invalid list length $thisCount. Expected $recordCount.") if T(0); + $retVal = 0; + } + } + } else { + # Here the field is not present. Flag it as missing. + push @missing, $fieldName; + } + } + # If we are the primary relation, add the new-record flag. + if ($relationName eq $newObjectType) { + push @valueList, 1; + push @fieldNameList, "new_record"; + } + # Only proceed if there are no missing fields. + if (@missing > 0) { + Trace("Relation $relationName for $newObjectType skipped due to missing fields: " . + join(' ', @missing)) if T(1); + } else { + # Build the INSERT statement. + my $statement = "INSERT INTO $relationName (" . join (', ', @fieldNameList) . + ") VALUES ("; + # Create a marker list of the proper size and put it in the statement. + my @markers = (); + while (@markers < @fieldNameList) { push @markers, '?'; } + $statement .= join(', ', @markers) . ")"; + # We have the insert statement, so prepare it. + my $sth = $dbh->prepare_command($statement); + Trace("Insert statement prepared: $statement") if T(3); + # Now we loop through the values. If a value is scalar, we use it unmodified. If it's + # a list, we use the current element. The values are stored in the @parameterList array. + my $done = 0; + for (my $i = 0; $i < $recordCount; $i++) { + # Clear the parameter list array. + my @parameterList = (); + # Loop through the values. + for my $value (@valueList) { + # Check to see if this is a scalar value. + if (ref $value eq "ARRAY") { + # Here we have a list value. Pull the current entry. + push @parameterList, $value->[$i]; + } else { + # Here we have a scalar value. Use it unmodified. + push @parameterList, $value; + } + } + # Execute the INSERT statement with the specified parameter list. + $retVal = $sth->execute(@parameterList); + if (!$retVal) { + my $errorString = $sth->errstr(); + Trace("Insert error: $errorString.") if T(0); + } + } + } + } + # Return the success indicator. + return $retVal; } =head3 LoadTable -C<< my %results = $database->LoadTable($fileName, $relationName, $truncateFlag); >> +C<< my %results = $erdb->LoadTable($fileName, $relationName, $truncateFlag); >> -Load data from a tab-delimited file into a specified table, optionally re-creating the table first. +Load data from a tab-delimited file into a specified table, optionally re-creating the table +first. =over 4 @@ -1270,103 +1521,78 @@ =item RETURN -Returns a statistical object containing the number of records read and a list of the error messages. +Returns a statistical object containing a list of the error messages. =back =cut sub LoadTable { - # Get the parameters. - my ($self, $fileName, $relationName, $truncateFlag) = @_; - # Create the statistical return object. - my $retVal = _GetLoadStats(); - # Trace the fact of the load. - Trace("Loading table $relationName from $fileName") if T(1); - # Get the database handle. - my $dbh = $self->{_dbh}; - # Get the relation data. - my $relation = $self->_FindRelation($relationName); - # Check the truncation flag. - if ($truncateFlag) { - Trace("Creating table $relationName") if T(1); - # Re-create the table without its index. - $self->CreateTable($relationName, 0); - } - # Determine whether or not this is a primary relation. Primary relations have an extra - # field indicating whether or not a given object is new or was loaded from the flat files. - my $primary = $self->_IsPrimary($relationName); - # Get the number of fields in this relation. - my @fieldList = @{$relation->{Fields}}; - my $fieldCount = @fieldList; - # Record the number of expected fields. - my $expectedFields = $fieldCount + ($primary ? 1 : 0); - # Start a database transaction. - $dbh->begin_tran; - # Open the relation file. We need to create a cleaned-up copy before loading. - open TABLEIN, '<', $fileName; - my $tempName = "$fileName.tbl"; - open TABLEOUT, '>', $tempName; - # Loop through the file. - while () { - # Chop off the new-line character. - my $record = $_; - chomp $record; - # Only proceed if the record is non-blank. - if ($record) { - # Escape all the backslashes found in the line. - $record =~ s/\\/\\\\/g; - # Eliminate any trailing tabs. - chop $record while substr($record, -1) eq "\t"; - # If this is a primary relation, add a 0 for the new-record flag (indicating that - # this record is not new, but part of the original load). - if ($primary) { - $record .= "\t0"; - } - # Write the record. - print TABLEOUT "$record\n"; - # Count the record read. - my $count = $retVal->Add('records'); - my $len = length $record; - Trace("Record $count written with $len characters.") if T(4); - } - } - # Close the files. - close TABLEIN; - close TABLEOUT; - Trace("Temporary file $tempName created.") if T(4); + # Get the parameters. + my ($self, $fileName, $relationName, $truncateFlag) = @_; + # Create the statistical return object. + my $retVal = _GetLoadStats(); + # Trace the fact of the load. + Trace("Loading table $relationName from $fileName") if T(2); + # Get the database handle. + my $dbh = $self->{_dbh}; + # Get the input file size. + my $fileSize = -s $fileName; + # Get the relation data. + my $relation = $self->_FindRelation($relationName); + # Check the truncation flag. + if ($truncateFlag) { + Trace("Creating table $relationName") if T(2); + # Compute the row count estimate. We take the size of the load file, + # divide it by the estimated row size, and then multiply by 1.5 to + # leave extra room. We postulate a minimum row count of 1000 to + # prevent problems with incoming empty load files. + my $rowSize = $self->EstimateRowSize($relationName); + my $estimate = FIG::max($fileSize * 1.5 / $rowSize, 1000); + # Re-create the table without its index. + $self->CreateTable($relationName, 0, $estimate); + # If this is a pre-index DBMS, create the index here. + if ($dbh->{_preIndex}) { + eval { + $self->CreateIndex($relationName); + }; + if ($@) { + $retVal->AddMessage($@); + } + } + } # Load the table. - my $rv; - eval { - $rv = $dbh->load_table(file => $tempName, tbl => $relationName); - }; - if (!defined $rv) { + my $rv; + eval { + $rv = $dbh->load_table(file => $fileName, tbl => $relationName); + }; + if (!defined $rv) { $retVal->AddMessage($@) if ($@); - $retVal->AddMessage("Table load failed for $relationName using $tempName."); - Trace("Table load failed for $relationName.") if T(1); - } else { - # Here we successfully loaded the table. Trace the number of records loaded. - Trace("$retVal->{records} records read for $relationName.") if T(1); - # If we're rebuilding, we need to create the table indexes. - if ($truncateFlag) { - eval { - $self->CreateIndex($relationName); - }; - if ($@) { - $retVal->AddMessage($@); - } - } - } - # Commit the database changes. - $dbh->commit_tran; - # Delete the temporary file. - unlink $tempName; - # Return the statistics. - return $retVal; + $retVal->AddMessage("Table load failed for $relationName using $fileName."); + Trace("Table load failed for $relationName.") if T(1); + } else { + # Here we successfully loaded the table. + $retVal->Add("tables"); + my $size = -s $fileName; + Trace("$size bytes loaded into $relationName.") if T(2); + # If we're rebuilding, we need to create the table indexes. + if ($truncateFlag && ! $dbh->{_preIndex}) { + eval { + $self->CreateIndex($relationName); + }; + if ($@) { + $retVal->AddMessage($@); + } + } + } + # Analyze the table to improve performance. + $dbh->vacuum_it($relationName); + # Return the statistics. + return $retVal; } =head3 GenerateEntity -C<< my $fieldHash = $database->GenerateEntity($id, $type, \%values); >> +C<< my $fieldHash = $erdb->GenerateEntity($id, $type, \%values); >> Generate the data for a new entity instance. This method creates a field hash suitable for passing as a parameter to L. The ID is specified by the callr, but the rest @@ -1403,28 +1629,28 @@ =cut sub GenerateEntity { - # Get the parameters. - my ($self, $id, $type, $values) = @_; - # Create the return hash. - my $this = { id => $id }; - # Get the metadata structure. - my $metadata = $self->{_metaData}; - # Get this entity's list of fields. - if (!exists $metadata->{Entities}->{$type}) { - Confess("Unrecognized entity type $type in GenerateEntity."); - } else { - my $entity = $metadata->{Entities}->{$type}; - my $fields = $entity->{Fields}; - # Generate data from the fields. - _GenerateFields($this, $fields, $type, $values); - } - # Return the hash created. - return $this; + # Get the parameters. + my ($self, $id, $type, $values) = @_; + # Create the return hash. + my $this = { id => $id }; + # Get the metadata structure. + my $metadata = $self->{_metaData}; + # Get this entity's list of fields. + if (!exists $metadata->{Entities}->{$type}) { + Confess("Unrecognized entity type $type in GenerateEntity."); + } else { + my $entity = $metadata->{Entities}->{$type}; + my $fields = $entity->{Fields}; + # Generate data from the fields. + _GenerateFields($this, $fields, $type, $values); + } + # Return the hash created. + return $this; } =head3 GetEntity -C<< my $entityObject = $sprout->GetEntity($entityType, $ID); >> +C<< my $entityObject = $erdb->GetEntity($entityType, $ID); >> Return an object describing the entity instance with a specified ID. @@ -1448,19 +1674,19 @@ =cut sub GetEntity { - # Get the parameters. - my ($self, $entityType, $ID) = @_; - # Create a query. - my $query = $self->Get([$entityType], "$entityType(id) = ?", $ID); - # Get the first (and only) object. - my $retVal = $query->Fetch(); - # Return the result. - return $retVal; + # Get the parameters. + my ($self, $entityType, $ID) = @_; + # Create a query. + my $query = $self->Get([$entityType], "$entityType(id) = ?", $ID); + # Get the first (and only) object. + my $retVal = $query->Fetch(); + # Return the result. + return $retVal; } =head3 GetEntityValues -C<< my @values = GetEntityValues($entityType, $ID, \@fields); >> +C<< my @values = $erdb->GetEntityValues($entityType, $ID, \@fields); >> Return a list of values from a specified entity instance. @@ -1487,23 +1713,23 @@ =cut sub GetEntityValues { - # Get the parameters. - my ($self, $entityType, $ID, $fields) = @_; - # Get the specified entity. - my $entity = $self->GetEntity($entityType, $ID); - # Declare the return list. - my @retVal = (); - # If we found the entity, push the values into the return list. - if ($entity) { - push @retVal, $entity->Values($fields); - } - # Return the result. - return @retVal; + # Get the parameters. + my ($self, $entityType, $ID, $fields) = @_; + # Get the specified entity. + my $entity = $self->GetEntity($entityType, $ID); + # Declare the return list. + my @retVal = (); + # If we found the entity, push the values into the return list. + if ($entity) { + push @retVal, $entity->Values($fields); + } + # Return the result. + return @retVal; } =head3 GetAll -C<< my @list = $sprout->GetAll(\@objectNames, $filterClause, \@parameters, \@fields, $count); >> +C<< my @list = $erdb->GetAll(\@objectNames, $filterClause, \@parameters, \@fields, $count); >> Return a list of values taken from the objects returned by a query. The first three parameters correspond to the parameters of the L method. The final parameter is @@ -1519,7 +1745,7 @@ spreadsheet cell, and each feature will be represented by a list containing the feature ID followed by all of its aliases. -C<< $query = $sprout->Get(['ContainsFeature', 'Feature'], "ContainsFeature(from-link) = ?", [$ssCellID], ['Feature(id)', 'Feature(alias)']); >> +C<< $query = $erdb->Get(['ContainsFeature', 'Feature'], "ContainsFeature(from-link) = ?", [$ssCellID], ['Feature(id)', 'Feature(alias)']); >> =over 4 @@ -1558,34 +1784,76 @@ =cut #: Return Type @@; sub GetAll { - # Get the parameters. - my ($self, $objectNames, $filterClause, $parameterList, $fields, $count) = @_; - # Translate the parameters from a list reference to a list. If the parameter - # list is a scalar we convert it into a singleton list. - my @parmList = (); - if (ref $parameterList eq "ARRAY") { - @parmList = @{$parameterList}; - } else { - push @parmList, $parameterList; - } - # Create the query. - my $query = $self->Get($objectNames, $filterClause, @parmList); - # Set up a counter of the number of records read. - my $fetched = 0; - # Insure the counter has a value. - if (!defined $count) { - $count = 0; - } - # Loop through the records returned, extracting the fields. Note that if the - # counter is non-zero, we stop when the number of records read hits the count. - my @retVal = (); - while (($count == 0 || $fetched < $count) && (my $row = $query->Fetch())) { - my @rowData = $row->Values($fields); - push @retVal, \@rowData; - $fetched++; - } - # Return the resulting list. - return @retVal; + # Get the parameters. + my ($self, $objectNames, $filterClause, $parameterList, $fields, $count) = @_; + # Translate the parameters from a list reference to a list. If the parameter + # list is a scalar we convert it into a singleton list. + my @parmList = (); + if (ref $parameterList eq "ARRAY") { + @parmList = @{$parameterList}; + } else { + push @parmList, $parameterList; + } + # Insure the counter has a value. + if (!defined $count) { + $count = 0; + } + # Add the row limit to the filter clause. + if ($count > 0) { + $filterClause .= " LIMIT $count"; + } + # Create the query. + my $query = $self->Get($objectNames, $filterClause, @parmList); + # Set up a counter of the number of records read. + my $fetched = 0; + # Loop through the records returned, extracting the fields. Note that if the + # counter is non-zero, we stop when the number of records read hits the count. + my @retVal = (); + while (($count == 0 || $fetched < $count) && (my $row = $query->Fetch())) { + my @rowData = $row->Values($fields); + push @retVal, \@rowData; + $fetched++; + } + # Return the resulting list. + return @retVal; +} + +=head3 EstimateRowSize + +C<< my $rowSize = $erdb->EstimateRowSize($relName); >> + +Estimate the row size of the specified relation. The estimated row size is computed by adding +up the average length for each data type. + +=over 4 + +=item relName + +Name of the relation whose estimated row size is desired. + +=item RETURN + +Returns an estimate of the row size for the specified relation. + +=back + +=cut +#: Return Type $; +sub EstimateRowSize { + # Get the parameters. + my ($self, $relName) = @_; + # Declare the return variable. + my $retVal = 0; + # Find the relation descriptor. + my $relation = $self->_FindRelation($relName); + # Get the list of fields. + for my $fieldData (@{$relation->{Fields}}) { + # Get the field type and add its length. + my $fieldLen = $TypeTable{$fieldData->{type}}->{avgLen}; + $retVal += $fieldLen; + } + # Return the result. + return $retVal; } =head2 Internal Utility Methods @@ -1598,8 +1866,8 @@ =cut -sub _GetLoadStats { - return Stats->new('records'); +sub _GetLoadStats{ + return Stats->new(); } =head3 GenerateFields @@ -1642,38 +1910,38 @@ =cut sub _GenerateFields { - # Get the parameters. - my ($this, $fields, $type, $values, $from, $to) = @_; - # Sort the field names by pass number. - my @fieldNames = sort { $fields->{$a}->{DataGen}->{pass} <=> $fields->{$b}->{DataGen}->{pass} } keys %{$fields}; - # Loop through the field names, generating data. - for my $name (@fieldNames) { - # Only proceed if this field needs to be generated. - if (!exists $this->{$name}) { - # Get this field's data generation descriptor. - my $fieldDescriptor = $fields->{$name}; - my $data = $fieldDescriptor->{DataGen}; - # Get the code to generate the field value. - my $codeString = $data->{content}; - # Determine whether or not this field is in the primary relation. - if ($fieldDescriptor->{relation} eq $type) { - # Here we have a primary relation field. Store the field value as - # a scalar. - $this->{$name} = eval($codeString); - } else { - # Here we have a secondary relation field. Create a null list - # and push the desired number of field values onto it. - my @fieldValues = (); - my $count = IntGen(0,$data->{testCount}); - for (my $i = 0; $i < $count; $i++) { - my $newValue = eval($codeString); - push @fieldValues, $newValue; - } - # Store the value list in the main hash. - $this->{$name} = \@fieldValues; - } - } - } + # Get the parameters. + my ($this, $fields, $type, $values, $from, $to) = @_; + # Sort the field names by pass number. + my @fieldNames = sort { $fields->{$a}->{DataGen}->{pass} <=> $fields->{$b}->{DataGen}->{pass} } keys %{$fields}; + # Loop through the field names, generating data. + for my $name (@fieldNames) { + # Only proceed if this field needs to be generated. + if (!exists $this->{$name}) { + # Get this field's data generation descriptor. + my $fieldDescriptor = $fields->{$name}; + my $data = $fieldDescriptor->{DataGen}; + # Get the code to generate the field value. + my $codeString = $data->{content}; + # Determine whether or not this field is in the primary relation. + if ($fieldDescriptor->{relation} eq $type) { + # Here we have a primary relation field. Store the field value as + # a scalar. + $this->{$name} = eval($codeString); + } else { + # Here we have a secondary relation field. Create a null list + # and push the desired number of field values onto it. + my @fieldValues = (); + my $count = IntGen(0,$data->{testCount}); + for (my $i = 0; $i < $count; $i++) { + my $newValue = eval($codeString); + push @fieldValues, $newValue; + } + # Store the value list in the main hash. + $this->{$name} = \@fieldValues; + } + } + } } =head3 DumpRelation @@ -1701,29 +1969,29 @@ =cut sub _DumpRelation { - # Get the parameters. - my ($self, $outputDirectory, $relationName, $relation) = @_; - # Open the output file. - my $fileName = "$outputDirectory/$relationName.dtx"; - open(DTXOUT, ">$fileName") || Confess("Could not open dump file $fileName: $!"); - # Create a query for the specified relation. - my $dbh = $self->{_dbh}; - my $query = $dbh->prepare_command("SELECT * FROM $relationName"); - # Execute the query. - $query->execute() || Confess("SELECT error dumping $relationName."); - # Loop through the results. - while (my @row = $query->fetchrow) { - # Escape any tabs or new-lines in the row text. - for my $field (@row) { - $field =~ s/\n/\\n/g; - $field =~ s/\t/\\t/g; - } - # Tab-join the row and write it to the output file. - my $rowText = join("\t", @row); - print DTXOUT "$rowText\n"; - } - # Close the output file. - close DTXOUT; + # Get the parameters. + my ($self, $outputDirectory, $relationName, $relation) = @_; + # Open the output file. + my $fileName = "$outputDirectory/$relationName.dtx"; + open(DTXOUT, ">$fileName") || Confess("Could not open dump file $fileName: $!"); + # Create a query for the specified relation. + my $dbh = $self->{_dbh}; + my $query = $dbh->prepare_command("SELECT * FROM $relationName"); + # Execute the query. + $query->execute() || Confess("SELECT error dumping $relationName."); + # Loop through the results. + while (my @row = $query->fetchrow) { + # Escape any tabs or new-lines in the row text. + for my $field (@row) { + $field =~ s/\n/\\n/g; + $field =~ s/\t/\\t/g; + } + # Tab-join the row and write it to the output file. + my $rowText = join("\t", @row); + print DTXOUT "$rowText\n"; + } + # Close the output file. + close DTXOUT; } =head3 GetStructure @@ -1747,22 +2015,22 @@ =cut sub _GetStructure { - # Get the parameters. - my ($self, $objectName) = @_; - # Get the metadata structure. - my $metadata = $self->{_metaData}; - # Declare the variable to receive the descriptor. - my $retVal; - # Get the descriptor from the metadata. - if (exists $metadata->{Entities}->{$objectName}) { - $retVal = $metadata->{Entities}->{$objectName}; - } elsif (exists $metadata->{Relationships}->{$objectName}) { - $retVal = $metadata->{Relationships}->{$objectName}; - } else { - Confess("Object $objectName not found in database."); - } - # Return the descriptor. - return $retVal; + # Get the parameters. + my ($self, $objectName) = @_; + # Get the metadata structure. + my $metadata = $self->{_metaData}; + # Declare the variable to receive the descriptor. + my $retVal; + # Get the descriptor from the metadata. + if (exists $metadata->{Entities}->{$objectName}) { + $retVal = $metadata->{Entities}->{$objectName}; + } elsif (exists $metadata->{Relationships}->{$objectName}) { + $retVal = $metadata->{Relationships}->{$objectName}; + } else { + Confess("Object $objectName not found in database."); + } + # Return the descriptor. + return $retVal; } =head3 GetRelationTable @@ -1786,12 +2054,12 @@ =cut sub _GetRelationTable { - # Get the parameters. - my ($self, $objectName) = @_; - # Get the descriptor from the metadata. - my $objectData = $self->_GetStructure($objectName); - # Return the object's relation list. - return $objectData->{Relations}; + # Get the parameters. + my ($self, $objectName) = @_; + # Get the descriptor from the metadata. + my $objectData = $self->_GetStructure($objectName); + # Return the object's relation list. + return $objectData->{Relations}; } =head3 GetFieldTable @@ -1815,12 +2083,12 @@ =cut sub _GetFieldTable { - # Get the parameters. - my ($self, $objectName) = @_; - # Get the descriptor from the metadata. - my $objectData = $self->_GetStructure($objectName); - # Return the object's field table. - return $objectData->{Fields}; + # Get the parameters. + my ($self, $objectName) = @_; + # Get the descriptor from the metadata. + my $objectData = $self->_GetStructure($objectName); + # Return the object's field table. + return $objectData->{Fields}; } =head3 ValidateFieldNames @@ -1840,42 +2108,42 @@ =cut sub _ValidateFieldNames { - # Get the object. - my ($metadata) = @_; - # Declare the return value. We assume success. - my $retVal = 1; - # Loop through the sections of the database definition. - for my $section ('Entities', 'Relationships') { - # Loop through the objects in this section. - for my $object (values %{$metadata->{$section}}) { - # Loop through the object's fields. - for my $fieldName (keys %{$object->{Fields}}) { - # Now we make some initial validations. - if ($fieldName =~ /--/) { - # Here we have a doubled minus sign. - print STDERR "Field name $fieldName has a doubled hyphen.\n"; - $retVal = 0; - } elsif ($fieldName !~ /^[A-Za-z]/) { - # Here the field name is missing the initial letter. - print STDERR "Field name $fieldName does not begin with a letter.\n"; - $retVal = 0; - } else { - # Strip out the minus signs. Everything remaining must be a letter - # or digit. - my $strippedName = $fieldName; - $strippedName =~ s/-//g; - if ($strippedName !~ /^[A-Za-z0-9]+$/) { - print STDERR "Field name $fieldName contains illegal characters.\n"; - $retVal = 0; - } - } - } - } - } - # If an error was found, fail. - if ($retVal == 0) { - Confess("Errors found in field names."); - } + # Get the object. + my ($metadata) = @_; + # Declare the return value. We assume success. + my $retVal = 1; + # Loop through the sections of the database definition. + for my $section ('Entities', 'Relationships') { + # Loop through the objects in this section. + for my $object (values %{$metadata->{$section}}) { + # Loop through the object's fields. + for my $fieldName (keys %{$object->{Fields}}) { + # Now we make some initial validations. + if ($fieldName =~ /--/) { + # Here we have a doubled minus sign. + print STDERR "Field name $fieldName has a doubled hyphen.\n"; + $retVal = 0; + } elsif ($fieldName !~ /^[A-Za-z]/) { + # Here the field name is missing the initial letter. + print STDERR "Field name $fieldName does not begin with a letter.\n"; + $retVal = 0; + } else { + # Strip out the minus signs. Everything remaining must be a letter + # or digit. + my $strippedName = $fieldName; + $strippedName =~ s/-//g; + if ($strippedName !~ /^[A-Za-z0-9]+$/) { + print STDERR "Field name $fieldName contains illegal characters.\n"; + $retVal = 0; + } + } + } + } + } + # If an error was found, fail. + if ($retVal == 0) { + Confess("Errors found in field names."); + } } =head3 LoadRelation @@ -1912,30 +2180,30 @@ =cut sub _LoadRelation { - # Get the parameters. - my ($self, $directoryName, $relationName, $rebuild) = @_; - # Create the file name. - my $fileName = "$directoryName/$relationName"; - # If the file doesn't exist, try adding the .dtx suffix. - if (! -e $fileName) { - $fileName .= ".dtx"; - if (! -e $fileName) { - $fileName = ""; - } - } - # Create the return object. - my $retVal = _GetLoadStats(); - # If a file exists to load the table, its name will be in $fileName. Otherwise, $fileName will - # be a null string. - if ($fileName ne "") { - # Load the relation from the file. - $retVal = $self->LoadTable($fileName, $relationName, $rebuild); - } elsif ($rebuild) { - # Here we are rebuilding, but no file exists, so we just re-create the table. - $self->CreateTable($relationName, 1); - } - # Return the statistics from the load. - return $retVal; + # Get the parameters. + my ($self, $directoryName, $relationName, $rebuild) = @_; + # Create the file name. + my $fileName = "$directoryName/$relationName"; + # If the file doesn't exist, try adding the .dtx suffix. + if (! -e $fileName) { + $fileName .= ".dtx"; + if (! -e $fileName) { + $fileName = ""; + } + } + # Create the return object. + my $retVal = _GetLoadStats(); + # If a file exists to load the table, its name will be in $fileName. Otherwise, $fileName will + # be a null string. + if ($fileName ne "") { + # Load the relation from the file. + $retVal = $self->LoadTable($fileName, $relationName, $rebuild); + } elsif ($rebuild) { + # Here we are rebuilding, but no file exists, so we just re-create the table. + $self->CreateTable($relationName, 1); + } + # Return the statistics from the load. + return $retVal; } =head3 LoadMetaData @@ -1961,307 +2229,308 @@ =cut sub _LoadMetaData { - # Get the parameters. - my ($filename) = @_; - # Slurp the XML file into a variable. Extensive use of options is used to insure we - # get the exact structure we want. - my $metadata = XML::Simple::XMLin($filename, - GroupTags => { Relationships => 'Relationship', - Entities => 'Entity', - Fields => 'Field', - Indexes => 'Index', - IndexFields => 'IndexField'}, - KeyAttr => { Relationship => 'name', - Entity => 'name', - Field => 'name'}, - ForceArray => ['Field', 'Index', 'IndexField'], - ForceContent => 1, - NormalizeSpace => 2 - ); - Trace("XML metadata loaded from file $filename.") if T(1); - # Before we go any farther, we need to validate the field and object names. If an error is found, - # the method below will fail. - _ValidateFieldNames($metadata); - # Next we need to create a hash table for finding relations. The entities and relationships are - # implemented as one or more database relations. - my %masterRelationTable = (); - # Loop through the entities. - my $entityList = $metadata->{Entities}; - for my $entityName (keys %{$entityList}) { - my $entityStructure = $entityList->{$entityName}; - # - # The first step is to run creating all the entity's default values. For C elements, - # the relation name must be added where it is not specified. For relationships, - # the B and B fields must be inserted, and for entities an B - # field must be added to each relation. Finally, each field will have a C attribute - # added that can be used to pull the implicit fields to the top when displaying the field - # documentation. The PrettySort values are 1-based and indicate in which pass through a - # relation's data the field should be displayed-- 1 for the first pass, 2 for the second, - # and so on. - # - # Fix up this entity. - _FixupFields($entityStructure, $entityName, 2, 3); - # Add the ID field. - _AddField($entityStructure, 'id', { type => $entityStructure->{keyType}, - relation => $entityName, - Notes => { content => "Unique identifier for this \[b\]$entityName\[/b\]." }, - PrettySort => 1}); - # - # The current field list enables us to quickly find the relation containing a particular field. - # We also need a list that tells us the fields in each relation. We do this by creating a - # Relations structure in the entity structure and collating the fields into it based on their - # C property. There is one tricky bit, which is that every relation has to have the - # C field in it. Note also that the field list is put into a C member of the - # relation's structure so that it looks more like the entity and relationship structures. - # - # First we need to create the relations list. - my $relationTable = { }; - # Loop through the fields. We use a list of field names to prevent a problem with - # the hash table cursor losing its place during the loop. - my $fieldList = $entityStructure->{Fields}; - my @fieldNames = keys %{$fieldList}; - for my $fieldName (@fieldNames) { - my $fieldData = $fieldList->{$fieldName}; - # Get the current field's relation name. - my $relationName = $fieldData->{relation}; - # Insure the relation exists. - if (!exists $relationTable->{$relationName}) { - $relationTable->{$relationName} = { Fields => { } }; - } - # Add the field to the relation's field structure. - $relationTable->{$relationName}->{Fields}->{$fieldName} = $fieldData; - } - # Now that we've organized all our fields by relation name we need to do some serious - # housekeeping. We must add the C field to every relation and convert each relation - # to a list of fields. First, we need the ID field itself. - my $idField = $fieldList->{id}; - # Loop through the relations. - for my $relationName (keys %{$relationTable}) { - my $relation = $relationTable->{$relationName}; - # Get the relation's field list. - my $relationFieldList = $relation->{Fields}; - # Add the ID field to it. If the field's already there, it will not make any - # difference. - $relationFieldList->{id} = $idField; - # Convert the field set from a hash into a list using the pretty-sort number. - $relation->{Fields} = _ReOrderRelationTable($relationFieldList); - # Add the relation to the master table. - $masterRelationTable{$relationName} = $relation; - } - # The indexes come next. The primary relation will have a unique-keyed index based on the ID field. - # The other relations must have at least one index that begins with the ID field. In addition, the - # metadata may require alternate indexes. We do those alternate indexes first. To begin, we need to - # get the entity's field list and index list. - my $indexList = $entityStructure->{Indexes}; - # Loop through the indexes. - for my $indexData (@{$indexList}) { - # We need to find this index's fields. All of them should belong to the same relation. - # The ID field is an exception, since it's in all relations. - my $relationName = '0'; - for my $fieldDescriptor (@{$indexData->{IndexFields}}) { - # Get this field's name. - my $fieldName = $fieldDescriptor->{name}; - # Only proceed if it is NOT the ID field. - if ($fieldName ne 'id') { - # Find the relation containing the current index field. - my $thisName = $fieldList->{$fieldName}->{relation}; - if ($relationName eq '0') { - # Here we're looking at the first field, so we save its relation name. - $relationName = $thisName; - } elsif ($relationName ne $thisName) { - # Here we have a field mismatch. - Confess("Mixed index: field $fieldName does not belong to relation $relationName."); - } - } - } - # Now $relationName is the name of the relation that contains this index. Add the index structure - # to the relation. - push @{$relationTable->{$relationName}->{Indexes}}, $indexData; - } - # Now each index has been put in a relation. We need to add the primary index for the primary - # relation. - push @{$relationTable->{$entityName}->{Indexes}}, - { IndexFields => [ {name => 'id', order => 'ascending'} ], Unique => 'true', - Notes => { content => "Primary index for $entityName." } - }; - # The next step is to insure that each relation has at least one index that begins with the ID field. - # After that, we convert each relation's index list to an index table. We first need to loop through - # the relations. - for my $relationName (keys %{$relationTable}) { - my $relation = $relationTable->{$relationName}; - # Get the relation's index list. - my $indexList = $relation->{Indexes}; - # Insure this relation has an ID index. - my $found = 0; - for my $index (@{$indexList}) { - if ($index->{IndexFields}->[0]->{name} eq "id") { - $found = 1; - } - } - if ($found == 0) { - push @{$indexList}, { IndexFields => [ {name => 'id', order => 'ascending'} ] }; - } - # Now we need to convert the relation's index list to an index table. We begin by creating - # an empty table in the relation structure. - $relation->{Indexes} = { }; - # Loop through the indexes. - my $count = 0; - for my $index (@{$indexList}) { - # Add this index to the index table. - _AddIndex("idx$relationName$count", $relation, $index); - # Increment the counter so that the next index has a different name. - $count++; - } - } - # Finally, we add the relation structure to the entity. - $entityStructure->{Relations} = $relationTable; - } - # Loop through the relationships. Relationships actually turn out to be much simpler than entities. - # For one thing, there is only a single constituent relation. - my $relationshipList = $metadata->{Relationships}; - for my $relationshipName (keys %{$relationshipList}) { - my $relationshipStructure = $relationshipList->{$relationshipName}; - # Fix up this relationship. - _FixupFields($relationshipStructure, $relationshipName, 2, 3); - # Format a description for the FROM field. - my $fromEntity = $relationshipStructure->{from}; - my $fromComment = "id of the source $fromEntity."; - # Get the FROM entity's key type. - my $fromType = $entityList->{$fromEntity}->{keyType}; - # Add the FROM field. - _AddField($relationshipStructure, 'from-link', { type => $fromType, - relation => $relationshipName, - Notes => { content => $fromComment }, - PrettySort => 1}); - # Format a description for the TO field. - my $toEntity = $relationshipStructure->{to}; - my $toComment = "id of the target $toEntity."; - # Get the TO entity's key type. - my $toType = $entityList->{$toEntity}->{keyType}; - # Add the TO field. - _AddField($relationshipStructure, 'to-link', { type=> $toType, - relation => $relationshipName, - Notes => { content => $toComment }, - PrettySort => 1}); - # Create an index-free relation from the fields. - my $thisRelation = { Fields => _ReOrderRelationTable($relationshipStructure->{Fields}), - Indexes => { } }; - $relationshipStructure->{Relations} = { $relationshipName => $thisRelation }; - # Create the FROM and TO indexes. - _CreateRelationshipIndex("From", $relationshipName, $relationshipStructure); - _CreateRelationshipIndex("To", $relationshipName, $relationshipStructure); - # Add the relation to the master table. - $masterRelationTable{$relationshipName} = $thisRelation; - } - # Now store the master relation table in the metadata structure. - $metadata->{RelationTable} = \%masterRelationTable; - # Our final task is to create the join table. The join table is a hash that describes all - # the join clauses for traveling through the relationships. The join clause is an equality - # condition that can be put into a WHERE clause in order to join two objects. Two relationships - # can be joined if they share an entity in common; and an entity can be joined to a relationship - # if the entity is at either end of the relationship. - my %joinTable = (); - # Loop through the entities. - for my $entityName (keys %{$entityList}) { - # Build three lists of the relationships connected to this entity. One will be - # for relationships from the entity, one for relationships to the entity, and - # one for recursive relationships. - my @fromList = (); - my @toList = (); - my @bothList = (); - Trace("Join table build for $entityName.") if T(3); - for my $relationshipName (keys %{$relationshipList}) { - my $relationship = $relationshipList->{$relationshipName}; - # Determine if this relationship has our entity in one of its link fields. - my $fromEntity = $relationship->{from}; - my $toEntity = $relationship->{to}; - Trace("Join check for relationship $relationshipName from $fromEntity to $toEntity.") if T(3); - if ($fromEntity eq $entityName) { - if ($toEntity eq $entityName) { - # Here the relationship is recursive. - push @bothList, $relationshipName; - Trace("Relationship $relationshipName put in both-list.") if T(3); - } else { - # Here the relationship comes from the entity. - push @fromList, $relationshipName; - Trace("Relationship $relationshipName put in from-list.") if T(3); - } - } elsif ($toEntity eq $entityName) { - # Here the relationship goes to the entity. - push @toList, $relationshipName; - Trace("Relationship $relationshipName put in to-list.") if T(3); - } - } - # Create the nonrecursive joins. Note that we build two hashes for running - # through the nonrecursive relationships since we'll have an outer loop - # and an inner loop, and we can't do two "each" iterations on the same - # hash table at the same time. - my %directRelationships = ( from => \@fromList, to => \@toList ); - my %otherRelationships = ( from => \@fromList, to => \@toList ); - for my $linkType (keys %directRelationships) { - my $relationships = $directRelationships{$linkType}; - # Loop through all the relationships. - for my $relationshipName (@{$relationships}) { - # Create joins between the entity and this relationship. - my $linkField = "$relationshipName.${linkType}_link"; - my $joinClause = "$entityName.id = $linkField"; - Trace("Entity join clause is $joinClause for $entityName and $relationshipName.") if T(4); - $joinTable{"$entityName/$relationshipName"} = $joinClause; - $joinTable{"$relationshipName/$entityName"} = $joinClause; - # Create joins between this relationship and the other relationships. - for my $otherType (keys %otherRelationships) { - my $otherships = $otherRelationships{$otherType}; - for my $otherName (@{$otherships}) { - # Get the key for this join. - my $joinKey = "$otherName/$relationshipName"; - # Check for a duplicate or a self-join. - if (exists $joinTable{$joinKey}) { - # Here we have a duplicate, which means that the join - # path is ambiguous. We delete the join from the join - # table to prevent it from being used. - delete $joinTable{$joinKey}; - Trace("Deleting ambiguous join $joinKey.") if T(4); - } elsif ($otherName ne $relationshipName) { - # Here we have a valid join. Note that joins between a - # relationship and itself are prohibited. - my $relJoinClause = "$otherName.${otherType}_link = $linkField"; - $joinTable{$joinKey} = $relJoinClause; - Trace("Relationship join clause is $relJoinClause for $joinKey.") if T(4); - } - } - } - # Create joins between this relationship and the recursive relationships. - # We don't need to check for ambiguous joins here, because a recursive - # relationship can only be ambiguous with another recursive relationship, - # and the incoming relationship from the outer loop is never recursive. - for my $otherName (@bothList) { - Trace("Setting up relationship joins to recursive relationship $otherName with $relationshipName.") if T(3); - # Join from the left. - $joinTable{"$relationshipName/$otherName"} = - "$linkField = $otherName.from_link"; - # Join from the right. - $joinTable{"$otherName/$relationshipName"} = - "$otherName.to_link = $linkField"; - } - } - } - # Create entity joins for the recursive relationships. Unlike the non-recursive - # joins, the direction makes a difference with the recursive joins. This can give - # rise to situations where we can't create the path we want; however, it is always - # possible to get the same effect using multiple queries. - for my $relationshipName (@bothList) { - Trace("Setting up entity joins to recursive relationship $relationshipName with $entityName.") if T(3); - # Join to the entity from each direction. - $joinTable{"$entityName/$relationshipName"} = - "$entityName.id = $relationshipName.from_link"; - $joinTable{"$relationshipName/$entityName"} = - "$relationshipName.to_link = $entityName.id"; - } - } - # Add the join table to the structure. - $metadata->{Joins} = \%joinTable; - # Return the slurped and fixed-up structure. - return $metadata; + # Get the parameters. + my ($filename) = @_; + Trace("Reading Sprout DBD from $filename.") if T(2); + # Slurp the XML file into a variable. Extensive use of options is used to insure we + # get the exact structure we want. + my $metadata = XML::Simple::XMLin($filename, + GroupTags => { Relationships => 'Relationship', + Entities => 'Entity', + Fields => 'Field', + Indexes => 'Index', + IndexFields => 'IndexField'}, + KeyAttr => { Relationship => 'name', + Entity => 'name', + Field => 'name'}, + ForceArray => ['Field', 'Index', 'IndexField'], + ForceContent => 1, + NormalizeSpace => 2 + ); + Trace("XML metadata loaded from file $filename.") if T(1); + # Before we go any farther, we need to validate the field and object names. If an error is found, + # the method below will fail. + _ValidateFieldNames($metadata); + # Next we need to create a hash table for finding relations. The entities and relationships are + # implemented as one or more database relations. + my %masterRelationTable = (); + # Loop through the entities. + my $entityList = $metadata->{Entities}; + for my $entityName (keys %{$entityList}) { + my $entityStructure = $entityList->{$entityName}; + # + # The first step is to create all the entity's default values. For C elements, + # the relation name must be added where it is not specified. For relationships, + # the B and B fields must be inserted, and for entities an B + # field must be added to each relation. Finally, each field will have a C attribute + # added that can be used to pull the implicit fields to the top when displaying the field + # documentation. The PrettySort values are 1-based and indicate in which pass through a + # relation's data the field should be displayed-- 1 for the first pass, 2 for the second, + # and so on. + # + # Fix up this entity. + _FixupFields($entityStructure, $entityName, 2, 3); + # Add the ID field. + _AddField($entityStructure, 'id', { type => $entityStructure->{keyType}, + relation => $entityName, + Notes => { content => "Unique identifier for this \[b\]$entityName\[/b\]." }, + PrettySort => 1}); + # + # The current field list enables us to quickly find the relation containing a particular field. + # We also need a list that tells us the fields in each relation. We do this by creating a + # Relations structure in the entity structure and collating the fields into it based on their + # C property. There is one tricky bit, which is that every relation has to have the + # C field in it. Note also that the field list is put into a C member of the + # relation's structure so that it looks more like the entity and relationship structures. + # + # First we need to create the relations list. + my $relationTable = { }; + # Loop through the fields. We use a list of field names to prevent a problem with + # the hash table cursor losing its place during the loop. + my $fieldList = $entityStructure->{Fields}; + my @fieldNames = keys %{$fieldList}; + for my $fieldName (@fieldNames) { + my $fieldData = $fieldList->{$fieldName}; + # Get the current field's relation name. + my $relationName = $fieldData->{relation}; + # Insure the relation exists. + if (!exists $relationTable->{$relationName}) { + $relationTable->{$relationName} = { Fields => { } }; + } + # Add the field to the relation's field structure. + $relationTable->{$relationName}->{Fields}->{$fieldName} = $fieldData; + } + # Now that we've organized all our fields by relation name we need to do some serious + # housekeeping. We must add the C field to every relation and convert each relation + # to a list of fields. First, we need the ID field itself. + my $idField = $fieldList->{id}; + # Loop through the relations. + for my $relationName (keys %{$relationTable}) { + my $relation = $relationTable->{$relationName}; + # Get the relation's field list. + my $relationFieldList = $relation->{Fields}; + # Add the ID field to it. If the field's already there, it will not make any + # difference. + $relationFieldList->{id} = $idField; + # Convert the field set from a hash into a list using the pretty-sort number. + $relation->{Fields} = _ReOrderRelationTable($relationFieldList); + # Add the relation to the master table. + $masterRelationTable{$relationName} = $relation; + } + # The indexes come next. The primary relation will have a unique-keyed index based on the ID field. + # The other relations must have at least one index that begins with the ID field. In addition, the + # metadata may require alternate indexes. We do those alternate indexes first. To begin, we need to + # get the entity's field list and index list. + my $indexList = $entityStructure->{Indexes}; + # Loop through the indexes. + for my $indexData (@{$indexList}) { + # We need to find this index's fields. All of them should belong to the same relation. + # The ID field is an exception, since it's in all relations. + my $relationName = '0'; + for my $fieldDescriptor (@{$indexData->{IndexFields}}) { + # Get this field's name. + my $fieldName = $fieldDescriptor->{name}; + # Only proceed if it is NOT the ID field. + if ($fieldName ne 'id') { + # Find the relation containing the current index field. + my $thisName = $fieldList->{$fieldName}->{relation}; + if ($relationName eq '0') { + # Here we're looking at the first field, so we save its relation name. + $relationName = $thisName; + } elsif ($relationName ne $thisName) { + # Here we have a field mismatch. + Confess("Mixed index: field $fieldName does not belong to relation $relationName."); + } + } + } + # Now $relationName is the name of the relation that contains this index. Add the index structure + # to the relation. + push @{$relationTable->{$relationName}->{Indexes}}, $indexData; + } + # Now each index has been put in a relation. We need to add the primary index for the primary + # relation. + push @{$relationTable->{$entityName}->{Indexes}}, + { IndexFields => [ {name => 'id', order => 'ascending'} ], Unique => 'true', + Notes => { content => "Primary index for $entityName." } + }; + # The next step is to insure that each relation has at least one index that begins with the ID field. + # After that, we convert each relation's index list to an index table. We first need to loop through + # the relations. + for my $relationName (keys %{$relationTable}) { + my $relation = $relationTable->{$relationName}; + # Get the relation's index list. + my $indexList = $relation->{Indexes}; + # Insure this relation has an ID index. + my $found = 0; + for my $index (@{$indexList}) { + if ($index->{IndexFields}->[0]->{name} eq "id") { + $found = 1; + } + } + if ($found == 0) { + push @{$indexList}, { IndexFields => [ {name => 'id', order => 'ascending'} ] }; + } + # Now we need to convert the relation's index list to an index table. We begin by creating + # an empty table in the relation structure. + $relation->{Indexes} = { }; + # Loop through the indexes. + my $count = 0; + for my $index (@{$indexList}) { + # Add this index to the index table. + _AddIndex("idx$relationName$count", $relation, $index); + # Increment the counter so that the next index has a different name. + $count++; + } + } + # Finally, we add the relation structure to the entity. + $entityStructure->{Relations} = $relationTable; + } + # Loop through the relationships. Relationships actually turn out to be much simpler than entities. + # For one thing, there is only a single constituent relation. + my $relationshipList = $metadata->{Relationships}; + for my $relationshipName (keys %{$relationshipList}) { + my $relationshipStructure = $relationshipList->{$relationshipName}; + # Fix up this relationship. + _FixupFields($relationshipStructure, $relationshipName, 2, 3); + # Format a description for the FROM field. + my $fromEntity = $relationshipStructure->{from}; + my $fromComment = "id of the source $fromEntity."; + # Get the FROM entity's key type. + my $fromType = $entityList->{$fromEntity}->{keyType}; + # Add the FROM field. + _AddField($relationshipStructure, 'from-link', { type => $fromType, + relation => $relationshipName, + Notes => { content => $fromComment }, + PrettySort => 1}); + # Format a description for the TO field. + my $toEntity = $relationshipStructure->{to}; + my $toComment = "id of the target $toEntity."; + # Get the TO entity's key type. + my $toType = $entityList->{$toEntity}->{keyType}; + # Add the TO field. + _AddField($relationshipStructure, 'to-link', { type=> $toType, + relation => $relationshipName, + Notes => { content => $toComment }, + PrettySort => 1}); + # Create an index-free relation from the fields. + my $thisRelation = { Fields => _ReOrderRelationTable($relationshipStructure->{Fields}), + Indexes => { } }; + $relationshipStructure->{Relations} = { $relationshipName => $thisRelation }; + # Create the FROM and TO indexes. + _CreateRelationshipIndex("From", $relationshipName, $relationshipStructure); + _CreateRelationshipIndex("To", $relationshipName, $relationshipStructure); + # Add the relation to the master table. + $masterRelationTable{$relationshipName} = $thisRelation; + } + # Now store the master relation table in the metadata structure. + $metadata->{RelationTable} = \%masterRelationTable; + # Our final task is to create the join table. The join table is a hash that describes all + # the join clauses for traveling through the relationships. The join clause is an equality + # condition that can be put into a WHERE clause in order to join two objects. Two relationships + # can be joined if they share an entity in common; and an entity can be joined to a relationship + # if the entity is at either end of the relationship. + my %joinTable = (); + # Loop through the entities. + for my $entityName (keys %{$entityList}) { + # Build three lists of the relationships connected to this entity. One will be + # for relationships from the entity, one for relationships to the entity, and + # one for recursive relationships. + my @fromList = (); + my @toList = (); + my @bothList = (); + Trace("Join table build for $entityName.") if T(metadata => 4); + for my $relationshipName (keys %{$relationshipList}) { + my $relationship = $relationshipList->{$relationshipName}; + # Determine if this relationship has our entity in one of its link fields. + my $fromEntity = $relationship->{from}; + my $toEntity = $relationship->{to}; + Trace("Join check for relationship $relationshipName from $fromEntity to $toEntity.") if T(4); + if ($fromEntity eq $entityName) { + if ($toEntity eq $entityName) { + # Here the relationship is recursive. + push @bothList, $relationshipName; + Trace("Relationship $relationshipName put in both-list.") if T(metadata => 4); + } else { + # Here the relationship comes from the entity. + push @fromList, $relationshipName; + Trace("Relationship $relationshipName put in from-list.") if T(metadata => 4); + } + } elsif ($toEntity eq $entityName) { + # Here the relationship goes to the entity. + push @toList, $relationshipName; + Trace("Relationship $relationshipName put in to-list.") if T(metadata => 4); + } + } + # Create the nonrecursive joins. Note that we build two hashes for running + # through the nonrecursive relationships since we'll have an outer loop + # and an inner loop, and we can't do two "each" iterations on the same + # hash table at the same time. + my %directRelationships = ( from => \@fromList, to => \@toList ); + my %otherRelationships = ( from => \@fromList, to => \@toList ); + for my $linkType (keys %directRelationships) { + my $relationships = $directRelationships{$linkType}; + # Loop through all the relationships. + for my $relationshipName (@{$relationships}) { + # Create joins between the entity and this relationship. + my $linkField = "$relationshipName.${linkType}_link"; + my $joinClause = "$entityName.id = $linkField"; + Trace("Entity join clause is $joinClause for $entityName and $relationshipName.") if T(metadata => 4); + $joinTable{"$entityName/$relationshipName"} = $joinClause; + $joinTable{"$relationshipName/$entityName"} = $joinClause; + # Create joins between this relationship and the other relationships. + for my $otherType (keys %otherRelationships) { + my $otherships = $otherRelationships{$otherType}; + for my $otherName (@{$otherships}) { + # Get the key for this join. + my $joinKey = "$otherName/$relationshipName"; + # Check for a duplicate or a self-join. + if (exists $joinTable{$joinKey}) { + # Here we have a duplicate, which means that the join + # path is ambiguous. We delete the join from the join + # table to prevent it from being used. + delete $joinTable{$joinKey}; + Trace("Deleting ambiguous join $joinKey.") if T(4); + } elsif ($otherName ne $relationshipName) { + # Here we have a valid join. Note that joins between a + # relationship and itself are prohibited. + my $relJoinClause = "$otherName.${otherType}_link = $linkField"; + $joinTable{$joinKey} = $relJoinClause; + Trace("Relationship join clause is $relJoinClause for $joinKey.") if T(metadata => 4); + } + } + } + # Create joins between this relationship and the recursive relationships. + # We don't need to check for ambiguous joins here, because a recursive + # relationship can only be ambiguous with another recursive relationship, + # and the incoming relationship from the outer loop is never recursive. + for my $otherName (@bothList) { + Trace("Setting up relationship joins to recursive relationship $otherName with $relationshipName.") if T(metadata => 4); + # Join from the left. + $joinTable{"$relationshipName/$otherName"} = + "$linkField = $otherName.from_link"; + # Join from the right. + $joinTable{"$otherName/$relationshipName"} = + "$otherName.to_link = $linkField"; + } + } + } + # Create entity joins for the recursive relationships. Unlike the non-recursive + # joins, the direction makes a difference with the recursive joins. This can give + # rise to situations where we can't create the path we want; however, it is always + # possible to get the same effect using multiple queries. + for my $relationshipName (@bothList) { + Trace("Setting up entity joins to recursive relationship $relationshipName with $entityName.") if T(metadata => 4); + # Join to the entity from each direction. + $joinTable{"$entityName/$relationshipName"} = + "$entityName.id = $relationshipName.from_link"; + $joinTable{"$relationshipName/$entityName"} = + "$relationshipName.to_link = $entityName.id"; + } + } + # Add the join table to the structure. + $metadata->{Joins} = \%joinTable; + # Return the slurped and fixed-up structure. + return $metadata; } =head3 CreateRelationshipIndex @@ -2289,20 +2558,24 @@ =cut sub _CreateRelationshipIndex { - # Get the parameters. - my ($indexKey, $relationshipName, $relationshipStructure) = @_; - # Get the target relation. - my $relationStructure = $relationshipStructure->{Relations}->{$relationshipName}; - # Create a descriptor for the link field that goes at the beginning of this index. - my $firstField = { name => lcfirst $indexKey . '-link', order => 'ascending' }; - # Get the target index descriptor. - my $newIndex = $relationshipStructure->{$indexKey . "Index"}; - # Add the first field to the index's field list. Due to the craziness of PERL, if the - # index descriptor does not exist, it will be created automatically so we can add - # the field to it. - unshift @{$newIndex->{IndexFields}}, $firstField; - # Add the index to the relation. - _AddIndex("idx$relationshipName$indexKey", $relationStructure, $newIndex); + # Get the parameters. + my ($indexKey, $relationshipName, $relationshipStructure) = @_; + # Get the target relation. + my $relationStructure = $relationshipStructure->{Relations}->{$relationshipName}; + # Create a descriptor for the link field that goes at the beginning of this index. + my $firstField = { name => lcfirst $indexKey . '-link', order => 'ascending' }; + # Get the target index descriptor. + my $newIndex = $relationshipStructure->{$indexKey . "Index"}; + # Add the first field to the index's field list. Due to the craziness of PERL, if the + # index descriptor does not exist, it will be created automatically so we can add + # the field to it. + unshift @{$newIndex->{IndexFields}}, $firstField; + # If this is a one-to-many relationship, the "To" index is unique. + if ($relationshipStructure->{arity} eq "1M" && $indexKey eq "To") { + $newIndex->{Unique} = 'true'; + } + # Add the index to the relation. + _AddIndex("idx$relationshipName$indexKey", $relationStructure, $newIndex); } =head3 AddIndex @@ -2330,25 +2603,25 @@ =cut sub _AddIndex { - # Get the parameters. - my ($indexName, $relationStructure, $newIndex) = @_; - # We want to re-do the index's field list. Instead of an object for each field, - # we want a string consisting of the field name optionally followed by the token DESC. - my @fieldList = ( ); - for my $field (@{$newIndex->{IndexFields}}) { - # Create a string containing the field name. - my $fieldString = $field->{name}; - # Add the ordering token if needed. - if ($field->{order} eq "descending") { - $fieldString .= " DESC"; - } - # Push the result onto the field list. - push @fieldList, $fieldString; - } - # Store the field list just created as the new index field list. - $newIndex->{IndexFields} = \@fieldList; - # Add the index to the relation's index list. - $relationStructure->{Indexes}->{$indexName} = $newIndex; + # Get the parameters. + my ($indexName, $relationStructure, $newIndex) = @_; + # We want to re-do the index's field list. Instead of an object for each field, + # we want a string consisting of the field name optionally followed by the token DESC. + my @fieldList = ( ); + for my $field (@{$newIndex->{IndexFields}}) { + # Create a string containing the field name. + my $fieldString = $field->{name}; + # Add the ordering token if needed. + if ($field->{order} eq "descending") { + $fieldString .= " DESC"; + } + # Push the result onto the field list. + push @fieldList, $fieldString; + } + # Store the field list just created as the new index field list. + $newIndex->{IndexFields} = \@fieldList; + # Add the index to the relation's index list. + $relationStructure->{Indexes}->{$indexName} = $newIndex; } =head3 FixupFields @@ -2382,33 +2655,33 @@ =cut sub _FixupFields { - # Get the parameters. - my ($structure, $defaultRelationName, $prettySortValue, $textPrettySortValue) = @_; - # Insure the structure has a field list. - if (!exists $structure->{Fields}) { - # Here it doesn't, so we create a new one. - $structure->{Fields} = { }; - } else { - # Here we have a field list. Loop through its fields. - my $fieldStructures = $structure->{Fields}; - for my $fieldName (keys %{$fieldStructures}) { + # Get the parameters. + my ($structure, $defaultRelationName, $prettySortValue, $textPrettySortValue) = @_; + # Insure the structure has a field list. + if (!exists $structure->{Fields}) { + # Here it doesn't, so we create a new one. + $structure->{Fields} = { }; + } else { + # Here we have a field list. Loop through its fields. + my $fieldStructures = $structure->{Fields}; + for my $fieldName (keys %{$fieldStructures}) { Trace("Processing field $fieldName of $defaultRelationName.") if T(4); - my $fieldData = $fieldStructures->{$fieldName}; - # Get the field type. - my $type = $fieldData->{type}; - # Plug in a relation name if it is needed. - Tracer::MergeOptions($fieldData, { relation => $defaultRelationName }); - # Plug in a data generator if we need one. - if (!exists $fieldData->{DataGen}) { - # The data generator will use the default for the field's type. - $fieldData->{DataGen} = { content => $TypeTable{$type}->{dataGen} }; - } - # Plug in the defaults for the optional data generation parameters. - Tracer::MergeOptions($fieldData->{DataGen}, { testCount => 1, pass => 0 }); - # Add the PrettySortValue. - $fieldData->{PrettySort} = (($type eq "text") ? $textPrettySortValue : $prettySortValue); - } - } + my $fieldData = $fieldStructures->{$fieldName}; + # Get the field type. + my $type = $fieldData->{type}; + # Plug in a relation name if it is needed. + Tracer::MergeOptions($fieldData, { relation => $defaultRelationName }); + # Plug in a data generator if we need one. + if (!exists $fieldData->{DataGen}) { + # The data generator will use the default for the field's type. + $fieldData->{DataGen} = { content => $TypeTable{$type}->{dataGen} }; + } + # Plug in the defaults for the optional data generation parameters. + Tracer::MergeOptions($fieldData->{DataGen}, { testCount => 1, pass => 0 }); + # Add the PrettySortValue. + $fieldData->{PrettySort} = (($type eq "text") ? $textPrettySortValue : $prettySortValue); + } + } } =head3 FixName @@ -2432,12 +2705,12 @@ =cut sub _FixName { - # Get the parameter. - my ($fieldName) = @_; - # Replace its minus signs with underscores. - $fieldName =~ s/-/_/g; - # Return the result. - return $fieldName; + # Get the parameter. + my ($fieldName) = @_; + # Replace its minus signs with underscores. + $fieldName =~ s/-/_/g; + # Return the result. + return $fieldName; } =head3 FixNames @@ -2461,14 +2734,14 @@ =cut sub _FixNames { - # Create the result list. - my @result = ( ); - # Loop through the incoming parameters. - for my $field (@_) { - push @result, _FixName($field); - } - # Return the result. - return @result; + # Create the result list. + my @result = ( ); + # Loop through the incoming parameters. + for my $field (@_) { + push @result, _FixName($field); + } + # Return the result. + return @result; } =head3 AddField @@ -2496,14 +2769,14 @@ =cut sub _AddField { - # Get the parameters. - my ($structure, $fieldName, $fieldData) = @_; - # Create the field structure by copying the incoming data. - my $fieldStructure = {%{$fieldData}}; - # Get a reference to the field list itself. - my $fieldList = $structure->{Fields}; - # Add the field to the field list. - $fieldList->{$fieldName} = $fieldStructure; + # Get the parameters. + my ($structure, $fieldName, $fieldData) = @_; + # Create the field structure by copying the incoming data. + my $fieldStructure = {%{$fieldData}}; + # Get a reference to the field list itself. + my $fieldList = $structure->{Fields}; + # Add the field to the field list. + $fieldList->{$fieldName} = $fieldStructure; } =head3 ReOrderRelationTable @@ -2530,40 +2803,40 @@ =cut sub _ReOrderRelationTable { - # Get the parameters. - my ($relationTable) = @_; - # Create the return list. - my @resultList; - # Rather than copy all the fields in a single pass, we make multiple passes and only copy - # fields whose PrettySort value matches the current pass number. This process continues - # until we process all the fields in the relation. - my $fieldsLeft = (values %{$relationTable}); - for (my $sortPass = 1; $fieldsLeft > 0; $sortPass++) { - # Loop through the fields. Note that we lexically sort the fields. This makes field name - # secondary to pretty-sort number in the final ordering. - for my $fieldName (sort keys %{$relationTable}) { - # Get this field's data. - my $fieldData = $relationTable->{$fieldName}; - # Verify the sort pass. - if ($fieldData->{PrettySort} == $sortPass) { - # Here we're in the correct pass. Denote we've found a field. - $fieldsLeft--; - # The next step is to create the field structure. This done by copying all - # of the field elements except PrettySort and adding the name. - my %thisField; - for my $property (keys %{$fieldData}) { - if ($property ne 'PrettySort') { - $thisField{$property} = $fieldData->{$property}; - } - } - $thisField{name} = $fieldName; - # Now we add this field to the end of the result list. - push @resultList, \%thisField; - } - } - } - # Return a reference to the result list. - return \@resultList; + # Get the parameters. + my ($relationTable) = @_; + # Create the return list. + my @resultList; + # Rather than copy all the fields in a single pass, we make multiple passes and only copy + # fields whose PrettySort value matches the current pass number. This process continues + # until we process all the fields in the relation. + my $fieldsLeft = (values %{$relationTable}); + for (my $sortPass = 1; $fieldsLeft > 0; $sortPass++) { + # Loop through the fields. Note that we lexically sort the fields. This makes field name + # secondary to pretty-sort number in the final ordering. + for my $fieldName (sort keys %{$relationTable}) { + # Get this field's data. + my $fieldData = $relationTable->{$fieldName}; + # Verify the sort pass. + if ($fieldData->{PrettySort} == $sortPass) { + # Here we're in the correct pass. Denote we've found a field. + $fieldsLeft--; + # The next step is to create the field structure. This done by copying all + # of the field elements except PrettySort and adding the name. + my %thisField; + for my $property (keys %{$fieldData}) { + if ($property ne 'PrettySort') { + $thisField{$property} = $fieldData->{$property}; + } + } + $thisField{name} = $fieldName; + # Now we add this field to the end of the result list. + push @resultList, \%thisField; + } + } + } + # Return a reference to the result list. + return \@resultList; } @@ -2589,18 +2862,18 @@ =cut sub _IsPrimary { - # Get the parameters. - my ($self, $relationName) = @_; - # Check for the relation in the entity table. - my $entityTable = $self->{_metaData}->{Entities}; - my $retVal = exists $entityTable->{$relationName}; - if (! $retVal) { - # Check for it in the relationship table. - my $relationshipTable = $self->{_metaData}->{Relationships}; - $retVal = exists $relationshipTable->{$relationName}; - } - # Return the determination indicator. - return $retVal; + # Get the parameters. + my ($self, $relationName) = @_; + # Check for the relation in the entity table. + my $entityTable = $self->{_metaData}->{Entities}; + my $retVal = exists $entityTable->{$relationName}; + if (! $retVal) { + # Check for it in the relationship table. + my $relationshipTable = $self->{_metaData}->{Relationships}; + $retVal = exists $relationshipTable->{$relationName}; + } + # Return the determination indicator. + return $retVal; } =head3 FindRelation @@ -2623,13 +2896,13 @@ =cut sub _FindRelation { - # Get the parameters. - my ($self, $relationName) = @_; - # Get the relation's structure from the master relation table in the metadata structure. - my $metaData = $self->{_metaData}; - my $retVal = $metaData->{RelationTable}->{$relationName}; - # Return it to the caller. - return $retVal; + # Get the parameters. + my ($self, $relationName) = @_; + # Get the relation's structure from the master relation table in the metadata structure. + my $metaData = $self->{_metaData}; + my $retVal = $metaData->{RelationTable}->{$relationName}; + # Return it to the caller. + return $retVal; } =head2 HTML Documentation Utility Methods @@ -2661,15 +2934,15 @@ =cut sub _ComputeRelationshipSentence { - # Get the parameters. - my ($relationshipName, $relationshipStructure) = @_; - # Format the relationship sentence. - my $result = "$relationshipStructure->{from} $relationshipName $relationshipStructure->{to}"; - # Compute the arity. - my $arityCode = $relationshipStructure->{arity}; - my $arity = $ArityTable{$arityCode}; - $result .= " ($arity)"; - return $result; + # Get the parameters. + my ($relationshipName, $relationshipStructure) = @_; + # Format the relationship sentence. + my $result = "$relationshipStructure->{from} $relationshipName $relationshipStructure->{to}"; + # Compute the arity. + my $arityCode = $relationshipStructure->{arity}; + my $arity = $ArityTable{$arityCode}; + $result .= " ($arity)"; + return $result; } =head3 ComputeRelationshipHeading @@ -2699,14 +2972,14 @@ =cut sub _ComputeRelationshipHeading { - # Get the parameters. - my ($relationshipName, $relationshipStructure) = @_; - # Get the FROM and TO entity names. - my $fromEntity = $relationshipStructure->{from}; - my $toEntity = $relationshipStructure->{to}; - # Format a relationship sentence with hyperlinks in it. - my $result = "$fromEntity $relationshipName $toEntity"; - return $result; + # Get the parameters. + my ($relationshipName, $relationshipStructure) = @_; + # Get the FROM and TO entity names. + my $fromEntity = $relationshipStructure->{from}; + my $toEntity = $relationshipStructure->{to}; + # Format a relationship sentence with hyperlinks in it. + my $result = "$fromEntity $relationshipName $toEntity"; + return $result; } =head3 ShowRelationTable @@ -2735,39 +3008,39 @@ =cut sub _ShowRelationTable { - # Get the parameters. - my ($relationName, $relationData) = @_; - # Start the relation's field table. - my $htmlString = _OpenFieldTable($relationName); - # Loop through the fields. - for my $field (@{$relationData->{Fields}}) { - $htmlString .= _ShowField($field); - } - # Close this relation's field table. - $htmlString .= &_CloseTable; - # Now we show the relation's indexes. - $htmlString .= "
    \n"; - my $indexTable = $relationData->{Indexes}; - for my $indexName (sort keys %{$indexTable}) { - my $indexData = $indexTable->{$indexName}; - # Determine whether or not the index is unique. - my $fullName = $indexName; - if (exists $indexData->{Unique} && $indexData->{Unique} eq "true") { - $fullName .= " (unique)"; - } - # Start an HTML list item for this index. - $htmlString .= "
  • Index $fullName\n
      \n"; - # Add any note text. - if (my $note = $indexData->{Notes}) { - $htmlString .= "
    • " . _HTMLNote($note->{content}) . "
    • \n"; - } - # Add the fiield list. - $htmlString .= "
    • " . join(', ', @{$indexData->{IndexFields}}) . "
    • \n"; - # Close this entry. - $htmlString .= "
  • \n"; - } - # Close off the index list. - $htmlString .= "
\n"; + # Get the parameters. + my ($relationName, $relationData) = @_; + # Start the relation's field table. + my $htmlString = _OpenFieldTable($relationName); + # Loop through the fields. + for my $field (@{$relationData->{Fields}}) { + $htmlString .= _ShowField($field); + } + # Close this relation's field table. + $htmlString .= &_CloseTable; + # Now we show the relation's indexes. + $htmlString .= "
    \n"; + my $indexTable = $relationData->{Indexes}; + for my $indexName (sort keys %{$indexTable}) { + my $indexData = $indexTable->{$indexName}; + # Determine whether or not the index is unique. + my $fullName = $indexName; + if (exists $indexData->{Unique} && $indexData->{Unique} eq "true") { + $fullName .= " (unique)"; + } + # Start an HTML list item for this index. + $htmlString .= "
  • Index $fullName\n
      \n"; + # Add any note text. + if (my $note = $indexData->{Notes}) { + $htmlString .= "
    • " . _HTMLNote($note->{content}) . "
    • \n"; + } + # Add the fiield list. + $htmlString .= "
    • " . join(', ', @{$indexData->{IndexFields}}) . "
    • \n"; + # Close this entry. + $htmlString .= "
  • \n"; + } + # Close off the index list. + $htmlString .= "
\n"; } =head3 OpenFieldTable @@ -2791,8 +3064,8 @@ =cut sub _OpenFieldTable { - my ($tablename) = @_; - return _OpenTable($tablename, 'Field', 'Type', 'Description'); + my ($tablename) = @_; + return _OpenTable($tablename, 'Field', 'Type', 'Description'); } =head3 OpenTable @@ -2820,19 +3093,19 @@ =cut sub _OpenTable { - # Get the parameters. - my ($tablename, @colNames) = @_; - # Compute the number of columns. - my $colCount = @colNames; - # Generate the title row. - my $htmlString = "

\n"; - # Loop through the columns, adding the column header rows. - $htmlString .= ""; - for my $colName (@colNames) { - $htmlString .= ""; - } - $htmlString .= "\n"; - return $htmlString; + # Get the parameters. + my ($tablename, @colNames) = @_; + # Compute the number of columns. + my $colCount = @colNames; + # Generate the title row. + my $htmlString = "

$tablename
$colName
\n"; + # Loop through the columns, adding the column header rows. + $htmlString .= ""; + for my $colName (@colNames) { + $htmlString .= ""; + } + $htmlString .= "\n"; + return $htmlString; } =head3 CloseTable @@ -2844,7 +3117,7 @@ =cut sub _CloseTable { - return "
$tablename
$colName

\n"; + return "

\n"; } =head3 ShowField @@ -2868,18 +3141,18 @@ =cut sub _ShowField { - # Get the parameters. - my ($fieldData) = @_; - # Create the HTML string. - my $htmlString = "$fieldData->{name}$fieldData->{type}"; - # If we have content, add it as a third column. - if (exists $fieldData->{Notes}) { - $htmlString .= "" . _HTMLNote($fieldData->{Notes}->{content}) . ""; - } - # Close off the row. - $htmlString .= "\n"; - # Return the result. - return $htmlString; + # Get the parameters. + my ($fieldData) = @_; + # Create the HTML string. + my $htmlString = "$fieldData->{name}$fieldData->{type}"; + # If we have content, add it as a third column. + if (exists $fieldData->{Notes}) { + $htmlString .= "" . _HTMLNote($fieldData->{Notes}->{content}) . ""; + } + # Close off the row. + $htmlString .= "\n"; + # Return the result. + return $htmlString; } =head3 HTMLNote @@ -2906,13 +3179,13 @@ =cut sub _HTMLNote { - # Get the parameter. - my ($dataString) = @_; - # Substitute the codes. - $dataString =~ s!\[(/?[bi])\]!<$1>!g; - $dataString =~ s!\[p\]!

!g; - # Return the result. - return $dataString; + # Get the parameter. + my ($dataString) = @_; + # Substitute the codes. + $dataString =~ s!\[(/?[bi])\]!<$1>!g; + $dataString =~ s!\[p\]!

!g; + # Return the result. + return $dataString; } =head2 Data Generation Utilities @@ -2942,15 +3215,15 @@ =cut sub IntGen { - # Get the parameters. - my ($min, $max) = @_; - # Determine the range of possible values. Note we put some space well above the - # maximum value to give it a fighting chance of apppearing in the list. - my $span = $max + 0.99 - $min; - # Create an integer in the range. - my $retVal = $min + int(rand($span)); - # Return the result. - return $retVal; + # Get the parameters. + my ($min, $max) = @_; + # Determine the range of possible values. Note we put some space well above the + # maximum value to give it a fighting chance of apppearing in the list. + my $span = $max + 0.99 - $min; + # Create an integer in the range. + my $retVal = $min + int(rand($span)); + # Return the result. + return $retVal; } =head3 RandChar @@ -2974,12 +3247,12 @@ =cut sub RandChar { - # Get the parameter. - my ($sourceString) = @_; - # Select a random character. - my $retVal = IntGen(0, (length $sourceString) - 1); - # Return it. - return substr($sourceString, $retVal, 1); + # Get the parameter. + my ($sourceString) = @_; + # Select a random character. + my $retVal = IntGen(0, (length $sourceString) - 1); + # Return it. + return substr($sourceString, $retVal, 1); } =head3 RandChars @@ -3008,15 +3281,15 @@ =cut sub RandChars { - # Get the parameters. - my ($sourceString, $length) = @_; - # Call RandChar repeatedly to generate the string. - my $retVal = ""; - for (my $i = 0; $i < $length; $i++) { - $retVal .= RandChar($sourceString); - } - # Return the result. - return $retVal; + # Get the parameters. + my ($sourceString, $length) = @_; + # Call RandChar repeatedly to generate the string. + my $retVal = ""; + for (my $i = 0; $i < $length; $i++) { + $retVal .= RandChar($sourceString); + } + # Return the result. + return $retVal; } =head3 RandParam @@ -3040,11 +3313,11 @@ =cut sub RandParam { - # Get the parameter. - my @parms = @_; - # Choose a random parameter from the list. - my $chosenIndex = IntGen(0, $#parms); - return $parms[$chosenIndex]; + # Get the parameter. + my @parms = @_; + # Choose a random parameter from the list. + my $chosenIndex = IntGen(0, $#parms); + return $parms[$chosenIndex]; } =head3 StringGen @@ -3073,54 +3346,54 @@ =cut sub StringGen { - # Get the parameters. - my @patterns = @_; - # Choose the appropriate pattern. - my $chosenPattern = RandParam(@patterns); - # Declare the return variable. - my $retVal = ""; - # Determine whether this is a count or a picture pattern. - if ($chosenPattern =~ m/^\d+/) { - # Here we have a count. Get the string of source characters. - my $letterString = $PictureTable{'X'}; - my $stringLen = length $letterString; - # Save the number of characters we have to generate. - my $charsLeft = $chosenPattern; - # Loop until the return variable is full. - while ($charsLeft > 0) { - # Generate a random position in the soruce string. - my $stringIndex = IntGen(0, $stringLen - 1); - # Compute the number of characters to pull out of the source string. - my $chunkSize = $stringLen - $stringIndex; - if ($chunkSize > $charsLeft) { $chunkSize = $charsLeft; } - # Stuff this chunk into the return value. - $retVal .= substr($letterString, $stringIndex, $chunkSize); - # Record the data moved. - $charsLeft -= $chunkSize; - } - } elsif ($chosenPattern =~ m/^P/) { - # Here we have a picture string. We will move through the picture one - # character at a time generating data. - for (my $i = 1; $i < length $chosenPattern; $i++) { - # Get this picture character. - my $chr = substr($chosenPattern, $i, 1); - # Check to see if the picture char is one we recognize. - if (exists $PictureTable{$chr}) { - # Choose a random character from the available values for this - # picture character. - $retVal .= RandChar($PictureTable{$chr}); - } else { - # Copy in the picture character as a literal. - $retVal .= $chr; - } - } - } else { - # Here we have neither a picture string or a letter count, so we treat - # the string as a literal. - $retVal = $chosenPattern; - } - # Return the string formed. - return $retVal; + # Get the parameters. + my @patterns = @_; + # Choose the appropriate pattern. + my $chosenPattern = RandParam(@patterns); + # Declare the return variable. + my $retVal = ""; + # Determine whether this is a count or a picture pattern. + if ($chosenPattern =~ m/^\d+/) { + # Here we have a count. Get the string of source characters. + my $letterString = $PictureTable{'X'}; + my $stringLen = length $letterString; + # Save the number of characters we have to generate. + my $charsLeft = $chosenPattern; + # Loop until the return variable is full. + while ($charsLeft > 0) { + # Generate a random position in the soruce string. + my $stringIndex = IntGen(0, $stringLen - 1); + # Compute the number of characters to pull out of the source string. + my $chunkSize = $stringLen - $stringIndex; + if ($chunkSize > $charsLeft) { $chunkSize = $charsLeft; } + # Stuff this chunk into the return value. + $retVal .= substr($letterString, $stringIndex, $chunkSize); + # Record the data moved. + $charsLeft -= $chunkSize; + } + } elsif ($chosenPattern =~ m/^P/) { + # Here we have a picture string. We will move through the picture one + # character at a time generating data. + for (my $i = 1; $i < length $chosenPattern; $i++) { + # Get this picture character. + my $chr = substr($chosenPattern, $i, 1); + # Check to see if the picture char is one we recognize. + if (exists $PictureTable{$chr}) { + # Choose a random character from the available values for this + # picture character. + $retVal .= RandChar($PictureTable{$chr}); + } else { + # Copy in the picture character as a literal. + $retVal .= $chr; + } + } + } else { + # Here we have neither a picture string or a letter count, so we treat + # the string as a literal. + $retVal = $chosenPattern; + } + # Return the string formed. + return $retVal; } =head3 DateGen @@ -3157,18 +3430,18 @@ =cut sub DateGen { - # Get the parameters. - my ($startDayOffset, $endDayOffset, $minutes) = @_; - # Get midnight of the current day. - my $now = time(); - my ($sec, $min, $hour) = localtime($now); - my $today = $now - (($hour * 60 + $min) * 60 + $sec); - # Compute the day we want. - my $newDay = IntGen($startDayOffset, $endDayOffset) * 86400 + $today; - # Add the minutes. - my $retVal = $newDay + $minutes * 60; - # Return the result. - return $retVal; + # Get the parameters. + my ($startDayOffset, $endDayOffset, $minutes) = @_; + # Get midnight of the current day. + my $now = time(); + my ($sec, $min, $hour) = localtime($now); + my $today = $now - (($hour * 60 + $min) * 60 + $sec); + # Compute the day we want. + my $newDay = IntGen($startDayOffset, $endDayOffset) * 86400 + $today; + # Add the minutes. + my $retVal = $newDay + $minutes * 60; + # Return the result. + return $retVal; } =head3 FloatGen @@ -3197,11 +3470,11 @@ =cut sub FloatGen { - # Get the parameters. - my ($min, $max) = @_; - # Generate the result. - my $retVal = rand($max - $min) + $min; - return $retVal; + # Get the parameters. + my ($min, $max) = @_; + # Generate the result. + my $retVal = rand($max - $min) + $min; + return $retVal; } =head3 ListGen @@ -3230,15 +3503,15 @@ =cut sub ListGen { - # Get the parameters. - my ($pattern, $count) = @_; - # Generate the list. - my @retVal = (); - for (my $i = 0; $i < $count; $i++) { - push @retVal, StringGen($pattern); - } - # Return it. - return @retVal; + # Get the parameters. + my ($pattern, $count) = @_; + # Generate the list. + my @retVal = (); + for (my $i = 0; $i < $count; $i++) { + push @retVal, StringGen($pattern); + } + # Return it. + return @retVal; } -1; \ No newline at end of file +1;