[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.74, Fri Nov 3 16:49:44 2006 UTC revision 1.75, Thu Nov 9 21:21:49 2006 UTC
# Line 336  Line 336 
336  # 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.
337  # "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
338  # of the specified type. "avgLen" is the average byte length for estimating  # of the specified type. "avgLen" is the average byte length for estimating
339  # 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,
340    # and "indexMod", if non-zero, is the number of characters to use when the field is specified in an
341    # index
342  my %TypeTable = ( char =>    { sqlType => 'CHAR(1)',            maxLen => 1,            avgLen =>   1, sort => "",  my %TypeTable = ( char =>    { sqlType => 'CHAR(1)',            maxLen => 1,            avgLen =>   1, sort => "",
343                                 notes => "single ASCII character"},                                 indexMod =>   0, notes => "single ASCII character"},
344                    int =>     { sqlType => 'INTEGER',            maxLen => 20,           avgLen =>   4, sort => "n",                    int =>     { sqlType => 'INTEGER',            maxLen => 20,           avgLen =>   4, sort => "n",
345                                 notes => "signed 32-bit integer"},                                 indexMod =>   0, notes => "signed 32-bit integer"},
346                    counter => { sqlType => 'INTEGER UNSIGNED',   maxLen => 20,           avgLen =>   4, sort => "n",                    counter => { sqlType => 'INTEGER UNSIGNED',   maxLen => 20,           avgLen =>   4, sort => "n",
347                                 notes => "unsigned 32-bit integer"},                                 indexMod =>   0, notes => "unsigned 32-bit integer"},
348                    string =>  { sqlType => 'VARCHAR(255)',       maxLen => 255,          avgLen => 100, sort => "",                    string =>  { sqlType => 'VARCHAR(255)',       maxLen => 255,          avgLen => 100, sort => "",
349                                 notes => "character string, 0 to 255 characters"},                                 indexMod =>   0, notes => "character string, 0 to 255 characters"},
350                    text =>    { sqlType => 'TEXT',               maxLen => 1000000000,   avgLen => 500, sort => "",                    text =>    { sqlType => 'TEXT',               maxLen => 1000000000,   avgLen => 500, sort => "",
351                                 notes => "character string, nearly unlimited length, cannot be indexed"},                                 indexMod => 255, notes => "character string, nearly unlimited length, only first 255 characters are indexed"},
352                    date =>    { sqlType => 'BIGINT',             maxLen => 80,           avgLen =>   8, sort => "n",                    date =>    { sqlType => 'BIGINT',             maxLen => 80,           avgLen =>   8, sort => "n",
353                                 notes => "signed, 64-bit integer"},                                 indexMod =>   0, notes => "signed, 64-bit integer"},
354                    float =>   { sqlType => 'DOUBLE PRECISION',   maxLen => 40,           avgLen =>   8, sort => "g",                    float =>   { sqlType => 'DOUBLE PRECISION',   maxLen => 40,           avgLen =>   8, sort => "g",
355                                 notes => "64-bit double precision floating-point number"},                                 indexMod =>   0, notes => "64-bit double precision floating-point number"},
356                    boolean => { sqlType => 'SMALLINT',           maxLen => 1,            avgLen =>   1, sort => "n",                    boolean => { sqlType => 'SMALLINT',           maxLen => 1,            avgLen =>   1, sort => "n",
357                                 notes => "boolean value: 0 if false, 1 if true"},                                 indexMod =>   0, notes => "boolean value: 0 if false, 1 if true"},
358                   'hash-string' =>                   'hash-string' =>
359                               { sqlType => 'VARCHAR(22)',        maxLen => 22,           avgLen =>  22, sort => "",                               { sqlType => 'VARCHAR(22)',        maxLen => 22,           avgLen =>  22, sort => "",
360                                 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"},
361                   'id-string' =>                   'id-string' =>
362                               { sqlType => 'VARCHAR(25)',        maxLen => 25,           avgLen =>  25, sort => "",                               { sqlType => 'VARCHAR(25)',        maxLen => 25,           avgLen =>  25, sort => "",
363                                 notes => "character string, 0 to 25 characters"},                                 indexMod =>   0, notes => "character string, 0 to 25 characters"},
364                   'key-string' =>                   'key-string' =>
365                               { sqlType => 'VARCHAR(40)',        maxLen => 40,           avgLen =>  10, sort => "",                               { sqlType => 'VARCHAR(40)',        maxLen => 40,           avgLen =>  10, sort => "",
366                                 notes => "character string, 0 to 40 characters"},                                 indexMod =>   0, notes => "character string, 0 to 40 characters"},
367                   'name-string' =>                   'name-string' =>
368                               { sqlType => 'VARCHAR(80)',        maxLen => 80,           avgLen =>  40, sort => "",                               { sqlType => 'VARCHAR(80)',        maxLen => 80,           avgLen =>  40, sort => "",
369                                 notes => "character string, 0 to 80 characters"},                                 indexMod =>   0, notes => "character string, 0 to 80 characters"},
370                   'medium-string' =>                   'medium-string' =>
371                               { sqlType => 'VARCHAR(160)',       maxLen => 160,          avgLen =>  40, sort => "",                               { sqlType => 'VARCHAR(160)',       maxLen => 160,          avgLen =>  40, sort => "",
372                                 notes => "character string, 0 to 160 characters"},                                 indexMod =>   0, notes => "character string, 0 to 160 characters"},
373                  );                  );
374    
375  # Table translating arities into natural language.  # Table translating arities into natural language.
# Line 961  Line 963 
963      for my $indexName (keys %{$indexHash}) {      for my $indexName (keys %{$indexHash}) {
964          my $indexData = $indexHash->{$indexName};          my $indexData = $indexHash->{$indexName};
965          # Get the index's field list.          # Get the index's field list.
966          my @fieldList = _FixNames(@{$indexData->{IndexFields}});          my @rawFields = @{$indexData->{IndexFields}};
967            # Get a hash of the relation's field types.
968            my %types = map { $_->{name} => $_->{type} } @{$relationData->{Fields}};
969            # We need to check for text fields. We need a append a length limitation for them. To do
970            # that, we need the relation's field list.
971            my $relFields = $relationData->{Fields};
972            for (my $i = 0; $i <= $#rawFields; $i++) {
973                # Get the field type.
974                my $field = $rawFields[$i];
975                my $type = $types{$field};
976                # Ask if it requires using prefix notation for the index.
977                my $mod = $TypeTable{$type}->{indexMod};
978                Trace("Field $field ($i) in $relationName has type $type and indexMod $mod.") if T(3);
979                if ($mod) {
980                    # Append the prefix length to the field name,
981                    $rawFields[$i] .= "($mod)";
982                }
983            }
984            my @fieldList = _FixNames(@rawFields);
985          my $flds = join(', ', @fieldList);          my $flds = join(', ', @fieldList);
986          # Get the index's uniqueness flag.          # Get the index's uniqueness flag.
987          my $unique = (exists $indexData->{Unique} ? 'unique' : undef);          my $unique = (exists $indexData->{Unique} ? 'unique' : undef);
# Line 976  Line 996 
996      }      }
997  }  }
998    
999    =head3 GetSecondaryFields
1000    
1001    C<< my %fieldTuples = $erdb->GetSecondaryFields($entityName); >>
1002    
1003    This method will return a list of the name and type of each of the secondary
1004    fields for a specified entity. Secondary fields are stored in two-column tables
1005    in addition to the primary entity table. This enables the field to have no value
1006    or to have multiple values.
1007    
1008    =over 4
1009    
1010    =item entityName
1011    
1012    Name of the entity whose secondary fields are desired.
1013    
1014    =item RETURN
1015    
1016    Returns a hash mapping the field names to their field types.
1017    
1018    =back
1019    
1020    =cut
1021    
1022    sub GetSecondaryFields {
1023        # Get the parameters.
1024        my ($self, $entityName) = @_;
1025        # Declare the return variable.
1026        my %retVal = ();
1027        # Look for the entity.
1028        my $table = $self->GetFieldTable($entityName);
1029        # Loop through the fields, pulling out the secondaries.
1030        for my $field (sort keys %{$table}) {
1031            if ($table->{$field}->{relation} ne $entityName) {
1032                # Here we have a secondary field.
1033                $retVal{$field} = $table->{$field}->{type};
1034            }
1035        }
1036        # Return the result.
1037        return %retVal;
1038    }
1039    
1040    =head3 GetFieldRelationName
1041    
1042    C<< my $name = $erdb->GetFieldRelationName($objectName, $fieldName); >>
1043    
1044    Return the name of the relation containing a specified field.
1045    
1046    =over 4
1047    
1048    =item objectName
1049    
1050    Name of the entity or relationship containing the field.
1051    
1052    =item fieldName
1053    
1054    Name of the relevant field in that entity or relationship.
1055    
1056    =item RETURN
1057    
1058    Returns the name of the database relation containing the field, or C<undef> if
1059    the field does not exist.
1060    
1061    =back
1062    
1063    =cut
1064    
1065    sub GetFieldRelationName {
1066        # Get the parameters.
1067        my ($self, $objectName, $fieldName) = @_;
1068        # Declare the return variable.
1069        my $retVal;
1070        # Get the object field table.
1071        my $table = $self->GetFieldTable($objectName);
1072        # Only proceed if the field exists.
1073        if (exists $table->{$fieldName}) {
1074            # Determine the name of the relation that contains this field.
1075            $retVal = $table->{$fieldName}->{relation};
1076        }
1077        # Return the result.
1078        return $retVal;
1079    }
1080    
1081    =head3 DeleteValue
1082    
1083    C<< my $numDeleted = $erdb->DeleteValue($entityName, $id, $fieldName, $fieldValue); >>
1084    
1085    Delete secondary field values from the database. This method can be used to delete all
1086    values of a specified field for a particular entity instance, or only a single value.
1087    
1088    Secondary fields are stored in two-column relations separate from an entity's primary
1089    table, and as a result a secondary field can legitimately have no value or multiple
1090    values. Therefore, it makes sense to talk about deleting secondary fields where it
1091    would not make sense for primary fields.
1092    
1093    =over 4
1094    
1095    =item entityName
1096    
1097    Name of the entity from which the fields are to be deleted.
1098    
1099    =item id
1100    
1101    ID of the entity instance to be processed. If the instance is not found, this
1102    method will have no effect.
1103    
1104    =item fieldName
1105    
1106    Name of the field whose values are to be deleted.
1107    
1108    =item fieldValue (optional)
1109    
1110    Value to be deleted. If not specified, then all values of the specified field
1111    will be deleted for the entity instance. If specified, then only the values which
1112    match this parameter will be deleted.
1113    
1114    =item RETURN
1115    
1116    Returns the number of rows deleted.
1117    
1118    =back
1119    
1120    =cut
1121    
1122    sub DeleteValue {
1123        # Get the parameters.
1124        my ($self, $entityName, $id, $fieldName, $fieldValue) = @_;
1125        # Declare the return value.
1126        my $retVal = 0;
1127        # We need to set up an SQL command to do the deletion. First, we
1128        # find the name of the field's relation.
1129        my $table = $self->GetFieldTable($entityName);
1130        my $field = $table->{$fieldName};
1131        my $relation = $field->{relation};
1132        # Make sure this is a secondary field.
1133        if ($relation eq $entityName) {
1134            Confess("Cannot delete values of $fieldName for $entityName.");
1135        } else {
1136            # Set up the SQL command to delete all values.
1137            my $sql = "DELETE FROM $relation WHERE id = ?";
1138            my @parms = $id;
1139            # If a value has been specified, append it to the statement.
1140            if (defined $fieldValue) {
1141                $sql .= " AND $fieldName = ?";
1142                push @parms, $fieldValue;
1143            }
1144            # Execute the command.
1145            my $dbh = $self->{_dbh};
1146            $retVal = $dbh->SQL($sql, 0, @parms);
1147        }
1148        # Return the result.
1149        return $retVal;
1150    }
1151    
1152  =head3 LoadTables  =head3 LoadTables
1153    
1154  C<< my $stats = $erdb->LoadTables($directoryName, $rebuild); >>  C<< my $stats = $erdb->LoadTables($directoryName, $rebuild); >>
# Line 1246  Line 1419 
1419    
1420  =item searchExpression  =item searchExpression
1421    
1422  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
1423    a Boolean search expression is OR, but we want the default to be AND, so we will
1424    add a C<+> operator to each word with no other operator before it.
1425    
1426  =item idx  =item idx
1427    
# Line 1300  Line 1475 
1475          my @fields = @{$object1Structure->{searchFields}};          my @fields = @{$object1Structure->{searchFields}};
1476          # Clean the search expression.          # Clean the search expression.
1477          my $actualKeywords = $self->CleanKeywords($searchExpression);          my $actualKeywords = $self->CleanKeywords($searchExpression);
1478            # Prefix a "+" to each uncontrolled word. This converts the default
1479            # search mode from OR to AND.
1480            $actualKeywords =~ s/(^|\s)(\w)/$1\+$2/g;
1481          Trace("Actual keywords for search are\n$actualKeywords") if T(3);          Trace("Actual keywords for search are\n$actualKeywords") if T(3);
1482          # 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
1483          # 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 1407  Line 1585 
1585      # Declare the return variable.      # Declare the return variable.
1586      my %retVal = ();      my %retVal = ();
1587      # Find the entity's data structure.      # Find the entity's data structure.
1588      my $entityData = $self->{Entities}->{$entityName};      my $entityData = $self->{_metaData}->{Entities}->{$entityName};
1589      # Loop through its fields, adding each special field to the return hash.      # Loop through its fields, adding each special field to the return hash.
1590      my $fieldHash = $entityData->{Fields};      my $fieldHash = $entityData->{Fields};
1591      for my $fieldName (keys %{$fieldHash}) {      for my $fieldName (keys %{$fieldHash}) {
# Line 1476  Line 1654 
1654      # This final hash is used to remember what work still needs to be done. We push paths      # This final hash is used to remember what work still needs to be done. We push paths
1655      # 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
1656      # 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
1657      # TODO list is always an entity.      # to-do list is always an entity.
1658      my @todoList = ([$entityName]);      my @todoList = ([$entityName]);
1659      while (@todoList) {      while (@todoList) {
1660          # Get the current path.          # Get the current path.
# Line 1638  Line 1816 
1816      } elsif (exists $relationshipTable->{$relationName}) {      } elsif (exists $relationshipTable->{$relationName}) {
1817          # Here we have a relationship. We sort using the FROM index.          # Here we have a relationship. We sort using the FROM index.
1818          my $relationshipData = $relationshipTable->{$relationName};          my $relationshipData = $relationshipTable->{$relationName};
1819          my $index = $relationData->{Indexes}->{"idx${relationName}From"};          my $index = $relationData->{Indexes}->{idxFrom};
1820          push @keyNames, @{$index->{IndexFields}};          push @keyNames, @{$index->{IndexFields}};
1821      } else {      } else {
1822          # 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 2221  Line 2399 
2399                      # Get an SQL-formatted field name list.                      # Get an SQL-formatted field name list.
2400                      my $fields = join(", ", $self->_FixNames(@{$structure->{searchFields}}));                      my $fields = join(", ", $self->_FixNames(@{$structure->{searchFields}}));
2401                      # Create the index.                      # Create the index.
2402                      $dbh->create_index(tbl => $relationName, idx => "search_idx_$relationName",                      $dbh->create_index(tbl => $relationName, idx => "search_idx",
2403                                         flds => $fields, kind => 'fulltext');                                         flds => $fields, kind => 'fulltext');
2404                  }                  }
2405              }              }
# Line 2680  Line 2858 
2858          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);
2859          $retVal = 0;          $retVal = 0;
2860      } else {      } else {
2861          # Strip out the minus signs. Everything remaining must be a letter          # Strip out the minus signs. Everything remaining must be a letter,
2862          # or digit.          # underscore, or digit.
2863          my $strippedName = $fieldName;          my $strippedName = $fieldName;
2864          $strippedName =~ s/-//g;          $strippedName =~ s/-//g;
2865          if ($strippedName !~ /^[A-Za-z0-9]+$/) {          if ($strippedName !~ /^(\w|\d)+$/) {
2866              Trace("Field name $fieldName contains illegal characters.") if T(1);              Trace("Field name $fieldName contains illegal characters.") if T(1);
2867              $retVal = 0;              $retVal = 0;
2868          }          }
# Line 3363  Line 3541 
3541      # Prepare the command.      # Prepare the command.
3542      my $sth = $dbh->prepare_command($command);      my $sth = $dbh->prepare_command($command);
3543      # Execute it with the parameters bound in.      # Execute it with the parameters bound in.
3544      $sth->execute(@{$params}) || Confess("SELECT error" . $sth->errstr());      $sth->execute(@{$params}) || Confess("SELECT error:  " . $sth->errstr());
3545      # Return the statement handle.      # Return the statement handle.
3546      return $sth;      return $sth;
3547  }  }
# Line 3627  Line 3805 
3805  sub _LoadMetaData {  sub _LoadMetaData {
3806      # Get the parameters.      # Get the parameters.
3807      my ($filename) = @_;      my ($filename) = @_;
3808      Trace("Reading Sprout DBD from $filename.") if T(2);      Trace("Reading DBD from $filename.") if T(2);
3809      # 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
3810      # get the exact structure we want.      # get the exact structure we want.
3811      my $metadata = ReadMetaXML($filename);      my $metadata = ReadMetaXML($filename);
# Line 3760  Line 3938 
3938              my $count = 0;              my $count = 0;
3939              for my $index (@{$indexList}) {              for my $index (@{$indexList}) {
3940                  # Add this index to the index table.                  # Add this index to the index table.
3941                  _AddIndex("idx$relationName$count", $relation, $index);                  _AddIndex("idx$count", $relation, $index);
3942                  # Increment the counter so that the next index has a different name.                  # Increment the counter so that the next index has a different name.
3943                  $count++;                  $count++;
3944              }              }
# Line 3958  Line 4136 
4136          $newIndex->{Unique} = 'true';          $newIndex->{Unique} = 'true';
4137      }      }
4138      # Add the index to the relation.      # Add the index to the relation.
4139      _AddIndex("idx$relationshipName$indexKey", $relationStructure, $newIndex);      _AddIndex("idx$indexKey", $relationStructure, $newIndex);
4140  }  }
4141    
4142  =head3 _AddIndex  =head3 _AddIndex

Legend:
Removed from v.1.74  
changed lines
  Added in v.1.75

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3