Diff of /Sprout/ERDB.pm

-revision 1.26, Tue Oct 18 06:47:46 2005 UTC
+revision 1.37, Mon Jan 30 04:04:32 2006 UTC
 Line 309
                    text =>    { sqlType => 'TEXT',               maxLen => 1000000000,   avgLen => 500, dataGen => "StringGen(IntGen(80,1000))" },
                    date =>    { sqlType => 'BIGINT',             maxLen => 80,           avgLen =>   8, dataGen => "DateGen(-7, 7, IntGen(0,1400))" },
                    float =>   { sqlType => 'DOUBLE PRECISION',   maxLen => 40,           avgLen =>   8, dataGen => "FloatGen(0.0, 100.0)" },
-                   boolean => { sqlType => 'SMALLINT',           maxLen => 1,            avgLen =>   2, dataGen => "IntGen(0, 1)" },
+                   boolean => { sqlType => 'SMALLINT',           maxLen => 1,            avgLen =>   1, dataGen => "IntGen(0, 1)" },
                   'key-string' =>
                               { sqlType => 'VARCHAR(40)',        maxLen => 40,           avgLen =>  10, dataGen => "StringGen(IntGen(10,40))" },
                   'name-string' =>
 Line 508
          # Separate out the source, the target, and the join clause.
          $joinKey =~ m!^([^/]+)/(.+)$!;
          my ($sourceRelation, $targetRelation) = ($1, $2);
-         Trace("Join with key $joinKey is from $sourceRelation to $targetRelation.") if T(4);
+         Trace("Join with key $joinKey is from $sourceRelation to $targetRelation.") if T(Joins => 4);
          my $source = $self->ComputeObjectSentence($sourceRelation);
          my $target = $self->ComputeObjectSentence($targetRelation);
          my $clause = $joinTable->{$joinKey};
 Line 632
      }
  }
+ =head3 VerifyFields
+ C<< my $count = $erdb->VerifyFields($relName, \@fieldList); >>
+ Run through the list of proposed field values, insuring that all the character fields are
+ below the maximum length. If any fields are too long, they will be truncated in place.
+ =over 4
+ =item relName
+ Name of the relation for which the specified fields are destined.
+ =item fieldList
+ Reference to a list, in order, of the fields to be put into the relation.
+ =item RETURN
+ Returns the number of fields truncated.
+ =back
+ =cut
+ sub VerifyFields {
+     # Get the parameters.
+     my ($self, $relName, $fieldList) = @_;
+     # Initialize the return value.
+     my $retVal = 0;
+     # Get the relation definition.
+     my $relData = $self->_FindRelation($relName);
+     # Get the list of field descriptors.
+     my $fieldTypes = $relData->{Fields};
+     my $fieldCount = scalar @{$fieldTypes};
+     # Loop through the two lists.
+     for (my $i = 0; $i < $fieldCount; $i++) {
+         # Get the type of the current field.
+         my $fieldType = $fieldTypes->[$i]->{type};
+         # If it's a character field, verify the length.
+         if ($fieldType =~ /string/) {
+             my $maxLen = $TypeTable{$fieldType}->{maxLen};
+             my $oldString = $fieldList->[$i];
+             if (length($oldString) > $maxLen) {
+                 # Here it's too big, so we truncate it.
+                 Trace("Truncating field $i in relation $relName to $maxLen characters from \"$oldString\".") if T(1);
+                 $fieldList->[$i] = substr $oldString, 0, $maxLen;
+                 $retVal++;
+             }
+         }
+     }
+     # Return the truncation count.
+     return $retVal;
+ }
  =head3 CreateIndex
  C<< $erdb->CreateIndex($relationName); >>
-Line 851
+Line 906
  C<< "Genome(genus) = ? ORDER BY Genome(species)" >>
+ Note that the case is important. Only an uppercase "ORDER BY" with a single space will
+ be processed. The idea is to make it less likely to find the verb by accident.
  The rules for field references in a sort order are the same as those for field references in the
  filter clause in general; however, odd things may happen if a sort field is from a secondary
  relation.
-Line 877
+Line 935
      my $dbh = $self->{_dbh};
      my $command = "SELECT DISTINCT " . join('.*, ', @{$objectNames}) . ".* FROM " .
                  join(', ', @{$objectNames});
-     Trace("SQL = $command") if T(SQL => 4);
      # Check for a filter clause.
      if ($filterClause) {
          # Here we have one, so we convert its field names and add it to the query. First,
-Line 960
+Line 1017
                  $lastObject = $thisObject;
              }
          }
-         # 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
-         # in the following variable.
+         # here is we want the filter clause to be empty if there's no WHERE filter.
+         # We'll put the ORDER BY / LIMIT clauses in the following variable.
          my $orderClause = "";
-         # Locate the ORDER BY verb (if any).
+         # Locate the ORDER BY or LIMIT verbs (if any). We use a non-greedy
-         if ($filterString =~ m/^(.*)ORDER BY/g) {
+         # operator so that we find the first occurrence of either verb.
-             # Here we have an ORDER BY verb. Split it off of the filter string.
+         if ($filterString =~ m/^(.*?)\s*(ORDER BY|LIMIT)/g) {
+             # Here we have an ORDER BY or LIMIT verb. Split it off of the filter string.
              my $pos = pos $filterString;
-             $orderClause = substr($filterString, $pos);
+             $orderClause = $2 . substr($filterString, $pos);
              $filterString = $1;
          }
          # Add the filter and the join clauses (if any) to the SELECT command.
-Line 977
+Line 1036
          if (@joinWhere) {
              $command .= " WHERE " . join(' AND ', @joinWhere);
          }
-         # Add the sort clause (if any) to the SELECT command.
+         # Add the sort or limit clause (if any) to the SELECT command.
          if ($orderClause) {
-             $command .= " ORDER BY $orderClause";
+             $command .= " $orderClause";
          }
      }
-     Trace("SQL query: $command") if T(3);
+     Trace("SQL query: $command") if T(SQL => 4);
-     Trace("PARMS: '" . (join "', '", @params) . "'") if (T(4) && (@params > 0));
+     Trace("PARMS: '" . (join "', '", @params) . "'") if (T(SQL => 4) && (@params > 0));
      my $sth = $dbh->prepare_command($command);
      # Execute it with the parameters bound in.
      $sth->execute(@params) || Confess("SELECT error" . $sth->errstr());
-Line 992
+Line 1051
      return $retVal;
  }
+ =head3 Delete
+ C<< my $stats = $erdb->Delete($entityName, $objectID); >>
+ Delete an entity instance from the database. The instance is deleted along with all entity and
+ relationship instances dependent on it. The idea of dependence here is recursive. An object is
+ always dependent on itself. An object is dependent if it is a 1-to-many or many-to-many
+ relationship connected to a dependent entity or the "to" entity connected to a 1-to-many
+ dependent relationship.
+ =over 4
+ =item entityName
+ Name of the entity type for the instance being deleted.
+ =item objectID
+ ID of the entity instance to be deleted. If the ID contains a wild card character (C<%>),
+ then it is presumed to by a LIKE pattern.
+ =item testFlag
+ If TRUE, the delete statements will be traced without being executed.
+ =item RETURN
+ Returns a statistics object indicating how many records of each particular table were
+ deleted.
+ =back
+ =cut
+ #: Return Type $%;
+ sub Delete {
+     # Get the parameters.
+     my ($self, $entityName, $objectID, $testFlag) = @_;
+     # Declare the return variable.
+     my $retVal = Stats->new();
+     # Get the DBKernel object.
+     my $db = $self->{_dbh};
+     # We're going to generate all the paths branching out from the starting entity. One of
+     # the things we have to be careful about is preventing loops. We'll use a hash to
+     # determine if we've hit a loop.
+     my %alreadyFound = ();
+     # These next lists will serve as our result stack. We start by pushing object lists onto
+     # the stack, and then popping them off to do the deletes. This means the deletes will
+     # start with the longer paths before getting to the shorter ones. That, in turn, makes
+     # sure we don't delete records that might be needed to forge relationships back to the
+     # original item. We have two lists-- one for TO-relationships, and one for
+     # FROM-relationships and entities.
+     my @fromPathList = ();
+     my @toPathList = ();
+     # This final hash is used to remember what work still needs to be done. We push paths
+     # onto the list, then pop them off to extend the paths. We prime it with the starting
+     # point. Note that we will work hard to insure that the last item on a path in the
+     # TODO list is always an entity.
+     my @todoList = ([$entityName]);
+     while (@todoList) {
+         # Get the current path.
+         my $current = pop @todoList;
+         # Copy it into a list.
+         my @stackedPath = @{$current};
+         # Pull off the last item on the path. It will always be an entity.
+         my $entityName = pop @stackedPath;
+         # Add it to the alreadyFound list.
+         $alreadyFound{$entityName} = 1;
+         # Get the entity data.
+         my $entityData = $self->_GetStructure($entityName);
+         # The first task is to loop through the entity's relation. A DELETE command will
+         # be needed for each of them.
+         my $relations = $entityData->{Relations};
+         for my $relation (keys %{$relations}) {
+             my @augmentedList = (@stackedPath, $relation);
+             push @fromPathList, \@augmentedList;
+         }
+         # Now we need to look for relationships connected to this entity.
+         my $relationshipList = $self->{_metaData}->{Relationships};
+         for my $relationshipName (keys %{$relationshipList}) {
+             my $relationship = $relationshipList->{$relationshipName};
+             # Check the FROM field. We're only interested if it's us.
+             if ($relationship->{from} eq $entityName) {
+                 # Add the path to this relationship.
+                 my @augmentedList = (@stackedPath, $entityName, $relationshipName);
+                 push @fromPathList, \@augmentedList;
+                 # Check the arity. If it's MM we're done. If it's 1M
+                 # and the target hasn't been seen yet, we want to
+                 # stack the entity for future processing.
+                 if ($relationship->{arity} eq '1M') {
+                     my $toEntity = $relationship->{to};
+                     if (! exists $alreadyFound{$toEntity}) {
+                         # Here we have a new entity that's dependent on
+                         # the current entity, so we need to stack it.
+                         my @stackList = (@augmentedList, $toEntity);
+                         push @fromPathList, \@stackList;
+                     } else {
+                         Trace("$toEntity ignored because it occurred previously.") if T(4);
+                     }
+                 }
+             }
+             # Now check the TO field. In this case only the relationship needs
+             # deletion.
+             if ($relationship->{to} eq $entityName) {
+                 my @augmentedList = (@stackedPath, $entityName, $relationshipName);
+                 push @toPathList, \@augmentedList;
+             }
+         }
+     }
+     # Create the first qualifier for the WHERE clause. This selects the
+     # keys of the primary entity records to be deleted. When we're deleting
+     # from a dependent table, we construct a join page from the first qualifier
+     # to the table containing the dependent records to delete.
+     my $qualifier = ($objectID =~ /%/ ? "LIKE ?" : "= ?");
+     # We need to make two passes. The first is through the to-list, and
+     # the second through the from-list. The from-list is second because
+     # the to-list may need to pass through some of the entities the
+     # from-list would delete.
+     my %stackList = ( from_link => \@fromPathList, to_link => \@toPathList );
+     # Now it's time to do the deletes. We do it in two passes.
+     for my $keyName ('to_link', 'from_link') {
+         # Get the list for this key.
+         my @pathList = @{$stackList{$keyName}};
+         Trace(scalar(@pathList) . " entries in path list for $keyName.") if T(3);
+         # Loop through this list.
+         while (my $path = pop @pathList) {
+             # Get the table whose rows are to be deleted.
+             my @pathTables = @{$path};
+             # Start the DELETE statement. We need to call DBKernel because the
+             # syntax of a DELETE-USING varies among DBMSs.
+             my $target = $pathTables[$#pathTables];
+             my $stmt = $db->SetUsing(@pathTables);
+             # Now start the WHERE. The first thing is the ID field from the starting table. That
+             # starting table will either be the entity relation or one of the entity's
+             # sub-relations.
+             $stmt .= " WHERE $pathTables[0].id $qualifier";
+             # Now we run through the remaining entities in the path, connecting them up.
+             for (my $i = 1; $i <= $#pathTables; $i += 2) {
+                 # Connect the current relationship to the preceding entity.
+                 my ($entity, $rel) = @pathTables[$i-1,$i];
+                 # The style of connection depends on the direction of the relationship.
+                 $stmt .= " AND $entity.id = $rel.$keyName";
+                 if ($i + 1 <= $#pathTables) {
+                     # Here there's a next entity, so connect that to the relationship's
+                     # to-link.
+                     my $entity2 = $pathTables[$i+1];
+                     $stmt .= " AND $rel.to_link = $entity2.id";
+                 }
+             }
+             # Now we have our desired DELETE statement.
+             if ($testFlag) {
+                 # Here the user wants to trace without executing.
+                 Trace($stmt) if T(0);
+             } else {
+                 # Here we can delete. Note that the SQL method dies with a confessing
+                 # if an error occurs, so we just go ahead and do it.
+                 Trace("Executing delete from $target using '$objectID'.") if T(3);
+                 my $rv = $db->SQL($stmt, 0, $objectID);
+                 # Accumulate the statistics for this delete. The only rows deleted
+                 # are from the target table, so we use its name to record the
+                 # statistic.
+                 $retVal->Add($target, $rv);
+             }
+         }
+     }
+     # Return the result.
+     return $retVal;
+ }
  =head3 GetList
  C<< my @dbObjects = $erdb->GetList(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >>
-Line 1294
+Line 1521
  =item RETURN
- 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.
  =back
-Line 1568
+Line 1794
      } else {
          push @parmList, $parameterList;
      }
-     # Create the query.
-     my $query = $self->Get($objectNames, $filterClause, @parmList);
-     # Set up a counter of the number of records read.
-     my $fetched = 0;
      # Insure the counter has a value.
      if (!defined $count) {
          $count = 0;
      }
+     # Add the row limit to the filter clause.
+     if ($count > 0) {
+         $filterClause .= " LIMIT $count";
+     }
+     # Create the query.
+     my $query = $self->Get($objectNames, $filterClause, @parmList);
+     # Set up a counter of the number of records read.
+     my $fetched = 0;
      # Loop through the records returned, extracting the fields. Note that if the
      # counter is non-zero, we stop when the number of records read hits the count.
      my @retVal = ();
-Line 1637
+Line 1867
  =cut
  sub _GetLoadStats {
-     return Stats->new('records');
+     return Stats->new();
  }
  =head3 GenerateFields

 Legend:



Removed from v.1.26
 


changed lines


 
Added in v.1.37
 Legend:



Removed from v.1.26
 


changed lines


 
Added in v.1.37
-Removed from v.1.26
+Added in v.1.37

MCS Webmaster	ViewVC Help
Powered by ViewVC 1.0.3