Diff of /Sprout/ERDB.pm

-revision 1.77, Mon Nov 20 05:53:02 2006 UTC
+revision 1.92, Mon Jun 11 18:51:23 2007 UTC
 Line 6
      use Data::Dumper;
      use XML::Simple;
      use DBQuery;
-     use DBObject;
+     use ERDBObject;
      use Stats;
      use Time::HiRes qw(gettimeofday);
      use Digest::MD5 qw(md5_base64);
-     use FIG;
      use CGI;
  =head1 Entity-Relationship Database Package
-Line 228
+Line 227
  =head3 Indexes
- 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 in an
- all be from the same relation. The alternate indexes assist in ordering results
+ index must all be from the same relation. The alternate indexes assist in searching
- from a query. A relationship can have up to two indexes-- a I<to-index> and a
+ on fields other than the entity ID. A relationship has at least two indexes-- a I<to-index> and a
- I<from-index>. These order the results when crossing the relationship. For
+ I<from-index> that order the results when crossing the relationship. For
  example, in the relationship C<HasContig> from C<Genome> to C<Contig>, the
  from-index would order the contigs of a ganome, and the to-index would order
- the genomes of a contig. A relationship's index must specify only fields in
+ the genomes of a contig. In addition, it can have zero or more alternate
+ indexes. A relationship's index must specify only fields in
  the relationship.
- The indexes for an entity must be listed inside the B<Indexes> tag. The from-index
+ The alternate indexes for an entity or relationship must be listed inside the B<Indexes> tag.
- of a relationship is specified using the B<FromIndex> tag; the to-index is specified
+ The from-index of a relationship is specified using the B<FromIndex> tag; the to-index is
- using the B<ToIndex> tag.
+ specified using the B<ToIndex> tag.
  Each index can contain a B<Notes> tag. In addition, it will have an B<IndexFields>
  tag containing the B<IndexField> tags. These specify, in order, the fields used in
 Line 257
  =back
- 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
+ have a B<Unique> attribute. If specified, the index will be generated as a unique
+ index.
  =head3 Object and Field Names
-Line 301
+Line 303
  A relationship is described by the C<Relationship> tag. Within a relationship,
  there can be a C<Notes> tag, a C<Fields> tag containing the intersection data
- fields, a C<FromIndex> tag containing the from-index, and a C<ToIndex> tag containing
+ fields, a C<FromIndex> tag containing the from-index, a C<ToIndex> tag containing
- the to-index.
+ the to-index, and an C<Indexes> tag containing the alternate indexes.
  The C<Relationship> tag has the following attributes.
-Line 370
+Line 372
                   'medium-string' =>
                               { sqlType => 'VARCHAR(160)',       maxLen => 160,          avgLen =>  40, sort => "",
                                 indexMod =>   0, notes => "character string, 0 to 160 characters"},
+                  'long-string' =>
+                              { sqlType => 'VARCHAR(500)',       maxLen => 500,          avglen => 255, sort => "",
+                                indexMod =>   0, notes => "character string, 0 to 500 characters"},
                  );
  # Table translating arities into natural language.
-Line 394
+Line 399
                   );
  my %XmlInOpts  = (
-                   ForceArray => ['Field', 'Index', 'IndexField'],
+                   ForceArray => ['Field', 'Index', 'IndexField', 'Relationship', 'Entity'],
                    ForceContent => 1,
                    NormalizeSpace => 2,
                   );
-Line 546
+Line 551
          if (my $notes = $entityData->{Notes}) {
              $retVal .= "<p>" . HTMLNote($notes->{content}) . "</p>\n";
          }
-         # Now we want a list of the entity's relationships. First, we set up the relationship subsection.
+         # See if we need a list of the entity's relationships.
+         my $relCount = keys %{$relationshipList};
+         if ($relCount > 0) {
+             # First, we set up the relationship subsection.
          $retVal .= "<h4>Relationships for <b>$key</b></h4>\n<ul>\n";
          # Loop through the relationships.
          for my $relationship (sort keys %{$relationshipList}) {
-Line 562
+Line 570
          }
          # Close off the relationship list.
          $retVal .= "</ul>\n";
+         }
          # Get the entity's relations.
          my $relationList = $entityData->{Relations};
          # Create a header for the relation subsection.
-Line 648
+Line 657
      return Data::Dumper::Dumper($self->{_metaData});
  }
+ =head3 CreatePPO
+ C<< ERDB::CreatePPO($erdbXMLFile, $ppoXMLFile); >>
+ Create a PPO XML file from an ERDB data definition XML file. At the
+ current time, the PPO XML file can be used to create a database with
+ similar functionality. Eventually, the PPO will be able to use the
+ created XML to access the live ERDB database.
+ =over 4
+ =item erdbXMLFile
+ Name of the XML data definition file for the ERDB database. This
+ file must exist.
+ =item ppoXMLFile
+ Output file for the PPO XML definition. If this file exists, it
+ will be overwritten.
+ =back
+ =cut
+ sub CreatePPO {
+     # Get the parameters.
+     my ($erdbXMLFile, $ppoXMLFile) = @_;
+     # First, we want to slurp in the ERDB XML file in its raw form.
+     my $xml = ReadMetaXML($erdbXMLFile);
+     # Create a variable to hold all of the objects in the PPO project.
+     my @objects = ();
+     # Get the relationship hash.
+     my $relationships = $xml->{Relationships};
+     # Loop through the entities.
+     my $entities = $xml->{Entities};
+     for my $entityName (keys %{$entities}) {
+         # Get the entity's data structures.
+         my $entityObject = $entities->{$entityName};
+         # We put the object's fields in here, according to their type.
+         my (@object_refs, @scalars, @indexes, @arrays);
+         # Create the ID field for the entity. We get the key type from the
+         # entity object and compute the corresponding SQL type.
+         my $type = $TypeTable{$entityObject->{keyType}}->{sqlType};
+         push @scalars, { label => 'id', type => $type };
+         # Loop through the entity fields.
+         for my $fieldName ( keys %{$entityObject->{Fields}} ) {
+             # Get the field object.
+             my $fieldObject = $entityObject->{Fields}->{$fieldName};
+             # Convert it to a scalar tag.
+             my $scalar = _CreatePPOField($fieldName, $fieldObject);
+             # If we have a relation, this field is stored in an array.
+             # otherwise, it is a scalar. The array tag has scalars
+             # stored as an XML array. In ERDB, there is only ever one,
+             # but PPO can have more.
+             my $relation = $fieldObject->{relation};
+             if ($relation) {
+                 push @arrays, { scalar => [$scalar] };
+             } else {
+                 push @scalars, $scalar;
+             }
+         }
+         # Loop through the relationships. If this entity is the to-entity
+         # on a relationship of 1M arity, then it is implemented as a PPO
+         # object reference.
+         for my $relationshipName (keys %{$relationships}) {
+             # Get the relationship data.
+             my $relationshipData = $relationships->{$relationshipName};
+             # If we have a from for this entity and an arity of 1M, we
+             # have an object reference.
+             if ($relationshipData->{to} eq $entityName &&
+                 $relationshipData->{arity} eq '1M') {
+                 # Build the object reference tag.
+                 push @object_refs, { label => $relationshipName,
+                                      type => $relationshipData->{from} };
+             }
+         }
+         # Create the indexes.
+         my $indexList = $entityObject->{Indexes};
+         push @indexes, map { _CreatePPOIndex($_) } @{$indexList};
+         # Build the object XML tree.
+         my $object = { label => $entityName,
+                        object_ref => \@object_refs,
+                        scalar => \@scalars,
+                        index => \@indexes,
+                        array => \@arrays
+                       };
+         # Push the object onto the objects list.
+         push @objects, $object;
+     }
+     # Loop through the relationships, searching for MMs. The 1Ms were
+     # already handled by the entity search above.
+     for my $relationshipName (keys %{$relationships}) {
+         # Get this relationship's object.
+         my $relationshipObject = $relationships->{$relationshipName};
+         # Only proceed if it's many-to-many.
+         if ($relationshipObject->{arity} eq 'MM') {
+             # Create the tag lists for the relationship object.
+             my (@object_refs, @scalars, @indexes);
+             # The relationship will be created as an object with object
+             # references for its links to the participating entities.
+             my %links = ( from_link => $relationshipObject->{from},
+                           to_link => $relationshipObject->{to} );
+             for my $link (keys %links) {
+                 # Create an object_ref tag for this piece of the
+                 # relationship (from or to).
+                 my $object_ref = { label => $link,
+                                    type => $links{$link} };
+                 push @object_refs, $object_ref;
+             }
+             # Loop through the intersection data fields, creating scalar tags.
+             # There are no fancy array tags in a relationship.
+             for my $fieldName (keys %{$relationshipObject->{Fields}}) {
+                 my $fieldObject = $relationshipObject->{Fields}->{$fieldName};
+                 push @scalars, _CreatePPOField($fieldName, $fieldObject);
+             }
+             # Finally, the indexes: currently we cannot support the to-index and
+             # from-index in PPO, so we just process the alternate indexes.
+             my $indexList = $relationshipObject->{Indexes};
+             push @indexes, map { _CreatePPOIndex($_) } @{$indexList};
+             # Wrap up all the stuff about this relationship.
+             my $object = { label => $relationshipName,
+                            scalar => \@scalars,
+                            object_ref => \@object_refs,
+                            index => \@indexes
+                          };
+             # Push it into the object list.
+             push @objects, $object;
+         }
+     }
+     # Compute a title.
+     my $title;
+     if ($erdbXMLFile =~ /(\/|^)([^\/]+)DBD\.xml/) {
+         # Here we have a standard file name we can use for a title.
+         $title = $2;
+     } else {
+         # Here the file name is non-standard, so we carve up the
+         # database title.
+         $title = $xml->{Title}->{content};
+         $title =~ s/\s\.,//g;
+     }
+     # Wrap up the XML as a project.
+     my $ppoXML = { project => { label => $title,
+                                 object => \@objects }};
+     # Write out the results.
+     my $ppoString = XML::Simple::XMLout($ppoXML,
+                                         AttrIndent => 1,
+                                         KeepRoot => 1);
+     Tracer::PutFile($ppoXMLFile, [ $ppoString ]);
+ }
  =head3 FindIndexForEntity
  C<< my $indexFound = ERDB::FindIndexForEntity($xml, $entityName, $attributeName); >>
-Line 737
+Line 897
      # Loop through the relations.
      for my $relationName (@relNames) {
          # Create a table for this relation.
-         $self->CreateTable($relationName);
+         $self->CreateTable($relationName, 1);
          Trace("Relation $relationName created.") if T(2);
      }
  }
-Line 857
+Line 1017
              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);
+                 Trace("Truncating field $i ($fieldTypes->[$i]->{name}) in relation $relName to $maxLen characters from \"$oldString\".") if T(1);
                  $fieldList->[$i] = substr $oldString, 0, $maxLen;
                  $retVal++;
              }
-Line 966
+Line 1126
          my @rawFields = @{$indexData->{IndexFields}};
          # Get a hash of the relation's field types.
          my %types = map { $_->{name} => $_->{type} } @{$relationData->{Fields}};
-         # We need to check for text fields. We need a append a length limitation for them. To do
+         # We need to check for text fields so we can append a length limitation for them. To do
          # that, we need the relation's field list.
          my $relFields = $relationData->{Fields};
          for (my $i = 0; $i <= $#rawFields; $i++) {
-Line 1418
+Line 1578
      return $retVal;
  }
  =head3 Search
  C<< my $query = $erdb->Search($searchExpression, $idx, \@objectNames, $filterClause, \@params); >>
-Line 1489
+Line 1651
          my $actualKeywords = $self->CleanKeywords($searchExpression);
          # Prefix a "+" to each uncontrolled word. This converts the default
          # search mode from OR to AND.
-         $actualKeywords =~ s/(^|\s)(\w)/$1\+$2/g;
+         $actualKeywords =~ s/(^|\s)(\w|")/$1\+$2/g;
          Trace("Actual keywords for search are\n$actualKeywords") if T(3);
          # We need two match expressions, one for the filter clause and one in the
          # query itself. Both will use a parameter mark, so we need to push the
-Line 1612
+Line 1774
  =head3 Delete
- C<< my $stats = $erdb->Delete($entityName, $objectID, $testFlag); >>
+ C<< my $stats = $erdb->Delete($entityName, $objectID, %options); >>
  Delete an entity instance from the database. The instance is deleted along with all entity and
  relationship instances dependent on it. The definition of I<dependence> is recursive.
-Line 1632
+Line 1794
  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
+ =item options
- If TRUE, the delete statements will be traced without being executed.
+ A hash detailing the options for this delete operation.
  =item RETURN
-Line 1643
+Line 1805
  =back
+ The permissible options for this method are as follows.
+ =over 4
+ =item testMode
+ If TRUE, then the delete statements will be traced, but no changes will be made to the database.
+ =item keepRoot
+ If TRUE, then the entity instances will not be deleted, only the dependent records.
+ =back
  =cut
  #: Return Type $%;
  sub Delete {
      # Get the parameters.
-     my ($self, $entityName, $objectID, $testFlag) = @_;
+     my ($self, $entityName, $objectID, %options) = @_;
      # Declare the return variable.
      my $retVal = Stats->new();
      # Get the DBKernel object.
-Line 1664
+Line 1840
      # 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
+     # This final list 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
      # to-do list is always an entity.
-Line 1675
+Line 1851
          # 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;
+         my $myEntityName = pop @stackedPath;
          # Add it to the alreadyFound list.
-         $alreadyFound{$entityName} = 1;
+         $alreadyFound{$myEntityName} = 1;
+         # Figure out if we need to delete this entity.
+         if ($myEntityName ne $entityName || ! $options{keepRoot}) {
          # Get the entity data.
-         my $entityData = $self->_GetStructure($entityName);
+             my $entityData = $self->_GetStructure($myEntityName);
-         # 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.
          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) {
+             if ($relationship->{from} eq $myEntityName) {
                  # Add the path to this relationship.
-                 my @augmentedList = (@stackedPath, $entityName, $relationshipName);
+                 my @augmentedList = (@stackedPath, $myEntityName, $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
-Line 1713
+Line 1891
              }
              # Now check the TO field. In this case only the relationship needs
              # deletion.
-             if ($relationship->{to} eq $entityName) {
+             if ($relationship->{to} eq $myEntityName) {
-                 my @augmentedList = (@stackedPath, $entityName, $relationshipName);
+                 my @augmentedList = (@stackedPath, $myEntityName, $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
+     # from a dependent table, we construct a join path 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
-Line 1760
+Line 1938
                  }
              }
              # Now we have our desired DELETE statement.
-             if ($testFlag) {
+             if ($options{testMode}) {
                  # Here the user wants to trace without executing.
                  Trace($stmt) if T(0);
              } else {
-Line 1779
+Line 1957
      return $retVal;
  }
+ =head3 Disconnect
+ C<< $erdb->Disconnect($relationshipName, $originEntityName, $originEntityID); >>
+ Disconnect an entity instance from all the objects to which it is related. This
+ will delete each relationship instance that connects to the specified entity.
+ =over 4
+ =item relationshipName
+ Name of the relationship whose instances are to be deleted.
+ =item originEntityName
+ Name of the entity that is to be disconnected.
+ =item originEntityID
+ ID of the entity that is to be disconnected.
+ =back
+ =cut
+ sub Disconnect {
+     # Get the parameters.
+     my ($self, $relationshipName, $originEntityName, $originEntityID) = @_;
+     # Get the relationship descriptor.
+     my $structure = $self->_GetStructure($relationshipName);
+     # Insure we have a relationship.
+     if (! exists $structure->{from}) {
+         Confess("$relationshipName is not a relationship in the database.");
+     } else {
+         # Get the database handle.
+         my $dbh = $self->{_dbh};
+         # We'll set this value to 1 if we find our entity.
+         my $found = 0;
+         # Loop through the ends of the relationship.
+         for my $dir ('from', 'to') {
+             if ($structure->{$dir} eq $originEntityName) {
+                 # Delete all relationship instances on this side of the entity instance.
+                 Trace("Disconnecting in $dir direction with ID \"$originEntityID\".");
+                 $dbh->SQL("DELETE FROM $relationshipName WHERE ${dir}_link = ?", 0, $originEntityID);
+                 $found = 1;
+             }
+         }
+         # Insure we found the entity on at least one end.
+         if (! $found) {
+             Confess("Entity \"$originEntityName\" does not use $relationshipName.");
+         }
+     }
+ }
+ =head3 DeleteRow
+ C<< $erdb->DeleteRow($relationshipName, $fromLink, $toLink, \%values); >>
+ Delete a row from a relationship. In most cases, only the from-link and to-link are
+ needed; however, for relationships with intersection data values can be specified
+ for the other fields using a hash.
+ =over 4
+ =item relationshipName
+ Name of the relationship from which the row is to be deleted.
+ =item fromLink
+ ID of the entity instance in the From direction.
+ =item toLink
+ ID of the entity instance in the To direction.
+ =item values
+ Reference to a hash of other values to be used for filtering the delete.
+ =back
+ =cut
+ sub DeleteRow {
+     # Get the parameters.
+     my ($self, $relationshipName, $fromLink, $toLink, $values) = @_;
+     # Create a hash of all the filter information.
+     my %filter = ('from-link' => $fromLink, 'to-link' => $toLink);
+     if (defined $values) {
+         for my $key (keys %{$values}) {
+             $filter{$key} = $values->{$key};
+         }
+     }
+     # Build an SQL statement out of the hash.
+     my @filters = ();
+     my @parms = ();
+     for my $key (keys %filter) {
+         push @filters, _FixName($key) . " = ?";
+         push @parms, $filter{$key};
+     }
+     Trace("Parms for delete row are " . join(", ", map { "\"$_\"" } @parms) . ".") if T(SQL => 4);
+     my $command = "DELETE FROM $relationshipName WHERE " .
+                   join(" AND ", @filters);
+     # Execute it.
+     my $dbh = $self->{_dbh};
+     $dbh->SQL($command, undef, @parms);
+ }
+ =head3 DeleteLike
+ C<< my $deleteCount = $erdb->DeleteLike($relName, $filter, \@parms); >>
+ Delete all the relationship rows that satisfy a particular filter condition. Unlike a normal
+ filter, only fields from the relationship itself can be used.
+ =over 4
+ =item relName
+ Name of the relationship whose records are to be deleted.
+ =item filter
+ A filter clause (L</Get>-style) for the delete query.
+ =item parms
+ Reference to a list of parameters for the filter clause.
+ =item RETURN
+ Returns a count of the number of rows deleted.
+ =back
+ =cut
+ sub DeleteLike {
+     # Get the parameters.
+     my ($self, $objectName, $filter, $parms) = @_;
+     # Declare the return variable.
+     my $retVal;
+     # Insure the parms argument is an array reference if the caller left it off.
+     if (! defined($parms)) {
+         $parms = [];
+     }
+     # Insure we have a relationship. The main reason for this is if we delete an entity
+     # instance we have to yank out a bunch of other stuff with it.
+     if ($self->IsEntity($objectName)) {
+         Confess("Cannot use DeleteLike on $objectName, because it is not a relationship.");
+     } else {
+         # Create the SQL command suffix to get the desierd records.
+         my ($suffix) = $self->_SetupSQL([$objectName], $filter);
+         # Convert it to a DELETE command.
+         my $command = "DELETE $suffix";
+         # Execute the command.
+         my $dbh = $self->{_dbh};
+         my $result = $dbh->SQL($command, 0, @{$parms});
+         # Check the results. Note we convert the "0D0" result to a real zero.
+         # A failure causes an abnormal termination, so the caller isn't going to
+         # worry about it.
+         if (! defined $result) {
+             Confess("Error deleting from $objectName: " . $dbh->errstr());
+         } elsif ($result == 0) {
+             $retVal = 0;
+         } else {
+             $retVal = $result;
+         }
+     }
+     # Return the result count.
+     return $retVal;
+ }
  =head3 SortNeeded
  C<< my $parms = $erdb->SortNeeded($relationName); >>
-Line 1919
+Line 2271
  =item RETURN
- Returns a list of B<DBObject>s that satisfy the query conditions.
+ Returns a list of B<ERDBObject>s that satisfy the query conditions.
  =back
-Line 2175
+Line 2527
  =head3 InsertObject
- C<< my $ok = $erdb->InsertObject($objectType, \%fieldHash); >>
+ C<< $erdb->InsertObject($objectType, \%fieldHash); >>
  Insert an object into the database. The object is defined by a type name and then a hash
  of field names to values. Field values in the primary relation are represented by scalars.
-Line 2201
+Line 2553
  Hash of field names to values.
- =item RETURN
- Returns 1 if successful, 0 if an error occurred.
  =back
  =cut
-Line 2303
+Line 2651
                  $retVal = $sth->execute(@parameterList);
                  if (!$retVal) {
                      my $errorString = $sth->errstr();
-                     Trace("Insert error: $errorString.") if T(0);
+                     Confess("Error inserting into $relationName: $errorString");
+                 } else {
+                     Trace("Insert successful using $parameterList[0].") if T(3);
                  }
              }
          }
      }
-     # Return the success indicator.
+     # Return a 1 for backward compatability.
-     return $retVal;
+     return 1;
+ }
+ =head3 UpdateEntity
+ C<< $erdb->UpdateEntity($entityName, $id, \%fields); >>
+ Update the values of an entity. This is an unprotected update, so it should only be
+ done if the database resides on a database server.
+ =over 4
+ =item entityName
+ Name of the entity to update. (This is the entity type.)
+ =item id
+ ID of the entity to update. If no entity exists with this ID, an error will be thrown.
+ =item fields
+ Reference to a hash mapping field names to their new values. All of the fields named
+ must be in the entity's primary relation, and they cannot any of them be the ID field.
+ =back
+ =cut
+ sub UpdateEntity {
+     # Get the parameters.
+     my ($self, $entityName, $id, $fields) = @_;
+     # Get a list of the field names being updated.
+     my @fieldList = keys %{$fields};
+     # Verify that the fields exist.
+     my $checker = $self->GetFieldTable($entityName);
+     for my $field (@fieldList) {
+         if ($field eq 'id') {
+             Confess("Cannot update the ID field for entity $entityName.");
+         } elsif ($checker->{$field}->{relation} ne $entityName) {
+             Confess("Cannot find $field in primary relation of $entityName.");
+         }
+     }
+     # Build the SQL statement.
+     my @sets = ();
+     my @valueList = ();
+     for my $field (@fieldList) {
+         push @sets, _FixName($field) . " = ?";
+         push @valueList, $fields->{$field};
+     }
+     my $command = "UPDATE $entityName SET " . join(", ", @sets) . " WHERE id = ?";
+     # Add the ID to the list of binding values.
+     push @valueList, $id;
+     # Call SQL to do the work.
+     my $rows = $self->{_dbh}->SQL($command, 0, @valueList);
+     # Check for errors.
+     if ($rows == 0) {
+         Confess("Entity $id of type $entityName not found.");
+     }
  }
  =head3 LoadTable
- C<< my %results = $erdb->LoadTable($fileName, $relationName, $truncateFlag); >>
+ C<< my $results = $erdb->LoadTable($fileName, $relationName, $truncateFlag); >>
  Load data from a tab-delimited file into a specified table, optionally re-creating the table
  first.
-Line 2361
+Line 2769
          # leave extra room. We postulate a minimum row count of 1000 to
          # prevent problems with incoming empty load files.
          my $rowSize = $self->EstimateRowSize($relationName);
-         my $estimate = FIG::max($fileSize * 1.5 / $rowSize, 1000);
+         my $estimate = $fileSize * 1.5 / $rowSize;
+         if ($estimate < 1000) {
+             $estimate = 1000;
+         }
          # Re-create the table without its index.
          $self->CreateTable($relationName, 0, $estimate);
          # If this is a pre-index DBMS, create the index here.
-Line 2403
+Line 2814
              # The full-text index (if any) is always built last, even for MySQL.
              # First we need to see if this table has a full-text index. Only
              # primary relations are allowed that privilege.
+             Trace("Checking for full-text index on $relationName.") if T(2);
              if ($self->_IsPrimary($relationName)) {
-                 # Get the relation's entity/relationship structure.
+                 $self->CreateSearchIndex($relationName);
-                 my $structure = $self->_GetStructure($relationName);
-                 # Check for a searchable fields list.
-                 if (exists $structure->{searchFields}) {
-                     # Here we know that we need to create a full-text search index.
-                     # Get an SQL-formatted field name list.
-                     my $fields = join(", ", $self->_FixNames(@{$structure->{searchFields}}));
-                     # Create the index.
-                     $dbh->create_index(tbl => $relationName, idx => "search_idx",
-                                        flds => $fields, kind => 'fulltext');
-                 }
              }
          }
      }
-Line 2426
+Line 2828
      return $retVal;
  }
+ =head3 CreateSearchIndex
+ C<< $erdb->CreateSearchIndex($objectName); >>
+ Check for a full-text search index on the specified entity or relationship object, and
+ if one is required, rebuild it.
+ =over 4
+ =item objectName
+ Name of the entity or relationship to be indexed.
+ =back
+ =cut
+ sub CreateSearchIndex {
+     # Get the parameters.
+     my ($self, $objectName) = @_;
+     # Get the relation's entity/relationship structure.
+     my $structure = $self->_GetStructure($objectName);
+     # Get the database handle.
+     my $dbh = $self->{_dbh};
+     Trace("Checking for search fields in $objectName.") if T(3);
+     # Check for a searchable fields list.
+     if (exists $structure->{searchFields}) {
+         # Here we know that we need to create a full-text search index.
+         # Get an SQL-formatted field name list.
+         my $fields = join(", ", _FixNames(@{$structure->{searchFields}}));
+         # Create the index. If it already exists, it will be dropped.
+         $dbh->create_index(tbl => $objectName, idx => "search_idx",
+                            flds => $fields, kind => 'fulltext');
+         Trace("Index created for $fields in $objectName.") if T(2);
+     }
+ }
  =head3 DropRelation
  C<< $erdb->DropRelation($relationName); >>
-Line 2454
+Line 2893
      $dbh->drop_table(tbl => $relationName);
  }
+ =head3 MatchSqlPattern
+ C<< my $matched = ERDB::MatchSqlPattern($value, $pattern); >>
+ Determine whether or not a specified value matches an SQL pattern. An SQL
+ pattern has two wild card characters: C<%> that matches multiple characters,
+ and C<_> that matches a single character. These can be escaped using a
+ backslash (C<\>). We pull this off by converting the SQL pattern to a
+ PERL regular expression. As per SQL rules, the match is case-insensitive.
+ =over 4
+ =item value
+ Value to be matched against the pattern. Note that an undefined or empty
+ value will not match anything.
+ =item pattern
+ SQL pattern against which to match the value. An undefined or empty pattern will
+ match everything.
+ =item RETURN
+ Returns TRUE if the value and pattern match, else FALSE.
+ =back
+ =cut
+ sub MatchSqlPattern {
+     # Get the parameters.
+     my ($value, $pattern) = @_;
+     # Declare the return variable.
+     my $retVal;
+     # Insure we have a pattern.
+     if (! defined($pattern) || $pattern eq "") {
+         $retVal = 1;
+     } else {
+         # Break the pattern into pieces around the wildcard characters. Because we
+         # use parentheses in the split function's delimiter expression, we'll get
+         # list elements for the delimiters as well as the rest of the string.
+         my @pieces = split /([_%]|\\[_%])/, $pattern;
+         # Check some fast special cases.
+         if ($pattern eq '%') {
+             # A null pattern matches everything.
+             $retVal = 1;
+         } elsif (@pieces == 1) {
+             # No wildcards, so we have a literal comparison. Note we're case-insensitive.
+             $retVal = (lc($value) eq lc($pattern));
+         } elsif (@pieces == 2 && $pieces[1] eq '%') {
+             # A wildcard at the end, so we have a substring match. This is also case-insensitive.
+             $retVal = (lc(substr($value, 0, length($pieces[0]))) eq lc($pieces[0]));
+         } else {
+             # Okay, we have to do it the hard way. Convert each piece to a PERL pattern.
+             my $realPattern = "";
+             for my $piece (@pieces) {
+                 # Determine the type of piece.
+                 if ($piece eq "") {
+                     # Empty pieces are ignored.
+                 } elsif ($piece eq "%") {
+                     # Here we have a multi-character wildcard. Note that it can match
+                     # zero or more characters.
+                     $realPattern .= ".*"
+                 } elsif ($piece eq "_") {
+                     # Here we have a single-character wildcard.
+                     $realPattern .= ".";
+                 } elsif ($piece eq "\\%" || $piece eq "\\_") {
+                     # This is an escape sequence (which is a rare thing, actually).
+                     $realPattern .= substr($piece, 1, 1);
+                 } else {
+                     # Here we have raw text.
+                     $realPattern .= quotemeta($piece);
+                 }
+             }
+             # Do the match.
+             $retVal = ($value =~ /^$realPattern$/i ? 1 : 0);
+         }
+     }
+     # Return the result.
+     return $retVal;
+ }
  =head3 GetEntity
  C<< my $entityObject = $erdb->GetEntity($entityType, $ID); >>
-Line 2472
+Line 2994
  =item RETURN
- Returns a B<DBObject> representing the desired entity instance, or an undefined value if no
+ Returns a B<ERDBObject> representing the desired entity instance, or an undefined value if no
  instance is found with the specified key.
  =back
-Line 2605
+Line 3127
  fields specified returns multiple values, they are flattened in with the rest. For
  example, the following call will return a list of the features in a particular
  spreadsheet cell, and each feature will be represented by a list containing the
- feature ID followed by all of its aliases.
+ feature ID followed by all of its essentiality determinations.
- 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(essential)']); >>
  =over 4
-Line 2861
+Line 3383
      # Declare the return variable. The field name is valid until we hear
      # differently.
      my $retVal = 1;
+     # Compute the maximum name length.
+     my $maxLen = $TypeTable{'name-string'}->{maxLen};
      # Look for bad stuff in the name.
      if ($fieldName =~ /--/) {
          # Here we have a doubled minus sign.
-Line 2870
+Line 3394
          # Here the field name is missing the initial letter.
          Trace("Field name $fieldName does not begin with a letter.") if T(1);
          $retVal = 0;
+     } elsif (length($fieldName) > $maxLen) {
+         # Here the field name is too long.
+         Trace("Maximum field name length is $maxLen. Field name must be truncated to " . substr($fieldName,0, $maxLen) . ".");
      } else {
          # Strip out the minus signs. Everything remaining must be a letter,
          # underscore, or digit.
-Line 3024
+Line 3551
      # Substitute the bulletin board codes.
      $retVal =~ s!\[(/?[bi])\]!<$1>!g;
      $retVal =~ s!\[p\]!</p><p>!g;
+     $retVal =~ s!\[link\s+([^\]]+)\]!<a href="$1">!g;
+     $retVal =~ s!\[/link\]!</a>!g;
+     # Return the result.
+     return $retVal;
+ }
+ =head3 BeginTran
+ C<< $erdb->BeginTran(); >>
+ Start a database transaction.
+ =cut
+ sub BeginTran {
+     my ($self) = @_;
+     $self->{_dbh}->begin_tran();
+ }
+ =head3 CommitTran
+ C<< $erdb->CommitTran(); >>
+ Commit an active database transaction.
+ =cut
+ sub CommitTran {
+     my ($self) = @_;
+     $self->{_dbh}->commit_tran();
+ }
+ =head3 RollbackTran
+ C<< $erdb->RollbackTran(); >>
+ Roll back an active database transaction.
+ =cut
+ sub RollbackTran {
+     my ($self) = @_;
+     $self->{_dbh}->roll_tran();
+ }
+ =head3 UpdateField
+ C<< my $count = $erdb->UpdateField($objectNames, $fieldName, $oldValue, $newValue, $filter, $parms); >>
+ Update all occurrences of a specific field value to a new value. The number of rows changed will be
+ returned.
+ =over 4
+ =item fieldName
+ Name of the field in standard I<objectName>C<(>I<fieldName>C<)> format.
+ =item oldValue
+ Value to be modified. All occurrences of this value in the named field will be replaced by the
+ new value.
+ =item newValue
+ New value to be substituted for the old value when it's found.
+ =item filter
+ A standard ERDB filter clause (see L</Get>). The filter will be applied before any substitutions take place.
+ =item parms
+ Reference to a list of parameter values in the filter.
+ =item RETURN
+ Returns the number of rows modified.
+ =back
+ =cut
+ sub UpdateField {
+     # Get the parameters.
+     my ($self, $fieldName, $oldValue, $newValue, $filter, $parms) = @_;
+     # Get the object and field names from the field name parameter.
+     $fieldName =~ /^([^(]+)\(([^)]+)\)/;
+     my $objectName = $1;
+     my $realFieldName = _FixName($2);
+     # Add the old value to the filter. Note we allow the possibility that no
+     # filter was specified.
+     my $realFilter = "$fieldName = ?";
+     if ($filter) {
+         $realFilter .= " AND $filter";
+     }
+     # Format the query filter.
+     my ($suffix, $mappedNameListRef, $mappedNameHashRef) =
+         $self->_SetupSQL([$objectName], $realFilter);
+     # Create the query. Since there is only one object name, the mapped-name data is not
+     # necessary. Neither is the FROM clause.
+     $suffix =~ s/^FROM.+WHERE\s+//;
+     # Create the update statement.
+     my $command = "UPDATE $objectName SET $realFieldName = ? WHERE $suffix";
+     # Get the database handle.
+     my $dbh = $self->{_dbh};
+     # Add the old and new values to the parameter list. Note we allow the possibility that
+     # there are no user-supplied parameters.
+     my @params = ($newValue, $oldValue);
+     if (defined $parms) {
+         push @params, @{$parms};
+     }
+     # Execute the update.
+     my $retVal = $dbh->SQL($command, 0, @params);
+     # Make the funky zero a real zero.
+     if ($retVal == 0) {
+         $retVal = 0;
+     }
      # Return the result.
      return $retVal;
  }
-Line 3184
+Line 3830
  =head2 Virtual Methods
+ =head3 _CreatePPOIndex
+ C<< my $index = ERDB::_CreatePPOIndex($indexObject); >>
+ Convert the XML for an ERDB index to the XML structure for a PPO
+ index.
+ =over 4
+ ERDB XML structure for an index.
+ =item RETURN
+ PPO XML structure for the same index.
+ =back
+ =cut
+ sub _CreatePPOIndex {
+     # Get the parameters.
+     my ($indexObject) = @_;
+     # The incoming index contains a list of the index fields in the IndexFields
+     # member. We loop through it to create the index tags.
+     my @fields = map { { label => _FixName($_->{name}) } } @{$indexObject->{IndexFields}};
+     # Wrap the fields in attribute tags.
+     my $retVal = { attribute => \@fields };
+     # Return the result.
+     return $retVal;
+ }
+ =head3 _CreatePPOField
+ C<< my $fieldXML = ERDB::_CreatePPOField($fieldName, $fieldObject); >>
+ Convert the ERDB XML structure for a field to a PPO scalar XML structure.
+ =over 4
+ =item fieldName
+ Name of the scalar field.
+ =item fieldObject
+ ERDB XML structure describing the field.
+ =item RETURN
+ Returns a PPO XML structure for the same field.
+ =back
+ =cut
+ sub _CreatePPOField {
+     # Get the parameters.
+     my ($fieldName, $fieldObject) = @_;
+     # Get the field type.
+     my $type = $TypeTable{$fieldObject->{type}}->{sqlType};
+     # Fix up the field name.
+     $fieldName = _FixName($fieldName);
+     # Build the scalar tag.
+     my $retVal = { label => $fieldName, type => $type };
+     # Return the result.
+     return $retVal;
+ }
  =head3 CleanKeywords
  C<< my $cleanedString = $erdb->CleanKeywords($searchExpression); >>
-Line 3235
+Line 3949
  C<< my @relationMap = _RelationMap($mappedNameHashRef, $mappedNameListRef); >>
- Create the relation map for an SQL query. The relation map is used by B<DBObject>
+ Create the relation map for an SQL query. The relation map is used by B<ERDBObject>
  to determine how to interpret the results of the query.
  =over 4
-Line 3252
+Line 3966
  =item RETURN
  Returns a list of 2-tuples. Each tuple consists of an object name as used in the
- query followed by the actual name of that object. This enables the B<DBObject> to
+ query followed by the actual name of that object. This enables the B<ERDBObject> to
  determine the order of the tables in the query and which object name belongs to each
  mapped object name. Most of the time these two values are the same; however, if a
  relation occurs twice in the query, the relation name in the field list and WHERE
-Line 3795
+Line 4509
  =head3 _LoadMetaData
+ C<< my $metadata = ERDB::_LoadMetaData($filename); >>
  This method loads the data describing this database from an XML file into a metadata structure.
  The resulting structure is a set of nested hash tables containing all the information needed to
  load or use the database. The schema for the XML file is F<ERDatabase.xml>.
-Line 3944
+Line 4660
              if ($found == 0) {
                  push @{$indexList}, { IndexFields => [ {name => 'id', order => 'ascending'} ] };
              }
-             # Now we need to convert the relation's index list to an index table. We begin by creating
+             # Attach all the indexes to the relation.
-             # an empty table in the relation structure.
+             _ProcessIndexes($indexList, $relation);
-             $relation->{Indexes} = { };
-             # Loop through the indexes.
-             my $count = 0;
-             for my $index (@{$indexList}) {
-                 # Add this index to the index table.
-                 _AddIndex("idx$count", $relation, $index);
-                 # Increment the counter so that the next index has a different name.
-                 $count++;
-             }
          }
          # Finally, we add the relation structure to the entity.
          $entityStructure->{Relations} = $relationTable;
-Line 3968
+Line 4675
          _FixupFields($relationshipStructure, $relationshipName, 2, 3);
          # Format a description for the FROM field.
          my $fromEntity = $relationshipStructure->{from};
-         my $fromComment = "<b>id</b> of the source <b><a href=\"#$fromEntity\">$fromEntity</a></b>.";
+         my $fromComment = "[b]id[/b] of the source [b][link #$fromEntity]$fromEntity\[/link][/b].";
          # Get the FROM entity's key type.
          my $fromType = $entityList->{$fromEntity}->{keyType};
          # Add the FROM field.
-Line 3978
+Line 4685
                                                      PrettySort => 1});
          # Format a description for the TO field.
          my $toEntity = $relationshipStructure->{to};
-         my $toComment = "<b>id</b> of the target <b><a href=\"#$toEntity\">$toEntity</a></b>.";
+         my $toComment = "[b]id[/b] of the target [b][link #$toEntity]$toEntity\[/link][/b].";
          # Get the TO entity's key type.
          my $toType = $entityList->{$toEntity}->{keyType};
          # Add the TO field.
-Line 3990
+Line 4697
          my $thisRelation = { Fields => _ReOrderRelationTable($relationshipStructure->{Fields}),
                               Indexes => { } };
          $relationshipStructure->{Relations} = { $relationshipName => $thisRelation };
+         # Add the alternate indexes (if any). This MUST be done before the FROM and
+         # TO indexes, because it erases the relation's index list.
+         if (exists $relationshipStructure->{Indexes}) {
+             _ProcessIndexes($relationshipStructure->{Indexes}, $thisRelation);
+         }
+         # Add the relation to the master table.
          # Create the FROM and TO indexes.
          _CreateRelationshipIndex("From", $relationshipName, $relationshipStructure);
          _CreateRelationshipIndex("To", $relationshipName, $relationshipStructure);
-         # Add the relation to the master table.
          $masterRelationTable{$relationshipName} = $thisRelation;
      }
      # Now store the master relation table in the metadata structure.
-Line 4152
+Line 4865
      _AddIndex("idx$indexKey", $relationStructure, $newIndex);
  }
+ =head3 _ProcessIndexes
+ C<< ERDB::_ProcessIndexes($indexList, $relation); >>
+ Build the data structures for the specified indexes in the specified relation.
+ =over 4
+ =item indexList
+ Reference to a list of indexes. Each index is a hash reference containing an optional
+ C<Notes> value that describes the index and an C<IndexFields> value that is a reference
+ to a list of index field structures. An index field structure, in turn, is a reference
+ to a hash that contains a C<name> attribute for the field name and an C<order>
+ attribute that specifies either C<ascending> or C<descending>. In this sense the
+ index list encapsulates the XML C<Indexes> structure in the database definition.
+ =item relation
+ The structure that describes the current relation. The new index descriptors will
+ be stored in the structure's C<Indexes> member. Any previous data in the structure
+ will be lost.
+ =back
+ =cut
+ sub _ProcessIndexes {
+     # Get the parameters.
+     my ($indexList, $relation) = @_;
+     # Now we need to convert the relation's index list to an index table. We begin by creating
+     # an empty table in the relation structure.
+     $relation->{Indexes} = { };
+     # Loop through the indexes.
+     my $count = 0;
+     for my $index (@{$indexList}) {
+         # Add this index to the index table.
+         _AddIndex("idx$count", $relation, $index);
+         # Increment the counter so that the next index has a different name.
+         $count++;
+     }
+ }
  =head3 _AddIndex
  Add an index to a relation structure.
-Line 4681
+Line 5437
      # Compute the number of columns.
      my $colCount = @colNames;
      # Generate the title row.
-     my $htmlString = "<p><table border=\"2\"><tr><td colspan=\"$colCount\" align=\"center\">$tablename</td></tr>\n";
+     my $htmlString = "<table border=\"2\"><tr><td colspan=\"$colCount\" align=\"center\">$tablename</td></tr>\n";
      # Loop through the columns, adding the column header rows.
      $htmlString .= "<tr>";
      for my $colName (@colNames) {
-Line 4700
+Line 5456
  =cut
  sub _CloseTable {
-     return "</table></p>\n";
+     return "</table>\n";
  }
  =head3 _ShowField

 Legend:



Removed from v.1.77
 


changed lines


 
Added in v.1.92
 Legend:



Removed from v.1.77
 


changed lines


 
Added in v.1.92
-Removed from v.1.77
+Added in v.1.92

MCS Webmaster	ViewVC Help
Powered by ViewVC 1.0.3