[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.17, Wed Jul 27 20:00:00 2005 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;
# Line 539  Line 539 
539    
540  =head3 CreateTables  =head3 CreateTables
541    
542  C<< $datanase->CreateTables(); >>  C<< $database->CreateTables(); >>
543    
544  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
545  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 637  Line 637 
637  C<< $database->CreateIndex($relationName); >>  C<< $database->CreateIndex($relationName); >>
638    
639  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
640  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.
641  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
642  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.
643    
644  =cut  =cut
645    
# Line 959  Line 959 
959              $command .= " ORDER BY $orderClause";              $command .= " ORDER BY $orderClause";
960          }          }
961      }      }
962      Trace("SQL query: $command") if T(2);      Trace("SQL query: $command") if T(3);
963      Trace("PARMS: '" . (join "', '", @params) . "'") if (T(3) && (@params > 0));      Trace("PARMS: '" . (join "', '", @params) . "'") if (T(4) && (@params > 0));
964      my $sth = $dbh->prepare_command($command);      my $sth = $dbh->prepare_command($command);
965      # Execute it with the parameters bound in.      # Execute it with the parameters bound in.
966      $sth->execute(@params) || Confess("SELECT error" . $sth->errstr());      $sth->execute(@params) || Confess("SELECT error" . $sth->errstr());
# Line 1379  Line 1379 
1379                  $retVal->AddMessage($@);                  $retVal->AddMessage($@);
1380              }              }
1381          }          }
1382            # Analyze the table to help optimize tables.
1383      }      }
1384      # Commit the database changes.      # Commit the database changes.
1385      $dbh->commit_tran;      $dbh->commit_tran;
1386        $dbh->vacuum_it($relationName);
1387      # Delete the temporary file.      # Delete the temporary file.
1388      unlink $tempName;      unlink $tempName;
1389      # Return the statistics.      # Return the statistics.
# Line 1987  Line 1989 
1989  sub _LoadMetaData {  sub _LoadMetaData {
1990      # Get the parameters.      # Get the parameters.
1991      my ($filename) = @_;      my ($filename) = @_;
1992        Trace("Reading Sprout DBD from $filename.") if T(2);
1993      # 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
1994      # get the exact structure we want.      # get the exact structure we want.
1995      my $metadata = XML::Simple::XMLin($filename,      my $metadata = XML::Simple::XMLin($filename,
# Line 2014  Line 2017 
2017      for my $entityName (keys %{$entityList}) {      for my $entityName (keys %{$entityList}) {
2018          my $entityStructure = $entityList->{$entityName};          my $entityStructure = $entityList->{$entityName};
2019          #          #
2020          # 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,
2021          # 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,
2022          # 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>
2023          # 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 2196 
2196          my @fromList = ();          my @fromList = ();
2197          my @toList = ();          my @toList = ();
2198          my @bothList = ();          my @bothList = ();
2199          Trace("Join table build for $entityName.") if T(3);          Trace("Join table build for $entityName.") if T(4);
2200          for my $relationshipName (keys %{$relationshipList}) {          for my $relationshipName (keys %{$relationshipList}) {
2201              my $relationship = $relationshipList->{$relationshipName};              my $relationship = $relationshipList->{$relationshipName};
2202              # 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.
2203              my $fromEntity = $relationship->{from};              my $fromEntity = $relationship->{from};
2204              my $toEntity = $relationship->{to};              my $toEntity = $relationship->{to};
2205              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);
2206              if ($fromEntity eq $entityName) {              if ($fromEntity eq $entityName) {
2207                  if ($toEntity eq $entityName) {                  if ($toEntity eq $entityName) {
2208                      # Here the relationship is recursive.                      # Here the relationship is recursive.
2209                      push @bothList, $relationshipName;                      push @bothList, $relationshipName;
2210                      Trace("Relationship $relationshipName put in both-list.") if T(3);                      Trace("Relationship $relationshipName put in both-list.") if T(4);
2211                  } else {                  } else {
2212                      # Here the relationship comes from the entity.                      # Here the relationship comes from the entity.
2213                      push @fromList, $relationshipName;                      push @fromList, $relationshipName;
2214                      Trace("Relationship $relationshipName put in from-list.") if T(3);                      Trace("Relationship $relationshipName put in from-list.") if T(4);
2215                  }                  }
2216              } elsif ($toEntity eq $entityName) {              } elsif ($toEntity eq $entityName) {
2217                  # Here the relationship goes to the entity.                  # Here the relationship goes to the entity.
2218                  push @toList, $relationshipName;                  push @toList, $relationshipName;
2219                  Trace("Relationship $relationshipName put in to-list.") if T(3);                  Trace("Relationship $relationshipName put in to-list.") if T(4);
2220              }              }
2221          }          }
2222          # 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 2259  Line 2262 
2262                  # relationship can only be ambiguous with another recursive relationship,                  # relationship can only be ambiguous with another recursive relationship,
2263                  # and the incoming relationship from the outer loop is never recursive.                  # and the incoming relationship from the outer loop is never recursive.
2264                  for my $otherName (@bothList) {                  for my $otherName (@bothList) {
2265                      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(4);
2266                      # Join from the left.                      # Join from the left.
2267                      $joinTable{"$relationshipName/$otherName"} =                      $joinTable{"$relationshipName/$otherName"} =
2268                          "$linkField = $otherName.from_link";                          "$linkField = $otherName.from_link";
# Line 2274  Line 2277 
2277          # 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
2278          # possible to get the same effect using multiple queries.          # possible to get the same effect using multiple queries.
2279          for my $relationshipName (@bothList) {          for my $relationshipName (@bothList) {
2280              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(4);
2281              # Join to the entity from each direction.              # Join to the entity from each direction.
2282              $joinTable{"$entityName/$relationshipName"} =              $joinTable{"$entityName/$relationshipName"} =
2283                  "$entityName.id = $relationshipName.from_link";                  "$entityName.id = $relationshipName.from_link";
# Line 2325  Line 2328 
2328      # 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
2329      # the field to it.      # the field to it.
2330      unshift @{$newIndex->{IndexFields}}, $firstField;      unshift @{$newIndex->{IndexFields}}, $firstField;
2331        # If this is a one-to-many relationship, the "To" index is unique.
2332        if ($relationshipStructure->{arity} eq "1M" && $indexKey eq "To") {
2333            $newIndex->{Unique} = 'true';
2334        }
2335      # Add the index to the relation.      # Add the index to the relation.
2336      _AddIndex("idx$relationshipName$indexKey", $relationStructure, $newIndex);      _AddIndex("idx$relationshipName$indexKey", $relationStructure, $newIndex);
2337  }  }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3