[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.5, Tue Apr 5 05:17:01 2005 UTC revision 1.31, Thu Jan 19 09:28:11 2006 UTC
# Line 1  Line 1 
1  package ERDB;  package ERDB;
2    
3          use strict;          use strict;
         use Carp;  
4          use Tracer;          use Tracer;
5          use DBKernel;      use DBrtns;
6          use Data::Dumper;          use Data::Dumper;
7          use XML::Simple;          use XML::Simple;
8          use DBQuery;          use DBQuery;
9          use DBObject;          use DBObject;
10          use Stats;          use Stats;
11          use Time::HiRes qw(gettimeofday);          use Time::HiRes qw(gettimeofday);
12        use FIG;
13    
14  =head1 Entity-Relationship Database Package  =head1 Entity-Relationship Database Package
15    
# Line 33  Line 33 
33  relation that contains two fields-- the feature ID (C<id>) and the alias name (C<alias>).  relation that contains two fields-- the feature ID (C<id>) and the alias name (C<alias>).
34  The B<FEATURE> entity also contains an optional virulence number. This is implemented  The B<FEATURE> entity also contains an optional virulence number. This is implemented
35  as a separate relation C<FeatureVirulence> which contains an ID (C<id>) and a virulence number  as a separate relation C<FeatureVirulence> which contains an ID (C<id>) and a virulence number
36  (C<virulence>). If the virulence of a feature I<ABC> is known to be 6, there will be one row in the  (C<virulence>). If the virulence of a feature I<ABC> is known to be 6, there will be one row in
37  C<FeatureVirulence> relation possessing the value I<ABC> as its ID and 6 as its virulence number.  the C<FeatureVirulence> relation possessing the value I<ABC> as its ID and 6 as its virulence
38  If the virulence of I<ABC> is not known, there will not be any rows for it in C<FeatureVirulence>.  number. If the virulence of I<ABC> is not known, there will not be any rows for it in
39    C<FeatureVirulence>.
40    
41  Entities are connected by binary relationships implemented using single relations possessing the  Entities are connected by binary relationships implemented using single relations possessing the
42  same name as the relationship itself and that has an I<arity> of 1-to-1 (C<11>), 1-to-many (C<1M>),  same name as the relationship itself and that has an I<arity> of 1-to-1 (C<11>), 1-to-many (C<1M>),
# Line 70  Line 71 
71  is described in the L</GenerateEntity> and L</GenerateConnection> methods, though it is not yet  is described in the L</GenerateEntity> and L</GenerateConnection> methods, though it is not yet
72  fully implemented.  fully implemented.
73    
74    =head2 XML Database Description
75    
76    =head3 Data Types
77    
78    The ERDB system supports the following data types. Note that there are numerous string
79    types depending on the maximum length. Some database packages limit the total number of
80    characters you have in an index key; to insure the database works in all environments,
81    the type of string should be the shortest one possible that supports all the known values.
82    
83    =over 4
84    
85    =item char
86    
87    single ASCII character
88    
89    =item int
90    
91    32-bit signed integer
92    
93    =item date
94    
95    64-bit unsigned integer, representing a PERL date/time value
96    
97    =item text
98    
99    long string; Text fields cannot be used in indexes or sorting and do not support the
100    normal syntax of filter clauses, but can be up to a billion character in length
101    
102    =item float
103    
104    double-precision floating-point number
105    
106    =item boolean
107    
108    single-bit numeric value; The value is stored as a 16-bit signed integer (for
109    compatability with certain database packages), but the only values supported are
110    0 and 1.
111    
112    =item key-string
113    
114    variable-length string, maximum 40 characters
115    
116    =item name-string
117    
118    variable-length string, maximum 80 characters
119    
120    =item medium-string
121    
122    variable-length string, maximum 160 characters
123    
124    =item string
125    
126    variable-length string, maximum 255 characters
127    
128    =back
129    
130    =head3 Global Tags
131    
132    The entire database definition must be inside a B<Database> tag. The display name of
133    the database is given by the text associated with the B<Title> tag. The display name
134    is only used in the automated documentation. It has no other effect. The entities and
135    relationships are listed inside the B<Entities> and B<Relationships> tags,
136    respectively. None of these tags have attributes.
137    
138        <Database>
139            <Title>... display title here...</Title>
140            <Entities>
141                ... entity definitions here ...
142            </Entities>
143            <Relationships>
144                ... relationship definitions here...
145            </Relationships>
146        </Database>
147    
148    Entities, relationships, indexes, and fields all allow a text tag called B<Notes>.
149    The text inside the B<Notes> tag contains comments that will appear when the database
150    documentation is generated. Within a B<Notes> tag, you may use C<[i]> and C<[/i]> for
151    italics, C<[b]> and C<[/b]> for bold, and C<[p]> for a new paragraph.
152    
153    =head3 Fields
154    
155    Both entities and relationships have fields described by B<Field> tags. A B<Field>
156    tag can have B<Notes> associated with it. The complete set of B<Field> tags for an
157    object mus be inside B<Fields> tags.
158    
159        <Entity ... >
160            <Fields>
161                ... Field tags ...
162            </Fields>
163        </Entity>
164    
165    The attributes for the B<Field> tag are as follows.
166    
167    =over 4
168    
169    =item name
170    
171    Name of the field. The field name should contain only letters, digits, and hyphens (C<->),
172    and the first character should be a letter. Most underlying databases are case-insensitive
173    with the respect to field names, so a best practice is to use lower-case letters only.
174    
175    =item type
176    
177    Data type of the field. The legal data types are given above.
178    
179    =item relation
180    
181    Name of the relation containing the field. This should only be specified for entity
182    fields. The ERDB system does not support optional fields or multi-occurring fields
183    in the primary relation of an entity. Instead, they are put into secondary relations.
184    So, for example, in the C<Genome> entity, the C<group-name> field indicates a special
185    grouping used to select a subset of the genomes. A given genome may not be in any
186    groups or may be in multiple groups. Therefore, C<group-name> specifies a relation
187    value. The relation name specified must be a valid table name. By convention, it is
188    usually the entity name followed by a qualifying word (e.g. C<GenomeGroup>). In an
189    entity, the fields without a relation attribute are said to belong to the
190    I<primary relation>. This relation has the same name as the entity itself.
191    
192    =back
193    
194    =head3 Indexes
195    
196    An entity can have multiple alternate indexes associated with it. The fields must
197    be from the primary relation. The alternate indexes assist in ordering results
198    from a query. A relationship can have up to two indexes-- a I<to-index> and a
199    I<from-index>. These order the results when crossing the relationship. For
200    example, in the relationship C<HasContig> from C<Genome> to C<Contig>, the
201    from-index would order the contigs of a ganome, and the to-index would order
202    the genomes of a contig. A relationship's index must specify only fields in
203    the relationship.
204    
205    The indexes for an entity must be listed inside the B<Indexes> tag. The from-index
206    of a relationship is specified using the B<FromIndex> tag; the to-index is specified
207    using the B<ToIndex> tag.
208    
209    Each index can contain a B<Notes> tag. In addition, it will have an B<IndexFields>
210    tag containing the B<IndexField> tags. These specify, in order, the fields used in
211    the index. The attributes of an B<IndexField> tag are as follows.
212    
213    =over 4
214    
215    =item name
216    
217    Name of the field.
218    
219    =item order
220    
221    Sort order of the field-- C<ascending> or C<descending>.
222    
223    =back
224    
225    The B<Index>, B<FromIndex>, and B<ToIndex> tags themselves have no attributes.
226    
227    =head3 Object and Field Names
228    
229    By convention entity and relationship names use capital casing (e.g. C<Genome> or
230    C<HasRegionsIn>. Most underlying databases, however, are aggressively case-insensitive
231    with respect to relation names, converting them internally to all-upper case or
232    all-lower case.
233    
234    If syntax or parsing errors occur when you try to load or use an ERDB database, the
235    most likely reason is that one of your objects has an SQL reserved word as its name.
236    The list of SQL reserved words keeps increasing; however, most are unlikely to show
237    up as a noun or declarative verb phrase. The exceptions are C<Group>, C<User>,
238    C<Table>, C<Index>, C<Object>, C<Date>, C<Number>, C<Update>, C<Time>, C<Percent>,
239    C<Memo>, C<Order>, and C<Sum>. This problem can crop up in field names as well.
240    
241    Every entity has a field called C<id> that acts as its primary key. Every relationship
242    has fields called C<from-link> and C<to-link> that contain copies of the relevant
243    entity IDs. These are essentially ERDB's reserved words, and should not be used
244    for user-defined field names.
245    
246    =head3 Entities
247    
248    An entity is described by the B<Entity> tag. The entity can contain B<Notes>, an
249    B<Indexes> tag containing one or more secondary indexes, and a B<Fields> tag
250    containing one or more fields. The attributes of the B<Entity> tag are as follows.
251    
252    =over 4
253    
254    =item name
255    
256    Name of the entity. The entity name, by convention, uses capital casing (e.g. C<Genome>
257    or C<GroupBlock>) and should be a noun or noun phrase.
258    
259    =item keyType
260    
261    Data type of the primary key. The primary key is always named C<id>.
262    
263    =back
264    
265    =head3 Relationships
266    
267    A relationship is described by the C<Relationship> tag. Within a relationship,
268    there can be a C<Notes> tag, a C<Fields> tag containing the intersection data
269    fields, a C<FromIndex> tag containing the from-index, and a C<ToIndex> tag containing
270    the to-index.
271    
272    The C<Relationship> tag has the following attributes.
273    
274    =over 4
275    
276    =item name
277    
278    Name of the relationship. The relationship name, by convention, uses capital casing
279    (e.g. C<ContainsRegionIn> or C<HasContig>), and should be a declarative verb
280    phrase, designed to fit between the from-entity and the to-entity (e.g.
281    Block C<ContainsRegionIn> Genome).
282    
283    =item from
284    
285    Name of the entity from which the relationship starts.
286    
287    =item to
288    
289    Name of the entity to which the relationship proceeds.
290    
291    =item arity
292    
293    Relationship type: C<1M> for one-to-many and C<MM> for many-to-many.
294    
295    =back
296    
297  =cut  =cut
298    
299  # GLOBALS  # GLOBALS
# Line 77  Line 301 
301  # Table of information about our datatypes. "sqlType" is the corresponding SQL datatype string.  # Table of information about our datatypes. "sqlType" is the corresponding SQL datatype string.
302  # "maxLen" is the maximum permissible length of the incoming string data used to populate a field  # "maxLen" is the maximum permissible length of the incoming string data used to populate a field
303  # of the specified type. "dataGen" is PERL string that will be evaluated if no test data generation  # of the specified type. "dataGen" is PERL string that will be evaluated if no test data generation
304   #string is specified in the field definition.  # string is specified in the field definition. "avgLen" is the average byte length for estimating
305  my %TypeTable = ( char =>        { sqlType => 'CHAR(1)',                        maxLen => 1,                    dataGen => "StringGen('A')" },  # record sizes.
306                                    int =>         { sqlType => 'INTEGER',                        maxLen => 20,                   dataGen => "IntGen(0, 99999999)" },  my %TypeTable = ( char =>    { sqlType => 'CHAR(1)',            maxLen => 1,            avgLen =>   1, dataGen => "StringGen('A')" },
307                                    string =>  { sqlType => 'VARCHAR(255)',               maxLen => 255,                  dataGen => "StringGen(IntGen(10,250))" },                    int =>     { sqlType => 'INTEGER',            maxLen => 20,           avgLen =>   4, dataGen => "IntGen(0, 99999999)" },
308                                    text =>        { sqlType => 'TEXT',                           maxLen => 1000000000,   dataGen => "StringGen(IntGen(80,1000))" },                    string =>  { sqlType => 'VARCHAR(255)',       maxLen => 255,          avgLen => 100, dataGen => "StringGen(IntGen(10,250))" },
309                                    date =>        { sqlType => 'BIGINT',                         maxLen => 80,                   dataGen => "DateGen(-7, 7, IntGen(0,1400))" },                    text =>    { sqlType => 'TEXT',               maxLen => 1000000000,   avgLen => 500, dataGen => "StringGen(IntGen(80,1000))" },
310                                    float =>       { sqlType => 'DOUBLE PRECISION',       maxLen => 40,                   dataGen => "FloatGen(0.0, 100.0)" },                    date =>    { sqlType => 'BIGINT',             maxLen => 80,           avgLen =>   8, dataGen => "DateGen(-7, 7, IntGen(0,1400))" },
311                                    boolean => { sqlType => 'SMALLINT',                   maxLen => 1,                    dataGen => "IntGen(0, 1)" },                    float =>   { sqlType => 'DOUBLE PRECISION',   maxLen => 40,           avgLen =>   8, dataGen => "FloatGen(0.0, 100.0)" },
312                      boolean => { sqlType => 'SMALLINT',           maxLen => 1,            avgLen =>   1, dataGen => "IntGen(0, 1)" },
313                               'key-string' =>                               'key-string' =>
314                                                           { sqlType => 'VARCHAR(40)',            maxLen => 40,                   dataGen => "StringGen(IntGen(10,40))" },                               { sqlType => 'VARCHAR(40)',        maxLen => 40,           avgLen =>  10, dataGen => "StringGen(IntGen(10,40))" },
315                                   'name-string' =>                                   'name-string' =>
316                                                           { sqlType => 'VARCHAR(80)',            maxLen => 80,                   dataGen => "StringGen(IntGen(10,80))" },                               { sqlType => 'VARCHAR(80)',        maxLen => 80,           avgLen =>  40, dataGen => "StringGen(IntGen(10,80))" },
317                                   'medium-string' =>                                   'medium-string' =>
318                                                           { sqlType => 'VARCHAR(160)',           maxLen => 160,                  dataGen => "StringGen(IntGen(10,160))" },                               { sqlType => 'VARCHAR(160)',       maxLen => 160,          avgLen =>  40, dataGen => "StringGen(IntGen(10,160))" },
319                                  );                                  );
320    
321  # Table translating arities into natural language.  # Table translating arities into natural language.
# Line 140  Line 365 
365                                   _metaData => $metaData                                   _metaData => $metaData
366                             };                             };
367          # Bless and return it.          # Bless and return it.
368          bless $self;      bless $self, $class;
369          return $self;          return $self;
370  }  }
371    
372  =head3 ShowMetaData  =head3 ShowMetaData
373    
374  C<< $database->ShowMetaData($fileName); >>  C<< $erdb->ShowMetaData($fileName); >>
375    
376  This method outputs a description of the database. This description can be used to help users create  This method outputs a description of the database. This description can be used to help users create
377  the data to be loaded into the relations.  the data to be loaded into the relations.
# Line 278  Line 503 
503          print HTMLOUT _OpenTable("Join Table", "Source", "Target", "Join Condition");          print HTMLOUT _OpenTable("Join Table", "Source", "Target", "Join Condition");
504          # Loop through the joins.          # Loop through the joins.
505          my $joinTable = $metadata->{Joins};          my $joinTable = $metadata->{Joins};
506          for my $joinKey (sort keys %{$joinTable}) {      my @joinKeys = keys %{$joinTable};
507        for my $joinKey (sort @joinKeys) {
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 ($source, $target, $clause) = ($self->ComputeObjectSentence($1),          my ($sourceRelation, $targetRelation) = ($1, $2);
511                                                                                    $self->ComputeObjectSentence($2),          Trace("Join with key $joinKey is from $sourceRelation to $targetRelation.") if T(Joins => 4);
512                                                                                    $joinTable->{$joinKey});          my $source = $self->ComputeObjectSentence($sourceRelation);
513            my $target = $self->ComputeObjectSentence($targetRelation);
514            my $clause = $joinTable->{$joinKey};
515                  # Display them in a table row.                  # Display them in a table row.
516                  print HTMLOUT "<tr><td>$source</td><td>$target</td><td>$clause</td></tr>\n";                  print HTMLOUT "<tr><td>$source</td><td>$target</td><td>$clause</td></tr>\n";
517          }          }
# Line 298  Line 526 
526    
527  =head3 DumpMetaData  =head3 DumpMetaData
528    
529  C<< $database->DumpMetaData(); >>  C<< $erdb->DumpMetaData(); >>
530    
531  Return a dump of the metadata structure.  Return a dump of the metadata structure.
532    
# Line 313  Line 541 
541    
542  =head3 CreateTables  =head3 CreateTables
543    
544  C<< $datanase->CreateTables(); >>  C<< $erdb->CreateTables(); >>
545    
546  This method creates the tables for the database from the metadata structure loaded by the  This method creates the tables for the database from the metadata structure loaded by the
547  constructor. It is expected this function will only be used on rare occasions, when the  constructor. It is expected this function will only be used on rare occasions, when the
# Line 325  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          while (my ($entityName, $entityData) = each %{$metadata->{Entities}}) {      for my $relationName (@relNames) {
                 # Tell the user what we're doing.  
                 Trace("Creating relations for entity $entityName.") if T(1);  
                 # Loop through the entity's relations.  
                 for my $relationName (keys %{$entityData->{Relations}}) {  
560                          # Create a table for this relation.                          # Create a table for this relation.
561                          $self->CreateTable($relationName);                          $self->CreateTable($relationName);
562                          Trace("Relation $relationName created.") if T(1);          Trace("Relation $relationName created.") if T(2);
                 }  
         }  
         # Loop through the relationships.  
         my $relationshipTable = $metadata->{Relationships};  
         for my $relationshipName (keys %{$metadata->{Relationships}}) {  
                 # Create a table for this relationship.  
                 Trace("Creating relationship $relationshipName.") if T(1);  
                 $self->CreateTable($relationshipName);  
563          }          }
564  }  }
565    
566  =head3 CreateTable  =head3 CreateTable
567    
568  C<< $database->CreateTable($tableName, $indexFlag); >>  C<< $erdb->CreateTable($tableName, $indexFlag, $estimatedRows); >>
569    
570  Create the table for a relation and optionally create its indexes.  Create the table for a relation and optionally create its indexes.
571    
# Line 359  Line 575 
575    
576  Name of the relation (which will also be the table name).  Name of the relation (which will also be the table name).
577    
578  =item $indexFlag  =item indexFlag
579    
580  TRUE if the indexes for the relation should be created, else FALSE. If FALSE,  TRUE if the indexes for the relation should be created, else FALSE. If FALSE,
581  L</CreateIndexes> must be called later to bring the indexes into existence.  L</CreateIndexes> must be called later to bring the indexes into existence.
582    
583    =item estimatedRows (optional)
584    
585    If specified, the estimated maximum number of rows for the relation. This
586    information allows the creation of tables using storage engines that are
587    faster but require size estimates, such as MyISAM.
588    
589  =back  =back
590    
591  =cut  =cut
592    
593  sub CreateTable {  sub CreateTable {
594          # Get the parameters.          # Get the parameters.
595          my ($self, $relationName, $indexFlag) = @_;      my ($self, $relationName, $indexFlag, $estimatedRows) = @_;
596          # Get the database handle.          # Get the database handle.
597          my $dbh = $self->{_dbh};          my $dbh = $self->{_dbh};
598          # Get the relation data and determine whether or not the relation is primary.          # Get the relation data and determine whether or not the relation is primary.
# Line 394  Line 616 
616          # Insure the table is not already there.          # Insure the table is not already there.
617          $dbh->drop_table(tbl => $relationName);          $dbh->drop_table(tbl => $relationName);
618          Trace("Table $relationName dropped.") if T(2);          Trace("Table $relationName dropped.") if T(2);
619        # If there are estimated rows, create an estimate so we can take advantage of
620        # faster DB technologies.
621        my $estimation = undef;
622        if ($estimatedRows) {
623            $estimation = [$self->EstimateRowSize($relationName), $estimatedRows];
624        }
625          # Create the table.          # Create the table.
626          Trace("Creating table $relationName: $fieldThing") if T(2);          Trace("Creating table $relationName: $fieldThing") if T(2);
627          $dbh->create_table(tbl => $relationName, flds => $fieldThing);      $dbh->create_table(tbl => $relationName, flds => $fieldThing, estimates => $estimation);
628          Trace("Relation $relationName created in database.") if T(2);          Trace("Relation $relationName created in database.") if T(2);
629          # If we want to build the indexes, we do it here.          # If we want to build the indexes, we do it here.
630          if ($indexFlag) {          if ($indexFlag) {
# Line 404  Line 632 
632          }          }
633  }  }
634    
635    =head3 VerifyFields
636    
637    C<< my $count = $erdb->VerifyFields($relName, \@fieldList); >>
638    
639    Run through the list of proposed field values, insuring that all the character fields are
640    below the maximum length. If any fields are too long, they will be truncated in place.
641    
642    =over 4
643    
644    =item relName
645    
646    Name of the relation for which the specified fields are destined.
647    
648    =item fieldList
649    
650    Reference to a list, in order, of the fields to be put into the relation.
651    
652    =item RETURN
653    
654    Returns the number of fields truncated.
655    
656    =back
657    
658    =cut
659    
660    sub VerifyFields {
661        # Get the parameters.
662        my ($self, $relName, $fieldList) = @_;
663        # Initialize the return value.
664        my $retVal = 0;
665        # Get the relation definition.
666        my $relData = $self->_FindRelation($relName);
667        # Get the list of field descriptors.
668        my $fieldTypes = $relData->{Fields};
669        my $fieldCount = scalar @{$fieldTypes};
670        # Loop through the two lists.
671        for (my $i = 0; $i < $fieldCount; $i++) {
672            # Get the type of the current field.
673            my $fieldType = $fieldTypes->[$i]->{type};
674            # If it's a character field, verify the length.
675            if ($fieldType =~ /string/) {
676                my $maxLen = $TypeTable{$fieldType}->{maxLen};
677                my $oldString = $fieldList->[$i];
678                if (length($oldString) > $maxLen) {
679                    # Here it's too big, so we truncate it.
680                    Trace("Truncating field $i in relation $relName to $maxLen characters from \"$oldString\".") if T(1);
681                    $fieldList->[$i] = substr $oldString, 0, $maxLen;
682                    $retVal++;
683                }
684            }
685        }
686        # Return the truncation count.
687        return $retVal;
688    }
689    
690  =head3 CreateIndex  =head3 CreateIndex
691    
692  C<< $database->CreateIndex($relationName); >>  C<< $erdb->CreateIndex($relationName); >>
693    
694  Create the indexes for a relation. If a table is being loaded from a large source file (as  Create the indexes for a relation. If a table is being loaded from a large source file (as
695  is the case in L</LoadTable>), it is best to create the indexes after the load. If that is  is the case in L</LoadTable>), it is sometimes best to create the indexes after the load.
696  the case, then L</CreateTable> should be called with the index flag set to FALSE, and this  If that is the case, then L</CreateTable> should be called with the index flag set to
697  method used after the load to create the indexes for the table.  FALSE, and this method used after the load to create the indexes for the table.
698    
699  =cut  =cut
700    
# Line 423  Line 706 
706          # Get the database handle.          # Get the database handle.
707          my $dbh = $self->{_dbh};          my $dbh = $self->{_dbh};
708          # Now we need to create this relation's indexes. We do this by looping through its index table.          # Now we need to create this relation's indexes. We do this by looping through its index table.
709          while (my ($indexName, $indexData) = each %{$relationData->{Indexes}}) {      my $indexHash = $relationData->{Indexes};
710        for my $indexName (keys %{$indexHash}) {
711            my $indexData = $indexHash->{$indexName};
712                  # Get the index's field list.                  # Get the index's field list.
713                  my @fieldList = _FixNames(@{$indexData->{IndexFields}});                  my @fieldList = _FixNames(@{$indexData->{IndexFields}});
714                  my $flds = join(', ', @fieldList);                  my $flds = join(', ', @fieldList);
715                  # Get the index's uniqueness flag.                  # Get the index's uniqueness flag.
716                  my $unique = (exists $indexData->{Unique} ? $indexData->{Unique} : 'false');                  my $unique = (exists $indexData->{Unique} ? $indexData->{Unique} : 'false');
717                  # Create the index.                  # Create the index.
718                  $dbh->create_index(idx => $indexName, tbl => $relationName, flds => $flds, unique => $unique);          my $rv = $dbh->create_index(idx => $indexName, tbl => $relationName,
719                                        flds => $flds, unique => $unique);
720            if ($rv) {
721                  Trace("Index created: $indexName for $relationName ($flds)") if T(1);                  Trace("Index created: $indexName for $relationName ($flds)") if T(1);
722            } else {
723                Confess("Error creating index $indexName for $relationName using ($flds): " . $dbh->error_message());
724            }
725          }          }
726  }  }
727    
728  =head3 LoadTables  =head3 LoadTables
729    
730  C<< my $stats = $database->LoadTables($directoryName, $rebuild); >>  C<< my $stats = $erdb->LoadTables($directoryName, $rebuild); >>
731    
732  This method will load the database tables from a directory. The tables must already have been created  This method will load the database tables from a directory. The tables must already have been created
733  in the database. (This can be done by calling L</CreateTables>.) The caller passes in a directory name;  in the database. (This can be done by calling L</CreateTables>.) The caller passes in a directory name;
# Line 480  Line 770 
770          $directoryName =~ s!/\\$!!;          $directoryName =~ s!/\\$!!;
771          # Declare the return variable.          # Declare the return variable.
772          my $retVal = Stats->new();          my $retVal = Stats->new();
773          # Get the metadata structure.      # Get the relation names.
774          my $metaData = $self->{_metaData};      my @relNames = $self->GetTableNames();
775          # Loop through the entities.      for my $relationName (@relNames) {
         for my $entity (values %{$metaData->{Entities}}) {  
                 # Loop through the entity's relations.  
                 for my $relationName (keys %{$entity->{Relations}}) {  
776                          # Try to load this relation.                          # Try to load this relation.
777                          my $result = $self->_LoadRelation($directoryName, $relationName, $rebuild);                          my $result = $self->_LoadRelation($directoryName, $relationName, $rebuild);
778                          # Accumulate the statistics.                          # Accumulate the statistics.
779                          $retVal->Accumulate($result);                          $retVal->Accumulate($result);
780                  }                  }
         }  
         # Loop through the relationships.  
         for my $relationshipName (keys %{$metaData->{Relationships}}) {  
                 # Try to load this relationship's relation.  
                 my $result = $self->_LoadRelation($directoryName, $relationshipName, $rebuild);  
                 # Accumulate the statistics.  
                 $retVal->Accumulate($result);  
         }  
781          # Add the duration of the load to the statistical object.          # Add the duration of the load to the statistical object.
782          $retVal->Add('duration', gettimeofday - $startTime);          $retVal->Add('duration', gettimeofday - $startTime);
783          # Return the accumulated statistics.          # Return the accumulated statistics.
784          return $retVal;          return $retVal;
785  }  }
786    
787    
788  =head3 GetTableNames  =head3 GetTableNames
789    
790  C<< my @names = $database->GetTableNames; >>  C<< my @names = $erdb->GetTableNames; >>
791    
792  Return a list of the relations required to implement this database.  Return a list of the relations required to implement this database.
793    
# Line 524  Line 804 
804    
805  =head3 GetEntityTypes  =head3 GetEntityTypes
806    
807  C<< my @names = $database->GetEntityTypes; >>  C<< my @names = $erdb->GetEntityTypes; >>
808    
809  Return a list of the entity type names.  Return a list of the entity type names.
810    
# Line 539  Line 819 
819          return sort keys %{$entityList};          return sort keys %{$entityList};
820  }  }
821    
822    =head3 IsEntity
823    
824    C<< my $flag = $erdb->IsEntity($entityName); >>
825    
826    Return TRUE if the parameter is an entity name, else FALSE.
827    
828    =over 4
829    
830    =item entityName
831    
832    Object name to be tested.
833    
834    =item RETURN
835    
836    Returns TRUE if the specified string is an entity name, else FALSE.
837    
838    =back
839    
840    =cut
841    
842    sub IsEntity {
843        # Get the parameters.
844        my ($self, $entityName) = @_;
845        # Test to see if it's an entity.
846        return exists $self->{_metaData}->{Entities}->{$entityName};
847    }
848    
849  =head3 Get  =head3 Get
850    
851  C<< my $query = $database->Get(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >>  C<< my $query = $erdb->Get(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >>
852    
853  This method returns a query object for entities of a specified type using a specified filter.  This method returns a query object for entities of a specified type using a specified filter.
854  The filter is a standard WHERE/ORDER BY clause with question marks as parameter markers and each  The filter is a standard WHERE/ORDER BY clause with question marks as parameter markers and each
# Line 549  Line 856 
856  following call requests all B<Genome> objects for the genus specified in the variable  following call requests all B<Genome> objects for the genus specified in the variable
857  $genus.  $genus.
858    
859  C<< $query = $sprout->Get(['Genome'], "Genome(genus) = ?", $genus); >>  C<< $query = $erdb->Get(['Genome'], "Genome(genus) = ?", $genus); >>
860    
861  The WHERE clause contains a single question mark, so there is a single additional  The WHERE clause contains a single question mark, so there is a single additional
862  parameter representing the parameter value. It would also be possible to code  parameter representing the parameter value. It would also be possible to code
863    
864  C<< $query = $sprout->Get(['Genome'], "Genome(genus) = \'$genus\'"); >>  C<< $query = $erdb->Get(['Genome'], "Genome(genus) = \'$genus\'"); >>
865    
866  however, this version of the call would generate a syntax error if there were any quote  however, this version of the call would generate a syntax error if there were any quote
867  characters inside the variable C<$genus>.  characters inside the variable C<$genus>.
# Line 566  Line 873 
873  It is possible to specify multiple entity and relationship names in order to retrieve more than  It is possible to specify multiple entity and relationship names in order to retrieve more than
874  one object's data at the same time, which allows highly complex joined queries. For example,  one object's data at the same time, which allows highly complex joined queries. For example,
875    
876  C<< $query = $sprout->Get(['Genome', 'ComesFrom', 'Source'], "Genome(genus) = ?", $genus); >>  C<< $query = $erdb->Get(['Genome', 'ComesFrom', 'Source'], "Genome(genus) = ?", $genus); >>
877    
878  If multiple names are specified, then the query processor will automatically determine a  If multiple names are specified, then the query processor will automatically determine a
879  join path between the entities and relationships. The algorithm used is very simplistic.  join path between the entities and relationships. The algorithm used is very simplistic.
# Line 599  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 707  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 724  Line 1036 
1036                  if (@joinWhere) {                  if (@joinWhere) {
1037                          $command .= " WHERE " . join(' AND ', @joinWhere);                          $command .= " WHERE " . join(' AND ', @joinWhere);
1038                  }                  }
1039                  # Add the sort clause (if any) to the SELECT command.          # Add the sort or limit clause (if any) to the SELECT command.
1040                  if ($orderClause) {                  if ($orderClause) {
1041                          $command .= " ORDER BY $orderClause";              $command .= " $orderClause";
1042                  }                  }
1043          }          }
1044          Trace("SQL query: $command") if T(2);      Trace("SQL query: $command") if T(SQL => 4);
1045          Trace("PARMS: '" . (join "', '", @params) . "'") if (T(3) && (@params > 0));      Trace("PARMS: '" . (join "', '", @params) . "'") if (T(SQL => 4) && (@params > 0));
1046          my $sth = $dbh->prepare_command($command);          my $sth = $dbh->prepare_command($command);
1047          # Execute it with the parameters bound in.          # Execute it with the parameters bound in.
1048          $sth->execute(@params) || Confess("SELECT error" . $sth->errstr());          $sth->execute(@params) || Confess("SELECT error" . $sth->errstr());
# Line 739  Line 1051 
1051          return $retVal;          return $retVal;
1052  }  }
1053    
1054    =head3 GetList
1055    
1056    C<< my @dbObjects = $erdb->GetList(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >>
1057    
1058    Return a list of object descriptors for the specified objects as determined by the
1059    specified filter clause.
1060    
1061    This method is essentially the same as L</Get> except it returns a list of objects rather
1062    than a query object that can be used to get the results one record at a time.
1063    
1064    =over 4
1065    
1066    =item objectNames
1067    
1068    List containing the names of the entity and relationship objects to be retrieved.
1069    
1070    =item filterClause
1071    
1072    WHERE clause (without the WHERE) to be used to filter and sort the query. The WHERE clause can
1073    be parameterized with parameter markers (C<?>). Each field used in the WHERE clause must be
1074    specified in the standard form B<I<objectName>(I<fieldName>)>. Any parameters specified
1075    in the filter clause should be added to the parameter list as additional parameters. The
1076    fields in a filter clause can come from primary entity relations, relationship relations,
1077    or secondary entity relations; however, all of the entities and relationships involved must
1078    be included in the list of object names.
1079    
1080    The filter clause can also specify a sort order. To do this, simply follow the filter string
1081    with an ORDER BY clause. For example, the following filter string gets all genomes for a
1082    particular genus and sorts them by species name.
1083    
1084    C<< "Genome(genus) = ? ORDER BY Genome(species)" >>
1085    
1086    The rules for field references in a sort order are the same as those for field references in the
1087    filter clause in general; however, odd things may happen if a sort field is from a secondary
1088    relation.
1089    
1090    =item param1, param2, ..., paramN
1091    
1092    Parameter values to be substituted into the filter clause.
1093    
1094    =item RETURN
1095    
1096    Returns a list of B<DBObject>s that satisfy the query conditions.
1097    
1098    =back
1099    
1100    =cut
1101    #: Return Type @%
1102    sub GetList {
1103        # Get the parameters.
1104        my ($self, $objectNames, $filterClause, @params) = @_;
1105        # Declare the return variable.
1106        my @retVal = ();
1107        # Perform the query.
1108        my $query = $self->Get($objectNames, $filterClause, @params);
1109        # Loop through the results.
1110        while (my $object = $query->Fetch) {
1111            push @retVal, $object;
1112        }
1113        # Return the result.
1114        return @retVal;
1115    }
1116    
1117  =head3 ComputeObjectSentence  =head3 ComputeObjectSentence
1118    
1119  C<< my $sentence = $database->ComputeObjectSentence($objectName); >>  C<< my $sentence = $erdb->ComputeObjectSentence($objectName); >>
1120    
1121  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.
1122    
# Line 776  Line 1151 
1151    
1152  =head3 DumpRelations  =head3 DumpRelations
1153    
1154  C<< $database->DumpRelations($outputDirectory); >>  C<< $erdb->DumpRelations($outputDirectory); >>
1155    
1156  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.
1157  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 797  Line 1172 
1172          # Now we need to run through all the relations. First, we loop through the entities.          # Now we need to run through all the relations. First, we loop through the entities.
1173          my $metaData = $self->{_metaData};          my $metaData = $self->{_metaData};
1174          my $entities = $metaData->{Entities};          my $entities = $metaData->{Entities};
1175          while (my ($entityName, $entityStructure) = each %{$entities}) {      for my $entityName (keys %{$entities}) {
1176            my $entityStructure = $entities->{$entityName};
1177                  # Get the entity's relations.                  # Get the entity's relations.
1178                  my $relationList = $entityStructure->{Relations};                  my $relationList = $entityStructure->{Relations};
1179                  # Loop through the relations, dumping them.                  # Loop through the relations, dumping them.
1180                  while (my ($relationName, $relation) = each %{$relationList}) {          for my $relationName (keys %{$relationList}) {
1181                my $relation = $relationList->{$relationName};
1182                          $self->_DumpRelation($outputDirectory, $relationName, $relation);                          $self->_DumpRelation($outputDirectory, $relationName, $relation);
1183                  }                  }
1184          }          }
1185          # Next, we loop through the relationships.          # Next, we loop through the relationships.
1186          my $relationships = $metaData->{Relationships};          my $relationships = $metaData->{Relationships};
1187          while (my ($relationshipName, $relationshipStructure) = each %{$relationships}) {      for my $relationshipName (keys %{$relationships}) {
1188            my $relationshipStructure = $relationships->{$relationshipName};
1189                  # Dump this relationship's relation.                  # Dump this relationship's relation.
1190                  $self->_DumpRelation($outputDirectory, $relationshipName, $relationshipStructure->{Relations}->{$relationshipName});                  $self->_DumpRelation($outputDirectory, $relationshipName, $relationshipStructure->{Relations}->{$relationshipName});
1191          }          }
# Line 815  Line 1193 
1193    
1194  =head3 InsertObject  =head3 InsertObject
1195    
1196  C<< my $ok = $database->InsertObject($objectType, \%fieldHash); >>  C<< my $ok = $erdb->InsertObject($objectType, \%fieldHash); >>
1197    
1198  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
1199  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 824  Line 1202 
1202  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
1203  C<ZP_00210270.1> and C<gi|46206278>.  C<ZP_00210270.1> and C<gi|46206278>.
1204    
1205  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']}); >>
1206    
1207  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
1208  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>.
1209    
1210  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'}); >>
1211    
1212  =over 4  =over 4
1213    
# Line 861  Line 1239 
1239          # Loop through the relations. We'll build insert statements for each one. If a relation is          # Loop through the relations. We'll build insert statements for each one. If a relation is
1240          # secondary, we may end up generating multiple insert statements. If an error occurs, we          # secondary, we may end up generating multiple insert statements. If an error occurs, we
1241          # stop the loop.          # stop the loop.
1242          while ($retVal && (my ($relationName, $relationDefinition) = each %{$relationTable})) {      my @relationList = keys %{$relationTable};
1243        for (my $i = 0; $retVal && $i <= $#relationList; $i++) {
1244            my $relationName = $relationList[$i];
1245            my $relationDefinition = $relationTable->{$relationName};
1246                  # Get the relation's fields. For each field we will collect a value in the corresponding                  # Get the relation's fields. For each field we will collect a value in the corresponding
1247                  # position of the @valueList array. If one of the fields is missing, we will add it to the                  # position of the @valueList array. If one of the fields is missing, we will add it to the
1248                  # @missing list.                  # @missing list.
# Line 951  Line 1332 
1332    
1333  =head3 LoadTable  =head3 LoadTable
1334    
1335  C<< my %results = $database->LoadTable($fileName, $relationName, $truncateFlag); >>  C<< my %results = $erdb->LoadTable($fileName, $relationName, $truncateFlag); >>
1336    
1337  Load data from a tab-delimited file into a specified table, optionally re-creating the table first.  Load data from a tab-delimited file into a specified table, optionally re-creating the table
1338    first.
1339    
1340  =over 4  =over 4
1341    
# Line 971  Line 1353 
1353    
1354  =item RETURN  =item RETURN
1355    
1356  Returns a statistical object containing the number of records read and a list of the error messages.  Returns a statistical object containing a list of the error messages.
1357    
1358  =back  =back
1359    
# Line 982  Line 1364 
1364          # Create the statistical return object.          # Create the statistical return object.
1365          my $retVal = _GetLoadStats();          my $retVal = _GetLoadStats();
1366          # Trace the fact of the load.          # Trace the fact of the load.
1367          Trace("Loading table $relationName from $fileName") if T(1);      Trace("Loading table $relationName from $fileName") if T(2);
1368          # Get the database handle.          # Get the database handle.
1369          my $dbh = $self->{_dbh};          my $dbh = $self->{_dbh};
1370        # Get the input file size.
1371        my $fileSize = -s $fileName;
1372          # Get the relation data.          # Get the relation data.
1373          my $relation = $self->_FindRelation($relationName);          my $relation = $self->_FindRelation($relationName);
1374          # Check the truncation flag.          # Check the truncation flag.
1375          if ($truncateFlag) {          if ($truncateFlag) {
1376                  Trace("Creating table $relationName") if T(1);          Trace("Creating table $relationName") if T(2);
1377            # Compute the row count estimate. We take the size of the load file,
1378            # divide it by the estimated row size, and then multiply by 1.5 to
1379            # leave extra room. We postulate a minimum row count of 1000 to
1380            # prevent problems with incoming empty load files.
1381            my $rowSize = $self->EstimateRowSize($relationName);
1382            my $estimate = FIG::max($fileSize * 1.5 / $rowSize, 1000);
1383                  # Re-create the table without its index.                  # Re-create the table without its index.
1384                  $self->CreateTable($relationName, 0);          $self->CreateTable($relationName, 0, $estimate);
1385            # If this is a pre-index DBMS, create the index here.
1386            if ($dbh->{_preIndex}) {
1387                eval {
1388                    $self->CreateIndex($relationName);
1389                };
1390                if ($@) {
1391                    $retVal->AddMessage($@);
1392                }
1393            }
1394          }          }
         # 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;  
         # Record the number of expected fields.  
         my $expectedFields = $fieldCount + ($primary ? 1 : 0);  
         # 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;  
         # Loop through the file.  
         while (<TABLEIN>) {  
                 # Chop off the new-line character.  
                 my $record = $_;  
                 chomp $record;  
         # Only proceed if the record is non-blank.  
         if ($record) {  
             # Escape all the backslashes found in the line.  
             $record =~ s/\\/\\\\/g;  
             # Eliminate any trailing tabs.  
             chop $record while substr($record, -1) eq "\t";  
             # 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) {  
                 $record .= "\t0";  
             }  
             # Write the record.  
             print TABLEOUT "$record\n";  
             # Count the record read.  
             my $count = $retVal->Add('records');  
             my $len = length $record;  
             Trace("Record $count written with $len characters.") if T(4);  
         }  
         }  
         # Close the files.  
         close TABLEIN;  
         close TABLEOUT;  
     Trace("Temporary file $tempName created.") if T(4);  
1395      # Load the table.      # Load the table.
1396          my $rv;          my $rv;
1397          eval {          eval {
1398                  $rv = $dbh->load_table(file => $tempName, tbl => $relationName);          $rv = $dbh->load_table(file => $fileName, tbl => $relationName);
1399          };          };
1400          if (!defined $rv) {          if (!defined $rv) {
1401          $retVal->AddMessage($@) if ($@);          $retVal->AddMessage($@) if ($@);
1402          $retVal->AddMessage("Table load failed for $relationName using $tempName.");          $retVal->AddMessage("Table load failed for $relationName using $fileName.");
1403                  Trace("Table load failed for $relationName.") if T(1);                  Trace("Table load failed for $relationName.") if T(1);
1404          } else {          } else {
1405                  # Here we successfully loaded the table. Trace the number of records loaded.          # Here we successfully loaded the table.
1406                  Trace("$retVal->{records} records read for $relationName.") if T(1);          $retVal->Add("tables");
1407            my $size = -s $fileName;
1408            Trace("$size bytes loaded into $relationName.") if T(2);
1409                  # If we're rebuilding, we need to create the table indexes.                  # If we're rebuilding, we need to create the table indexes.
1410                  if ($truncateFlag) {          if ($truncateFlag && ! $dbh->{_preIndex}) {
1411                          eval {                          eval {
1412                                  $self->CreateIndex($relationName);                                  $self->CreateIndex($relationName);
1413                          };                          };
# Line 1057  Line 1416 
1416                          }                          }
1417                  }                  }
1418          }          }
1419          # Commit the database changes.      # Analyze the table to improve performance.
1420          $dbh->commit_tran;      $dbh->vacuum_it($relationName);
         # Delete the temporary file.  
         unlink $tempName;  
1421          # Return the statistics.          # Return the statistics.
1422          return $retVal;          return $retVal;
1423  }  }
1424    
1425  =head3 GenerateEntity  =head3 GenerateEntity
1426    
1427  C<< my $fieldHash = $database->GenerateEntity($id, $type, \%values); >>  C<< my $fieldHash = $erdb->GenerateEntity($id, $type, \%values); >>
1428    
1429  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
1430  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 1123  Line 1480 
1480          return $this;          return $this;
1481  }  }
1482    
1483    =head3 GetEntity
1484    
1485    C<< my $entityObject = $erdb->GetEntity($entityType, $ID); >>
1486    
1487    Return an object describing the entity instance with a specified ID.
1488    
1489    =over 4
1490    
1491    =item entityType
1492    
1493    Entity type name.
1494    
1495    =item ID
1496    
1497    ID of the desired entity.
1498    
1499    =item RETURN
1500    
1501    Returns a B<DBObject> representing the desired entity instance, or an undefined value if no
1502    instance is found with the specified key.
1503    
1504    =back
1505    
1506    =cut
1507    
1508    sub GetEntity {
1509        # Get the parameters.
1510        my ($self, $entityType, $ID) = @_;
1511        # Create a query.
1512        my $query = $self->Get([$entityType], "$entityType(id) = ?", $ID);
1513        # Get the first (and only) object.
1514        my $retVal = $query->Fetch();
1515        # Return the result.
1516        return $retVal;
1517    }
1518    
1519    =head3 GetEntityValues
1520    
1521    C<< my @values = $erdb->GetEntityValues($entityType, $ID, \@fields); >>
1522    
1523    Return a list of values from a specified entity instance.
1524    
1525    =over 4
1526    
1527    =item entityType
1528    
1529    Entity type name.
1530    
1531    =item ID
1532    
1533    ID of the desired entity.
1534    
1535    =item fields
1536    
1537    List of field names, each of the form I<objectName>C<(>I<fieldName>C<)>.
1538    
1539    =item RETURN
1540    
1541    Returns a flattened list of the values of the specified fields for the specified entity.
1542    
1543    =back
1544    
1545    =cut
1546    
1547    sub GetEntityValues {
1548        # Get the parameters.
1549        my ($self, $entityType, $ID, $fields) = @_;
1550        # Get the specified entity.
1551        my $entity = $self->GetEntity($entityType, $ID);
1552        # Declare the return list.
1553        my @retVal = ();
1554        # If we found the entity, push the values into the return list.
1555        if ($entity) {
1556            push @retVal, $entity->Values($fields);
1557        }
1558        # Return the result.
1559        return @retVal;
1560    }
1561    
1562    =head3 GetAll
1563    
1564    C<< my @list = $erdb->GetAll(\@objectNames, $filterClause, \@parameters, \@fields, $count); >>
1565    
1566    Return a list of values taken from the objects returned by a query. The first three
1567    parameters correspond to the parameters of the L</Get> method. The final parameter is
1568    a list of the fields desired from each record found by the query. The field name
1569    syntax is the standard syntax used for fields in the B<ERDB> system--
1570    B<I<objectName>(I<fieldName>)>-- where I<objectName> is the name of the relevant entity
1571    or relationship and I<fieldName> is the name of the field.
1572    
1573    The list returned will be a list of lists. Each element of the list will contain
1574    the values returned for the fields specified in the fourth parameter. If one of the
1575    fields specified returns multiple values, they are flattened in with the rest. For
1576    example, the following call will return a list of the features in a particular
1577    spreadsheet cell, and each feature will be represented by a list containing the
1578    feature ID followed by all of its aliases.
1579    
1580    C<< $query = $erdb->Get(['ContainsFeature', 'Feature'], "ContainsFeature(from-link) = ?", [$ssCellID], ['Feature(id)', 'Feature(alias)']); >>
1581    
1582    =over 4
1583    
1584    =item objectNames
1585    
1586    List containing the names of the entity and relationship objects to be retrieved.
1587    
1588    =item filterClause
1589    
1590    WHERE/ORDER BY clause (without the WHERE) to be used to filter and sort the query. The WHERE clause can
1591    be parameterized with parameter markers (C<?>). Each field used must be specified in the standard form
1592    B<I<objectName>(I<fieldName>)>. Any parameters specified in the filter clause should be added to the
1593    parameter list as additional parameters. The fields in a filter clause can come from primary
1594    entity relations, relationship relations, or secondary entity relations; however, all of the
1595    entities and relationships involved must be included in the list of object names.
1596    
1597    =item parameterList
1598    
1599    List of the parameters to be substituted in for the parameters marks in the filter clause.
1600    
1601    =item fields
1602    
1603    List of the fields to be returned in each element of the list returned.
1604    
1605    =item count
1606    
1607    Maximum number of records to return. If omitted or 0, all available records will be returned.
1608    
1609    =item RETURN
1610    
1611    Returns a list of list references. Each element of the return list contains the values for the
1612    fields specified in the B<fields> parameter.
1613    
1614    =back
1615    
1616    =cut
1617    #: Return Type @@;
1618    sub GetAll {
1619        # Get the parameters.
1620        my ($self, $objectNames, $filterClause, $parameterList, $fields, $count) = @_;
1621        # Translate the parameters from a list reference to a list. If the parameter
1622        # list is a scalar we convert it into a singleton list.
1623        my @parmList = ();
1624        if (ref $parameterList eq "ARRAY") {
1625            @parmList = @{$parameterList};
1626        } else {
1627            push @parmList, $parameterList;
1628        }
1629        # Insure the counter has a value.
1630        if (!defined $count) {
1631            $count = 0;
1632        }
1633        # Add the row limit to the filter clause.
1634        if ($count > 0) {
1635            $filterClause .= " LIMIT $count";
1636        }
1637        # Create the query.
1638        my $query = $self->Get($objectNames, $filterClause, @parmList);
1639        # Set up a counter of the number of records read.
1640        my $fetched = 0;
1641        # Loop through the records returned, extracting the fields. Note that if the
1642        # counter is non-zero, we stop when the number of records read hits the count.
1643        my @retVal = ();
1644        while (($count == 0 || $fetched < $count) && (my $row = $query->Fetch())) {
1645            my @rowData = $row->Values($fields);
1646            push @retVal, \@rowData;
1647            $fetched++;
1648        }
1649        # Return the resulting list.
1650        return @retVal;
1651    }
1652    
1653    =head3 EstimateRowSize
1654    
1655    C<< my $rowSize = $erdb->EstimateRowSize($relName); >>
1656    
1657    Estimate the row size of the specified relation. The estimated row size is computed by adding
1658    up the average length for each data type.
1659    
1660    =over 4
1661    
1662    =item relName
1663    
1664    Name of the relation whose estimated row size is desired.
1665    
1666    =item RETURN
1667    
1668    Returns an estimate of the row size for the specified relation.
1669    
1670    =back
1671    
1672    =cut
1673    #: Return Type $;
1674    sub EstimateRowSize {
1675        # Get the parameters.
1676        my ($self, $relName) = @_;
1677        # Declare the return variable.
1678        my $retVal = 0;
1679        # Find the relation descriptor.
1680        my $relation = $self->_FindRelation($relName);
1681        # Get the list of fields.
1682        for my $fieldData (@{$relation->{Fields}}) {
1683            # Get the field type and add its length.
1684            my $fieldLen = $TypeTable{$fieldData->{type}}->{avgLen};
1685            $retVal += $fieldLen;
1686        }
1687        # Return the result.
1688        return $retVal;
1689    }
1690    
1691  =head2 Internal Utility Methods  =head2 Internal Utility Methods
1692    
# Line 1135  Line 1699 
1699  =cut  =cut
1700    
1701  sub _GetLoadStats {  sub _GetLoadStats {
1702          return Stats->new('records');      return Stats->new();
1703  }  }
1704    
1705  =head3 GenerateFields  =head3 GenerateFields
# Line 1499  Line 2063 
2063  sub _LoadMetaData {  sub _LoadMetaData {
2064          # Get the parameters.          # Get the parameters.
2065          my ($filename) = @_;          my ($filename) = @_;
2066        Trace("Reading Sprout DBD from $filename.") if T(2);
2067          # 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
2068          # get the exact structure we want.          # get the exact structure we want.
2069          my $metadata = XML::Simple::XMLin($filename,          my $metadata = XML::Simple::XMLin($filename,
# Line 1523  Line 2088 
2088          my %masterRelationTable = ();          my %masterRelationTable = ();
2089          # Loop through the entities.          # Loop through the entities.
2090          my $entityList = $metadata->{Entities};          my $entityList = $metadata->{Entities};
2091          while (my ($entityName, $entityStructure) = each %{$entityList}) {      for my $entityName (keys %{$entityList}) {
2092            my $entityStructure = $entityList->{$entityName};
2093                  #                  #
2094                  # 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,
2095                  # 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,
2096                  # 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>
2097                  # 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 1571  Line 2137 
2137                  # to a list of fields. First, we need the ID field itself.                  # to a list of fields. First, we need the ID field itself.
2138                  my $idField = $fieldList->{id};                  my $idField = $fieldList->{id};
2139                  # Loop through the relations.                  # Loop through the relations.
2140                  while (my ($relationName, $relation) = each %{$relationTable}) {          for my $relationName (keys %{$relationTable}) {
2141                my $relation = $relationTable->{$relationName};
2142                          # Get the relation's field list.                          # Get the relation's field list.
2143                          my $relationFieldList = $relation->{Fields};                          my $relationFieldList = $relation->{Fields};
2144                          # Add the ID field to it. If the field's already there, it will not make any                          # Add the ID field to it. If the field's already there, it will not make any
# Line 1621  Line 2188 
2188                  # The next step is to insure that each relation has at least one index that begins with the ID field.                  # The next step is to insure that each relation has at least one index that begins with the ID field.
2189                  # After that, we convert each relation's index list to an index table. We first need to loop through                  # After that, we convert each relation's index list to an index table. We first need to loop through
2190                  # the relations.                  # the relations.
2191                  while (my ($relationName, $relation) = each %{$relationTable}) {          for my $relationName (keys %{$relationTable}) {
2192                my $relation = $relationTable->{$relationName};
2193                          # Get the relation's index list.                          # Get the relation's index list.
2194                          my $indexList = $relation->{Indexes};                          my $indexList = $relation->{Indexes};
2195                          # Insure this relation has an ID index.                          # Insure this relation has an ID index.
# Line 1652  Line 2220 
2220          # Loop through the relationships. Relationships actually turn out to be much simpler than entities.          # Loop through the relationships. Relationships actually turn out to be much simpler than entities.
2221          # For one thing, there is only a single constituent relation.          # For one thing, there is only a single constituent relation.
2222          my $relationshipList = $metadata->{Relationships};          my $relationshipList = $metadata->{Relationships};
2223          while (my ($relationshipName, $relationshipStructure) = each %{$relationshipList}) {      for my $relationshipName (keys %{$relationshipList}) {
2224            my $relationshipStructure = $relationshipList->{$relationshipName};
2225                  # Fix up this relationship.                  # Fix up this relationship.
2226                  _FixupFields($relationshipStructure, $relationshipName, 2, 3);                  _FixupFields($relationshipStructure, $relationshipName, 2, 3);
2227                  # Format a description for the FROM field.                  # Format a description for the FROM field.
# Line 1701  Line 2270 
2270                  my @fromList = ();                  my @fromList = ();
2271                  my @toList = ();                  my @toList = ();
2272                  my @bothList = ();                  my @bothList = ();
2273                  while (my ($relationshipName, $relationship) = each %{$relationshipList}) {          Trace("Join table build for $entityName.") if T(metadata => 4);
2274            for my $relationshipName (keys %{$relationshipList}) {
2275                my $relationship = $relationshipList->{$relationshipName};
2276                          # 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.
2277                          if ($relationship->{from} eq $entityName) {              my $fromEntity = $relationship->{from};
2278                                  if ($relationship->{to} eq $entityName) {              my $toEntity = $relationship->{to};
2279                Trace("Join check for relationship $relationshipName from $fromEntity to $toEntity.") if T(4);
2280                if ($fromEntity eq $entityName) {
2281                    if ($toEntity eq $entityName) {
2282                                          # Here the relationship is recursive.                                          # Here the relationship is recursive.
2283                                          push @bothList, $relationshipName;                                          push @bothList, $relationshipName;
2284                        Trace("Relationship $relationshipName put in both-list.") if T(metadata => 4);
2285                                  } else {                                  } else {
2286                                          # Here the relationship comes from the entity.                                          # Here the relationship comes from the entity.
2287                                          push @fromList, $relationshipName;                                          push @fromList, $relationshipName;
2288                        Trace("Relationship $relationshipName put in from-list.") if T(metadata => 4);
2289                                  }                                  }
2290                          } elsif ($relationship->{to} eq $entityName) {              } elsif ($toEntity eq $entityName) {
2291                                  # Here the relationship goes to the entity.                                  # Here the relationship goes to the entity.
2292                                  push @toList, $relationshipName;                                  push @toList, $relationshipName;
2293                    Trace("Relationship $relationshipName put in to-list.") if T(metadata => 4);
2294                          }                          }
2295                  }                  }
2296                  # 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 1722  Line 2299 
2299                  # hash table at the same time.                  # hash table at the same time.
2300                  my %directRelationships = ( from => \@fromList, to => \@toList );                  my %directRelationships = ( from => \@fromList, to => \@toList );
2301                  my %otherRelationships = ( from => \@fromList, to => \@toList );                  my %otherRelationships = ( from => \@fromList, to => \@toList );
2302                  while (my ($linkType, $relationships) = each %directRelationships) {          for my $linkType (keys %directRelationships) {
2303                my $relationships = $directRelationships{$linkType};
2304                          # Loop through all the relationships.                          # Loop through all the relationships.
2305                          for my $relationshipName (@{$relationships}) {                          for my $relationshipName (@{$relationships}) {
2306                                  # Create joins between the entity and this relationship.                                  # Create joins between the entity and this relationship.
2307                                  my $linkField = "$relationshipName.${linkType}_link";                                  my $linkField = "$relationshipName.${linkType}_link";
2308                                  my $joinClause = "$entityName.id = $linkField";                                  my $joinClause = "$entityName.id = $linkField";
2309                    Trace("Entity join clause is $joinClause for $entityName and $relationshipName.") if T(metadata => 4);
2310                                  $joinTable{"$entityName/$relationshipName"} = $joinClause;                                  $joinTable{"$entityName/$relationshipName"} = $joinClause;
2311                                  $joinTable{"$relationshipName/$entityName"} = $joinClause;                                  $joinTable{"$relationshipName/$entityName"} = $joinClause;
2312                                  # Create joins between this relationship and the other relationships.                                  # Create joins between this relationship and the other relationships.
2313                                  while (my ($otherType, $otherships) = each %otherRelationships) {                  for my $otherType (keys %otherRelationships) {
2314                        my $otherships = $otherRelationships{$otherType};
2315                                          for my $otherName (@{$otherships}) {                                          for my $otherName (@{$otherships}) {
2316                                                  # Get the key for this join.                                                  # Get the key for this join.
2317                                                  my $joinKey = "$otherName/$relationshipName";                                                  my $joinKey = "$otherName/$relationshipName";
# Line 1741  Line 2321 
2321                                                          # path is ambiguous. We delete the join from the join                                                          # path is ambiguous. We delete the join from the join
2322                                                          # table to prevent it from being used.                                                          # table to prevent it from being used.
2323                                                          delete $joinTable{$joinKey};                                                          delete $joinTable{$joinKey};
2324                                Trace("Deleting ambiguous join $joinKey.") if T(4);
2325                                                  } elsif ($otherName ne $relationshipName) {                                                  } elsif ($otherName ne $relationshipName) {
2326                                                          # Here we have a valid join. Note that joins between a                                                          # Here we have a valid join. Note that joins between a
2327                                                          # relationship and itself are prohibited.                                                          # relationship and itself are prohibited.
2328                                                          $joinTable{$joinKey} = "$otherName.${otherType}_link = $linkField";                              my $relJoinClause = "$otherName.${otherType}_link = $linkField";
2329                                $joinTable{$joinKey} = $relJoinClause;
2330                                Trace("Relationship join clause is $relJoinClause for $joinKey.") if T(metadata => 4);
2331                                                  }                                                  }
2332                                          }                                          }
2333                                  }                                  }
# Line 1753  Line 2336 
2336                                  # relationship can only be ambiguous with another recursive relationship,                                  # relationship can only be ambiguous with another recursive relationship,
2337                                  # and the incoming relationship from the outer loop is never recursive.                                  # and the incoming relationship from the outer loop is never recursive.
2338                                  for my $otherName (@bothList) {                                  for my $otherName (@bothList) {
2339                        Trace("Setting up relationship joins to recursive relationship $otherName with $relationshipName.") if T(metadata => 4);
2340                                          # Join from the left.                                          # Join from the left.
2341                                          $joinTable{"$relationshipName/$otherName"} =                                          $joinTable{"$relationshipName/$otherName"} =
2342                                                  "$linkField = $otherName.from_link";                                                  "$linkField = $otherName.from_link";
# Line 1767  Line 2351 
2351                  # 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
2352                  # possible to get the same effect using multiple queries.                  # possible to get the same effect using multiple queries.
2353                  for my $relationshipName (@bothList) {                  for my $relationshipName (@bothList) {
2354                Trace("Setting up entity joins to recursive relationship $relationshipName with $entityName.") if T(metadata => 4);
2355                          # Join to the entity from each direction.                          # Join to the entity from each direction.
2356                          $joinTable{"$entityName/$relationshipName"} =                          $joinTable{"$entityName/$relationshipName"} =
2357                                  "$entityName.id = $relationshipName.from_link";                                  "$entityName.id = $relationshipName.from_link";
# Line 1817  Line 2402 
2402          # 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
2403          # the field to it.          # the field to it.
2404          unshift @{$newIndex->{IndexFields}}, $firstField;          unshift @{$newIndex->{IndexFields}}, $firstField;
2405        # If this is a one-to-many relationship, the "To" index is unique.
2406        if ($relationshipStructure->{arity} eq "1M" && $indexKey eq "To") {
2407            $newIndex->{Unique} = 'true';
2408        }
2409          # Add the index to the relation.          # Add the index to the relation.
2410          _AddIndex("idx$relationshipName$indexKey", $relationStructure, $newIndex);          _AddIndex("idx$relationshipName$indexKey", $relationStructure, $newIndex);
2411  }  }
# Line 1906  Line 2495 
2495                  $structure->{Fields} = { };                  $structure->{Fields} = { };
2496          } else {          } else {
2497                  # Here we have a field list. Loop through its fields.                  # Here we have a field list. Loop through its fields.
2498                  while (my ($fieldName, $fieldData) = each %{$structure->{Fields}}) {          my $fieldStructures = $structure->{Fields};
2499            for my $fieldName (keys %{$fieldStructures}) {
2500                Trace("Processing field $fieldName of $defaultRelationName.") if T(4);
2501                my $fieldData = $fieldStructures->{$fieldName};
2502                          # Get the field type.                          # Get the field type.
2503                          my $type = $fieldData->{type};                          my $type = $fieldData->{type};
2504                          # Plug in a relation name if it is needed.                          # Plug in a relation name if it is needed.

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.31

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3