[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.9, Thu Jun 16 19:08:59 2005 UTC revision 1.18, Sun Aug 14 23:32:08 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 300  Line 300 
300  # 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.
301  # "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
302  # 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
303   #string is specified in the field definition.  # string is specified in the field definition. "avgLen" is the average byte length for estimating
304  my %TypeTable = ( char =>        { sqlType => 'CHAR(1)',                        maxLen => 1,                    dataGen => "StringGen('A')" },  # record sizes.
305                                    int =>         { sqlType => 'INTEGER',                        maxLen => 20,                   dataGen => "IntGen(0, 99999999)" },  my %TypeTable = ( char =>    { sqlType => 'CHAR(1)',            maxLen => 1,            avgLen =>   1, dataGen => "StringGen('A')" },
306                                    string =>  { sqlType => 'VARCHAR(255)',               maxLen => 255,                  dataGen => "StringGen(IntGen(10,250))" },                    int =>     { sqlType => 'INTEGER',            maxLen => 20,           avgLen =>   4, dataGen => "IntGen(0, 99999999)" },
307                                    text =>        { sqlType => 'TEXT',                           maxLen => 1000000000,   dataGen => "StringGen(IntGen(80,1000))" },                    string =>  { sqlType => 'VARCHAR(255)',       maxLen => 255,          avgLen => 100, dataGen => "StringGen(IntGen(10,250))" },
308                                    date =>        { sqlType => 'BIGINT',                         maxLen => 80,                   dataGen => "DateGen(-7, 7, IntGen(0,1400))" },                    text =>    { sqlType => 'TEXT',               maxLen => 1000000000,   avgLen => 500, dataGen => "StringGen(IntGen(80,1000))" },
309                                    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))" },
310                                    boolean => { sqlType => 'SMALLINT',                   maxLen => 1,                    dataGen => "IntGen(0, 1)" },                    float =>   { sqlType => 'DOUBLE PRECISION',   maxLen => 40,           avgLen =>   8, dataGen => "FloatGen(0.0, 100.0)" },
311                      boolean => { sqlType => 'SMALLINT',           maxLen => 1,            avgLen =>   2, dataGen => "IntGen(0, 1)" },
312                               'key-string' =>                               'key-string' =>
313                                                           { sqlType => 'VARCHAR(40)',            maxLen => 40,                   dataGen => "StringGen(IntGen(10,40))" },                               { sqlType => 'VARCHAR(40)',        maxLen => 40,           avgLen =>  10, dataGen => "StringGen(IntGen(10,40))" },
314                                   'name-string' =>                                   'name-string' =>
315                                                           { sqlType => 'VARCHAR(80)',            maxLen => 80,                   dataGen => "StringGen(IntGen(10,80))" },                               { sqlType => 'VARCHAR(80)',        maxLen => 80,           avgLen =>  40, dataGen => "StringGen(IntGen(10,80))" },
316                                   'medium-string' =>                                   'medium-string' =>
317                                                           { sqlType => 'VARCHAR(160)',           maxLen => 160,                  dataGen => "StringGen(IntGen(10,160))" },                               { sqlType => 'VARCHAR(160)',       maxLen => 160,          avgLen =>  40, dataGen => "StringGen(IntGen(10,160))" },
318                                  );                                  );
319    
320  # Table translating arities into natural language.  # Table translating arities into natural language.
# Line 369  Line 370 
370    
371  =head3 ShowMetaData  =head3 ShowMetaData
372    
373  C<< $database->ShowMetaData($fileName); >>  C<< $erdb->ShowMetaData($fileName); >>
374    
375  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
376  the data to be loaded into the relations.  the data to be loaded into the relations.
# Line 524  Line 525 
525    
526  =head3 DumpMetaData  =head3 DumpMetaData
527    
528  C<< $database->DumpMetaData(); >>  C<< $erdb->DumpMetaData(); >>
529    
530  Return a dump of the metadata structure.  Return a dump of the metadata structure.
531    
# Line 539  Line 540 
540    
541  =head3 CreateTables  =head3 CreateTables
542    
543  C<< $datanase->CreateTables(); >>  C<< $erdb->CreateTables(); >>
544    
545  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
546  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 577  Line 578 
578    
579  =head3 CreateTable  =head3 CreateTable
580    
581  C<< $database->CreateTable($tableName, $indexFlag); >>  C<< $erdb->CreateTable($tableName, $indexFlag, $estimatedRows); >>
582    
583  Create the table for a relation and optionally create its indexes.  Create the table for a relation and optionally create its indexes.
584    
# Line 587  Line 588 
588    
589  Name of the relation (which will also be the table name).  Name of the relation (which will also be the table name).
590    
591  =item $indexFlag  =item indexFlag
592    
593  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,
594  L</CreateIndexes> must be called later to bring the indexes into existence.  L</CreateIndexes> must be called later to bring the indexes into existence.
595    
596    =item estimatedRows (optional)
597    
598    If specified, the estimated maximum number of rows for the relation. This
599    information allows the creation of tables using storage engines that are
600    faster but require size estimates, such as MyISAM.
601    
602  =back  =back
603    
604  =cut  =cut
605    
606  sub CreateTable {  sub CreateTable {
607          # Get the parameters.          # Get the parameters.
608          my ($self, $relationName, $indexFlag) = @_;      my ($self, $relationName, $indexFlag, $estimatedRows) = @_;
609          # Get the database handle.          # Get the database handle.
610          my $dbh = $self->{_dbh};          my $dbh = $self->{_dbh};
611          # 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 629 
629          # Insure the table is not already there.          # Insure the table is not already there.
630          $dbh->drop_table(tbl => $relationName);          $dbh->drop_table(tbl => $relationName);
631          Trace("Table $relationName dropped.") if T(2);          Trace("Table $relationName dropped.") if T(2);
632        # If there are estimated rows, create an estimate so we can take advantage of
633        # faster DB technologies.
634        my $estimation = undef;
635        if ($estimatedRows) {
636            $estimation = [$self->EstimateRowSize($relationName), $estimatedRows];
637        }
638          # Create the table.          # Create the table.
639          Trace("Creating table $relationName: $fieldThing") if T(2);          Trace("Creating table $relationName: $fieldThing") if T(2);
640          $dbh->create_table(tbl => $relationName, flds => $fieldThing);      $dbh->create_table(tbl => $relationName, flds => $fieldThing, estimates => $estimation);
641          Trace("Relation $relationName created in database.") if T(2);          Trace("Relation $relationName created in database.") if T(2);
642          # If we want to build the indexes, we do it here.          # If we want to build the indexes, we do it here.
643          if ($indexFlag) {          if ($indexFlag) {
# Line 634  Line 647 
647    
648  =head3 CreateIndex  =head3 CreateIndex
649    
650  C<< $database->CreateIndex($relationName); >>  C<< $erdb->CreateIndex($relationName); >>
651    
652  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
653  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.
654  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
655  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.
656    
657  =cut  =cut
658    
# Line 667  Line 680 
680    
681  =head3 LoadTables  =head3 LoadTables
682    
683  C<< my $stats = $database->LoadTables($directoryName, $rebuild); >>  C<< my $stats = $erdb->LoadTables($directoryName, $rebuild); >>
684    
685  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
686  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 737  Line 750 
750    
751  =head3 GetTableNames  =head3 GetTableNames
752    
753  C<< my @names = $database->GetTableNames; >>  C<< my @names = $erdb->GetTableNames; >>
754    
755  Return a list of the relations required to implement this database.  Return a list of the relations required to implement this database.
756    
# Line 754  Line 767 
767    
768  =head3 GetEntityTypes  =head3 GetEntityTypes
769    
770  C<< my @names = $database->GetEntityTypes; >>  C<< my @names = $erdb->GetEntityTypes; >>
771    
772  Return a list of the entity type names.  Return a list of the entity type names.
773    
# Line 771  Line 784 
784    
785  =head3 Get  =head3 Get
786    
787  C<< my $query = $database->Get(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >>  C<< my $query = $erdb->Get(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >>
788    
789  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.
790  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 792 
792  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
793  $genus.  $genus.
794    
795  C<< $query = $sprout->Get(['Genome'], "Genome(genus) = ?", $genus); >>  C<< $query = $erdb->Get(['Genome'], "Genome(genus) = ?", $genus); >>
796    
797  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
798  parameter representing the parameter value. It would also be possible to code  parameter representing the parameter value. It would also be possible to code
799    
800  C<< $query = $sprout->Get(['Genome'], "Genome(genus) = \'$genus\'"); >>  C<< $query = $erdb->Get(['Genome'], "Genome(genus) = \'$genus\'"); >>
801    
802  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
803  characters inside the variable C<$genus>.  characters inside the variable C<$genus>.
# Line 796  Line 809 
809  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
810  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,
811    
812  C<< $query = $sprout->Get(['Genome', 'ComesFrom', 'Source'], "Genome(genus) = ?", $genus); >>  C<< $query = $erdb->Get(['Genome', 'ComesFrom', 'Source'], "Genome(genus) = ?", $genus); >>
813    
814  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
815  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 959  Line 972 
972                          $command .= " ORDER BY $orderClause";                          $command .= " ORDER BY $orderClause";
973                  }                  }
974          }          }
975          Trace("SQL query: $command") if T(2);      Trace("SQL query: $command") if T(3);
976          Trace("PARMS: '" . (join "', '", @params) . "'") if (T(3) && (@params > 0));      Trace("PARMS: '" . (join "', '", @params) . "'") if (T(4) && (@params > 0));
977          my $sth = $dbh->prepare_command($command);          my $sth = $dbh->prepare_command($command);
978          # Execute it with the parameters bound in.          # Execute it with the parameters bound in.
979          $sth->execute(@params) || Confess("SELECT error" . $sth->errstr());          $sth->execute(@params) || Confess("SELECT error" . $sth->errstr());
# Line 971  Line 984 
984    
985  =head3 GetList  =head3 GetList
986    
987  C<< my @dbObjects = $database->GetList(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >>  C<< my @dbObjects = $erdb->GetList(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >>
988    
989  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
990  specified filter clause.  specified filter clause.
# Line 1034  Line 1047 
1047    
1048  =head3 ComputeObjectSentence  =head3 ComputeObjectSentence
1049    
1050  C<< my $sentence = $database->ComputeObjectSentence($objectName); >>  C<< my $sentence = $erdb->ComputeObjectSentence($objectName); >>
1051    
1052  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.
1053    
# Line 1069  Line 1082 
1082    
1083  =head3 DumpRelations  =head3 DumpRelations
1084    
1085  C<< $database->DumpRelations($outputDirectory); >>  C<< $erdb->DumpRelations($outputDirectory); >>
1086    
1087  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.
1088  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 1124 
1124    
1125  =head3 InsertObject  =head3 InsertObject
1126    
1127  C<< my $ok = $database->InsertObject($objectType, \%fieldHash); >>  C<< my $ok = $erdb->InsertObject($objectType, \%fieldHash); >>
1128    
1129  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
1130  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 1133 
1133  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
1134  C<ZP_00210270.1> and C<gi|46206278>.  C<ZP_00210270.1> and C<gi|46206278>.
1135    
1136  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']}); >>
1137    
1138  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
1139  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>.
1140    
1141  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'}); >>
1142    
1143  =over 4  =over 4
1144    
# Line 1250  Line 1263 
1263    
1264  =head3 LoadTable  =head3 LoadTable
1265    
1266  C<< my %results = $database->LoadTable($fileName, $relationName, $truncateFlag); >>  C<< my %results = $erdb->LoadTable($fileName, $relationName, $truncateFlag); >>
1267    
1268  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
1269  first.  first.
# Line 1283  Line 1296 
1296          # Create the statistical return object.          # Create the statistical return object.
1297          my $retVal = _GetLoadStats();          my $retVal = _GetLoadStats();
1298          # Trace the fact of the load.          # Trace the fact of the load.
1299          Trace("Loading table $relationName from $fileName") if T(1);      Trace("Loading table $relationName from $fileName") if T(2);
1300          # Get the database handle.          # Get the database handle.
1301          my $dbh = $self->{_dbh};          my $dbh = $self->{_dbh};
1302          # Get the relation data.          # Get the relation data.
1303          my $relation = $self->_FindRelation($relationName);          my $relation = $self->_FindRelation($relationName);
1304          # Check the truncation flag.          # Check the truncation flag.
1305          if ($truncateFlag) {          if ($truncateFlag) {
1306                  Trace("Creating table $relationName") if T(1);          Trace("Creating table $relationName") if T(2);
1307                  # Re-create the table without its index.                  # Re-create the table without its index.
1308                  $self->CreateTable($relationName, 0);                  $self->CreateTable($relationName, 0);
1309            # If this is a pre-index DBMS, create the index here.
1310            if ($dbh->{_preIndex}) {
1311                eval {
1312                    $self->CreateIndex($relationName);
1313                };
1314                if ($@) {
1315                    $retVal->AddMessage($@);
1316                }
1317            }
1318          }          }
1319          # Determine whether or not this is a primary relation. Primary relations have an extra          # Determine whether or not this is a primary relation. Primary relations have an extra
1320          # field indicating whether or not a given object is new or was loaded from the flat files.          # field indicating whether or not a given object is new or was loaded from the flat files.
# Line 1348  Line 1370 
1370          # Close the files.          # Close the files.
1371          close TABLEIN;          close TABLEIN;
1372          close TABLEOUT;          close TABLEOUT;
1373      Trace("Temporary file $tempName created.") if T(4);      Trace("Temporary file $tempName created.") if T(2);
1374      # Load the table.      # Load the table.
1375          my $rv;          my $rv;
1376          eval {          eval {
# Line 1360  Line 1382 
1382                  Trace("Table load failed for $relationName.") if T(1);                  Trace("Table load failed for $relationName.") if T(1);
1383          } else {          } else {
1384                  # Here we successfully loaded the table. Trace the number of records loaded.                  # Here we successfully loaded the table. Trace the number of records loaded.
1385                  Trace("$retVal->{records} records read for $relationName.") if T(1);          Trace("$retVal->{records} records read for $relationName.") if T(2);
1386                  # If we're rebuilding, we need to create the table indexes.                  # If we're rebuilding, we need to create the table indexes.
1387                  if ($truncateFlag) {          if ($truncateFlag && ! $dbh->{_preIndex}) {
1388                          eval {                          eval {
1389                                  $self->CreateIndex($relationName);                                  $self->CreateIndex($relationName);
1390                          };                          };
# Line 1370  Line 1392 
1392                                  $retVal->AddMessage($@);                                  $retVal->AddMessage($@);
1393                          }                          }
1394                  }                  }
1395            # Analyze the table to help optimize tables.
1396          }          }
1397          # Commit the database changes.          # Commit the database changes.
1398          $dbh->commit_tran;          $dbh->commit_tran;
1399        $dbh->vacuum_it($relationName);
1400          # Delete the temporary file.          # Delete the temporary file.
1401          unlink $tempName;          unlink $tempName;
1402          # Return the statistics.          # Return the statistics.
# Line 1381  Line 1405 
1405    
1406  =head3 GenerateEntity  =head3 GenerateEntity
1407    
1408  C<< my $fieldHash = $database->GenerateEntity($id, $type, \%values); >>  C<< my $fieldHash = $erdb->GenerateEntity($id, $type, \%values); >>
1409    
1410  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
1411  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 1439  Line 1463 
1463    
1464  =head3 GetEntity  =head3 GetEntity
1465    
1466  C<< my $entityObject = $sprout->GetEntity($entityType, $ID); >>  C<< my $entityObject = $erdb->GetEntity($entityType, $ID); >>
1467    
1468  Return an object describing the entity instance with a specified ID.  Return an object describing the entity instance with a specified ID.
1469    
# Line 1475  Line 1499 
1499    
1500  =head3 GetEntityValues  =head3 GetEntityValues
1501    
1502  C<< my @values = GetEntityValues($entityType, $ID, \@fields); >>  C<< my @values = $erdb->GetEntityValues($entityType, $ID, \@fields); >>
1503    
1504  Return a list of values from a specified entity instance.  Return a list of values from a specified entity instance.
1505    
# Line 1518  Line 1542 
1542    
1543  =head3 GetAll  =head3 GetAll
1544    
1545  C<< my @list = $sprout->GetAll(\@objectNames, $filterClause, \@parameters, \@fields, $count); >>  C<< my @list = $erdb->GetAll(\@objectNames, $filterClause, \@parameters, \@fields, $count); >>
1546    
1547  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
1548  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 1534  Line 1558 
1558  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
1559  feature ID followed by all of its aliases.  feature ID followed by all of its aliases.
1560    
1561  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)']); >>
1562    
1563  =over 4  =over 4
1564    
# Line 1603  Line 1627 
1627          return @retVal;          return @retVal;
1628  }  }
1629    
1630    =head3 EstimateRowSize
1631    
1632    C<< my $rowSize = $erdb->EstimateRowSize($relName); >>
1633    
1634    Estimate the row size of the specified relation. The estimated row size is computed by adding
1635    up the average length for each data type.
1636    
1637    =over 4
1638    
1639    =item relName
1640    
1641    Name of the relation whose estimated row size is desired.
1642    
1643    =item RETURN
1644    
1645    Returns an estimate of the row size for the specified relation.
1646    
1647    =back
1648    
1649    =cut
1650    #: Return Type $;
1651    sub EstimateRowSize {
1652        # Get the parameters.
1653        my ($self, $relName) = @_;
1654        # Declare the return variable.
1655        my $retVal = 0;
1656        # Find the relation descriptor.
1657        my $relation = $self->_FindRelation($relName);
1658        # Get the list of fields.
1659        for my $fieldData (@{$relation->{Fields}}) {
1660            # Get the field type and add its length.
1661            my $fieldLen = $TypeTable{$fieldData->{type}}->{avgLen};
1662            $retVal += $fieldLen;
1663        }
1664        # Return the result.
1665        return $retVal;
1666    }
1667    
1668  =head2 Internal Utility Methods  =head2 Internal Utility Methods
1669    
1670  =head3 GetLoadStats  =head3 GetLoadStats
# Line 1978  Line 2040 
2040  sub _LoadMetaData {  sub _LoadMetaData {
2041          # Get the parameters.          # Get the parameters.
2042          my ($filename) = @_;          my ($filename) = @_;
2043        Trace("Reading Sprout DBD from $filename.") if T(2);
2044          # 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
2045          # get the exact structure we want.          # get the exact structure we want.
2046          my $metadata = XML::Simple::XMLin($filename,          my $metadata = XML::Simple::XMLin($filename,
# Line 2005  Line 2068 
2068          for my $entityName (keys %{$entityList}) {          for my $entityName (keys %{$entityList}) {
2069                  my $entityStructure = $entityList->{$entityName};                  my $entityStructure = $entityList->{$entityName};
2070                  #                  #
2071                  # 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,
2072                  # 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,
2073                  # 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>
2074                  # 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 2184  Line 2247 
2247                  my @fromList = ();                  my @fromList = ();
2248                  my @toList = ();                  my @toList = ();
2249                  my @bothList = ();                  my @bothList = ();
2250                  Trace("Join table build for $entityName.") if T(3);          Trace("Join table build for $entityName.") if T(4);
2251                  for my $relationshipName (keys %{$relationshipList}) {                  for my $relationshipName (keys %{$relationshipList}) {
2252                          my $relationship = $relationshipList->{$relationshipName};                          my $relationship = $relationshipList->{$relationshipName};
2253                          # 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.
2254                          my $fromEntity = $relationship->{from};                          my $fromEntity = $relationship->{from};
2255                          my $toEntity = $relationship->{to};                          my $toEntity = $relationship->{to};
2256                          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);
2257                          if ($fromEntity eq $entityName) {                          if ($fromEntity eq $entityName) {
2258                                  if ($toEntity eq $entityName) {                                  if ($toEntity eq $entityName) {
2259                                          # Here the relationship is recursive.                                          # Here the relationship is recursive.
2260                                          push @bothList, $relationshipName;                                          push @bothList, $relationshipName;
2261                                          Trace("Relationship $relationshipName put in both-list.") if T(3);                      Trace("Relationship $relationshipName put in both-list.") if T(4);
2262                                  } else {                                  } else {
2263                                          # Here the relationship comes from the entity.                                          # Here the relationship comes from the entity.
2264                                          push @fromList, $relationshipName;                                          push @fromList, $relationshipName;
2265                                          Trace("Relationship $relationshipName put in from-list.") if T(3);                      Trace("Relationship $relationshipName put in from-list.") if T(4);
2266                                  }                                  }
2267                          } elsif ($toEntity eq $entityName) {                          } elsif ($toEntity eq $entityName) {
2268                                  # Here the relationship goes to the entity.                                  # Here the relationship goes to the entity.
2269                                  push @toList, $relationshipName;                                  push @toList, $relationshipName;
2270                                  Trace("Relationship $relationshipName put in to-list.") if T(3);                  Trace("Relationship $relationshipName put in to-list.") if T(4);
2271                          }                          }
2272                  }                  }
2273                  # 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 2250  Line 2313 
2313                                  # relationship can only be ambiguous with another recursive relationship,                                  # relationship can only be ambiguous with another recursive relationship,
2314                                  # and the incoming relationship from the outer loop is never recursive.                                  # and the incoming relationship from the outer loop is never recursive.
2315                                  for my $otherName (@bothList) {                                  for my $otherName (@bothList) {
2316                                          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);
2317                                          # Join from the left.                                          # Join from the left.
2318                                          $joinTable{"$relationshipName/$otherName"} =                                          $joinTable{"$relationshipName/$otherName"} =
2319                                                  "$linkField = $otherName.from_link";                                                  "$linkField = $otherName.from_link";
# Line 2265  Line 2328 
2328                  # 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
2329                  # possible to get the same effect using multiple queries.                  # possible to get the same effect using multiple queries.
2330                  for my $relationshipName (@bothList) {                  for my $relationshipName (@bothList) {
2331                          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);
2332                          # Join to the entity from each direction.                          # Join to the entity from each direction.
2333                          $joinTable{"$entityName/$relationshipName"} =                          $joinTable{"$entityName/$relationshipName"} =
2334                                  "$entityName.id = $relationshipName.from_link";                                  "$entityName.id = $relationshipName.from_link";
# Line 2316  Line 2379 
2379          # 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
2380          # the field to it.          # the field to it.
2381          unshift @{$newIndex->{IndexFields}}, $firstField;          unshift @{$newIndex->{IndexFields}}, $firstField;
2382        # If this is a one-to-many relationship, the "To" index is unique.
2383        if ($relationshipStructure->{arity} eq "1M" && $indexKey eq "To") {
2384            $newIndex->{Unique} = 'true';
2385        }
2386          # Add the index to the relation.          # Add the index to the relation.
2387          _AddIndex("idx$relationshipName$indexKey", $relationStructure, $newIndex);          _AddIndex("idx$relationshipName$indexKey", $relationStructure, $newIndex);
2388  }  }

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.18

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3