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 |
|
|
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 |
|
|
660 |
# Get the index's uniqueness flag. |
# Get the index's uniqueness flag. |
661 |
my $unique = (exists $indexData->{Unique} ? $indexData->{Unique} : 'false'); |
my $unique = (exists $indexData->{Unique} ? $indexData->{Unique} : 'false'); |
662 |
# Create the index. |
# Create the index. |
663 |
$dbh->create_index(idx => $indexName, tbl => $relationName, flds => $flds, unique => $unique); |
my $rv = $dbh->create_index(idx => $indexName, tbl => $relationName, |
664 |
|
flds => $flds, unique => $unique); |
665 |
|
if ($rv) { |
666 |
Trace("Index created: $indexName for $relationName ($flds)") if T(1); |
Trace("Index created: $indexName for $relationName ($flds)") if T(1); |
667 |
|
} else { |
668 |
|
Confess("Error creating index $indexName for $relationName using ($flds): " . $dbh->error_message()); |
669 |
|
} |
670 |
} |
} |
671 |
} |
} |
672 |
|
|
715 |
$directoryName =~ s!/\\$!!; |
$directoryName =~ s!/\\$!!; |
716 |
# Declare the return variable. |
# Declare the return variable. |
717 |
my $retVal = Stats->new(); |
my $retVal = Stats->new(); |
718 |
# Get the metadata structure. |
# Get the relation names. |
719 |
my $metaData = $self->{_metaData}; |
my @relNames = $self->GetTableNames(); |
720 |
# 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}}) { |
|
721 |
# Try to load this relation. |
# Try to load this relation. |
722 |
my $result = $self->_LoadRelation($directoryName, $relationName, $rebuild); |
my $result = $self->_LoadRelation($directoryName, $relationName, $rebuild); |
723 |
# Accumulate the statistics. |
# Accumulate the statistics. |
724 |
$retVal->Accumulate($result); |
$retVal->Accumulate($result); |
725 |
} |
} |
|
} |
|
|
# 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); |
|
|
} |
|
726 |
# Add the duration of the load to the statistical object. |
# Add the duration of the load to the statistical object. |
727 |
$retVal->Add('duration', gettimeofday - $startTime); |
$retVal->Add('duration', gettimeofday - $startTime); |
728 |
# Return the accumulated statistics. |
# Return the accumulated statistics. |
729 |
return $retVal; |
return $retVal; |
730 |
} |
} |
731 |
|
|
732 |
|
|
733 |
=head3 GetTableNames |
=head3 GetTableNames |
734 |
|
|
735 |
C<< my @names = $erdb->GetTableNames; >> |
C<< my @names = $erdb->GetTableNames; >> |
764 |
return sort keys %{$entityList}; |
return sort keys %{$entityList}; |
765 |
} |
} |
766 |
|
|
767 |
|
=head3 IsEntity |
768 |
|
|
769 |
|
C<< my $flag = $erdb->IsEntity($entityName); >> |
770 |
|
|
771 |
|
Return TRUE if the parameter is an entity name, else FALSE. |
772 |
|
|
773 |
|
=over 4 |
774 |
|
|
775 |
|
=item entityName |
776 |
|
|
777 |
|
Object name to be tested. |
778 |
|
|
779 |
|
=item RETURN |
780 |
|
|
781 |
|
Returns TRUE if the specified string is an entity name, else FALSE. |
782 |
|
|
783 |
|
=back |
784 |
|
|
785 |
|
=cut |
786 |
|
|
787 |
|
sub IsEntity { |
788 |
|
# Get the parameters. |
789 |
|
my ($self, $entityName) = @_; |
790 |
|
# Test to see if it's an entity. |
791 |
|
return exists $self->{_metaData}->{Entities}->{$entityName}; |
792 |
|
} |
793 |
|
|
794 |
=head3 Get |
=head3 Get |
795 |
|
|
796 |
C<< my $query = $erdb->Get(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >> |
C<< my $query = $erdb->Get(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >> |
981 |
$command .= " ORDER BY $orderClause"; |
$command .= " ORDER BY $orderClause"; |
982 |
} |
} |
983 |
} |
} |
984 |
Trace("SQL query: $command") if T(3); |
Trace("SQL query: $command") if T(SQL => 4); |
985 |
Trace("PARMS: '" . (join "', '", @params) . "'") if (T(4) && (@params > 0)); |
Trace("PARMS: '" . (join "', '", @params) . "'") if (T(SQL => 4) && (@params > 0)); |
986 |
my $sth = $dbh->prepare_command($command); |
my $sth = $dbh->prepare_command($command); |
987 |
# Execute it with the parameters bound in. |
# Execute it with the parameters bound in. |
988 |
$sth->execute(@params) || Confess("SELECT error" . $sth->errstr()); |
$sth->execute(@params) || Confess("SELECT error" . $sth->errstr()); |
1293 |
|
|
1294 |
=item RETURN |
=item RETURN |
1295 |
|
|
1296 |
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. |
|
1297 |
|
|
1298 |
=back |
=back |
1299 |
|
|
1307 |
Trace("Loading table $relationName from $fileName") if T(2); |
Trace("Loading table $relationName from $fileName") if T(2); |
1308 |
# Get the database handle. |
# Get the database handle. |
1309 |
my $dbh = $self->{_dbh}; |
my $dbh = $self->{_dbh}; |
1310 |
|
# Get the input file size. |
1311 |
|
my $fileSize = -s $fileName; |
1312 |
# Get the relation data. |
# Get the relation data. |
1313 |
my $relation = $self->_FindRelation($relationName); |
my $relation = $self->_FindRelation($relationName); |
1314 |
# Check the truncation flag. |
# Check the truncation flag. |
1315 |
if ($truncateFlag) { |
if ($truncateFlag) { |
1316 |
Trace("Creating table $relationName") if T(2); |
Trace("Creating table $relationName") if T(2); |
1317 |
|
# Compute the row count estimate. We take the size of the load file, |
1318 |
|
# divide it by the estimated row size, and then multiply by 1.5 to |
1319 |
|
# leave extra room. We postulate a minimum row count of 1000 to |
1320 |
|
# prevent problems with incoming empty load files. |
1321 |
|
my $rowSize = $self->EstimateRowSize($relationName); |
1322 |
|
my $estimate = FIG::max($fileSize * 1.5 / $rowSize, 1000); |
1323 |
# Re-create the table without its index. |
# Re-create the table without its index. |
1324 |
$self->CreateTable($relationName, 0); |
$self->CreateTable($relationName, 0, $estimate); |
1325 |
# If this is a pre-index DBMS, create the index here. |
# If this is a pre-index DBMS, create the index here. |
1326 |
if ($dbh->{_preIndex}) { |
if ($dbh->{_preIndex}) { |
1327 |
eval { |
eval { |
1332 |
} |
} |
1333 |
} |
} |
1334 |
} |
} |
|
# 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); |
|
1335 |
# Load the table. |
# Load the table. |
1336 |
my $rv; |
my $rv; |
1337 |
eval { |
eval { |
1338 |
$rv = $dbh->load_table(file => $tempName, tbl => $relationName); |
$rv = $dbh->load_table(file => $fileName, tbl => $relationName); |
1339 |
}; |
}; |
1340 |
if (!defined $rv) { |
if (!defined $rv) { |
1341 |
$retVal->AddMessage($@) if ($@); |
$retVal->AddMessage($@) if ($@); |
1342 |
$retVal->AddMessage("Table load failed for $relationName using $tempName."); |
$retVal->AddMessage("Table load failed for $relationName using $fileName."); |
1343 |
Trace("Table load failed for $relationName.") if T(1); |
Trace("Table load failed for $relationName.") if T(1); |
1344 |
} else { |
} else { |
1345 |
# Here we successfully loaded the table. Trace the number of records loaded. |
# Here we successfully loaded the table. |
1346 |
Trace("$retVal->{records} records read for $relationName.") if T(2); |
$retVal->Add("tables"); |
1347 |
|
my $size = -s $fileName; |
1348 |
|
Trace("$size bytes loaded into $relationName.") if T(2); |
1349 |
# If we're rebuilding, we need to create the table indexes. |
# If we're rebuilding, we need to create the table indexes. |
1350 |
if ($truncateFlag && ! $dbh->{_preIndex}) { |
if ($truncateFlag && ! $dbh->{_preIndex}) { |
1351 |
eval { |
eval { |
1355 |
$retVal->AddMessage($@); |
$retVal->AddMessage($@); |
1356 |
} |
} |
1357 |
} |
} |
|
# Analyze the table to help optimize tables. |
|
1358 |
} |
} |
1359 |
# Commit the database changes. |
# Analyze the table to improve performance. |
|
$dbh->commit_tran; |
|
1360 |
$dbh->vacuum_it($relationName); |
$dbh->vacuum_it($relationName); |
|
# Delete the temporary file. |
|
|
unlink $tempName; |
|
1361 |
# Return the statistics. |
# Return the statistics. |
1362 |
return $retVal; |
return $retVal; |
1363 |
} |
} |
1635 |
=cut |
=cut |
1636 |
|
|
1637 |
sub _GetLoadStats { |
sub _GetLoadStats { |
1638 |
return Stats->new('records'); |
return Stats->new(); |
1639 |
} |
} |
1640 |
|
|
1641 |
=head3 GenerateFields |
=head3 GenerateFields |
2206 |
my @fromList = (); |
my @fromList = (); |
2207 |
my @toList = (); |
my @toList = (); |
2208 |
my @bothList = (); |
my @bothList = (); |
2209 |
Trace("Join table build for $entityName.") if T(4); |
Trace("Join table build for $entityName.") if T(metadata => 4); |
2210 |
for my $relationshipName (keys %{$relationshipList}) { |
for my $relationshipName (keys %{$relationshipList}) { |
2211 |
my $relationship = $relationshipList->{$relationshipName}; |
my $relationship = $relationshipList->{$relationshipName}; |
2212 |
# 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. |
2217 |
if ($toEntity eq $entityName) { |
if ($toEntity eq $entityName) { |
2218 |
# Here the relationship is recursive. |
# Here the relationship is recursive. |
2219 |
push @bothList, $relationshipName; |
push @bothList, $relationshipName; |
2220 |
Trace("Relationship $relationshipName put in both-list.") if T(4); |
Trace("Relationship $relationshipName put in both-list.") if T(metadata => 4); |
2221 |
} else { |
} else { |
2222 |
# Here the relationship comes from the entity. |
# Here the relationship comes from the entity. |
2223 |
push @fromList, $relationshipName; |
push @fromList, $relationshipName; |
2224 |
Trace("Relationship $relationshipName put in from-list.") if T(4); |
Trace("Relationship $relationshipName put in from-list.") if T(metadata => 4); |
2225 |
} |
} |
2226 |
} elsif ($toEntity eq $entityName) { |
} elsif ($toEntity eq $entityName) { |
2227 |
# Here the relationship goes to the entity. |
# Here the relationship goes to the entity. |
2228 |
push @toList, $relationshipName; |
push @toList, $relationshipName; |
2229 |
Trace("Relationship $relationshipName put in to-list.") if T(4); |
Trace("Relationship $relationshipName put in to-list.") if T(metadata => 4); |
2230 |
} |
} |
2231 |
} |
} |
2232 |
# Create the nonrecursive joins. Note that we build two hashes for running |
# Create the nonrecursive joins. Note that we build two hashes for running |
2242 |
# Create joins between the entity and this relationship. |
# Create joins between the entity and this relationship. |
2243 |
my $linkField = "$relationshipName.${linkType}_link"; |
my $linkField = "$relationshipName.${linkType}_link"; |
2244 |
my $joinClause = "$entityName.id = $linkField"; |
my $joinClause = "$entityName.id = $linkField"; |
2245 |
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); |
2246 |
$joinTable{"$entityName/$relationshipName"} = $joinClause; |
$joinTable{"$entityName/$relationshipName"} = $joinClause; |
2247 |
$joinTable{"$relationshipName/$entityName"} = $joinClause; |
$joinTable{"$relationshipName/$entityName"} = $joinClause; |
2248 |
# Create joins between this relationship and the other relationships. |
# Create joins between this relationship and the other relationships. |
2263 |
# relationship and itself are prohibited. |
# relationship and itself are prohibited. |
2264 |
my $relJoinClause = "$otherName.${otherType}_link = $linkField"; |
my $relJoinClause = "$otherName.${otherType}_link = $linkField"; |
2265 |
$joinTable{$joinKey} = $relJoinClause; |
$joinTable{$joinKey} = $relJoinClause; |
2266 |
Trace("Relationship join clause is $relJoinClause for $joinKey.") if T(4); |
Trace("Relationship join clause is $relJoinClause for $joinKey.") if T(metadata => 4); |
2267 |
} |
} |
2268 |
} |
} |
2269 |
} |
} |
2272 |
# relationship can only be ambiguous with another recursive relationship, |
# relationship can only be ambiguous with another recursive relationship, |
2273 |
# and the incoming relationship from the outer loop is never recursive. |
# and the incoming relationship from the outer loop is never recursive. |
2274 |
for my $otherName (@bothList) { |
for my $otherName (@bothList) { |
2275 |
Trace("Setting up relationship joins to recursive relationship $otherName with $relationshipName.") if T(4); |
Trace("Setting up relationship joins to recursive relationship $otherName with $relationshipName.") if T(metadata => 4); |
2276 |
# Join from the left. |
# Join from the left. |
2277 |
$joinTable{"$relationshipName/$otherName"} = |
$joinTable{"$relationshipName/$otherName"} = |
2278 |
"$linkField = $otherName.from_link"; |
"$linkField = $otherName.from_link"; |
2287 |
# 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 |
2288 |
# possible to get the same effect using multiple queries. |
# possible to get the same effect using multiple queries. |
2289 |
for my $relationshipName (@bothList) { |
for my $relationshipName (@bothList) { |
2290 |
Trace("Setting up entity joins to recursive relationship $relationshipName with $entityName.") if T(4); |
Trace("Setting up entity joins to recursive relationship $relationshipName with $entityName.") if T(metadata => 4); |
2291 |
# Join to the entity from each direction. |
# Join to the entity from each direction. |
2292 |
$joinTable{"$entityName/$relationshipName"} = |
$joinTable{"$entityName/$relationshipName"} = |
2293 |
"$entityName.id = $relationshipName.from_link"; |
"$entityName.id = $relationshipName.from_link"; |