[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.18, Sun Aug 14 23:32:08 2005 UTC revision 1.34, Sat Jan 28 09:54:12 2006 UTC
# Line 9  Line 9 
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 308  Line 309 
309                    text =>    { sqlType => 'TEXT',               maxLen => 1000000000,   avgLen => 500, dataGen => "StringGen(IntGen(80,1000))" },                    text =>    { sqlType => 'TEXT',               maxLen => 1000000000,   avgLen => 500, dataGen => "StringGen(IntGen(80,1000))" },
310                    date =>    { sqlType => 'BIGINT',             maxLen => 80,           avgLen =>   8, dataGen => "DateGen(-7, 7, IntGen(0,1400))" },                    date =>    { sqlType => 'BIGINT',             maxLen => 80,           avgLen =>   8, dataGen => "DateGen(-7, 7, IntGen(0,1400))" },
311                    float =>   { sqlType => 'DOUBLE PRECISION',   maxLen => 40,           avgLen =>   8, dataGen => "FloatGen(0.0, 100.0)" },                    float =>   { sqlType => 'DOUBLE PRECISION',   maxLen => 40,           avgLen =>   8, dataGen => "FloatGen(0.0, 100.0)" },
312                    boolean => { sqlType => 'SMALLINT',           maxLen => 1,            avgLen =>   2, dataGen => "IntGen(0, 1)" },                    boolean => { sqlType => 'SMALLINT',           maxLen => 1,            avgLen =>   1, dataGen => "IntGen(0, 1)" },
313                   'key-string' =>                   'key-string' =>
314                               { sqlType => 'VARCHAR(40)',        maxLen => 40,           avgLen =>  10, dataGen => "StringGen(IntGen(10,40))" },                               { sqlType => 'VARCHAR(40)',        maxLen => 40,           avgLen =>  10, dataGen => "StringGen(IntGen(10,40))" },
315                   'name-string' =>                   'name-string' =>
# Line 507  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 552  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    
# Line 645  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<< $erdb->CreateIndex($relationName); >>  C<< $erdb->CreateIndex($relationName); >>
# Line 673  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    
# Line 723  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 = $erdb->GetTableNames; >>  C<< my @names = $erdb->GetTableNames; >>
# Line 782  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 = $erdb->Get(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >>  C<< my $query = $erdb->Get(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >>
# Line 842  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 950  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 967  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(3);      Trace("SQL query: $command") if T(SQL => 4);
1045      Trace("PARMS: '" . (join "', '", @params) . "'") if (T(4) && (@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 982  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        # These next lists 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. We have two lists-- one for TO-relationships, and one for
1104        # FROM-relationships and entities.
1105        my @fromPathList = ();
1106        my @toPathList = ();
1107        # This final hash is used to remember what work still needs to be done. We push paths
1108        # onto the list, then pop them off to extend the paths. We prime it with the starting
1109        # point. Note that we will work hard to insure that the last item on a path in the
1110        # TODO list is always an entity.
1111        my @todoList = ([$entityName]);
1112        while (@todoList) {
1113            # Get the current path.
1114            my $current = pop @todoList;
1115            # Copy it into a list.
1116            my @stackedPath = @{$current};
1117            Trace("Processing path (" . join(", ", @stackedPath) . ").") if T(4);
1118            # Pull off the last item on the path. It will always be an entity.
1119            my $entityName = pop @stackedPath;
1120            # Add it to the alreadyFound list.
1121            $alreadyFound{$entityName} = 1;
1122            # Get the entity data.
1123            my $entityData = $self->_GetStructure($entityName);
1124            # The first task is to loop through the entity's relation. A DELETE command will
1125            # be needed for each of them.
1126            my $relations = $entityData->{Relations};
1127            for my $relation (keys %{$relations}) {
1128                my @augmentedList = (@stackedPath, $relation);
1129                push @fromPathList, \@augmentedList;
1130            }
1131            # Now we need to look for relationships connected to this entity.
1132            my $relationshipList = $self->{_metaData}->{Relationships};
1133            for my $relationshipName (keys %{$relationshipList}) {
1134                Trace("Checking relationship $relationshipName.") if T(4);
1135                my $relationship = $relationshipList->{$relationshipName};
1136                # Check the FROM field. We're only interested if it's us.
1137                if ($relationship->{from} eq $entityName) {
1138                    # Add the path to this relationship.
1139                    my @augmentedList = (@stackedPath, $entityName, $relationshipName);
1140                    push @fromPathList, \@augmentedList;
1141                    # Check the arity. If it's MM we're done. If it's 1M
1142                    # and the target hasn't been seen yet, we want to
1143                    # stack the entity for future processing.
1144                    if ($relationship->{arity} eq '1M') {
1145                        my $toEntity = $relationship->{to};
1146                        if (! exists $alreadyFound{$toEntity}) {
1147                            # Here we have a new entity that's dependent on
1148                            # the current entity, so we need to stack it.
1149                            my @stackList = (@augmentedList, $toEntity);
1150                            push @fromPathList, \@stackList;
1151                        } else {
1152                            Trace("$toEntity ignored because it occurred previously.") if T(4);
1153                        }
1154                    }
1155                }
1156                # Now check the TO field. In this case only the relationship needs
1157                # deletion.
1158                if ($relationship->{to} eq $entityName) {
1159                    my @augmentedList = (@stackedPath, $entityName, $relationshipName);
1160                    push @toPathList, \@augmentedList;
1161                }
1162            }
1163        }
1164        # Create the first qualifier for the WHERE clause. This selects the
1165        # keys of the primary entity records to be deleted. When we're deleting
1166        # from a dependent table, we construct a join page from the first qualifier
1167        # to the table containing the dependent records to delete.
1168        my $qualifier = ($objectID =~ /%/ ? "LIKE ?" : "= ?");
1169        # We need to make two passes. The first is through the to-list, and
1170        # the second through the from-list. The from-list is second because
1171        # the to-list may need to pass through some of the entities the
1172        # from-list would delete.
1173        my %stackList = ( from_link => \@fromPathList, to_link => \@toPathList );
1174        # Now it's time to do the deletes. We do it in two passes.
1175        for my $keyName ('to_link', 'from_link') {
1176            # Get the list for this key.
1177            my @pathList = @{$stackList{$keyName}};
1178            Trace(scalar(@pathList) . " entries in path list for $keyName.") if T(3);
1179            # Loop through this list.
1180            while (my $path = pop @pathList) {
1181                # Get the table whose rows are to be deleted.
1182                my @pathTables = @{$path};
1183                # Start the DELETE statement.
1184                my $target = $pathTables[$#pathTables];
1185                my $stmt = "DELETE FROM $target";
1186                # If there's more than just the one table, we need a USING clause.
1187                if (@pathTables > 1) {
1188                    $stmt .= " USING " . join(", ", @pathTables[0 .. ($#pathTables - 1)]);
1189                }
1190                # Now start the WHERE. The first thing is the ID field from the starting table. That
1191                # starting table will either be the entity relation or one of the entity's
1192                # sub-relations.
1193                $stmt .= " WHERE $pathTables[0].id $qualifier";
1194                # Now we run through the remaining entities in the path, connecting them up.
1195                for (my $i = 1; $i <= $#pathTables; $i += 2) {
1196                    # Connect the current relationship to the preceding entity.
1197                    my ($entity, $rel) = @pathTables[$i-1,$i];
1198                    # The style of connection depends on the direction of the relationship.
1199                    $stmt .= " AND $entity.id = $rel.from_link";
1200                    if ($i + 1 <= $#pathTables) {
1201                        # Here there's a next entity, so connect that to the relationship's
1202                        # to-link.
1203                        my $entity2 = $pathTables[$i+1];
1204                        $stmt .= " AND $rel.$keyName = $entity2.id";
1205                    }
1206                }
1207                # Now we have our desired DELETE statement.
1208                if ($testFlag) {
1209                    # Here the user wants to trace without executing.
1210                    Trace($stmt) if T(0);
1211                } else {
1212                    # Here we can delete. Note that the SQL method dies with a confessing
1213                    # if an error occurs, so we just go ahead and do it.
1214                    Trace("Executing delete: $stmt") if T(3);
1215                    my $rv = $db->SQL($stmt, 0, [$objectID]);
1216                    # Accumulate the statistics for this delete. The only rows deleted
1217                    # are from the target table, so we use its name to record the
1218                    # statistic.
1219                    $retVal->Add($target, $rv);
1220                }
1221            }
1222        }
1223        # Return the result.
1224        return $retVal;
1225    }
1226    
1227  =head3 GetList  =head3 GetList
1228    
1229  C<< my @dbObjects = $erdb->GetList(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >>  C<< my @dbObjects = $erdb->GetList(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >>
# Line 1284  Line 1526 
1526    
1527  =item RETURN  =item RETURN
1528    
1529  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.  
1530    
1531  =back  =back
1532    
# Line 1299  Line 1540 
1540      Trace("Loading table $relationName from $fileName") if T(2);      Trace("Loading table $relationName from $fileName") if T(2);
1541      # Get the database handle.      # Get the database handle.
1542      my $dbh = $self->{_dbh};      my $dbh = $self->{_dbh};
1543        # Get the input file size.
1544        my $fileSize = -s $fileName;
1545      # Get the relation data.      # Get the relation data.
1546      my $relation = $self->_FindRelation($relationName);      my $relation = $self->_FindRelation($relationName);
1547      # Check the truncation flag.      # Check the truncation flag.
1548      if ($truncateFlag) {      if ($truncateFlag) {
1549          Trace("Creating table $relationName") if T(2);          Trace("Creating table $relationName") if T(2);
1550            # Compute the row count estimate. We take the size of the load file,
1551            # divide it by the estimated row size, and then multiply by 1.5 to
1552            # leave extra room. We postulate a minimum row count of 1000 to
1553            # prevent problems with incoming empty load files.
1554            my $rowSize = $self->EstimateRowSize($relationName);
1555            my $estimate = FIG::max($fileSize * 1.5 / $rowSize, 1000);
1556          # Re-create the table without its index.          # Re-create the table without its index.
1557          $self->CreateTable($relationName, 0);          $self->CreateTable($relationName, 0, $estimate);
1558          # If this is a pre-index DBMS, create the index here.          # If this is a pre-index DBMS, create the index here.
1559          if ($dbh->{_preIndex}) {          if ($dbh->{_preIndex}) {
1560              eval {              eval {
# Line 1316  Line 1565 
1565              }              }
1566          }          }
1567      }      }
     # 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);  
1568      # Load the table.      # Load the table.
1569      my $rv;      my $rv;
1570      eval {      eval {
1571          $rv = $dbh->load_table(file => $tempName, tbl => $relationName);          $rv = $dbh->load_table(file => $fileName, tbl => $relationName);
1572      };      };
1573      if (!defined $rv) {      if (!defined $rv) {
1574          $retVal->AddMessage($@) if ($@);          $retVal->AddMessage($@) if ($@);
1575          $retVal->AddMessage("Table load failed for $relationName using $tempName.");          $retVal->AddMessage("Table load failed for $relationName using $fileName.");
1576          Trace("Table load failed for $relationName.") if T(1);          Trace("Table load failed for $relationName.") if T(1);
1577      } else {      } else {
1578          # Here we successfully loaded the table. Trace the number of records loaded.          # Here we successfully loaded the table.
1579          Trace("$retVal->{records} records read for $relationName.") if T(2);          $retVal->Add("tables");
1580            my $size = -s $fileName;
1581            Trace("$size bytes loaded into $relationName.") if T(2);
1582          # If we're rebuilding, we need to create the table indexes.          # If we're rebuilding, we need to create the table indexes.
1583          if ($truncateFlag && ! $dbh->{_preIndex}) {          if ($truncateFlag && ! $dbh->{_preIndex}) {
1584              eval {              eval {
# Line 1392  Line 1588 
1588                  $retVal->AddMessage($@);                  $retVal->AddMessage($@);
1589              }              }
1590          }          }
         # Analyze the table to help optimize tables.  
1591      }      }
1592      # Commit the database changes.      # Analyze the table to improve performance.
     $dbh->commit_tran;  
1593      $dbh->vacuum_it($relationName);      $dbh->vacuum_it($relationName);
     # Delete the temporary file.  
     unlink $tempName;  
1594      # Return the statistics.      # Return the statistics.
1595      return $retVal;      return $retVal;
1596  }  }
# Line 1607  Line 1799 
1799      } else {      } else {
1800          push @parmList, $parameterList;          push @parmList, $parameterList;
1801      }      }
     # Create the query.  
     my $query = $self->Get($objectNames, $filterClause, @parmList);  
     # Set up a counter of the number of records read.  
     my $fetched = 0;  
1802      # Insure the counter has a value.      # Insure the counter has a value.
1803      if (!defined $count) {      if (!defined $count) {
1804          $count = 0;          $count = 0;
1805      }      }
1806        # Add the row limit to the filter clause.
1807        if ($count > 0) {
1808            $filterClause .= " LIMIT $count";
1809        }
1810        # Create the query.
1811        my $query = $self->Get($objectNames, $filterClause, @parmList);
1812        # Set up a counter of the number of records read.
1813        my $fetched = 0;
1814      # Loop through the records returned, extracting the fields. Note that if the      # Loop through the records returned, extracting the fields. Note that if the
1815      # 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.
1816      my @retVal = ();      my @retVal = ();
# Line 1676  Line 1872 
1872  =cut  =cut
1873    
1874  sub _GetLoadStats {  sub _GetLoadStats {
1875      return Stats->new('records');      return Stats->new();
1876  }  }
1877    
1878  =head3 GenerateFields  =head3 GenerateFields
# Line 2247  Line 2443 
2443          my @fromList = ();          my @fromList = ();
2444          my @toList = ();          my @toList = ();
2445          my @bothList = ();          my @bothList = ();
2446          Trace("Join table build for $entityName.") if T(4);          Trace("Join table build for $entityName.") if T(metadata => 4);
2447          for my $relationshipName (keys %{$relationshipList}) {          for my $relationshipName (keys %{$relationshipList}) {
2448              my $relationship = $relationshipList->{$relationshipName};              my $relationship = $relationshipList->{$relationshipName};
2449              # 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.
# Line 2258  Line 2454 
2454                  if ($toEntity eq $entityName) {                  if ($toEntity eq $entityName) {
2455                      # Here the relationship is recursive.                      # Here the relationship is recursive.
2456                      push @bothList, $relationshipName;                      push @bothList, $relationshipName;
2457                      Trace("Relationship $relationshipName put in both-list.") if T(4);                      Trace("Relationship $relationshipName put in both-list.") if T(metadata => 4);
2458                  } else {                  } else {
2459                      # Here the relationship comes from the entity.                      # Here the relationship comes from the entity.
2460                      push @fromList, $relationshipName;                      push @fromList, $relationshipName;
2461                      Trace("Relationship $relationshipName put in from-list.") if T(4);                      Trace("Relationship $relationshipName put in from-list.") if T(metadata => 4);
2462                  }                  }
2463              } elsif ($toEntity eq $entityName) {              } elsif ($toEntity eq $entityName) {
2464                  # Here the relationship goes to the entity.                  # Here the relationship goes to the entity.
2465                  push @toList, $relationshipName;                  push @toList, $relationshipName;
2466                  Trace("Relationship $relationshipName put in to-list.") if T(4);                  Trace("Relationship $relationshipName put in to-list.") if T(metadata => 4);
2467              }              }
2468          }          }
2469          # 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 2283  Line 2479 
2479                  # Create joins between the entity and this relationship.                  # Create joins between the entity and this relationship.
2480                  my $linkField = "$relationshipName.${linkType}_link";                  my $linkField = "$relationshipName.${linkType}_link";
2481                  my $joinClause = "$entityName.id = $linkField";                  my $joinClause = "$entityName.id = $linkField";
2482                  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);
2483                  $joinTable{"$entityName/$relationshipName"} = $joinClause;                  $joinTable{"$entityName/$relationshipName"} = $joinClause;
2484                  $joinTable{"$relationshipName/$entityName"} = $joinClause;                  $joinTable{"$relationshipName/$entityName"} = $joinClause;
2485                  # Create joins between this relationship and the other relationships.                  # Create joins between this relationship and the other relationships.
# Line 2304  Line 2500 
2500                              # relationship and itself are prohibited.                              # relationship and itself are prohibited.
2501                              my $relJoinClause = "$otherName.${otherType}_link = $linkField";                              my $relJoinClause = "$otherName.${otherType}_link = $linkField";
2502                              $joinTable{$joinKey} = $relJoinClause;                              $joinTable{$joinKey} = $relJoinClause;
2503                              Trace("Relationship join clause is $relJoinClause for $joinKey.") if T(4);                              Trace("Relationship join clause is $relJoinClause for $joinKey.") if T(metadata => 4);
2504                          }                          }
2505                      }                      }
2506                  }                  }
# Line 2313  Line 2509 
2509                  # relationship can only be ambiguous with another recursive relationship,                  # relationship can only be ambiguous with another recursive relationship,
2510                  # and the incoming relationship from the outer loop is never recursive.                  # and the incoming relationship from the outer loop is never recursive.
2511                  for my $otherName (@bothList) {                  for my $otherName (@bothList) {
2512                      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);
2513                      # Join from the left.                      # Join from the left.
2514                      $joinTable{"$relationshipName/$otherName"} =                      $joinTable{"$relationshipName/$otherName"} =
2515                          "$linkField = $otherName.from_link";                          "$linkField = $otherName.from_link";
# Line 2328  Line 2524 
2524          # 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
2525          # possible to get the same effect using multiple queries.          # possible to get the same effect using multiple queries.
2526          for my $relationshipName (@bothList) {          for my $relationshipName (@bothList) {
2527              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);
2528              # Join to the entity from each direction.              # Join to the entity from each direction.
2529              $joinTable{"$entityName/$relationshipName"} =              $joinTable{"$entityName/$relationshipName"} =
2530                  "$entityName.id = $relationshipName.from_link";                  "$entityName.id = $relationshipName.from_link";
Legend:
Removed from v.1.18  
changed lines
  Added in v.1.34
MCS Webmaster
 ViewVC Help
Powered by ViewVC 1.0.3