[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.11, Thu Jun 23 21:24:49 2005 UTC revision 1.32, Sat Jan 28 08:58:53 2006 UTC
# Line 2  Line 2 
2    
3      use strict;      use strict;
4      use Tracer;      use Tracer;
5      use DBKernel;      use DBrtns;
6      use Data::Dumper;      use Data::Dumper;
7      use XML::Simple;      use XML::Simple;
8      use DBQuery;      use DBQuery;
9      use DBObject;      use DBObject;
10      use Stats;      use Stats;
11      use Time::HiRes qw(gettimeofday);      use Time::HiRes qw(gettimeofday);
12        use FIG;
13    
14  =head1 Entity-Relationship Database Package  =head1 Entity-Relationship Database Package
15    
# Line 300  Line 301 
301  # 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.
302  # "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
303  # of the specified type. "dataGen" is PERL string that will be evaluated if no test data generation  # of the specified type. "dataGen" is PERL string that will be evaluated if no test data generation
304   #string is specified in the field definition.  # string is specified in the field definition. "avgLen" is the average byte length for estimating
305  my %TypeTable = ( char =>    { sqlType => 'CHAR(1)',            maxLen => 1,            dataGen => "StringGen('A')" },  # record sizes.
306                    int =>     { sqlType => 'INTEGER',            maxLen => 20,           dataGen => "IntGen(0, 99999999)" },  my %TypeTable = ( char =>    { sqlType => 'CHAR(1)',            maxLen => 1,            avgLen =>   1, dataGen => "StringGen('A')" },
307                    string =>  { sqlType => 'VARCHAR(255)',       maxLen => 255,          dataGen => "StringGen(IntGen(10,250))" },                    int =>     { sqlType => 'INTEGER',            maxLen => 20,           avgLen =>   4, dataGen => "IntGen(0, 99999999)" },
308                    text =>    { sqlType => 'TEXT',               maxLen => 1000000000,   dataGen => "StringGen(IntGen(80,1000))" },                    string =>  { sqlType => 'VARCHAR(255)',       maxLen => 255,          avgLen => 100, dataGen => "StringGen(IntGen(10,250))" },
309                    date =>    { sqlType => 'BIGINT',             maxLen => 80,           dataGen => "DateGen(-7, 7, IntGen(0,1400))" },                    text =>    { sqlType => 'TEXT',               maxLen => 1000000000,   avgLen => 500, dataGen => "StringGen(IntGen(80,1000))" },
310                    float =>   { sqlType => 'DOUBLE PRECISION',   maxLen => 40,           dataGen => "FloatGen(0.0, 100.0)" },                    date =>    { sqlType => 'BIGINT',             maxLen => 80,           avgLen =>   8, dataGen => "DateGen(-7, 7, IntGen(0,1400))" },
311                    boolean => { sqlType => 'SMALLINT',           maxLen => 1,            dataGen => "IntGen(0, 1)" },                    float =>   { sqlType => 'DOUBLE PRECISION',   maxLen => 40,           avgLen =>   8, dataGen => "FloatGen(0.0, 100.0)" },
312                      boolean => { sqlType => 'SMALLINT',           maxLen => 1,            avgLen =>   1, dataGen => "IntGen(0, 1)" },
313                   'key-string' =>                   'key-string' =>
314                               { sqlType => 'VARCHAR(40)',        maxLen => 40,           dataGen => "StringGen(IntGen(10,40))" },                               { sqlType => 'VARCHAR(40)',        maxLen => 40,           avgLen =>  10, dataGen => "StringGen(IntGen(10,40))" },
315                   'name-string' =>                   'name-string' =>
316                               { sqlType => 'VARCHAR(80)',        maxLen => 80,           dataGen => "StringGen(IntGen(10,80))" },                               { sqlType => 'VARCHAR(80)',        maxLen => 80,           avgLen =>  40, dataGen => "StringGen(IntGen(10,80))" },
317                   'medium-string' =>                   'medium-string' =>
318                               { sqlType => 'VARCHAR(160)',       maxLen => 160,          dataGen => "StringGen(IntGen(10,160))" },                               { sqlType => 'VARCHAR(160)',       maxLen => 160,          avgLen =>  40, dataGen => "StringGen(IntGen(10,160))" },
319                  );                  );
320    
321  # Table translating arities into natural language.  # Table translating arities into natural language.
# Line 369  Line 371 
371    
372  =head3 ShowMetaData  =head3 ShowMetaData
373    
374  C<< $database->ShowMetaData($fileName); >>  C<< $erdb->ShowMetaData($fileName); >>
375    
376  This method outputs a description of the database. This description can be used to help users create  This method outputs a description of the database. This description can be used to help users create
377  the data to be loaded into the relations.  the data to be loaded into the relations.
# Line 506  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 524  Line 526 
526    
527  =head3 DumpMetaData  =head3 DumpMetaData
528    
529  C<< $database->DumpMetaData(); >>  C<< $erdb->DumpMetaData(); >>
530    
531  Return a dump of the metadata structure.  Return a dump of the metadata structure.
532    
# Line 539  Line 541 
541    
542  =head3 CreateTables  =head3 CreateTables
543    
544  C<< $datanase->CreateTables(); >>  C<< $erdb->CreateTables(); >>
545    
546  This method creates the tables for the database from the metadata structure loaded by the  This method creates the tables for the database from the metadata structure loaded by the
547  constructor. It is expected this function will only be used on rare occasions, when the  constructor. It is expected this function will only be used on rare occasions, when the
# Line 551  Line 553 
553  sub CreateTables {  sub CreateTables {
554      # Get the parameters.      # Get the parameters.
555      my ($self) = @_;      my ($self) = @_;
556      my $metadata = $self->{_metaData};      # Get the relation names.
557      my $dbh = $self->{_dbh};      my @relNames = $self->GetTableNames();
558      # Loop through the entities.      # Loop through the relations.
559      my $entityHash = $metadata->{Entities};      for my $relationName (@relNames) {
     for my $entityName (keys %{$entityHash}) {  
         my $entityData = $entityHash->{$entityName};  
         # Tell the user what we're doing.  
         Trace("Creating relations for entity $entityName.") if T(1);  
         # Loop through the entity's relations.  
         for my $relationName (keys %{$entityData->{Relations}}) {  
560              # Create a table for this relation.              # Create a table for this relation.
561              $self->CreateTable($relationName);              $self->CreateTable($relationName);
562              Trace("Relation $relationName created.") if T(1);          Trace("Relation $relationName created.") if T(2);
         }  
     }  
     # Loop through the relationships.  
     my $relationshipTable = $metadata->{Relationships};  
     for my $relationshipName (keys %{$metadata->{Relationships}}) {  
         # Create a table for this relationship.  
         Trace("Creating relationship $relationshipName.") if T(1);  
         $self->CreateTable($relationshipName);  
563      }      }
564  }  }
565    
566  =head3 CreateTable  =head3 CreateTable
567    
568  C<< $database->CreateTable($tableName, $indexFlag); >>  C<< $erdb->CreateTable($tableName, $indexFlag, $estimatedRows); >>
569    
570  Create the table for a relation and optionally create its indexes.  Create the table for a relation and optionally create its indexes.
571    
# Line 587  Line 575 
575    
576  Name of the relation (which will also be the table name).  Name of the relation (which will also be the table name).
577    
578  =item $indexFlag  =item indexFlag
579    
580  TRUE if the indexes for the relation should be created, else FALSE. If FALSE,  TRUE if the indexes for the relation should be created, else FALSE. If FALSE,
581  L</CreateIndexes> must be called later to bring the indexes into existence.  L</CreateIndexes> must be called later to bring the indexes into existence.
582    
583    =item estimatedRows (optional)
584    
585    If specified, the estimated maximum number of rows for the relation. This
586    information allows the creation of tables using storage engines that are
587    faster but require size estimates, such as MyISAM.
588    
589  =back  =back
590    
591  =cut  =cut
592    
593  sub CreateTable {  sub CreateTable {
594      # Get the parameters.      # Get the parameters.
595      my ($self, $relationName, $indexFlag) = @_;      my ($self, $relationName, $indexFlag, $estimatedRows) = @_;
596      # Get the database handle.      # Get the database handle.
597      my $dbh = $self->{_dbh};      my $dbh = $self->{_dbh};
598      # Get the relation data and determine whether or not the relation is primary.      # Get the relation data and determine whether or not the relation is primary.
# Line 622  Line 616 
616      # Insure the table is not already there.      # Insure the table is not already there.
617      $dbh->drop_table(tbl => $relationName);      $dbh->drop_table(tbl => $relationName);
618      Trace("Table $relationName dropped.") if T(2);      Trace("Table $relationName dropped.") if T(2);
619        # If there are estimated rows, create an estimate so we can take advantage of
620        # faster DB technologies.
621        my $estimation = undef;
622        if ($estimatedRows) {
623            $estimation = [$self->EstimateRowSize($relationName), $estimatedRows];
624        }
625      # Create the table.      # Create the table.
626      Trace("Creating table $relationName: $fieldThing") if T(2);      Trace("Creating table $relationName: $fieldThing") if T(2);
627      $dbh->create_table(tbl => $relationName, flds => $fieldThing);      $dbh->create_table(tbl => $relationName, flds => $fieldThing, estimates => $estimation);
628      Trace("Relation $relationName created in database.") if T(2);      Trace("Relation $relationName created in database.") if T(2);
629      # If we want to build the indexes, we do it here.      # If we want to build the indexes, we do it here.
630      if ($indexFlag) {      if ($indexFlag) {
# 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<< $database->CreateIndex($relationName); >>  C<< $erdb->CreateIndex($relationName); >>
693    
694  Create the indexes for a relation. If a table is being loaded from a large source file (as  Create the indexes for a relation. If a table is being loaded from a large source file (as
695  is the case in L</LoadTable>), it is best to create the indexes after the load. If that is  is the case in L</LoadTable>), it is sometimes best to create the indexes after the load.
696  the case, then L</CreateTable> should be called with the index flag set to FALSE, and this  If that is the case, then L</CreateTable> should be called with the index flag set to
697  method used after the load to create the indexes for the table.  FALSE, and this method used after the load to create the indexes for the table.
698    
699  =cut  =cut
700    
# Line 660  Line 715 
715          # Get the index's uniqueness flag.          # Get the index's uniqueness flag.
716          my $unique = (exists $indexData->{Unique} ? $indexData->{Unique} : 'false');          my $unique = (exists $indexData->{Unique} ? $indexData->{Unique} : 'false');
717          # Create the index.          # Create the index.
718          $dbh->create_index(idx => $indexName, tbl => $relationName, flds => $flds, unique => $unique);          my $rv = $dbh->create_index(idx => $indexName, tbl => $relationName,
719                                        flds => $flds, unique => $unique);
720            if ($rv) {
721          Trace("Index created: $indexName for $relationName ($flds)") if T(1);          Trace("Index created: $indexName for $relationName ($flds)") if T(1);
722            } else {
723                Confess("Error creating index $indexName for $relationName using ($flds): " . $dbh->error_message());
724            }
725      }      }
726  }  }
727    
728  =head3 LoadTables  =head3 LoadTables
729    
730  C<< my $stats = $database->LoadTables($directoryName, $rebuild); >>  C<< my $stats = $erdb->LoadTables($directoryName, $rebuild); >>
731    
732  This method will load the database tables from a directory. The tables must already have been created  This method will load the database tables from a directory. The tables must already have been created
733  in the database. (This can be done by calling L</CreateTables>.) The caller passes in a directory name;  in the database. (This can be done by calling L</CreateTables>.) The caller passes in a directory name;
# Line 710  Line 770 
770      $directoryName =~ s!/\\$!!;      $directoryName =~ s!/\\$!!;
771      # Declare the return variable.      # Declare the return variable.
772      my $retVal = Stats->new();      my $retVal = Stats->new();
773      # Get the metadata structure.      # Get the relation names.
774      my $metaData = $self->{_metaData};      my @relNames = $self->GetTableNames();
775      # Loop through the entities.      for my $relationName (@relNames) {
     for my $entity (values %{$metaData->{Entities}}) {  
         # Loop through the entity's relations.  
         for my $relationName (keys %{$entity->{Relations}}) {  
776              # Try to load this relation.              # Try to load this relation.
777              my $result = $self->_LoadRelation($directoryName, $relationName, $rebuild);              my $result = $self->_LoadRelation($directoryName, $relationName, $rebuild);
778              # Accumulate the statistics.              # Accumulate the statistics.
779              $retVal->Accumulate($result);              $retVal->Accumulate($result);
780          }          }
     }  
     # Loop through the relationships.  
     for my $relationshipName (keys %{$metaData->{Relationships}}) {  
         # Try to load this relationship's relation.  
         my $result = $self->_LoadRelation($directoryName, $relationshipName, $rebuild);  
         # Accumulate the statistics.  
         $retVal->Accumulate($result);  
     }  
781      # Add the duration of the load to the statistical object.      # Add the duration of the load to the statistical object.
782      $retVal->Add('duration', gettimeofday - $startTime);      $retVal->Add('duration', gettimeofday - $startTime);
783      # Return the accumulated statistics.      # Return the accumulated statistics.
784      return $retVal;      return $retVal;
785  }  }
786    
787    
788  =head3 GetTableNames  =head3 GetTableNames
789    
790  C<< my @names = $database->GetTableNames; >>  C<< my @names = $erdb->GetTableNames; >>
791    
792  Return a list of the relations required to implement this database.  Return a list of the relations required to implement this database.
793    
# Line 754  Line 804 
804    
805  =head3 GetEntityTypes  =head3 GetEntityTypes
806    
807  C<< my @names = $database->GetEntityTypes; >>  C<< my @names = $erdb->GetEntityTypes; >>
808    
809  Return a list of the entity type names.  Return a list of the entity type names.
810    
# Line 769  Line 819 
819      return sort keys %{$entityList};      return sort keys %{$entityList};
820  }  }
821    
822    =head3 IsEntity
823    
824    C<< my $flag = $erdb->IsEntity($entityName); >>
825    
826    Return TRUE if the parameter is an entity name, else FALSE.
827    
828    =over 4
829    
830    =item entityName
831    
832    Object name to be tested.
833    
834    =item RETURN
835    
836    Returns TRUE if the specified string is an entity name, else FALSE.
837    
838    =back
839    
840    =cut
841    
842    sub IsEntity {
843        # Get the parameters.
844        my ($self, $entityName) = @_;
845        # Test to see if it's an entity.
846        return exists $self->{_metaData}->{Entities}->{$entityName};
847    }
848    
849  =head3 Get  =head3 Get
850    
851  C<< my $query = $database->Get(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >>  C<< my $query = $erdb->Get(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >>
852    
853  This method returns a query object for entities of a specified type using a specified filter.  This method returns a query object for entities of a specified type using a specified filter.
854  The filter is a standard WHERE/ORDER BY clause with question marks as parameter markers and each  The filter is a standard WHERE/ORDER BY clause with question marks as parameter markers and each
# Line 779  Line 856 
856  following call requests all B<Genome> objects for the genus specified in the variable  following call requests all B<Genome> objects for the genus specified in the variable
857  $genus.  $genus.
858    
859  C<< $query = $sprout->Get(['Genome'], "Genome(genus) = ?", $genus); >>  C<< $query = $erdb->Get(['Genome'], "Genome(genus) = ?", $genus); >>
860    
861  The WHERE clause contains a single question mark, so there is a single additional  The WHERE clause contains a single question mark, so there is a single additional
862  parameter representing the parameter value. It would also be possible to code  parameter representing the parameter value. It would also be possible to code
863    
864  C<< $query = $sprout->Get(['Genome'], "Genome(genus) = \'$genus\'"); >>  C<< $query = $erdb->Get(['Genome'], "Genome(genus) = \'$genus\'"); >>
865    
866  however, this version of the call would generate a syntax error if there were any quote  however, this version of the call would generate a syntax error if there were any quote
867  characters inside the variable C<$genus>.  characters inside the variable C<$genus>.
# Line 796  Line 873 
873  It is possible to specify multiple entity and relationship names in order to retrieve more than  It is possible to specify multiple entity and relationship names in order to retrieve more than
874  one object's data at the same time, which allows highly complex joined queries. For example,  one object's data at the same time, which allows highly complex joined queries. For example,
875    
876  C<< $query = $sprout->Get(['Genome', 'ComesFrom', 'Source'], "Genome(genus) = ?", $genus); >>  C<< $query = $erdb->Get(['Genome', 'ComesFrom', 'Source'], "Genome(genus) = ?", $genus); >>
877    
878  If multiple names are specified, then the query processor will automatically determine a  If multiple names are specified, then the query processor will automatically determine a
879  join path between the entities and relationships. The algorithm used is very simplistic.  join path between the entities and relationships. The algorithm used is very simplistic.
# Line 829  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 937  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 954  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(2);      Trace("SQL query: $command") if T(SQL => 4);
1045      Trace("PARMS: '" . (join "', '", @params) . "'") if (T(3) && (@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 969  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 = $database->GetList(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >>  C<< my @dbObjects = $erdb->GetList(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >>
1224    
1225  Return a list of object descriptors for the specified objects as determined by the  Return a list of object descriptors for the specified objects as determined by the
1226  specified filter clause.  specified filter clause.
# Line 1034  Line 1283 
1283    
1284  =head3 ComputeObjectSentence  =head3 ComputeObjectSentence
1285    
1286  C<< my $sentence = $database->ComputeObjectSentence($objectName); >>  C<< my $sentence = $erdb->ComputeObjectSentence($objectName); >>
1287    
1288  Check an object name, and if it is a relationship convert it to a relationship sentence.  Check an object name, and if it is a relationship convert it to a relationship sentence.
1289    
# Line 1069  Line 1318 
1318    
1319  =head3 DumpRelations  =head3 DumpRelations
1320    
1321  C<< $database->DumpRelations($outputDirectory); >>  C<< $erdb->DumpRelations($outputDirectory); >>
1322    
1323  Write the contents of all the relations to tab-delimited files in the specified directory.  Write the contents of all the relations to tab-delimited files in the specified directory.
1324  Each file will have the same name as the relation dumped, with an extension of DTX.  Each file will have the same name as the relation dumped, with an extension of DTX.
# Line 1111  Line 1360 
1360    
1361  =head3 InsertObject  =head3 InsertObject
1362    
1363  C<< my $ok = $database->InsertObject($objectType, \%fieldHash); >>  C<< my $ok = $erdb->InsertObject($objectType, \%fieldHash); >>
1364    
1365  Insert an object into the database. The object is defined by a type name and then a hash  Insert an object into the database. The object is defined by a type name and then a hash
1366  of field names to values. Field values in the primary relation are represented by scalars.  of field names to values. Field values in the primary relation are represented by scalars.
# Line 1120  Line 1369 
1369  example, the following line inserts an inactive PEG feature named C<fig|188.1.peg.1> with aliases  example, the following line inserts an inactive PEG feature named C<fig|188.1.peg.1> with aliases
1370  C<ZP_00210270.1> and C<gi|46206278>.  C<ZP_00210270.1> and C<gi|46206278>.
1371    
1372  C<< $database->InsertObject('Feature', { id => 'fig|188.1.peg.1', active => 0, feature-type => 'peg', alias => ['ZP_00210270.1', 'gi|46206278']}); >>  C<< $erdb->InsertObject('Feature', { id => 'fig|188.1.peg.1', active => 0, feature-type => 'peg', alias => ['ZP_00210270.1', 'gi|46206278']}); >>
1373    
1374  The next statement inserts a C<HasProperty> relationship between feature C<fig|158879.1.peg.1> and  The next statement inserts a C<HasProperty> relationship between feature C<fig|158879.1.peg.1> and
1375  property C<4> with an evidence URL of C<http://seedu.uchicago.edu/query.cgi?article_id=142>.  property C<4> with an evidence URL of C<http://seedu.uchicago.edu/query.cgi?article_id=142>.
1376    
1377  C<< $database->InsertObject('HasProperty', { 'from-link' => 'fig|158879.1.peg.1', 'to-link' => 4, evidence = 'http://seedu.uchicago.edu/query.cgi?article_id=142'}); >>  C<< $erdb->InsertObject('HasProperty', { 'from-link' => 'fig|158879.1.peg.1', 'to-link' => 4, evidence = 'http://seedu.uchicago.edu/query.cgi?article_id=142'}); >>
1378    
1379  =over 4  =over 4
1380    
# Line 1250  Line 1499 
1499    
1500  =head3 LoadTable  =head3 LoadTable
1501    
1502  C<< my %results = $database->LoadTable($fileName, $relationName, $truncateFlag); >>  C<< my %results = $erdb->LoadTable($fileName, $relationName, $truncateFlag); >>
1503    
1504  Load data from a tab-delimited file into a specified table, optionally re-creating the table  Load data from a tab-delimited file into a specified table, optionally re-creating the table
1505  first.  first.
# Line 1271  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 1286  Line 1534 
1534      Trace("Loading table $relationName from $fileName") if T(2);      Trace("Loading table $relationName from $fileName") if T(2);
1535      # Get the database handle.      # Get the database handle.
1536      my $dbh = $self->{_dbh};      my $dbh = $self->{_dbh};
1537        # Get the input file size.
1538        my $fileSize = -s $fileName;
1539      # Get the relation data.      # Get the relation data.
1540      my $relation = $self->_FindRelation($relationName);      my $relation = $self->_FindRelation($relationName);
1541      # Check the truncation flag.      # Check the truncation flag.
1542      if ($truncateFlag) {      if ($truncateFlag) {
1543          Trace("Creating table $relationName") if T(2);          Trace("Creating table $relationName") if T(2);
1544            # Compute the row count estimate. We take the size of the load file,
1545            # divide it by the estimated row size, and then multiply by 1.5 to
1546            # leave extra room. We postulate a minimum row count of 1000 to
1547            # prevent problems with incoming empty load files.
1548            my $rowSize = $self->EstimateRowSize($relationName);
1549            my $estimate = FIG::max($fileSize * 1.5 / $rowSize, 1000);
1550          # Re-create the table without its index.          # Re-create the table without its index.
1551          $self->CreateTable($relationName, 0);          $self->CreateTable($relationName, 0, $estimate);
1552          # If this is a pre-index DBMS, create the index here.          # If this is a pre-index DBMS, create the index here.
1553          if ($dbh->{_preIndex}) {          if ($dbh->{_preIndex}) {
1554              eval {              eval {
# Line 1303  Line 1559 
1559              }              }
1560          }          }
1561      }      }
     # Determine whether or not this is a primary relation. Primary relations have an extra  
     # field indicating whether or not a given object is new or was loaded from the flat files.  
     my $primary = $self->_IsPrimary($relationName);  
     # Get the number of fields in this relation.  
     my @fieldList = @{$relation->{Fields}};  
     my $fieldCount = @fieldList;  
     # Start a database transaction.  
     $dbh->begin_tran;  
     # Open the relation file. We need to create a cleaned-up copy before loading.  
     open TABLEIN, '<', $fileName;  
     my $tempName = "$fileName.tbl";  
     open TABLEOUT, '>', $tempName;  
     my $inputCount = 0;  
     # Loop through the file.  
     while (<TABLEIN>) {  
         $inputCount++;  
         # Chop off the new-line character.  
         my $record = Tracer::Strip($_);  
         # Only proceed if the record is non-blank.  
         if ($record) {  
             # Escape all the backslashes found in the line.  
             $record =~ s/\\/\\\\/g;  
             # Insure the number of fields is correct.  
             my @fields = split /\t/, $record;  
             while (@fields > $fieldCount) {  
                 my $extraField = $fields[$#fields];  
                 delete $fields[$#fields];  
                 if ($extraField) {  
                     Trace("Nonblank extra field value \"$extraField\" deleted from record $inputCount of $fileName.") if T(1);  
                 }  
             }  
             while (@fields < $fieldCount) {  
                 push @fields, "";  
             }  
             # If this is a primary relation, add a 0 for the new-record flag (indicating that  
             # this record is not new, but part of the original load).  
             if ($primary) {  
                 push @fields, "0";  
             }  
             # Write the record.  
             $record = join "\t", @fields;  
             print TABLEOUT "$record\n";  
             # Count the record written.  
             my $count = $retVal->Add('records');  
             my $len = length $record;  
             Trace("Record $count written with $len characters.") if T(4);  
         } else {  
             # Here we have a blank record.  
             $retVal->Add('skipped');  
         }  
     }  
     # Close the files.  
     close TABLEIN;  
     close TABLEOUT;  
     Trace("Temporary file $tempName created.") if T(2);  
1562      # Load the table.      # Load the table.
1563      my $rv;      my $rv;
1564      eval {      eval {
1565          $rv = $dbh->load_table(file => $tempName, tbl => $relationName);          $rv = $dbh->load_table(file => $fileName, tbl => $relationName);
1566      };      };
1567      if (!defined $rv) {      if (!defined $rv) {
1568          $retVal->AddMessage($@) if ($@);          $retVal->AddMessage($@) if ($@);
1569          $retVal->AddMessage("Table load failed for $relationName using $tempName.");          $retVal->AddMessage("Table load failed for $relationName using $fileName.");
1570          Trace("Table load failed for $relationName.") if T(1);          Trace("Table load failed for $relationName.") if T(1);
1571      } else {      } else {
1572          # Here we successfully loaded the table. Trace the number of records loaded.          # Here we successfully loaded the table.
1573          Trace("$retVal->{records} records read for $relationName.") if T(2);          $retVal->Add("tables");
1574            my $size = -s $fileName;
1575            Trace("$size bytes loaded into $relationName.") if T(2);
1576          # If we're rebuilding, we need to create the table indexes.          # If we're rebuilding, we need to create the table indexes.
1577          if ($truncateFlag && ! $dbh->{_preIndex}) {          if ($truncateFlag && ! $dbh->{_preIndex}) {
1578              eval {              eval {
# Line 1380  Line 1583 
1583              }              }
1584          }          }
1585      }      }
1586      # Commit the database changes.      # Analyze the table to improve performance.
1587      $dbh->commit_tran;      $dbh->vacuum_it($relationName);
     # Delete the temporary file.  
     unlink $tempName;  
1588      # Return the statistics.      # Return the statistics.
1589      return $retVal;      return $retVal;
1590  }  }
1591    
1592  =head3 GenerateEntity  =head3 GenerateEntity
1593    
1594  C<< my $fieldHash = $database->GenerateEntity($id, $type, \%values); >>  C<< my $fieldHash = $erdb->GenerateEntity($id, $type, \%values); >>
1595    
1596  Generate the data for a new entity instance. This method creates a field hash suitable for  Generate the data for a new entity instance. This method creates a field hash suitable for
1597  passing as a parameter to L</InsertObject>. The ID is specified by the callr, but the rest  passing as a parameter to L</InsertObject>. The ID is specified by the callr, but the rest
# Line 1448  Line 1649 
1649    
1650  =head3 GetEntity  =head3 GetEntity
1651    
1652  C<< my $entityObject = $sprout->GetEntity($entityType, $ID); >>  C<< my $entityObject = $erdb->GetEntity($entityType, $ID); >>
1653    
1654  Return an object describing the entity instance with a specified ID.  Return an object describing the entity instance with a specified ID.
1655    
# Line 1484  Line 1685 
1685    
1686  =head3 GetEntityValues  =head3 GetEntityValues
1687    
1688  C<< my @values = GetEntityValues($entityType, $ID, \@fields); >>  C<< my @values = $erdb->GetEntityValues($entityType, $ID, \@fields); >>
1689    
1690  Return a list of values from a specified entity instance.  Return a list of values from a specified entity instance.
1691    
# Line 1527  Line 1728 
1728    
1729  =head3 GetAll  =head3 GetAll
1730    
1731  C<< my @list = $sprout->GetAll(\@objectNames, $filterClause, \@parameters, \@fields, $count); >>  C<< my @list = $erdb->GetAll(\@objectNames, $filterClause, \@parameters, \@fields, $count); >>
1732    
1733  Return a list of values taken from the objects returned by a query. The first three  Return a list of values taken from the objects returned by a query. The first three
1734  parameters correspond to the parameters of the L</Get> method. The final parameter is  parameters correspond to the parameters of the L</Get> method. The final parameter is
# Line 1543  Line 1744 
1744  spreadsheet cell, and each feature will be represented by a list containing the  spreadsheet cell, and each feature will be represented by a list containing the
1745  feature ID followed by all of its aliases.  feature ID followed by all of its aliases.
1746    
1747  C<< $query = $sprout->Get(['ContainsFeature', 'Feature'], "ContainsFeature(from-link) = ?", [$ssCellID], ['Feature(id)', 'Feature(alias)']); >>  C<< $query = $erdb->Get(['ContainsFeature', 'Feature'], "ContainsFeature(from-link) = ?", [$ssCellID], ['Feature(id)', 'Feature(alias)']); >>
1748    
1749  =over 4  =over 4
1750    
# Line 1592  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 1612  Line 1817 
1817      return @retVal;      return @retVal;
1818  }  }
1819    
1820    =head3 EstimateRowSize
1821    
1822    C<< my $rowSize = $erdb->EstimateRowSize($relName); >>
1823    
1824    Estimate the row size of the specified relation. The estimated row size is computed by adding
1825    up the average length for each data type.
1826    
1827    =over 4
1828    
1829    =item relName
1830    
1831    Name of the relation whose estimated row size is desired.
1832    
1833    =item RETURN
1834    
1835    Returns an estimate of the row size for the specified relation.
1836    
1837    =back
1838    
1839    =cut
1840    #: Return Type $;
1841    sub EstimateRowSize {
1842        # Get the parameters.
1843        my ($self, $relName) = @_;
1844        # Declare the return variable.
1845        my $retVal = 0;
1846        # Find the relation descriptor.
1847        my $relation = $self->_FindRelation($relName);
1848        # Get the list of fields.
1849        for my $fieldData (@{$relation->{Fields}}) {
1850            # Get the field type and add its length.
1851            my $fieldLen = $TypeTable{$fieldData->{type}}->{avgLen};
1852            $retVal += $fieldLen;
1853        }
1854        # Return the result.
1855        return $retVal;
1856    }
1857    
1858  =head2 Internal Utility Methods  =head2 Internal Utility Methods
1859    
1860  =head3 GetLoadStats  =head3 GetLoadStats
# Line 1623  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
# Line 1987  Line 2230 
2230  sub _LoadMetaData {  sub _LoadMetaData {
2231      # Get the parameters.      # Get the parameters.
2232      my ($filename) = @_;      my ($filename) = @_;
2233        Trace("Reading Sprout DBD from $filename.") if T(2);
2234      # 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
2235      # get the exact structure we want.      # get the exact structure we want.
2236      my $metadata = XML::Simple::XMLin($filename,      my $metadata = XML::Simple::XMLin($filename,
# Line 2014  Line 2258 
2258      for my $entityName (keys %{$entityList}) {      for my $entityName (keys %{$entityList}) {
2259          my $entityStructure = $entityList->{$entityName};          my $entityStructure = $entityList->{$entityName};
2260          #          #
2261          # The first step is to run creating all the entity's default values. For C<Field> elements,          # The first step is to create all the entity's default values. For C<Field> elements,
2262          # the relation name must be added where it is not specified. For relationships,          # the relation name must be added where it is not specified. For relationships,
2263          # the B<from-link> and B<to-link> fields must be inserted, and for entities an B<id>          # the B<from-link> and B<to-link> fields must be inserted, and for entities an B<id>
2264          # field must be added to each relation. Finally, each field will have a C<PrettySort> attribute          # field must be added to each relation. Finally, each field will have a C<PrettySort> attribute
# Line 2193  Line 2437 
2437          my @fromList = ();          my @fromList = ();
2438          my @toList = ();          my @toList = ();
2439          my @bothList = ();          my @bothList = ();
2440          Trace("Join table build for $entityName.") if T(3);          Trace("Join table build for $entityName.") if T(metadata => 4);
2441          for my $relationshipName (keys %{$relationshipList}) {          for my $relationshipName (keys %{$relationshipList}) {
2442              my $relationship = $relationshipList->{$relationshipName};              my $relationship = $relationshipList->{$relationshipName};
2443              # Determine if this relationship has our entity in one of its link fields.              # Determine if this relationship has our entity in one of its link fields.
2444              my $fromEntity = $relationship->{from};              my $fromEntity = $relationship->{from};
2445              my $toEntity = $relationship->{to};              my $toEntity = $relationship->{to};
2446              Trace("Join check for relationship $relationshipName from $fromEntity to $toEntity.") if T(3);              Trace("Join check for relationship $relationshipName from $fromEntity to $toEntity.") if T(4);
2447              if ($fromEntity eq $entityName) {              if ($fromEntity eq $entityName) {
2448                  if ($toEntity eq $entityName) {                  if ($toEntity eq $entityName) {
2449                      # Here the relationship is recursive.                      # Here the relationship is recursive.
2450                      push @bothList, $relationshipName;                      push @bothList, $relationshipName;
2451                      Trace("Relationship $relationshipName put in both-list.") if T(3);                      Trace("Relationship $relationshipName put in both-list.") if T(metadata => 4);
2452                  } else {                  } else {
2453                      # Here the relationship comes from the entity.                      # Here the relationship comes from the entity.
2454                      push @fromList, $relationshipName;                      push @fromList, $relationshipName;
2455                      Trace("Relationship $relationshipName put in from-list.") if T(3);                      Trace("Relationship $relationshipName put in from-list.") if T(metadata => 4);
2456                  }                  }
2457              } elsif ($toEntity eq $entityName) {              } elsif ($toEntity eq $entityName) {
2458                  # Here the relationship goes to the entity.                  # Here the relationship goes to the entity.
2459                  push @toList, $relationshipName;                  push @toList, $relationshipName;
2460                  Trace("Relationship $relationshipName put in to-list.") if T(3);                  Trace("Relationship $relationshipName put in to-list.") if T(metadata => 4);
2461              }              }
2462          }          }
2463          # Create the nonrecursive joins. Note that we build two hashes for running          # Create the nonrecursive joins. Note that we build two hashes for running
# Line 2229  Line 2473 
2473                  # Create joins between the entity and this relationship.                  # Create joins between the entity and this relationship.
2474                  my $linkField = "$relationshipName.${linkType}_link";                  my $linkField = "$relationshipName.${linkType}_link";
2475                  my $joinClause = "$entityName.id = $linkField";                  my $joinClause = "$entityName.id = $linkField";
2476                  Trace("Entity join clause is $joinClause for $entityName and $relationshipName.") if T(4);                  Trace("Entity join clause is $joinClause for $entityName and $relationshipName.") if T(metadata => 4);
2477                  $joinTable{"$entityName/$relationshipName"} = $joinClause;                  $joinTable{"$entityName/$relationshipName"} = $joinClause;
2478                  $joinTable{"$relationshipName/$entityName"} = $joinClause;                  $joinTable{"$relationshipName/$entityName"} = $joinClause;
2479                  # Create joins between this relationship and the other relationships.                  # Create joins between this relationship and the other relationships.
# Line 2250  Line 2494 
2494                              # relationship and itself are prohibited.                              # relationship and itself are prohibited.
2495                              my $relJoinClause = "$otherName.${otherType}_link = $linkField";                              my $relJoinClause = "$otherName.${otherType}_link = $linkField";
2496                              $joinTable{$joinKey} = $relJoinClause;                              $joinTable{$joinKey} = $relJoinClause;
2497                              Trace("Relationship join clause is $relJoinClause for $joinKey.") if T(4);                              Trace("Relationship join clause is $relJoinClause for $joinKey.") if T(metadata => 4);
2498                          }                          }
2499                      }                      }
2500                  }                  }
# Line 2259  Line 2503 
2503                  # relationship can only be ambiguous with another recursive relationship,                  # relationship can only be ambiguous with another recursive relationship,
2504                  # and the incoming relationship from the outer loop is never recursive.                  # and the incoming relationship from the outer loop is never recursive.
2505                  for my $otherName (@bothList) {                  for my $otherName (@bothList) {
2506                      Trace("Setting up relationship joins to recursive relationship $otherName with $relationshipName.") if T(3);                      Trace("Setting up relationship joins to recursive relationship $otherName with $relationshipName.") if T(metadata => 4);
2507                      # Join from the left.                      # Join from the left.
2508                      $joinTable{"$relationshipName/$otherName"} =                      $joinTable{"$relationshipName/$otherName"} =
2509                          "$linkField = $otherName.from_link";                          "$linkField = $otherName.from_link";
# Line 2274  Line 2518 
2518          # rise to situations where we can't create the path we want; however, it is always          # rise to situations where we can't create the path we want; however, it is always
2519          # possible to get the same effect using multiple queries.          # possible to get the same effect using multiple queries.
2520          for my $relationshipName (@bothList) {          for my $relationshipName (@bothList) {
2521              Trace("Setting up entity joins to recursive relationship $relationshipName with $entityName.") if T(3);              Trace("Setting up entity joins to recursive relationship $relationshipName with $entityName.") if T(metadata => 4);
2522              # Join to the entity from each direction.              # Join to the entity from each direction.
2523              $joinTable{"$entityName/$relationshipName"} =              $joinTable{"$entityName/$relationshipName"} =
2524                  "$entityName.id = $relationshipName.from_link";                  "$entityName.id = $relationshipName.from_link";
# Line 2325  Line 2569 
2569      # index descriptor does not exist, it will be created automatically so we can add      # index descriptor does not exist, it will be created automatically so we can add
2570      # the field to it.      # the field to it.
2571      unshift @{$newIndex->{IndexFields}}, $firstField;      unshift @{$newIndex->{IndexFields}}, $firstField;
2572        # If this is a one-to-many relationship, the "To" index is unique.
2573        if ($relationshipStructure->{arity} eq "1M" && $indexKey eq "To") {
2574            $newIndex->{Unique} = 'true';
2575        }
2576      # Add the index to the relation.      # Add the index to the relation.
2577      _AddIndex("idx$relationshipName$indexKey", $relationStructure, $newIndex);      _AddIndex("idx$relationshipName$indexKey", $relationStructure, $newIndex);
2578  }  }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3