[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.79, Wed Nov 29 20:29:53 2006 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 646  Line 650 
650      return Data::Dumper::Dumper($self->{_metaData});      return Data::Dumper::Dumper($self->{_metaData});
651  }  }
652    
653    =head3 FindIndexForEntity
654    
655    C<< my $indexFound = ERDB::FindIndexForEntity($xml, $entityName, $attributeName); >>
656    
657    This method locates the entry in an entity's index list that begins with the
658    specified attribute name. If the entity has no index list, one will be
659    created. This method works on raw XML, not a live ERDB object.
660    
661    =over 4
662    
663    =item xml
664    
665    The raw XML structure defining the database.
666    
667    =item entityName
668    
669    The name of the relevant entity.
670    
671    =item attributeName
672    
673    The name of the attribute relevant to the search.
674    
675    =item RETURN
676    
677    The numerical index in the index list of the index entry for the specified entity and
678    attribute, or C<undef> if no such index exists.
679    
680    =back
681    
682    =cut
683    
684    sub FindIndexForEntity {
685        # Get the parameters.
686        my ($xml, $entityName, $attributeName) = @_;
687        # Declare the return variable.
688        my $retVal;
689        # Get the named entity.
690        my $entityData = $xml->{Entities}->{$entityName};
691        if (! $entityData) {
692            Confess("Entity $entityName not found in DBD structure.");
693        } else {
694            # Insure it has an index list.
695            if (! exists $entityData->{Indexes}) {
696                $entityData->{Indexes} = [];
697            } else {
698                # Search for the desired index.
699                my $indexList = $entityData->{Indexes};
700                my $n = scalar @{$indexList};
701                Trace("Searching $n indexes in index list for $entityName.") if T(2);
702                # We use an indexed FOR here because we're returning an
703                # index number instead of an object. We do THAT so we can
704                # delete the index from the list if needed.
705                for (my $i = 0; $i < $n && !defined($retVal); $i++) {
706                    my $index = $indexList->[$i];
707                    my $fields = $index->{IndexFields};
708                    # Technically this IF should be safe (that is, we are guaranteed
709                    # the existence of a "$fields->[0]"), because when we load the XML
710                    # we have SuppressEmpty specified.
711                    if ($fields->[0]->{name} eq $attributeName) {
712                        $retVal = $i;
713                    }
714                }
715            }
716        }
717        Trace("Index for $attributeName of $entityName found at position $retVal.") if defined($retVal) && T(3);
718        Trace("Index for $attributeName not found in $entityName.") if !defined($retVal) && T(3);
719        # Return the result.
720        return $retVal;
721    }
722    
723  =head3 CreateTables  =head3 CreateTables
724    
725  C<< $erdb->CreateTables(); >>  C<< $erdb->CreateTables(); >>
# Line 891  Line 965 
965      for my $indexName (keys %{$indexHash}) {      for my $indexName (keys %{$indexHash}) {
966          my $indexData = $indexHash->{$indexName};          my $indexData = $indexHash->{$indexName};
967          # Get the index's field list.          # Get the index's field list.
968          my @fieldList = _FixNames(@{$indexData->{IndexFields}});          my @rawFields = @{$indexData->{IndexFields}};
969            # Get a hash of the relation's field types.
970            my %types = map { $_->{name} => $_->{type} } @{$relationData->{Fields}};
971            # We need to check for text fields so we can append a length limitation for them. To do
972            # that, we need the relation's field list.
973            my $relFields = $relationData->{Fields};
974            for (my $i = 0; $i <= $#rawFields; $i++) {
975                # Get the field type.
976                my $field = $rawFields[$i];
977                my $type = $types{$field};
978                # Ask if it requires using prefix notation for the index.
979                my $mod = $TypeTable{$type}->{indexMod};
980                Trace("Field $field ($i) in $relationName has type $type and indexMod $mod.") if T(3);
981                if ($mod) {
982                    # Append the prefix length to the field name,
983                    $rawFields[$i] .= "($mod)";
984                }
985            }
986            my @fieldList = _FixNames(@rawFields);
987          my $flds = join(', ', @fieldList);          my $flds = join(', ', @fieldList);
988          # Get the index's uniqueness flag.          # Get the index's uniqueness flag.
989          my $unique = (exists $indexData->{Unique} ? 'unique' : undef);          my $unique = (exists $indexData->{Unique} ? 'unique' : undef);
# Line 906  Line 998 
998      }      }
999  }  }
1000    
1001    =head3 GetSecondaryFields
1002    
1003    C<< my %fieldTuples = $erdb->GetSecondaryFields($entityName); >>
1004    
1005    This method will return a list of the name and type of each of the secondary
1006    fields for a specified entity. Secondary fields are stored in two-column tables
1007    in addition to the primary entity table. This enables the field to have no value
1008    or to have multiple values.
1009    
1010    =over 4
1011    
1012    =item entityName
1013    
1014    Name of the entity whose secondary fields are desired.
1015    
1016    =item RETURN
1017    
1018    Returns a hash mapping the field names to their field types.
1019    
1020    =back
1021    
1022    =cut
1023    
1024    sub GetSecondaryFields {
1025        # Get the parameters.
1026        my ($self, $entityName) = @_;
1027        # Declare the return variable.
1028        my %retVal = ();
1029        # Look for the entity.
1030        my $table = $self->GetFieldTable($entityName);
1031        # Loop through the fields, pulling out the secondaries.
1032        for my $field (sort keys %{$table}) {
1033            if ($table->{$field}->{relation} ne $entityName) {
1034                # Here we have a secondary field.
1035                $retVal{$field} = $table->{$field}->{type};
1036            }
1037        }
1038        # Return the result.
1039        return %retVal;
1040    }
1041    
1042    =head3 GetFieldRelationName
1043    
1044    C<< my $name = $erdb->GetFieldRelationName($objectName, $fieldName); >>
1045    
1046    Return the name of the relation containing a specified field.
1047    
1048    =over 4
1049    
1050    =item objectName
1051    
1052    Name of the entity or relationship containing the field.
1053    
1054    =item fieldName
1055    
1056    Name of the relevant field in that entity or relationship.
1057    
1058    =item RETURN
1059    
1060    Returns the name of the database relation containing the field, or C<undef> if
1061    the field does not exist.
1062    
1063    =back
1064    
1065    =cut
1066    
1067    sub GetFieldRelationName {
1068        # Get the parameters.
1069        my ($self, $objectName, $fieldName) = @_;
1070        # Declare the return variable.
1071        my $retVal;
1072        # Get the object field table.
1073        my $table = $self->GetFieldTable($objectName);
1074        # Only proceed if the field exists.
1075        if (exists $table->{$fieldName}) {
1076            # Determine the name of the relation that contains this field.
1077            $retVal = $table->{$fieldName}->{relation};
1078        }
1079        # Return the result.
1080        return $retVal;
1081    }
1082    
1083    =head3 DeleteValue
1084    
1085    C<< my $numDeleted = $erdb->DeleteValue($entityName, $id, $fieldName, $fieldValue); >>
1086    
1087    Delete secondary field values from the database. This method can be used to delete all
1088    values of a specified field for a particular entity instance, or only a single value.
1089    
1090    Secondary fields are stored in two-column relations separate from an entity's primary
1091    table, and as a result a secondary field can legitimately have no value or multiple
1092    values. Therefore, it makes sense to talk about deleting secondary fields where it
1093    would not make sense for primary fields.
1094    
1095    =over 4
1096    
1097    =item entityName
1098    
1099    Name of the entity from which the fields are to be deleted.
1100    
1101    =item id
1102    
1103    ID of the entity instance to be processed. If the instance is not found, this
1104    method will have no effect. If C<undef> is specified, all values for all of
1105    the entity instances will be deleted.
1106    
1107    =item fieldName
1108    
1109    Name of the field whose values are to be deleted.
1110    
1111    =item fieldValue (optional)
1112    
1113    Value to be deleted. If not specified, then all values of the specified field
1114    will be deleted for the entity instance. If specified, then only the values which
1115    match this parameter will be deleted.
1116    
1117    =item RETURN
1118    
1119    Returns the number of rows deleted.
1120    
1121    =back
1122    
1123    =cut
1124    
1125    sub DeleteValue {
1126        # Get the parameters.
1127        my ($self, $entityName, $id, $fieldName, $fieldValue) = @_;
1128        # Declare the return value.
1129        my $retVal = 0;
1130        # We need to set up an SQL command to do the deletion. First, we
1131        # find the name of the field's relation.
1132        my $table = $self->GetFieldTable($entityName);
1133        my $field = $table->{$fieldName};
1134        my $relation = $field->{relation};
1135        # Make sure this is a secondary field.
1136        if ($relation eq $entityName) {
1137            Confess("Cannot delete values of $fieldName for $entityName.");
1138        } else {
1139            # Set up the SQL command to delete all values.
1140            my $sql = "DELETE FROM $relation";
1141            # Build the filter.
1142            my @filters = ();
1143            my @parms = ();
1144            # Check for a filter by ID.
1145            if (defined $id) {
1146                push @filters, "id = ?";
1147                push @parms, $id;
1148            }
1149            # Check for a filter by value.
1150            if (defined $fieldValue) {
1151                push @filters, "$fieldName = ?";
1152                push @parms, $fieldValue;
1153            }
1154            # Append the filters to the command.
1155            if (@filters) {
1156                $sql .= " WHERE " . join(" AND ", @filters);
1157            }
1158            # Execute the command.
1159            my $dbh = $self->{_dbh};
1160            $retVal = $dbh->SQL($sql, 0, @parms);
1161        }
1162        # Return the result.
1163        return $retVal;
1164    }
1165    
1166  =head3 LoadTables  =head3 LoadTables
1167    
1168  C<< my $stats = $erdb->LoadTables($directoryName, $rebuild); >>  C<< my $stats = $erdb->LoadTables($directoryName, $rebuild); >>
# Line 1163  Line 1420 
1420      return $retVal;      return $retVal;
1421  }  }
1422    
1423    
1424    
1425  =head3 Search  =head3 Search
1426    
1427  C<< my $query = $erdb->Search($searchExpression, $idx, \@objectNames, $filterClause, \@params); >>  C<< my $query = $erdb->Search($searchExpression, $idx, \@objectNames, $filterClause, \@params); >>
# Line 1176  Line 1435 
1435    
1436  =item searchExpression  =item searchExpression
1437    
1438  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
1439    a Boolean search expression is OR, but we want the default to be AND, so we will
1440    add a C<+> operator to each word with no other operator before it.
1441    
1442  =item idx  =item idx
1443    
# Line 1230  Line 1491 
1491          my @fields = @{$object1Structure->{searchFields}};          my @fields = @{$object1Structure->{searchFields}};
1492          # Clean the search expression.          # Clean the search expression.
1493          my $actualKeywords = $self->CleanKeywords($searchExpression);          my $actualKeywords = $self->CleanKeywords($searchExpression);
1494            # Prefix a "+" to each uncontrolled word. This converts the default
1495            # search mode from OR to AND.
1496            $actualKeywords =~ s/(^|\s)(\w)/$1\+$2/g;
1497          Trace("Actual keywords for search are\n$actualKeywords") if T(3);          Trace("Actual keywords for search are\n$actualKeywords") if T(3);
1498          # 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
1499          # 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 1601 
1601      # Declare the return variable.      # Declare the return variable.
1602      my %retVal = ();      my %retVal = ();
1603      # Find the entity's data structure.      # Find the entity's data structure.
1604      my $entityData = $self->{Entities}->{$entityName};      my $entityData = $self->{_metaData}->{Entities}->{$entityName};
1605      # Loop through its fields, adding each special field to the return hash.      # Loop through its fields, adding each special field to the return hash.
1606      my $fieldHash = $entityData->{Fields};      my $fieldHash = $entityData->{Fields};
1607      for my $fieldName (keys %{$fieldHash}) {      for my $fieldName (keys %{$fieldHash}) {
# Line 1352  Line 1616 
1616    
1617  =head3 Delete  =head3 Delete
1618    
1619  C<< my $stats = $erdb->Delete($entityName, $objectID); >>  C<< my $stats = $erdb->Delete($entityName, $objectID, %options); >>
1620    
1621  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
1622  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.
1623  always dependent on itself. An object is dependent if it is a 1-to-many or many-to-many  
1624  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
1625    relationship connected to a dependent entity or if it is the "to" entity connected to a 1-to-many
1626  dependent relationship.  dependent relationship.
1627    
1628  =over 4  =over 4
# Line 1371  Line 1636 
1636  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<%>),
1637  then it is presumed to by a LIKE pattern.  then it is presumed to by a LIKE pattern.
1638    
1639  =item testFlag  =item options
1640    
1641  If TRUE, the delete statements will be traced without being executed.  A hash detailing the options for this delete operation.
1642    
1643  =item RETURN  =item RETURN
1644    
# Line 1382  Line 1647 
1647    
1648  =back  =back
1649    
1650    The permissible options for this method are as follows.
1651    
1652    =over 4
1653    
1654    =item testMode
1655    
1656    If TRUE, then the delete statements will be traced, but no changes will be made to the database.
1657    
1658    =item keepRoot
1659    
1660    If TRUE, then the entity instances will not be deleted, only the dependent records.
1661    
1662    =back
1663    
1664  =cut  =cut
1665  #: Return Type $%;  #: Return Type $%;
1666  sub Delete {  sub Delete {
1667      # Get the parameters.      # Get the parameters.
1668      my ($self, $entityName, $objectID, $testFlag) = @_;      my ($self, $entityName, $objectID, %options) = @_;
1669      # Declare the return variable.      # Declare the return variable.
1670      my $retVal = Stats->new();      my $retVal = Stats->new();
1671      # Get the DBKernel object.      # Get the DBKernel object.
# Line 1403  Line 1682 
1682      # FROM-relationships and entities.      # FROM-relationships and entities.
1683      my @fromPathList = ();      my @fromPathList = ();
1684      my @toPathList = ();      my @toPathList = ();
1685      # 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
1686      # 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
1687      # 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
1688      # TODO list is always an entity.      # to-do list is always an entity.
1689      my @todoList = ([$entityName]);      my @todoList = ([$entityName]);
1690      while (@todoList) {      while (@todoList) {
1691          # Get the current path.          # Get the current path.
# Line 1414  Line 1693 
1693          # Copy it into a list.          # Copy it into a list.
1694          my @stackedPath = @{$current};          my @stackedPath = @{$current};
1695          # 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.
1696          my $entityName = pop @stackedPath;          my $myEntityName = pop @stackedPath;
1697          # Add it to the alreadyFound list.          # Add it to the alreadyFound list.
1698          $alreadyFound{$entityName} = 1;          $alreadyFound{$myEntityName} = 1;
1699            # Figure out if we need to delete this entity.
1700            if ($myEntityName ne $entityName || ! $options{keepRoot}) {
1701          # Get the entity data.          # Get the entity data.
1702          my $entityData = $self->_GetStructure($entityName);              my $entityData = $self->_GetStructure($myEntityName);
1703          # 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.  
1704          my $relations = $entityData->{Relations};          my $relations = $entityData->{Relations};
1705          for my $relation (keys %{$relations}) {          for my $relation (keys %{$relations}) {
1706              my @augmentedList = (@stackedPath, $relation);              my @augmentedList = (@stackedPath, $relation);
1707              push @fromPathList, \@augmentedList;              push @fromPathList, \@augmentedList;
1708          }          }
1709            }
1710          # Now we need to look for relationships connected to this entity.          # Now we need to look for relationships connected to this entity.
1711          my $relationshipList = $self->{_metaData}->{Relationships};          my $relationshipList = $self->{_metaData}->{Relationships};
1712          for my $relationshipName (keys %{$relationshipList}) {          for my $relationshipName (keys %{$relationshipList}) {
1713              my $relationship = $relationshipList->{$relationshipName};              my $relationship = $relationshipList->{$relationshipName};
1714              # Check the FROM field. We're only interested if it's us.              # Check the FROM field. We're only interested if it's us.
1715              if ($relationship->{from} eq $entityName) {              if ($relationship->{from} eq $myEntityName) {
1716                  # Add the path to this relationship.                  # Add the path to this relationship.
1717                  my @augmentedList = (@stackedPath, $entityName, $relationshipName);                  my @augmentedList = (@stackedPath, $myEntityName, $relationshipName);
1718                  push @fromPathList, \@augmentedList;                  push @fromPathList, \@augmentedList;
1719                  # 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
1720                  # 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 1733 
1733              }              }
1734              # Now check the TO field. In this case only the relationship needs              # Now check the TO field. In this case only the relationship needs
1735              # deletion.              # deletion.
1736              if ($relationship->{to} eq $entityName) {              if ($relationship->{to} eq $myEntityName) {
1737                  my @augmentedList = (@stackedPath, $entityName, $relationshipName);                  my @augmentedList = (@stackedPath, $myEntityName, $relationshipName);
1738                  push @toPathList, \@augmentedList;                  push @toPathList, \@augmentedList;
1739              }              }
1740          }          }
1741      }      }
1742      # Create the first qualifier for the WHERE clause. This selects the      # Create the first qualifier for the WHERE clause. This selects the
1743      # 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
1744      # 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
1745      # to the table containing the dependent records to delete.      # to the table containing the dependent records to delete.
1746      my $qualifier = ($objectID =~ /%/ ? "LIKE ?" : "= ?");      my $qualifier = ($objectID =~ /%/ ? "LIKE ?" : "= ?");
1747      # 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 1780 
1780                  }                  }
1781              }              }
1782              # Now we have our desired DELETE statement.              # Now we have our desired DELETE statement.
1783              if ($testFlag) {              if ($options{testMode}) {
1784                  # Here the user wants to trace without executing.                  # Here the user wants to trace without executing.
1785                  Trace($stmt) if T(0);                  Trace($stmt) if T(0);
1786              } else {              } else {
1787                  # 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
1788                  # if an error occurs, so we just go ahead and do it.                  # if an error occurs, so we just go ahead and do it.
1789                  Trace("Executing delete from $target using '$objectID'.") if T(3);                  Trace("Executing delete from $target using '$objectID'.") if T(3);
1790                  my $rv = $db->SQL($stmt, 0, $objectID);                  my $rv = $db->SQL($stmt, 0, $objectID);
# Line 1518  Line 1799 
1799      return $retVal;      return $retVal;
1800  }  }
1801    
1802    =head3 Disconnect
1803    
1804    C<< $erdb->Disconnect($relationshipName, $originEntityName, $originEntityID); >>
1805    
1806    Disconnect an entity instance from all the objects to which it is related. This
1807    will delete each relationship instance that connects to the specified entity.
1808    
1809    =over 4
1810    
1811    =item relationshipName
1812    
1813    Name of the relationship whose instances are to be deleted.
1814    
1815    =item originEntityName
1816    
1817    Name of the entity that is to be disconnected.
1818    
1819    =item originEntityID
1820    
1821    ID of the entity that is to be disconnected.
1822    
1823    =back
1824    
1825    =cut
1826    
1827    sub Disconnect {
1828        # Get the parameters.
1829        my ($self, $relationshipName, $originEntityName, $originEntityID) = @_;
1830        # Get the relationship descriptor.
1831        my $structure = $self->_GetStructure($relationshipName);
1832        # Insure we have a relationship.
1833        if (! exists $structure->{from}) {
1834            Confess("$relationshipName is not a relationship in the database.");
1835        } else {
1836            # Get the database handle.
1837            my $dbh = $self->{_dbh};
1838            # We'll set this value to 1 if we find our entity.
1839            my $found = 0;
1840            # Loop through the ends of the relationship.
1841            for my $dir ('from', 'to') {
1842                if ($structure->{$dir} eq $originEntityName) {
1843                    # Delete all relationship instances on this side of the entity instance.
1844                    $dbh->SQL("DELETE FROM $relationshipName WHERE ${dir}_link = ?", 0, $originEntityID);
1845                    $found = 1;
1846                }
1847            }
1848            # Insure we found the entity on at least one end.
1849            if (! $found) {
1850                Confess("Entity \"$originEntityName\" does not use $relationshipName.");
1851            }
1852        }
1853    }
1854    
1855    =head3 DeleteRow
1856    
1857    C<< $erdb->DeleteRow($relationshipName, $fromLink, $toLink, \%values); >>
1858    
1859    Delete a row from a relationship. In most cases, only the from-link and to-link are
1860    needed; however, for relationships with intersection data values can be specified
1861    for the other fields using a hash.
1862    
1863    =over 4
1864    
1865    =item relationshipName
1866    
1867    Name of the relationship from which the row is to be deleted.
1868    
1869    =item fromLink
1870    
1871    ID of the entity instance in the From direction.
1872    
1873    =item toLink
1874    
1875    ID of the entity instance in the To direction.
1876    
1877    =item values
1878    
1879    Reference to a hash of other values to be used for filtering the delete.
1880    
1881    =back
1882    
1883    =cut
1884    
1885    sub DeleteRow {
1886        # Get the parameters.
1887        my ($self, $relationshipName, $fromLink, $toLink, $values) = @_;
1888        # Create a hash of all the filter information.
1889        my %filter = ('from-link' => $fromLink, 'to-link' => $toLink);
1890        if (defined $values) {
1891            for my $key (keys %{$values}) {
1892                $filter{$key} = $values->{$key};
1893            }
1894        }
1895        # Build an SQL statement out of the hash.
1896        my @filters = ();
1897        my @parms = ();
1898        for my $key (keys %filter) {
1899            push @filters, _FixName($key) . " = ?";
1900            push @parms, $filter{$key};
1901        }
1902        Trace("Parms for delete row are " . join(", ", map { "\"$_\"" } @parms) . ".") if T(SQL => 4);
1903        my $command = "DELETE FROM $relationshipName WHERE " .
1904                      join(" AND ", @filters);
1905        # Execute it.
1906        my $dbh = $self->{_dbh};
1907        $dbh->SQL($command, undef, @parms);
1908    }
1909    
1910  =head3 SortNeeded  =head3 SortNeeded
1911    
1912  C<< my $parms = $erdb->SortNeeded($relationName); >>  C<< my $parms = $erdb->SortNeeded($relationName); >>
# Line 1568  Line 1957 
1957      } elsif (exists $relationshipTable->{$relationName}) {      } elsif (exists $relationshipTable->{$relationName}) {
1958          # Here we have a relationship. We sort using the FROM index.          # Here we have a relationship. We sort using the FROM index.
1959          my $relationshipData = $relationshipTable->{$relationName};          my $relationshipData = $relationshipTable->{$relationName};
1960          my $index = $relationData->{Indexes}->{"idx${relationName}From"};          my $index = $relationData->{Indexes}->{idxFrom};
1961          push @keyNames, @{$index->{IndexFields}};          push @keyNames, @{$index->{IndexFields}};
1962      } else {      } else {
1963          # 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 2303 
2303    
2304  =head3 InsertObject  =head3 InsertObject
2305    
2306  C<< my $ok = $erdb->InsertObject($objectType, \%fieldHash); >>  C<< $erdb->InsertObject($objectType, \%fieldHash); >>
2307    
2308  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
2309  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 2329 
2329    
2330  Hash of field names to values.  Hash of field names to values.
2331    
 =item RETURN  
   
 Returns 1 if successful, 0 if an error occurred.  
   
2332  =back  =back
2333    
2334  =cut  =cut
# Line 2042  Line 2427 
2427                  $retVal = $sth->execute(@parameterList);                  $retVal = $sth->execute(@parameterList);
2428                  if (!$retVal) {                  if (!$retVal) {
2429                      my $errorString = $sth->errstr();                      my $errorString = $sth->errstr();
2430                      Trace("Insert error: $errorString.") if T(0);                      Confess("Error inserting into $relationName: $errorString");
2431                  }                  }
2432              }              }
2433          }          }
2434      }      }
2435      # Return the success indicator.      # Return a 1 for backward compatability.
2436      return $retVal;      return 1;
2437    }
2438    
2439    =head3 UpdateEntity
2440    
2441    C<< $erdb->UpdateEntity($entityName, $id, \%fields); >>
2442    
2443    Update the values of an entity. This is an unprotected update, so it should only be
2444    done if the database resides on a database server.
2445    
2446    =over 4
2447    
2448    =item entityName
2449    
2450    Name of the entity to update. (This is the entity type.)
2451    
2452    =item id
2453    
2454    ID of the entity to update. If no entity exists with this ID, an error will be thrown.
2455    
2456    =item fields
2457    
2458    Reference to a hash mapping field names to their new values. All of the fields named
2459    must be in the entity's primary relation, and they cannot any of them be the ID field.
2460    
2461    =back
2462    
2463    =cut
2464    
2465    sub UpdateEntity {
2466        # Get the parameters.
2467        my ($self, $entityName, $id, $fields) = @_;
2468        # Get a list of the field names being updated.
2469        my @fieldList = keys %{$fields};
2470        # Verify that the fields exist.
2471        my $checker = $self->GetFieldTable($entityName);
2472        for my $field (@fieldList) {
2473            if ($field eq 'id') {
2474                Confess("Cannot update the ID field for entity $entityName.");
2475            } elsif ($checker->{$field}->{relation} ne $entityName) {
2476                Confess("Cannot find $field in primary relation of $entityName.");
2477            }
2478        }
2479        # Build the SQL statement.
2480        my @sets = ();
2481        my @valueList = ();
2482        for my $field (@fieldList) {
2483            push @sets, _FixName($field) . " = ?";
2484            push @valueList, $fields->{$field};
2485        }
2486        my $command = "UPDATE $entityName SET " . join(", ", @sets) . " WHERE id = ?";
2487        # Add the ID to the list of binding values.
2488        push @valueList, $id;
2489        # Call SQL to do the work.
2490        my $rows = $self->{_dbh}->SQL($command, 0, @valueList);
2491        # Check for errors.
2492        if ($rows == 0) {
2493            Confess("Entity $id of type $entityName not found.");
2494        }
2495  }  }
2496    
2497  =head3 LoadTable  =head3 LoadTable
2498    
2499  C<< my %results = $erdb->LoadTable($fileName, $relationName, $truncateFlag); >>  C<< my $results = $erdb->LoadTable($fileName, $relationName, $truncateFlag); >>
2500    
2501  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
2502  first.  first.
# Line 2151  Line 2594 
2594                      # Get an SQL-formatted field name list.                      # Get an SQL-formatted field name list.
2595                      my $fields = join(", ", $self->_FixNames(@{$structure->{searchFields}}));                      my $fields = join(", ", $self->_FixNames(@{$structure->{searchFields}}));
2596                      # Create the index.                      # Create the index.
2597                      $dbh->create_index(tbl => $relationName, idx => "search_idx_$relationName",                      $dbh->create_index(tbl => $relationName, idx => "search_idx",
2598                                         flds => $fields, kind => 'fulltext');                                         flds => $fields, kind => 'fulltext');
2599                  }                  }
2600              }              }
# Line 2189  Line 2632 
2632      my $dbh = $self->{_dbh};      my $dbh = $self->{_dbh};
2633      # 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
2634      # does not exist.      # does not exist.
2635      $dbh->drop_table($relationName);      Trace("Invoking DB Kernel to drop $relationName.") if T(3);
2636        $dbh->drop_table(tbl => $relationName);
2637    }
2638    
2639    =head3 MatchSqlPattern
2640    
2641    C<< my $matched = ERDB::MatchSqlPattern($value, $pattern); >>
2642    
2643    Determine whether or not a specified value matches an SQL pattern. An SQL
2644    pattern has two wild card characters: C<%> that matches multiple characters,
2645    and C<_> that matches a single character. These can be escaped using a
2646    backslash (C<\>). We pull this off by converting the SQL pattern to a
2647    PERL regular expression. As per SQL rules, the match is case-insensitive.
2648    
2649    =over 4
2650    
2651    =item value
2652    
2653    Value to be matched against the pattern. Note that an undefined or empty
2654    value will not match anything.
2655    
2656    =item pattern
2657    
2658    SQL pattern against which to match the value. An undefined or empty pattern will
2659    match everything.
2660    
2661    =item RETURN
2662    
2663    Returns TRUE if the value and pattern match, else FALSE.
2664    
2665    =back
2666    
2667    =cut
2668    
2669    sub MatchSqlPattern {
2670        # Get the parameters.
2671        my ($value, $pattern) = @_;
2672        # Declare the return variable.
2673        my $retVal;
2674        # Insure we have a pattern.
2675        if (! defined($pattern) || $pattern eq "") {
2676            $retVal = 1;
2677        } else {
2678            # Break the pattern into pieces around the wildcard characters. Because we
2679            # use parentheses in the split function's delimiter expression, we'll get
2680            # list elements for the delimiters as well as the rest of the string.
2681            my @pieces = split /([_%]|\\[_%])/, $pattern;
2682            # Check some fast special cases.
2683            if ($pattern eq '%') {
2684                # A null pattern matches everything.
2685                $retVal = 1;
2686            } elsif (@pieces == 1) {
2687                # No wildcards, so we have a literal comparison. Note we're case-insensitive.
2688                $retVal = (lc($value) eq lc($pattern));
2689            } elsif (@pieces == 2 && $pieces[1] eq '%') {
2690                # A wildcard at the end, so we have a substring match. This is also case-insensitive.
2691                $retVal = (lc(substr($value, 0, length($pieces[0]))) eq lc($pieces[0]));
2692            } else {
2693                # Okay, we have to do it the hard way. Convert each piece to a PERL pattern.
2694                my $realPattern = "";
2695                for my $piece (@pieces) {
2696                    # Determine the type of piece.
2697                    if ($piece eq "") {
2698                        # Empty pieces are ignored.
2699                    } elsif ($piece eq "%") {
2700                        # Here we have a multi-character wildcard. Note that it can match
2701                        # zero or more characters.
2702                        $realPattern .= ".*"
2703                    } elsif ($piece eq "_") {
2704                        # Here we have a single-character wildcard.
2705                        $realPattern .= ".";
2706                    } elsif ($piece eq "\\%" || $piece eq "\\_") {
2707                        # This is an escape sequence (which is a rare thing, actually).
2708                        $realPattern .= substr($piece, 1, 1);
2709                    } else {
2710                        # Here we have raw text.
2711                        $realPattern .= quotemeta($piece);
2712                    }
2713                }
2714                # Do the match.
2715                $retVal = ($value =~ /^$realPattern$/i ? 1 : 0);
2716            }
2717        }
2718        # Return the result.
2719        return $retVal;
2720  }  }
2721    
2722  =head3 GetEntity  =head3 GetEntity
# Line 2345  Line 2872 
2872  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
2873  feature ID followed by all of its aliases.  feature ID followed by all of its aliases.
2874    
2875  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)']); >>
2876    
2877  =over 4  =over 4
2878    
# Line 2599  Line 3126 
3126      # Declare the return variable. The field name is valid until we hear      # Declare the return variable. The field name is valid until we hear
3127      # differently.      # differently.
3128      my $retVal = 1;      my $retVal = 1;
3129        # Compute the maximum name length.
3130        my $maxLen = $TypeTable{'name-string'}->{maxLen};
3131      # Look for bad stuff in the name.      # Look for bad stuff in the name.
3132      if ($fieldName =~ /--/) {      if ($fieldName =~ /--/) {
3133          # Here we have a doubled minus sign.          # Here we have a doubled minus sign.
# Line 2608  Line 3137 
3137          # Here the field name is missing the initial letter.          # Here the field name is missing the initial letter.
3138          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);
3139          $retVal = 0;          $retVal = 0;
3140        } elsif (length($fieldName) > $maxLen) {
3141            # Here the field name is too long.
3142            Trace("Maximum field name length is $maxLen. Field name must be truncated to " . substr($fieldName,0, $maxLen) . ".");
3143      } else {      } else {
3144          # Strip out the minus signs. Everything remaining must be a letter          # Strip out the minus signs. Everything remaining must be a letter,
3145          # or digit.          # underscore, or digit.
3146          my $strippedName = $fieldName;          my $strippedName = $fieldName;
3147          $strippedName =~ s/-//g;          $strippedName =~ s/-//g;
3148          if ($strippedName !~ /^[A-Za-z0-9]+$/) {          if ($strippedName !~ /^(\w|\d)+$/) {
3149              Trace("Field name $fieldName contains illegal characters.") if T(1);              Trace("Field name $fieldName contains illegal characters.") if T(1);
3150              $retVal = 0;              $retVal = 0;
3151          }          }
# Line 3292  Line 3824 
3824      # Prepare the command.      # Prepare the command.
3825      my $sth = $dbh->prepare_command($command);      my $sth = $dbh->prepare_command($command);
3826      # Execute it with the parameters bound in.      # Execute it with the parameters bound in.
3827      $sth->execute(@{$params}) || Confess("SELECT error" . $sth->errstr());      $sth->execute(@{$params}) || Confess("SELECT error:  " . $sth->errstr());
3828      # Return the statement handle.      # Return the statement handle.
3829      return $sth;      return $sth;
3830  }  }
# Line 3556  Line 4088 
4088  sub _LoadMetaData {  sub _LoadMetaData {
4089      # Get the parameters.      # Get the parameters.
4090      my ($filename) = @_;      my ($filename) = @_;
4091      Trace("Reading Sprout DBD from $filename.") if T(2);      Trace("Reading DBD from $filename.") if T(2);
4092      # 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
4093      # get the exact structure we want.      # get the exact structure we want.
4094      my $metadata = ReadMetaXML($filename);      my $metadata = ReadMetaXML($filename);
# Line 3689  Line 4221 
4221              my $count = 0;              my $count = 0;
4222              for my $index (@{$indexList}) {              for my $index (@{$indexList}) {
4223                  # Add this index to the index table.                  # Add this index to the index table.
4224                  _AddIndex("idx$relationName$count", $relation, $index);                  _AddIndex("idx$count", $relation, $index);
4225                  # Increment the counter so that the next index has a different name.                  # Increment the counter so that the next index has a different name.
4226                  $count++;                  $count++;
4227              }              }
# Line 3887  Line 4419 
4419          $newIndex->{Unique} = 'true';          $newIndex->{Unique} = 'true';
4420      }      }
4421      # Add the index to the relation.      # Add the index to the relation.
4422      _AddIndex("idx$relationshipName$indexKey", $relationStructure, $newIndex);      _AddIndex("idx$indexKey", $relationStructure, $newIndex);
4423  }  }
4424    
4425  =head3 _AddIndex  =head3 _AddIndex

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3