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

Diff of /Sprout/ERDB.pm

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

revision 1.73, Fri Nov 3 00:33:26 2006 UTC revision 1.84, Wed Jan 24 10:22:22 2007 UTC
# Line 229  Line 229 
229  =head3 Indexes  =head3 Indexes
230    
231  An entity can have multiple alternate indexes associated with it. The fields must  An entity can have multiple alternate indexes associated with it. The fields must
232  be from the primary relation. The alternate indexes assist in ordering results  all be from the same relation. The alternate indexes assist in ordering results
233  from a query. A relationship can have up to two indexes-- a I<to-index> and a  from a query. A relationship can have up to two indexes-- a I<to-index> and a
234  I<from-index>. These order the results when crossing the relationship. For  I<from-index>. These order the results when crossing the relationship. For
235  example, in the relationship C<HasContig> from C<Genome> to C<Contig>, the  example, in the relationship C<HasContig> from C<Genome> to C<Contig>, the
# Line 257  Line 257 
257    
258  =back  =back
259    
260  The B<Index>, B<FromIndex>, and B<ToIndex> tags themselves have no attributes.  The B<FromIndex>, and B<ToIndex> tags have no attributes. The B<Index> tag can
261    have a B<Unique> attribute. If specified, the index will be generated as a unique
262    index.
263    
264  =head3 Object and Field Names  =head3 Object and Field Names
265    
# Line 336  Line 338 
338  # Table of information about our datatypes. "sqlType" is the corresponding SQL datatype string.  # Table of information about our datatypes. "sqlType" is the corresponding SQL datatype string.
339  # "maxLen" is the maximum permissible length of the incoming string data used to populate a field  # "maxLen" is the maximum permissible length of the incoming string data used to populate a field
340  # of the specified type. "avgLen" is the average byte length for estimating  # of the specified type. "avgLen" is the average byte length for estimating
341  # record sizes. "sort" is the key modifier for the sort command, "notes" is a type description.  # record sizes. "sort" is the key modifier for the sort command, "notes" is a type description,
342    # and "indexMod", if non-zero, is the number of characters to use when the field is specified in an
343    # index
344  my %TypeTable = ( char =>    { sqlType => 'CHAR(1)',            maxLen => 1,            avgLen =>   1, sort => "",  my %TypeTable = ( char =>    { sqlType => 'CHAR(1)',            maxLen => 1,            avgLen =>   1, sort => "",
345                                 notes => "single ASCII character"},                                 indexMod =>   0, notes => "single ASCII character"},
346                    int =>     { sqlType => 'INTEGER',            maxLen => 20,           avgLen =>   4, sort => "n",                    int =>     { sqlType => 'INTEGER',            maxLen => 20,           avgLen =>   4, sort => "n",
347                                 notes => "signed 32-bit integer"},                                 indexMod =>   0, notes => "signed 32-bit integer"},
348                    counter => { sqlType => 'INTEGER UNSIGNED',   maxLen => 20,           avgLen =>   4, sort => "n",                    counter => { sqlType => 'INTEGER UNSIGNED',   maxLen => 20,           avgLen =>   4, sort => "n",
349                                 notes => "unsigned 32-bit integer"},                                 indexMod =>   0, notes => "unsigned 32-bit integer"},
350                    string =>  { sqlType => 'VARCHAR(255)',       maxLen => 255,          avgLen => 100, sort => "",                    string =>  { sqlType => 'VARCHAR(255)',       maxLen => 255,          avgLen => 100, sort => "",
351                                 notes => "character string, 0 to 255 characters"},                                 indexMod =>   0, notes => "character string, 0 to 255 characters"},
352                    text =>    { sqlType => 'TEXT',               maxLen => 1000000000,   avgLen => 500, sort => "",                    text =>    { sqlType => 'TEXT',               maxLen => 1000000000,   avgLen => 500, sort => "",
353                                 notes => "character string, nearly unlimited length, cannot be indexed"},                                 indexMod => 255, notes => "character string, nearly unlimited length, only first 255 characters are indexed"},
354                    date =>    { sqlType => 'BIGINT',             maxLen => 80,           avgLen =>   8, sort => "n",                    date =>    { sqlType => 'BIGINT',             maxLen => 80,           avgLen =>   8, sort => "n",
355                                 notes => "signed, 64-bit integer"},                                 indexMod =>   0, notes => "signed, 64-bit integer"},
356                    float =>   { sqlType => 'DOUBLE PRECISION',   maxLen => 40,           avgLen =>   8, sort => "g",                    float =>   { sqlType => 'DOUBLE PRECISION',   maxLen => 40,           avgLen =>   8, sort => "g",
357                                 notes => "64-bit double precision floating-point number"},                                 indexMod =>   0, notes => "64-bit double precision floating-point number"},
358                    boolean => { sqlType => 'SMALLINT',           maxLen => 1,            avgLen =>   1, sort => "n",                    boolean => { sqlType => 'SMALLINT',           maxLen => 1,            avgLen =>   1, sort => "n",
359                                 notes => "boolean value: 0 if false, 1 if true"},                                 indexMod =>   0, notes => "boolean value: 0 if false, 1 if true"},
360                   'hash-string' =>                   'hash-string' =>
361                               { sqlType => 'VARCHAR(22)',        maxLen => 22,           avgLen =>  22, sort => "",                               { sqlType => 'VARCHAR(22)',        maxLen => 22,           avgLen =>  22, sort => "",
362                                 notes => "string stored in digested form, used for certain types of key fields"},                                 indexMod =>   0, notes => "string stored in digested form, used for certain types of key fields"},
363                   'id-string' =>                   'id-string' =>
364                               { sqlType => 'VARCHAR(25)',        maxLen => 25,           avgLen =>  25, sort => "",                               { sqlType => 'VARCHAR(25)',        maxLen => 25,           avgLen =>  25, sort => "",
365                                 notes => "character string, 0 to 25 characters"},                                 indexMod =>   0, notes => "character string, 0 to 25 characters"},
366                   'key-string' =>                   'key-string' =>
367                               { sqlType => 'VARCHAR(40)',        maxLen => 40,           avgLen =>  10, sort => "",                               { sqlType => 'VARCHAR(40)',        maxLen => 40,           avgLen =>  10, sort => "",
368                                 notes => "character string, 0 to 40 characters"},                                 indexMod =>   0, notes => "character string, 0 to 40 characters"},
369                   'name-string' =>                   'name-string' =>
370                               { sqlType => 'VARCHAR(80)',        maxLen => 80,           avgLen =>  40, sort => "",                               { sqlType => 'VARCHAR(80)',        maxLen => 80,           avgLen =>  40, sort => "",
371                                 notes => "character string, 0 to 80 characters"},                                 indexMod =>   0, notes => "character string, 0 to 80 characters"},
372                   'medium-string' =>                   'medium-string' =>
373                               { sqlType => 'VARCHAR(160)',       maxLen => 160,          avgLen =>  40, sort => "",                               { sqlType => 'VARCHAR(160)',       maxLen => 160,          avgLen =>  40, sort => "",
374                                 notes => "character string, 0 to 160 characters"},                                 indexMod =>   0, notes => "character string, 0 to 160 characters"},
375                  );                  );
376    
377  # Table translating arities into natural language.  # Table translating arities into natural language.
# Line 392  Line 396 
396                   );                   );
397    
398  my %XmlInOpts  = (  my %XmlInOpts  = (
399                    ForceArray => ['Field', 'Index', 'IndexField'],                    ForceArray => ['Field', 'Index', 'IndexField', 'Relationship', 'Entity'],
400                    ForceContent => 1,                    ForceContent => 1,
401                    NormalizeSpace => 2,                    NormalizeSpace => 2,
402                   );                   );
# Line 544  Line 548 
548          if (my $notes = $entityData->{Notes}) {          if (my $notes = $entityData->{Notes}) {
549              $retVal .= "<p>" . HTMLNote($notes->{content}) . "</p>\n";              $retVal .= "<p>" . HTMLNote($notes->{content}) . "</p>\n";
550          }          }
551          # Now we want a list of the entity's relationships. First, we set up the relationship subsection.          # See if we need a list of the entity's relationships.
552            my $relCount = keys %{$relationshipList};
553            if ($relCount > 0) {
554                # First, we set up the relationship subsection.
555          $retVal .= "<h4>Relationships for <b>$key</b></h4>\n<ul>\n";          $retVal .= "<h4>Relationships for <b>$key</b></h4>\n<ul>\n";
556          # Loop through the relationships.          # Loop through the relationships.
557          for my $relationship (sort keys %{$relationshipList}) {          for my $relationship (sort keys %{$relationshipList}) {
# Line 560  Line 567 
567          }          }
568          # Close off the relationship list.          # Close off the relationship list.
569          $retVal .= "</ul>\n";          $retVal .= "</ul>\n";
570            }
571          # Get the entity's relations.          # Get the entity's relations.
572          my $relationList = $entityData->{Relations};          my $relationList = $entityData->{Relations};
573          # Create a header for the relation subsection.          # Create a header for the relation subsection.
# Line 646  Line 654 
654      return Data::Dumper::Dumper($self->{_metaData});      return Data::Dumper::Dumper($self->{_metaData});
655  }  }
656    
657    =head3 FindIndexForEntity
658    
659    C<< my $indexFound = ERDB::FindIndexForEntity($xml, $entityName, $attributeName); >>
660    
661    This method locates the entry in an entity's index list that begins with the
662    specified attribute name. If the entity has no index list, one will be
663    created. This method works on raw XML, not a live ERDB object.
664    
665    =over 4
666    
667    =item xml
668    
669    The raw XML structure defining the database.
670    
671    =item entityName
672    
673    The name of the relevant entity.
674    
675    =item attributeName
676    
677    The name of the attribute relevant to the search.
678    
679    =item RETURN
680    
681    The numerical index in the index list of the index entry for the specified entity and
682    attribute, or C<undef> if no such index exists.
683    
684    =back
685    
686    =cut
687    
688    sub FindIndexForEntity {
689        # Get the parameters.
690        my ($xml, $entityName, $attributeName) = @_;
691        # Declare the return variable.
692        my $retVal;
693        # Get the named entity.
694        my $entityData = $xml->{Entities}->{$entityName};
695        if (! $entityData) {
696            Confess("Entity $entityName not found in DBD structure.");
697        } else {
698            # Insure it has an index list.
699            if (! exists $entityData->{Indexes}) {
700                $entityData->{Indexes} = [];
701            } else {
702                # Search for the desired index.
703                my $indexList = $entityData->{Indexes};
704                my $n = scalar @{$indexList};
705                Trace("Searching $n indexes in index list for $entityName.") if T(2);
706                # We use an indexed FOR here because we're returning an
707                # index number instead of an object. We do THAT so we can
708                # delete the index from the list if needed.
709                for (my $i = 0; $i < $n && !defined($retVal); $i++) {
710                    my $index = $indexList->[$i];
711                    my $fields = $index->{IndexFields};
712                    # Technically this IF should be safe (that is, we are guaranteed
713                    # the existence of a "$fields->[0]"), because when we load the XML
714                    # we have SuppressEmpty specified.
715                    if ($fields->[0]->{name} eq $attributeName) {
716                        $retVal = $i;
717                    }
718                }
719            }
720        }
721        Trace("Index for $attributeName of $entityName found at position $retVal.") if defined($retVal) && T(3);
722        Trace("Index for $attributeName not found in $entityName.") if !defined($retVal) && T(3);
723        # Return the result.
724        return $retVal;
725    }
726    
727  =head3 CreateTables  =head3 CreateTables
728    
729  C<< $erdb->CreateTables(); >>  C<< $erdb->CreateTables(); >>
# Line 891  Line 969 
969      for my $indexName (keys %{$indexHash}) {      for my $indexName (keys %{$indexHash}) {
970          my $indexData = $indexHash->{$indexName};          my $indexData = $indexHash->{$indexName};
971          # Get the index's field list.          # Get the index's field list.
972          my @fieldList = _FixNames(@{$indexData->{IndexFields}});          my @rawFields = @{$indexData->{IndexFields}};
973            # Get a hash of the relation's field types.
974            my %types = map { $_->{name} => $_->{type} } @{$relationData->{Fields}};
975            # We need to check for text fields so we can append a length limitation for them. To do
976            # that, we need the relation's field list.
977            my $relFields = $relationData->{Fields};
978            for (my $i = 0; $i <= $#rawFields; $i++) {
979                # Get the field type.
980                my $field = $rawFields[$i];
981                my $type = $types{$field};
982                # Ask if it requires using prefix notation for the index.
983                my $mod = $TypeTable{$type}->{indexMod};
984                Trace("Field $field ($i) in $relationName has type $type and indexMod $mod.") if T(3);
985                if ($mod) {
986                    # Append the prefix length to the field name,
987                    $rawFields[$i] .= "($mod)";
988                }
989            }
990            my @fieldList = _FixNames(@rawFields);
991          my $flds = join(', ', @fieldList);          my $flds = join(', ', @fieldList);
992          # Get the index's uniqueness flag.          # Get the index's uniqueness flag.
993          my $unique = (exists $indexData->{Unique} ? 'unique' : undef);          my $unique = (exists $indexData->{Unique} ? 'unique' : undef);
# Line 906  Line 1002 
1002      }      }
1003  }  }
1004    
1005    =head3 GetSecondaryFields
1006    
1007    C<< my %fieldTuples = $erdb->GetSecondaryFields($entityName); >>
1008    
1009    This method will return a list of the name and type of each of the secondary
1010    fields for a specified entity. Secondary fields are stored in two-column tables
1011    in addition to the primary entity table. This enables the field to have no value
1012    or to have multiple values.
1013    
1014    =over 4
1015    
1016    =item entityName
1017    
1018    Name of the entity whose secondary fields are desired.
1019    
1020    =item RETURN
1021    
1022    Returns a hash mapping the field names to their field types.
1023    
1024    =back
1025    
1026    =cut
1027    
1028    sub GetSecondaryFields {
1029        # Get the parameters.
1030        my ($self, $entityName) = @_;
1031        # Declare the return variable.
1032        my %retVal = ();
1033        # Look for the entity.
1034        my $table = $self->GetFieldTable($entityName);
1035        # Loop through the fields, pulling out the secondaries.
1036        for my $field (sort keys %{$table}) {
1037            if ($table->{$field}->{relation} ne $entityName) {
1038                # Here we have a secondary field.
1039                $retVal{$field} = $table->{$field}->{type};
1040            }
1041        }
1042        # Return the result.
1043        return %retVal;
1044    }
1045    
1046    =head3 GetFieldRelationName
1047    
1048    C<< my $name = $erdb->GetFieldRelationName($objectName, $fieldName); >>
1049    
1050    Return the name of the relation containing a specified field.
1051    
1052    =over 4
1053    
1054    =item objectName
1055    
1056    Name of the entity or relationship containing the field.
1057    
1058    =item fieldName
1059    
1060    Name of the relevant field in that entity or relationship.
1061    
1062    =item RETURN
1063    
1064    Returns the name of the database relation containing the field, or C<undef> if
1065    the field does not exist.
1066    
1067    =back
1068    
1069    =cut
1070    
1071    sub GetFieldRelationName {
1072        # Get the parameters.
1073        my ($self, $objectName, $fieldName) = @_;
1074        # Declare the return variable.
1075        my $retVal;
1076        # Get the object field table.
1077        my $table = $self->GetFieldTable($objectName);
1078        # Only proceed if the field exists.
1079        if (exists $table->{$fieldName}) {
1080            # Determine the name of the relation that contains this field.
1081            $retVal = $table->{$fieldName}->{relation};
1082        }
1083        # Return the result.
1084        return $retVal;
1085    }
1086    
1087    =head3 DeleteValue
1088    
1089    C<< my $numDeleted = $erdb->DeleteValue($entityName, $id, $fieldName, $fieldValue); >>
1090    
1091    Delete secondary field values from the database. This method can be used to delete all
1092    values of a specified field for a particular entity instance, or only a single value.
1093    
1094    Secondary fields are stored in two-column relations separate from an entity's primary
1095    table, and as a result a secondary field can legitimately have no value or multiple
1096    values. Therefore, it makes sense to talk about deleting secondary fields where it
1097    would not make sense for primary fields.
1098    
1099    =over 4
1100    
1101    =item entityName
1102    
1103    Name of the entity from which the fields are to be deleted.
1104    
1105    =item id
1106    
1107    ID of the entity instance to be processed. If the instance is not found, this
1108    method will have no effect. If C<undef> is specified, all values for all of
1109    the entity instances will be deleted.
1110    
1111    =item fieldName
1112    
1113    Name of the field whose values are to be deleted.
1114    
1115    =item fieldValue (optional)
1116    
1117    Value to be deleted. If not specified, then all values of the specified field
1118    will be deleted for the entity instance. If specified, then only the values which
1119    match this parameter will be deleted.
1120    
1121    =item RETURN
1122    
1123    Returns the number of rows deleted.
1124    
1125    =back
1126    
1127    =cut
1128    
1129    sub DeleteValue {
1130        # Get the parameters.
1131        my ($self, $entityName, $id, $fieldName, $fieldValue) = @_;
1132        # Declare the return value.
1133        my $retVal = 0;
1134        # We need to set up an SQL command to do the deletion. First, we
1135        # find the name of the field's relation.
1136        my $table = $self->GetFieldTable($entityName);
1137        my $field = $table->{$fieldName};
1138        my $relation = $field->{relation};
1139        # Make sure this is a secondary field.
1140        if ($relation eq $entityName) {
1141            Confess("Cannot delete values of $fieldName for $entityName.");
1142        } else {
1143            # Set up the SQL command to delete all values.
1144            my $sql = "DELETE FROM $relation";
1145            # Build the filter.
1146            my @filters = ();
1147            my @parms = ();
1148            # Check for a filter by ID.
1149            if (defined $id) {
1150                push @filters, "id = ?";
1151                push @parms, $id;
1152            }
1153            # Check for a filter by value.
1154            if (defined $fieldValue) {
1155                push @filters, "$fieldName = ?";
1156                push @parms, $fieldValue;
1157            }
1158            # Append the filters to the command.
1159            if (@filters) {
1160                $sql .= " WHERE " . join(" AND ", @filters);
1161            }
1162            # Execute the command.
1163            my $dbh = $self->{_dbh};
1164            $retVal = $dbh->SQL($sql, 0, @parms);
1165        }
1166        # Return the result.
1167        return $retVal;
1168    }
1169    
1170  =head3 LoadTables  =head3 LoadTables
1171    
1172  C<< my $stats = $erdb->LoadTables($directoryName, $rebuild); >>  C<< my $stats = $erdb->LoadTables($directoryName, $rebuild); >>
# Line 1163  Line 1424 
1424      return $retVal;      return $retVal;
1425  }  }
1426    
1427    
1428    
1429  =head3 Search  =head3 Search
1430    
1431  C<< my $query = $erdb->Search($searchExpression, $idx, \@objectNames, $filterClause, \@params); >>  C<< my $query = $erdb->Search($searchExpression, $idx, \@objectNames, $filterClause, \@params); >>
# Line 1176  Line 1439 
1439    
1440  =item searchExpression  =item searchExpression
1441    
1442  Boolean search expression for the text fields of the target object.  Boolean search expression for the text fields of the target object. The default mode for
1443    a Boolean search expression is OR, but we want the default to be AND, so we will
1444    add a C<+> operator to each word with no other operator before it.
1445    
1446  =item idx  =item idx
1447    
# Line 1230  Line 1495 
1495          my @fields = @{$object1Structure->{searchFields}};          my @fields = @{$object1Structure->{searchFields}};
1496          # Clean the search expression.          # Clean the search expression.
1497          my $actualKeywords = $self->CleanKeywords($searchExpression);          my $actualKeywords = $self->CleanKeywords($searchExpression);
1498            # Prefix a "+" to each uncontrolled word. This converts the default
1499            # search mode from OR to AND.
1500            $actualKeywords =~ s/(^|\s)(\w|")/$1\+$2/g;
1501          Trace("Actual keywords for search are\n$actualKeywords") if T(3);          Trace("Actual keywords for search are\n$actualKeywords") if T(3);
1502          # We need two match expressions, one for the filter clause and one in the          # We need two match expressions, one for the filter clause and one in the
1503          # query itself. Both will use a parameter mark, so we need to push the          # query itself. Both will use a parameter mark, so we need to push the
# Line 1337  Line 1605 
1605      # Declare the return variable.      # Declare the return variable.
1606      my %retVal = ();      my %retVal = ();
1607      # Find the entity's data structure.      # Find the entity's data structure.
1608      my $entityData = $self->{Entities}->{$entityName};      my $entityData = $self->{_metaData}->{Entities}->{$entityName};
1609      # Loop through its fields, adding each special field to the return hash.      # Loop through its fields, adding each special field to the return hash.
1610      my $fieldHash = $entityData->{Fields};      my $fieldHash = $entityData->{Fields};
1611      for my $fieldName (keys %{$fieldHash}) {      for my $fieldName (keys %{$fieldHash}) {
# Line 1352  Line 1620 
1620    
1621  =head3 Delete  =head3 Delete
1622    
1623  C<< my $stats = $erdb->Delete($entityName, $objectID); >>  C<< my $stats = $erdb->Delete($entityName, $objectID, %options); >>
1624    
1625  Delete an entity instance from the database. The instance is deleted along with all entity and  Delete an entity instance from the database. The instance is deleted along with all entity and
1626  relationship instances dependent on it. The idea of dependence here is recursive. An object is  relationship instances dependent on it. The definition of I<dependence> is recursive.
1627  always dependent on itself. An object is dependent if it is a 1-to-many or many-to-many  
1628  relationship connected to a dependent entity or the "to" entity connected to a 1-to-many  An object is always dependent on itself. An object is dependent if it is a 1-to-many or many-to-many
1629    relationship connected to a dependent entity or if it is the "to" entity connected to a 1-to-many
1630  dependent relationship.  dependent relationship.
1631    
1632  =over 4  =over 4
# Line 1371  Line 1640 
1640  ID of the entity instance to be deleted. If the ID contains a wild card character (C<%>),  ID of the entity instance to be deleted. If the ID contains a wild card character (C<%>),
1641  then it is presumed to by a LIKE pattern.  then it is presumed to by a LIKE pattern.
1642    
1643  =item testFlag  =item options
1644    
1645  If TRUE, the delete statements will be traced without being executed.  A hash detailing the options for this delete operation.
1646    
1647  =item RETURN  =item RETURN
1648    
# Line 1382  Line 1651 
1651    
1652  =back  =back
1653    
1654    The permissible options for this method are as follows.
1655    
1656    =over 4
1657    
1658    =item testMode
1659    
1660    If TRUE, then the delete statements will be traced, but no changes will be made to the database.
1661    
1662    =item keepRoot
1663    
1664    If TRUE, then the entity instances will not be deleted, only the dependent records.
1665    
1666    =back
1667    
1668  =cut  =cut
1669  #: Return Type $%;  #: Return Type $%;
1670  sub Delete {  sub Delete {
1671      # Get the parameters.      # Get the parameters.
1672      my ($self, $entityName, $objectID, $testFlag) = @_;      my ($self, $entityName, $objectID, %options) = @_;
1673      # Declare the return variable.      # Declare the return variable.
1674      my $retVal = Stats->new();      my $retVal = Stats->new();
1675      # Get the DBKernel object.      # Get the DBKernel object.
# Line 1403  Line 1686 
1686      # FROM-relationships and entities.      # FROM-relationships and entities.
1687      my @fromPathList = ();      my @fromPathList = ();
1688      my @toPathList = ();      my @toPathList = ();
1689      # This final hash is used to remember what work still needs to be done. We push paths      # This final list is used to remember what work still needs to be done. We push paths
1690      # onto the list, then pop them off to extend the paths. We prime it with the starting      # onto the list, then pop them off to extend the paths. We prime it with the starting
1691      # point. Note that we will work hard to insure that the last item on a path in the      # point. Note that we will work hard to insure that the last item on a path in the
1692      # TODO list is always an entity.      # to-do list is always an entity.
1693      my @todoList = ([$entityName]);      my @todoList = ([$entityName]);
1694      while (@todoList) {      while (@todoList) {
1695          # Get the current path.          # Get the current path.
# Line 1414  Line 1697 
1697          # Copy it into a list.          # Copy it into a list.
1698          my @stackedPath = @{$current};          my @stackedPath = @{$current};
1699          # Pull off the last item on the path. It will always be an entity.          # Pull off the last item on the path. It will always be an entity.
1700          my $entityName = pop @stackedPath;          my $myEntityName = pop @stackedPath;
1701          # Add it to the alreadyFound list.          # Add it to the alreadyFound list.
1702          $alreadyFound{$entityName} = 1;          $alreadyFound{$myEntityName} = 1;
1703            # Figure out if we need to delete this entity.
1704            if ($myEntityName ne $entityName || ! $options{keepRoot}) {
1705          # Get the entity data.          # Get the entity data.
1706          my $entityData = $self->_GetStructure($entityName);              my $entityData = $self->_GetStructure($myEntityName);
1707          # The first task is to loop through the entity's relation. A DELETE command will              # Loop through the entity's relations. A DELETE command will be needed for each of them.
         # be needed for each of them.  
1708          my $relations = $entityData->{Relations};          my $relations = $entityData->{Relations};
1709          for my $relation (keys %{$relations}) {          for my $relation (keys %{$relations}) {
1710              my @augmentedList = (@stackedPath, $relation);              my @augmentedList = (@stackedPath, $relation);
1711              push @fromPathList, \@augmentedList;              push @fromPathList, \@augmentedList;
1712          }          }
1713            }
1714          # Now we need to look for relationships connected to this entity.          # Now we need to look for relationships connected to this entity.
1715          my $relationshipList = $self->{_metaData}->{Relationships};          my $relationshipList = $self->{_metaData}->{Relationships};
1716          for my $relationshipName (keys %{$relationshipList}) {          for my $relationshipName (keys %{$relationshipList}) {
1717              my $relationship = $relationshipList->{$relationshipName};              my $relationship = $relationshipList->{$relationshipName};
1718              # Check the FROM field. We're only interested if it's us.              # Check the FROM field. We're only interested if it's us.
1719              if ($relationship->{from} eq $entityName) {              if ($relationship->{from} eq $myEntityName) {
1720                  # Add the path to this relationship.                  # Add the path to this relationship.
1721                  my @augmentedList = (@stackedPath, $entityName, $relationshipName);                  my @augmentedList = (@stackedPath, $myEntityName, $relationshipName);
1722                  push @fromPathList, \@augmentedList;                  push @fromPathList, \@augmentedList;
1723                  # Check the arity. If it's MM we're done. If it's 1M                  # Check the arity. If it's MM we're done. If it's 1M
1724                  # and the target hasn't been seen yet, we want to                  # and the target hasn't been seen yet, we want to
# Line 1452  Line 1737 
1737              }              }
1738              # Now check the TO field. In this case only the relationship needs              # Now check the TO field. In this case only the relationship needs
1739              # deletion.              # deletion.
1740              if ($relationship->{to} eq $entityName) {              if ($relationship->{to} eq $myEntityName) {
1741                  my @augmentedList = (@stackedPath, $entityName, $relationshipName);                  my @augmentedList = (@stackedPath, $myEntityName, $relationshipName);
1742                  push @toPathList, \@augmentedList;                  push @toPathList, \@augmentedList;
1743              }              }
1744          }          }
1745      }      }
1746      # Create the first qualifier for the WHERE clause. This selects the      # Create the first qualifier for the WHERE clause. This selects the
1747      # keys of the primary entity records to be deleted. When we're deleting      # keys of the primary entity records to be deleted. When we're deleting
1748      # from a dependent table, we construct a join page from the first qualifier      # from a dependent table, we construct a join path from the first qualifier
1749      # to the table containing the dependent records to delete.      # to the table containing the dependent records to delete.
1750      my $qualifier = ($objectID =~ /%/ ? "LIKE ?" : "= ?");      my $qualifier = ($objectID =~ /%/ ? "LIKE ?" : "= ?");
1751      # We need to make two passes. The first is through the to-list, and      # We need to make two passes. The first is through the to-list, and
# Line 1499  Line 1784 
1784                  }                  }
1785              }              }
1786              # Now we have our desired DELETE statement.              # Now we have our desired DELETE statement.
1787              if ($testFlag) {              if ($options{testMode}) {
1788                  # Here the user wants to trace without executing.                  # Here the user wants to trace without executing.
1789                  Trace($stmt) if T(0);                  Trace($stmt) if T(0);
1790              } else {              } else {
1791                  # Here we can delete. Note that the SQL method dies with a confessing                  # Here we can delete. Note that the SQL method dies with a confession
1792                  # if an error occurs, so we just go ahead and do it.                  # if an error occurs, so we just go ahead and do it.
1793                  Trace("Executing delete from $target using '$objectID'.") if T(3);                  Trace("Executing delete from $target using '$objectID'.") if T(3);
1794                  my $rv = $db->SQL($stmt, 0, $objectID);                  my $rv = $db->SQL($stmt, 0, $objectID);
# Line 1518  Line 1803 
1803      return $retVal;      return $retVal;
1804  }  }
1805    
1806    =head3 Disconnect
1807    
1808    C<< $erdb->Disconnect($relationshipName, $originEntityName, $originEntityID); >>
1809    
1810    Disconnect an entity instance from all the objects to which it is related. This
1811    will delete each relationship instance that connects to the specified entity.
1812    
1813    =over 4
1814    
1815    =item relationshipName
1816    
1817    Name of the relationship whose instances are to be deleted.
1818    
1819    =item originEntityName
1820    
1821    Name of the entity that is to be disconnected.
1822    
1823    =item originEntityID
1824    
1825    ID of the entity that is to be disconnected.
1826    
1827    =back
1828    
1829    =cut
1830    
1831    sub Disconnect {
1832        # Get the parameters.
1833        my ($self, $relationshipName, $originEntityName, $originEntityID) = @_;
1834        # Get the relationship descriptor.
1835        my $structure = $self->_GetStructure($relationshipName);
1836        # Insure we have a relationship.
1837        if (! exists $structure->{from}) {
1838            Confess("$relationshipName is not a relationship in the database.");
1839        } else {
1840            # Get the database handle.
1841            my $dbh = $self->{_dbh};
1842            # We'll set this value to 1 if we find our entity.
1843            my $found = 0;
1844            # Loop through the ends of the relationship.
1845            for my $dir ('from', 'to') {
1846                if ($structure->{$dir} eq $originEntityName) {
1847                    # Delete all relationship instances on this side of the entity instance.
1848                    Trace("Disconnecting in $dir direction with ID \"$originEntityID\".");
1849                    $dbh->SQL("DELETE FROM $relationshipName WHERE ${dir}_link = ?", 0, $originEntityID);
1850                    $found = 1;
1851                }
1852            }
1853            # Insure we found the entity on at least one end.
1854            if (! $found) {
1855                Confess("Entity \"$originEntityName\" does not use $relationshipName.");
1856            }
1857        }
1858    }
1859    
1860    =head3 DeleteRow
1861    
1862    C<< $erdb->DeleteRow($relationshipName, $fromLink, $toLink, \%values); >>
1863    
1864    Delete a row from a relationship. In most cases, only the from-link and to-link are
1865    needed; however, for relationships with intersection data values can be specified
1866    for the other fields using a hash.
1867    
1868    =over 4
1869    
1870    =item relationshipName
1871    
1872    Name of the relationship from which the row is to be deleted.
1873    
1874    =item fromLink
1875    
1876    ID of the entity instance in the From direction.
1877    
1878    =item toLink
1879    
1880    ID of the entity instance in the To direction.
1881    
1882    =item values
1883    
1884    Reference to a hash of other values to be used for filtering the delete.
1885    
1886    =back
1887    
1888    =cut
1889    
1890    sub DeleteRow {
1891        # Get the parameters.
1892        my ($self, $relationshipName, $fromLink, $toLink, $values) = @_;
1893        # Create a hash of all the filter information.
1894        my %filter = ('from-link' => $fromLink, 'to-link' => $toLink);
1895        if (defined $values) {
1896            for my $key (keys %{$values}) {
1897                $filter{$key} = $values->{$key};
1898            }
1899        }
1900        # Build an SQL statement out of the hash.
1901        my @filters = ();
1902        my @parms = ();
1903        for my $key (keys %filter) {
1904            push @filters, _FixName($key) . " = ?";
1905            push @parms, $filter{$key};
1906        }
1907        Trace("Parms for delete row are " . join(", ", map { "\"$_\"" } @parms) . ".") if T(SQL => 4);
1908        my $command = "DELETE FROM $relationshipName WHERE " .
1909                      join(" AND ", @filters);
1910        # Execute it.
1911        my $dbh = $self->{_dbh};
1912        $dbh->SQL($command, undef, @parms);
1913    }
1914    
1915  =head3 SortNeeded  =head3 SortNeeded
1916    
1917  C<< my $parms = $erdb->SortNeeded($relationName); >>  C<< my $parms = $erdb->SortNeeded($relationName); >>
# Line 1568  Line 1962 
1962      } elsif (exists $relationshipTable->{$relationName}) {      } elsif (exists $relationshipTable->{$relationName}) {
1963          # Here we have a relationship. We sort using the FROM index.          # Here we have a relationship. We sort using the FROM index.
1964          my $relationshipData = $relationshipTable->{$relationName};          my $relationshipData = $relationshipTable->{$relationName};
1965          my $index = $relationData->{Indexes}->{"idx${relationName}From"};          my $index = $relationData->{Indexes}->{idxFrom};
1966          push @keyNames, @{$index->{IndexFields}};          push @keyNames, @{$index->{IndexFields}};
1967      } else {      } else {
1968          # Here we have a secondary entity relation, so we have a sort on the ID field.          # Here we have a secondary entity relation, so we have a sort on the ID field.
# Line 1914  Line 2308 
2308    
2309  =head3 InsertObject  =head3 InsertObject
2310    
2311  C<< my $ok = $erdb->InsertObject($objectType, \%fieldHash); >>  C<< $erdb->InsertObject($objectType, \%fieldHash); >>
2312    
2313  Insert an object into the database. The object is defined by a type name and then a hash  Insert an object into the database. The object is defined by a type name and then a hash
2314  of field names to values. Field values in the primary relation are represented by scalars.  of field names to values. Field values in the primary relation are represented by scalars.
# Line 1940  Line 2334 
2334    
2335  Hash of field names to values.  Hash of field names to values.
2336    
 =item RETURN  
   
 Returns 1 if successful, 0 if an error occurred.  
   
2337  =back  =back
2338    
2339  =cut  =cut
# Line 2042  Line 2432 
2432                  $retVal = $sth->execute(@parameterList);                  $retVal = $sth->execute(@parameterList);
2433                  if (!$retVal) {                  if (!$retVal) {
2434                      my $errorString = $sth->errstr();                      my $errorString = $sth->errstr();
2435                      Trace("Insert error: $errorString.") if T(0);                      Confess("Error inserting into $relationName: $errorString");
2436                  }                  }
2437              }              }
2438          }          }
2439      }      }
2440      # Return the success indicator.      # Return a 1 for backward compatability.
2441      return $retVal;      return 1;
2442    }
2443    
2444    =head3 UpdateEntity
2445    
2446    C<< $erdb->UpdateEntity($entityName, $id, \%fields); >>
2447    
2448    Update the values of an entity. This is an unprotected update, so it should only be
2449    done if the database resides on a database server.
2450    
2451    =over 4
2452    
2453    =item entityName
2454    
2455    Name of the entity to update. (This is the entity type.)
2456    
2457    =item id
2458    
2459    ID of the entity to update. If no entity exists with this ID, an error will be thrown.
2460    
2461    =item fields
2462    
2463    Reference to a hash mapping field names to their new values. All of the fields named
2464    must be in the entity's primary relation, and they cannot any of them be the ID field.
2465    
2466    =back
2467    
2468    =cut
2469    
2470    sub UpdateEntity {
2471        # Get the parameters.
2472        my ($self, $entityName, $id, $fields) = @_;
2473        # Get a list of the field names being updated.
2474        my @fieldList = keys %{$fields};
2475        # Verify that the fields exist.
2476        my $checker = $self->GetFieldTable($entityName);
2477        for my $field (@fieldList) {
2478            if ($field eq 'id') {
2479                Confess("Cannot update the ID field for entity $entityName.");
2480            } elsif ($checker->{$field}->{relation} ne $entityName) {
2481                Confess("Cannot find $field in primary relation of $entityName.");
2482            }
2483        }
2484        # Build the SQL statement.
2485        my @sets = ();
2486        my @valueList = ();
2487        for my $field (@fieldList) {
2488            push @sets, _FixName($field) . " = ?";
2489            push @valueList, $fields->{$field};
2490        }
2491        my $command = "UPDATE $entityName SET " . join(", ", @sets) . " WHERE id = ?";
2492        # Add the ID to the list of binding values.
2493        push @valueList, $id;
2494        # Call SQL to do the work.
2495        my $rows = $self->{_dbh}->SQL($command, 0, @valueList);
2496        # Check for errors.
2497        if ($rows == 0) {
2498            Confess("Entity $id of type $entityName not found.");
2499        }
2500  }  }
2501    
2502  =head3 LoadTable  =head3 LoadTable
2503    
2504  C<< my %results = $erdb->LoadTable($fileName, $relationName, $truncateFlag); >>  C<< my $results = $erdb->LoadTable($fileName, $relationName, $truncateFlag); >>
2505    
2506  Load data from a tab-delimited file into a specified table, optionally re-creating the table  Load data from a tab-delimited file into a specified table, optionally re-creating the table
2507  first.  first.
# Line 2142  Line 2590 
2590              # The full-text index (if any) is always built last, even for MySQL.              # The full-text index (if any) is always built last, even for MySQL.
2591              # First we need to see if this table has a full-text index. Only              # First we need to see if this table has a full-text index. Only
2592              # primary relations are allowed that privilege.              # primary relations are allowed that privilege.
2593                Trace("Checking for full-text index on $relationName.") if T(2);
2594              if ($self->_IsPrimary($relationName)) {              if ($self->_IsPrimary($relationName)) {
2595                  # Get the relation's entity/relationship structure.                  $self->CreateSearchIndex($relationName);
                 my $structure = $self->_GetStructure($relationName);  
                 # Check for a searchable fields list.  
                 if (exists $structure->{searchFields}) {  
                     # Here we know that we need to create a full-text search index.  
                     # Get an SQL-formatted field name list.  
                     my $fields = join(", ", $self->_FixNames(@{$structure->{searchFields}}));  
                     # Create the index.  
                     $dbh->create_index(tbl => $relationName, idx => "search_idx_$relationName",  
                                        flds => $fields, kind => 'fulltext');  
                 }  
2596              }              }
2597          }          }
2598      }      }
# Line 2165  Line 2604 
2604      return $retVal;      return $retVal;
2605  }  }
2606    
2607    =head3 CreateSearchIndex
2608    
2609    C<< $erdb->CreateSearchIndex($objectName); >>
2610    
2611    Check for a full-text search index on the specified entity or relationship object, and
2612    if one is required, rebuild it.
2613    
2614    =over 4
2615    
2616    =item objectName
2617    
2618    Name of the entity or relationship to be indexed.
2619    
2620    =back
2621    
2622    =cut
2623    
2624    sub CreateSearchIndex {
2625        # Get the parameters.
2626        my ($self, $objectName) = @_;
2627        # Get the relation's entity/relationship structure.
2628        my $structure = $self->_GetStructure($objectName);
2629        # Get the database handle.
2630        my $dbh = $self->{_dbh};
2631        Trace("Checking for search fields in $objectName.") if T(3);
2632        # Check for a searchable fields list.
2633        if (exists $structure->{searchFields}) {
2634            # Here we know that we need to create a full-text search index.
2635            # Get an SQL-formatted field name list.
2636            my $fields = join(", ", _FixNames(@{$structure->{searchFields}}));
2637            # Create the index. If it already exists, it will be dropped.
2638            $dbh->create_index(tbl => $objectName, idx => "search_idx",
2639                               flds => $fields, kind => 'fulltext');
2640            Trace("Index created for $fields in $objectName.") if T(2);
2641        }
2642    }
2643    
2644  =head3 DropRelation  =head3 DropRelation
2645    
2646  C<< $erdb->DropRelation($relationName); >>  C<< $erdb->DropRelation($relationName); >>
# Line 2189  Line 2665 
2665      my $dbh = $self->{_dbh};      my $dbh = $self->{_dbh};
2666      # Drop the relation. The method used here has no effect if the relation      # Drop the relation. The method used here has no effect if the relation
2667      # does not exist.      # does not exist.
2668      $dbh->drop_table($relationName);      Trace("Invoking DB Kernel to drop $relationName.") if T(3);
2669        $dbh->drop_table(tbl => $relationName);
2670    }
2671    
2672    =head3 MatchSqlPattern
2673    
2674    C<< my $matched = ERDB::MatchSqlPattern($value, $pattern); >>
2675    
2676    Determine whether or not a specified value matches an SQL pattern. An SQL
2677    pattern has two wild card characters: C<%> that matches multiple characters,
2678    and C<_> that matches a single character. These can be escaped using a
2679    backslash (C<\>). We pull this off by converting the SQL pattern to a
2680    PERL regular expression. As per SQL rules, the match is case-insensitive.
2681    
2682    =over 4
2683    
2684    =item value
2685    
2686    Value to be matched against the pattern. Note that an undefined or empty
2687    value will not match anything.
2688    
2689    =item pattern
2690    
2691    SQL pattern against which to match the value. An undefined or empty pattern will
2692    match everything.
2693    
2694    =item RETURN
2695    
2696    Returns TRUE if the value and pattern match, else FALSE.
2697    
2698    =back
2699    
2700    =cut
2701    
2702    sub MatchSqlPattern {
2703        # Get the parameters.
2704        my ($value, $pattern) = @_;
2705        # Declare the return variable.
2706        my $retVal;
2707        # Insure we have a pattern.
2708        if (! defined($pattern) || $pattern eq "") {
2709            $retVal = 1;
2710        } else {
2711            # Break the pattern into pieces around the wildcard characters. Because we
2712            # use parentheses in the split function's delimiter expression, we'll get
2713            # list elements for the delimiters as well as the rest of the string.
2714            my @pieces = split /([_%]|\\[_%])/, $pattern;
2715            # Check some fast special cases.
2716            if ($pattern eq '%') {
2717                # A null pattern matches everything.
2718                $retVal = 1;
2719            } elsif (@pieces == 1) {
2720                # No wildcards, so we have a literal comparison. Note we're case-insensitive.
2721                $retVal = (lc($value) eq lc($pattern));
2722            } elsif (@pieces == 2 && $pieces[1] eq '%') {
2723                # A wildcard at the end, so we have a substring match. This is also case-insensitive.
2724                $retVal = (lc(substr($value, 0, length($pieces[0]))) eq lc($pieces[0]));
2725            } else {
2726                # Okay, we have to do it the hard way. Convert each piece to a PERL pattern.
2727                my $realPattern = "";
2728                for my $piece (@pieces) {
2729                    # Determine the type of piece.
2730                    if ($piece eq "") {
2731                        # Empty pieces are ignored.
2732                    } elsif ($piece eq "%") {
2733                        # Here we have a multi-character wildcard. Note that it can match
2734                        # zero or more characters.
2735                        $realPattern .= ".*"
2736                    } elsif ($piece eq "_") {
2737                        # Here we have a single-character wildcard.
2738                        $realPattern .= ".";
2739                    } elsif ($piece eq "\\%" || $piece eq "\\_") {
2740                        # This is an escape sequence (which is a rare thing, actually).
2741                        $realPattern .= substr($piece, 1, 1);
2742                    } else {
2743                        # Here we have raw text.
2744                        $realPattern .= quotemeta($piece);
2745                    }
2746                }
2747                # Do the match.
2748                $retVal = ($value =~ /^$realPattern$/i ? 1 : 0);
2749            }
2750        }
2751        # Return the result.
2752        return $retVal;
2753  }  }
2754    
2755  =head3 GetEntity  =head3 GetEntity
# Line 2345  Line 2905 
2905  spreadsheet cell, and each feature will be represented by a list containing the  spreadsheet cell, and each feature will be represented by a list containing the
2906  feature ID followed by all of its aliases.  feature ID followed by all of its aliases.
2907    
2908  C<< $query = $erdb->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)']); >>
2909    
2910  =over 4  =over 4
2911    
# Line 2599  Line 3159 
3159      # Declare the return variable. The field name is valid until we hear      # Declare the return variable. The field name is valid until we hear
3160      # differently.      # differently.
3161      my $retVal = 1;      my $retVal = 1;
3162        # Compute the maximum name length.
3163        my $maxLen = $TypeTable{'name-string'}->{maxLen};
3164      # Look for bad stuff in the name.      # Look for bad stuff in the name.
3165      if ($fieldName =~ /--/) {      if ($fieldName =~ /--/) {
3166          # Here we have a doubled minus sign.          # Here we have a doubled minus sign.
# Line 2608  Line 3170 
3170          # Here the field name is missing the initial letter.          # Here the field name is missing the initial letter.
3171          Trace("Field name $fieldName does not begin with a letter.") if T(1);          Trace("Field name $fieldName does not begin with a letter.") if T(1);
3172          $retVal = 0;          $retVal = 0;
3173        } elsif (length($fieldName) > $maxLen) {
3174            # Here the field name is too long.
3175            Trace("Maximum field name length is $maxLen. Field name must be truncated to " . substr($fieldName,0, $maxLen) . ".");
3176      } else {      } else {
3177          # Strip out the minus signs. Everything remaining must be a letter          # Strip out the minus signs. Everything remaining must be a letter,
3178          # or digit.          # underscore, or digit.
3179          my $strippedName = $fieldName;          my $strippedName = $fieldName;
3180          $strippedName =~ s/-//g;          $strippedName =~ s/-//g;
3181          if ($strippedName !~ /^[A-Za-z0-9]+$/) {          if ($strippedName !~ /^(\w|\d)+$/) {
3182              Trace("Field name $fieldName contains illegal characters.") if T(1);              Trace("Field name $fieldName contains illegal characters.") if T(1);
3183              $retVal = 0;              $retVal = 0;
3184          }          }
# Line 2762  Line 3327 
3327      # Substitute the bulletin board codes.      # Substitute the bulletin board codes.
3328      $retVal =~ s!\[(/?[bi])\]!<$1>!g;      $retVal =~ s!\[(/?[bi])\]!<$1>!g;
3329      $retVal =~ s!\[p\]!</p><p>!g;      $retVal =~ s!\[p\]!</p><p>!g;
3330        $retVal =~ s!\[link\s+([^\]]+)\]!<a href="$1">!g;
3331        $retVal =~ s!\[/link\]!</a>!g;
3332      # Return the result.      # Return the result.
3333      return $retVal;      return $retVal;
3334  }  }
# Line 3292  Line 3859 
3859      # Prepare the command.      # Prepare the command.
3860      my $sth = $dbh->prepare_command($command);      my $sth = $dbh->prepare_command($command);
3861      # Execute it with the parameters bound in.      # Execute it with the parameters bound in.
3862      $sth->execute(@{$params}) || Confess("SELECT error" . $sth->errstr());      $sth->execute(@{$params}) || Confess("SELECT error:  " . $sth->errstr());
3863      # Return the statement handle.      # Return the statement handle.
3864      return $sth;      return $sth;
3865  }  }
# Line 3556  Line 4123 
4123  sub _LoadMetaData {  sub _LoadMetaData {
4124      # Get the parameters.      # Get the parameters.
4125      my ($filename) = @_;      my ($filename) = @_;
4126      Trace("Reading Sprout DBD from $filename.") if T(2);      Trace("Reading DBD from $filename.") if T(2);
4127      # Slurp the XML file into a variable. Extensive use of options is used to insure we      # Slurp the XML file into a variable. Extensive use of options is used to insure we
4128      # get the exact structure we want.      # get the exact structure we want.
4129      my $metadata = ReadMetaXML($filename);      my $metadata = ReadMetaXML($filename);
# Line 3689  Line 4256 
4256              my $count = 0;              my $count = 0;
4257              for my $index (@{$indexList}) {              for my $index (@{$indexList}) {
4258                  # Add this index to the index table.                  # Add this index to the index table.
4259                  _AddIndex("idx$relationName$count", $relation, $index);                  _AddIndex("idx$count", $relation, $index);
4260                  # Increment the counter so that the next index has a different name.                  # Increment the counter so that the next index has a different name.
4261                  $count++;                  $count++;
4262              }              }
# Line 3706  Line 4273 
4273          _FixupFields($relationshipStructure, $relationshipName, 2, 3);          _FixupFields($relationshipStructure, $relationshipName, 2, 3);
4274          # Format a description for the FROM field.          # Format a description for the FROM field.
4275          my $fromEntity = $relationshipStructure->{from};          my $fromEntity = $relationshipStructure->{from};
4276          my $fromComment = "<b>id</b> of the source <b><a href=\"#$fromEntity\">$fromEntity</a></b>.";          my $fromComment = "[b]id[/b] of the source [b][link #$fromEntity]$fromEntity\[/link][/b].";
4277          # Get the FROM entity's key type.          # Get the FROM entity's key type.
4278          my $fromType = $entityList->{$fromEntity}->{keyType};          my $fromType = $entityList->{$fromEntity}->{keyType};
4279          # Add the FROM field.          # Add the FROM field.
# Line 3716  Line 4283 
4283                                                      PrettySort => 1});                                                      PrettySort => 1});
4284          # Format a description for the TO field.          # Format a description for the TO field.
4285          my $toEntity = $relationshipStructure->{to};          my $toEntity = $relationshipStructure->{to};
4286          my $toComment = "<b>id</b> of the target <b><a href=\"#$toEntity\">$toEntity</a></b>.";          my $toComment = "[b]id[/b] of the target [b][link #$toEntity]$toEntity\[/link][/b].";
4287          # Get the TO entity's key type.          # Get the TO entity's key type.
4288          my $toType = $entityList->{$toEntity}->{keyType};          my $toType = $entityList->{$toEntity}->{keyType};
4289          # Add the TO field.          # Add the TO field.
# Line 3887  Line 4454 
4454          $newIndex->{Unique} = 'true';          $newIndex->{Unique} = 'true';
4455      }      }
4456      # Add the index to the relation.      # Add the index to the relation.
4457      _AddIndex("idx$relationshipName$indexKey", $relationStructure, $newIndex);      _AddIndex("idx$indexKey", $relationStructure, $newIndex);
4458  }  }
4459    
4460  =head3 _AddIndex  =head3 _AddIndex
# Line 4419  Line 4986 
4986      # Compute the number of columns.      # Compute the number of columns.
4987      my $colCount = @colNames;      my $colCount = @colNames;
4988      # Generate the title row.      # Generate the title row.
4989      my $htmlString = "<p><table border=\"2\"><tr><td colspan=\"$colCount\" align=\"center\">$tablename</td></tr>\n";      my $htmlString = "<table border=\"2\"><tr><td colspan=\"$colCount\" align=\"center\">$tablename</td></tr>\n";
4990      # Loop through the columns, adding the column header rows.      # Loop through the columns, adding the column header rows.
4991      $htmlString .= "<tr>";      $htmlString .= "<tr>";
4992      for my $colName (@colNames) {      for my $colName (@colNames) {
# Line 4438  Line 5005 
5005  =cut  =cut
5006    
5007  sub _CloseTable {  sub _CloseTable {
5008      return "</table></p>\n";      return "</table>\n";
5009  }  }
5010    
5011  =head3 _ShowField  =head3 _ShowField

Legend:
Removed from v.1.73  
changed lines
  Added in v.1.84

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3