[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.26, Tue Oct 18 06:47:46 2005 UTC revision 1.32, Sat Jan 28 08:58:53 2006 UTC
# Line 309  Line 309 
309                    text =>    { sqlType => 'TEXT',               maxLen => 1000000000,   avgLen => 500, dataGen => "StringGen(IntGen(80,1000))" },                    text =>    { sqlType => 'TEXT',               maxLen => 1000000000,   avgLen => 500, dataGen => "StringGen(IntGen(80,1000))" },
310                    date =>    { sqlType => 'BIGINT',             maxLen => 80,           avgLen =>   8, dataGen => "DateGen(-7, 7, IntGen(0,1400))" },                    date =>    { sqlType => 'BIGINT',             maxLen => 80,           avgLen =>   8, dataGen => "DateGen(-7, 7, IntGen(0,1400))" },
311                    float =>   { sqlType => 'DOUBLE PRECISION',   maxLen => 40,           avgLen =>   8, dataGen => "FloatGen(0.0, 100.0)" },                    float =>   { sqlType => 'DOUBLE PRECISION',   maxLen => 40,           avgLen =>   8, dataGen => "FloatGen(0.0, 100.0)" },
312                    boolean => { sqlType => 'SMALLINT',           maxLen => 1,            avgLen =>   2, dataGen => "IntGen(0, 1)" },                    boolean => { sqlType => 'SMALLINT',           maxLen => 1,            avgLen =>   1, dataGen => "IntGen(0, 1)" },
313                   'key-string' =>                   'key-string' =>
314                               { sqlType => 'VARCHAR(40)',        maxLen => 40,           avgLen =>  10, dataGen => "StringGen(IntGen(10,40))" },                               { sqlType => 'VARCHAR(40)',        maxLen => 40,           avgLen =>  10, dataGen => "StringGen(IntGen(10,40))" },
315                   'name-string' =>                   'name-string' =>
# Line 508  Line 508 
508          # Separate out the source, the target, and the join clause.          # Separate out the source, the target, and the join clause.
509          $joinKey =~ m!^([^/]+)/(.+)$!;          $joinKey =~ m!^([^/]+)/(.+)$!;
510          my ($sourceRelation, $targetRelation) = ($1, $2);          my ($sourceRelation, $targetRelation) = ($1, $2);
511          Trace("Join with key $joinKey is from $sourceRelation to $targetRelation.") if T(4);          Trace("Join with key $joinKey is from $sourceRelation to $targetRelation.") if T(Joins => 4);
512          my $source = $self->ComputeObjectSentence($sourceRelation);          my $source = $self->ComputeObjectSentence($sourceRelation);
513          my $target = $self->ComputeObjectSentence($targetRelation);          my $target = $self->ComputeObjectSentence($targetRelation);
514          my $clause = $joinTable->{$joinKey};          my $clause = $joinTable->{$joinKey};
# Line 632  Line 632 
632      }      }
633  }  }
634    
635    =head3 VerifyFields
636    
637    C<< my $count = $erdb->VerifyFields($relName, \@fieldList); >>
638    
639    Run through the list of proposed field values, insuring that all the character fields are
640    below the maximum length. If any fields are too long, they will be truncated in place.
641    
642    =over 4
643    
644    =item relName
645    
646    Name of the relation for which the specified fields are destined.
647    
648    =item fieldList
649    
650    Reference to a list, in order, of the fields to be put into the relation.
651    
652    =item RETURN
653    
654    Returns the number of fields truncated.
655    
656    =back
657    
658    =cut
659    
660    sub VerifyFields {
661        # Get the parameters.
662        my ($self, $relName, $fieldList) = @_;
663        # Initialize the return value.
664        my $retVal = 0;
665        # Get the relation definition.
666        my $relData = $self->_FindRelation($relName);
667        # Get the list of field descriptors.
668        my $fieldTypes = $relData->{Fields};
669        my $fieldCount = scalar @{$fieldTypes};
670        # Loop through the two lists.
671        for (my $i = 0; $i < $fieldCount; $i++) {
672            # Get the type of the current field.
673            my $fieldType = $fieldTypes->[$i]->{type};
674            # If it's a character field, verify the length.
675            if ($fieldType =~ /string/) {
676                my $maxLen = $TypeTable{$fieldType}->{maxLen};
677                my $oldString = $fieldList->[$i];
678                if (length($oldString) > $maxLen) {
679                    # Here it's too big, so we truncate it.
680                    Trace("Truncating field $i in relation $relName to $maxLen characters from \"$oldString\".") if T(1);
681                    $fieldList->[$i] = substr $oldString, 0, $maxLen;
682                    $retVal++;
683                }
684            }
685        }
686        # Return the truncation count.
687        return $retVal;
688    }
689    
690  =head3 CreateIndex  =head3 CreateIndex
691    
692  C<< $erdb->CreateIndex($relationName); >>  C<< $erdb->CreateIndex($relationName); >>
# Line 851  Line 906 
906    
907  C<< "Genome(genus) = ? ORDER BY Genome(species)" >>  C<< "Genome(genus) = ? ORDER BY Genome(species)" >>
908    
909    Note that the case is important. Only an uppercase "ORDER BY" with a single space will
910    be processed. The idea is to make it less likely to find the verb by accident.
911    
912  The rules for field references in a sort order are the same as those for field references in the  The rules for field references in a sort order are the same as those for field references in the
913  filter clause in general; however, odd things may happen if a sort field is from a secondary  filter clause in general; however, odd things may happen if a sort field is from a secondary
914  relation.  relation.
# Line 877  Line 935 
935      my $dbh = $self->{_dbh};      my $dbh = $self->{_dbh};
936      my $command = "SELECT DISTINCT " . join('.*, ', @{$objectNames}) . ".* FROM " .      my $command = "SELECT DISTINCT " . join('.*, ', @{$objectNames}) . ".* FROM " .
937                  join(', ', @{$objectNames});                  join(', ', @{$objectNames});
     Trace("SQL = $command") if T(SQL => 4);  
938      # Check for a filter clause.      # Check for a filter clause.
939      if ($filterClause) {      if ($filterClause) {
940          # Here we have one, so we convert its field names and add it to the query. First,          # Here we have one, so we convert its field names and add it to the query. First,
# Line 960  Line 1017 
1017                  $lastObject = $thisObject;                  $lastObject = $thisObject;
1018              }              }
1019          }          }
1020          # Now we need to handle the whole ORDER BY thing. We'll put the order by clause          # Now we need to handle the whole ORDER BY / LIMIT thing. The important part
1021          # in the following variable.          # here is we want the filter clause to be empty if there's no WHERE filter.
1022            # We'll put the ORDER BY / LIMIT clauses in the following variable.
1023          my $orderClause = "";          my $orderClause = "";
1024          # Locate the ORDER BY verb (if any).          # Locate the ORDER BY or LIMIT verbs (if any). We use a non-greedy
1025          if ($filterString =~ m/^(.*)ORDER BY/g) {          # operator so that we find the first occurrence of either verb.
1026              # Here we have an ORDER BY verb. Split it off of the filter string.          if ($filterString =~ m/^(.*?)\s*(ORDER BY|LIMIT)/g) {
1027                # Here we have an ORDER BY or LIMIT verb. Split it off of the filter string.
1028              my $pos = pos $filterString;              my $pos = pos $filterString;
1029              $orderClause = substr($filterString, $pos);              $orderClause = $2 . substr($filterString, $pos);
1030              $filterString = $1;              $filterString = $1;
1031          }          }
1032          # Add the filter and the join clauses (if any) to the SELECT command.          # Add the filter and the join clauses (if any) to the SELECT command.
# Line 977  Line 1036 
1036          if (@joinWhere) {          if (@joinWhere) {
1037              $command .= " WHERE " . join(' AND ', @joinWhere);              $command .= " WHERE " . join(' AND ', @joinWhere);
1038          }          }
1039          # Add the sort clause (if any) to the SELECT command.          # Add the sort or limit clause (if any) to the SELECT command.
1040          if ($orderClause) {          if ($orderClause) {
1041              $command .= " ORDER BY $orderClause";              $command .= " $orderClause";
1042          }          }
1043      }      }
1044      Trace("SQL query: $command") if T(3);      Trace("SQL query: $command") if T(SQL => 4);
1045      Trace("PARMS: '" . (join "', '", @params) . "'") if (T(4) && (@params > 0));      Trace("PARMS: '" . (join "', '", @params) . "'") if (T(SQL => 4) && (@params > 0));
1046      my $sth = $dbh->prepare_command($command);      my $sth = $dbh->prepare_command($command);
1047      # Execute it with the parameters bound in.      # Execute it with the parameters bound in.
1048      $sth->execute(@params) || Confess("SELECT error" . $sth->errstr());      $sth->execute(@params) || Confess("SELECT error" . $sth->errstr());
# Line 992  Line 1051 
1051      return $retVal;      return $retVal;
1052  }  }
1053    
1054    =head3 Delete
1055    
1056    C<< my $stats = $erdb->Delete($entityName, $objectID); >>
1057    
1058    Delete an entity instance from the database. The instance is deleted along with all entity and
1059    relationship instances dependent on it. The idea of dependence here is recursive. An object is
1060    always dependent on itself. An object is dependent if it is a 1-to-many or many-to-many
1061    relationship connected to a dependent entity or the "to" entity connected to a 1-to-many
1062    dependent relationship.
1063    
1064    =over 4
1065    
1066    =item entityName
1067    
1068    Name of the entity type for the instance being deleted.
1069    
1070    =item objectID
1071    
1072    ID of the entity instance to be deleted. If the ID contains a wild card character (C<%>),
1073    then it is presumed to by a LIKE pattern.
1074    
1075    =item testFlag
1076    
1077    If TRUE, the delete statements will be traced without being executed.
1078    
1079    =item RETURN
1080    
1081    Returns a statistics object indicating how many records of each particular table were
1082    deleted.
1083    
1084    =back
1085    
1086    =cut
1087    #: Return Type $%;
1088    sub Delete {
1089        # Get the parameters.
1090        my ($self, $entityName, $objectID, $testFlag) = @_;
1091        # Declare the return variable.
1092        my $retVal = Stats->new();
1093        # Get the DBKernel object.
1094        my $db = $self->{_dbh};
1095        # We're going to generate all the paths branching out from the starting entity. One of
1096        # the things we have to be careful about is preventing loops. We'll use a hash to
1097        # determine if we've hit a loop.
1098        my %alreadyFound = ();
1099        # This next list will serve as our result stack. We start by pushing object lists onto
1100        # the stack, and then popping them off to do the deletes. This means the deletes will
1101        # start with the longer paths before getting to the shorter ones. That, in turn, makes
1102        # sure we don't delete records that might be needed to forge relationships back to the
1103        # original item.
1104        my @pathList = ();
1105        # This final hash is used to remember what work still needs to be done. We push paths
1106        # onto the list, then pop them off to extend the paths. We prime it with the starting
1107        # point. Note that we will work hard to insure that the last item on a path in the
1108        # TODO list is always an entity.
1109        my @todoList = ([$entityName]);
1110        while (@todoList) {
1111            # Get the current path.
1112            my $current = pop @todoList;
1113            # Copy it into a list.
1114            my @stackedPath = @{$current};
1115            # Pull off the last item on the path. It will always be an entity.
1116            my $entityName = pop @stackedPath;
1117            # Add it to the alreadyFound list.
1118            $alreadyFound{$entityName} = 1;
1119            # Get the entity data.
1120            my $entityData = $self->_GetStructure($entityName);
1121            # The first task is to loop through the entity's relation. A DELETE command will
1122            # be needed for each of them.
1123            my $relations = $entityData->{Relations};
1124            for my $relation (keys %{$relations}) {
1125                my @augmentedList = (@stackedPath, $relation);
1126                push @pathList, \@augmentedList;
1127            }
1128            # Now we need to look for relationships connected to this entity.
1129            my $relationshipList = $self->{_metaData}->{Relationships};
1130            for my $relationshipName (keys %{$relationshipList}) {
1131                my $relationship = $relationshipList->{$relationshipName};
1132                # Check the FROM field. We're only interested if it's us.
1133                if ($relationship->{from} eq $entityName) {
1134                    # Add the path to this relationship.
1135                    my @augmentedList = (@stackedPath, $entityName, $relationshipName);
1136                    push @pathList, \@augmentedList;
1137                    # Check the arity. If it's MM we're done. If it's 1M
1138                    # and the target hasn't been seen yet, we want to
1139                    # stack the entity for future processing.
1140                    if ($relationship->{arity} eq '1M') {
1141                        my $toEntity = $relationship->{to};
1142                        if (! exists $alreadyFound{$toEntity}) {
1143                            # Here we have a new entity that's dependent on
1144                            # the current entity, so we need to stack it.
1145                            my @stackList = (@augmentedList, $toEntity);
1146                            push @pathList, \@stackList;
1147                        }
1148                    }
1149                }
1150                # Now check the TO field. In this case only the relationship needs
1151                # deletion.
1152                if ($relationship->{to} eq $entityName) {
1153                    my @augmentedList = (@stackedPath, $entityName, $relationshipName);
1154                    push @pathList, \@augmentedList;
1155                }
1156            }
1157        }
1158        # Create the first qualifier for the WHERE clause. This selects the
1159        # keys of the primary entity records to be deleted. When we're deleting
1160        # from a dependent table, we construct a join page from the first qualifier
1161        # to the table containing the dependent records to delete.
1162        my $qualifier = ($objectID =~ /%/ ? "LIKE ?" : "= ?");
1163        # Now it's time to do the deletes. We simply pop the paths off the stack.
1164        while (my $path = pop @pathList) {
1165            # Get the table whose rows are to be deleted.
1166            my @pathTables = @{$path};
1167            # Start the DELETE statement.
1168            my $target = $pathTables[$#pathTables];
1169            my $stmt = "DELETE FROM $target";
1170            # If there's more than just the one table, we need a USING clause.
1171            if (@pathTables > 1) {
1172                $stmt .= " USING " . join(", ", @pathTables[0 .. ($#pathTables - 1)]);
1173            }
1174            # Now start the WHERE. The first thing is the ID field from the starting table. That
1175            # starting table will either be the entity relation or one of the entity's
1176            # sub-relations.
1177            $stmt .= " WHERE $pathTables[0].id $qualifier";
1178            # Now we run through the remaining entities in the path, connecting them up.
1179            for (my $i = 1; $i <= $#pathTables; $i += 2) {
1180                # Connect the current relationship to the preceding entity.
1181                my ($entity, $rel) = @pathTables[$i-1,$i];
1182                # The style of connection depends on the direction of the relationship.
1183                # We compute the direction by checking whether the preceding entity is
1184                # the FROM or TO entity.
1185                my $relationship = $self->_GetStructure($rel);
1186                if ($relationship->{to} eq $entity) {
1187                    # Here we're the TO. A TO link is always the end of a chain, so
1188                    # we just tack it on at the end.
1189                    $stmt .= " AND $entity.id = $rel.to_link";
1190                } else {
1191                    # Here we're the FROM. In that case, we'll need to check for a
1192                    # next entity.
1193                    $stmt .= " AND $entity.id = $rel.from_link";
1194                    if ($i + 1 <= $#pathTables) {
1195                        # Here there's a next entity, so connect that to the relationship's
1196                        # to-link.
1197                        my $entity2 = $pathTables[$i+1];
1198                        $stmt .= " AND $rel.to_link = $entity2.id";
1199                    }
1200                }
1201            }
1202            # Now we have our desired DELETE statement.
1203            if ($testFlag) {
1204                # Here the user wants to trace without executing.
1205                Trace($stmt) if T(0);
1206            } else {
1207                # Here we can delete. Note that the SQL method dies with a confessing
1208                # if an error occurs, so we just go ahead and do it.
1209                Trace("Executing delete: $stmt") if T(3);
1210                my $rv = $db->SQL($stmt, 0, [$objectID]);
1211                # Accumulate the statistics for this delete. The only rows deleted
1212                # are from the target table, so we use its name to record the
1213                # statistic.
1214                $retVal->Add($target, $rv);
1215            }
1216        }
1217        # Return the result.
1218        return $retVal;
1219    }
1220    
1221  =head3 GetList  =head3 GetList
1222    
1223  C<< my @dbObjects = $erdb->GetList(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >>  C<< my @dbObjects = $erdb->GetList(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >>
# Line 1294  Line 1520 
1520    
1521  =item RETURN  =item RETURN
1522    
1523  Returns a statistical object containing the number of records read and a list of  Returns a statistical object containing a list of the error messages.
 the error messages.  
1524    
1525  =back  =back
1526    
# Line 1568  Line 1793 
1793      } else {      } else {
1794          push @parmList, $parameterList;          push @parmList, $parameterList;
1795      }      }
     # Create the query.  
     my $query = $self->Get($objectNames, $filterClause, @parmList);  
     # Set up a counter of the number of records read.  
     my $fetched = 0;  
1796      # Insure the counter has a value.      # Insure the counter has a value.
1797      if (!defined $count) {      if (!defined $count) {
1798          $count = 0;          $count = 0;
1799      }      }
1800        # Add the row limit to the filter clause.
1801        if ($count > 0) {
1802            $filterClause .= " LIMIT $count";
1803        }
1804        # Create the query.
1805        my $query = $self->Get($objectNames, $filterClause, @parmList);
1806        # Set up a counter of the number of records read.
1807        my $fetched = 0;
1808      # Loop through the records returned, extracting the fields. Note that if the      # Loop through the records returned, extracting the fields. Note that if the
1809      # counter is non-zero, we stop when the number of records read hits the count.      # counter is non-zero, we stop when the number of records read hits the count.
1810      my @retVal = ();      my @retVal = ();
# Line 1637  Line 1866 
1866  =cut  =cut
1867    
1868  sub _GetLoadStats {  sub _GetLoadStats {
1869      return Stats->new('records');      return Stats->new();
1870  }  }
1871    
1872  =head3 GenerateFields  =head3 GenerateFields

Legend:
Removed from v.1.26  
changed lines
  Added in v.1.32

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3