Parent Directory
|
Revision Log
|
Patch
revision 1.20, Sun Sep 11 17:02:33 2005 UTC | revision 1.77, Mon Nov 20 05:53:02 2006 UTC | |
---|---|---|
# | Line 9 | Line 9 |
9 | use DBObject; | use DBObject; |
10 | use Stats; | use Stats; |
11 | use Time::HiRes qw(gettimeofday); | use Time::HiRes qw(gettimeofday); |
12 | use Digest::MD5 qw(md5_base64); | |
13 | use FIG; | use FIG; |
14 | use CGI; | |
15 | ||
16 | =head1 Entity-Relationship Database Package | =head1 Entity-Relationship Database Package |
17 | ||
# | Line 58 | Line 60 |
60 | B<start-position>, which indicates where in the contig that the sequence begins. This attribute | B<start-position>, which indicates where in the contig that the sequence begins. This attribute |
61 | is implemented as the C<start_position> field in the C<IsMadeUpOf> relation. | is implemented as the C<start_position> field in the C<IsMadeUpOf> relation. |
62 | ||
63 | The database itself is described by an XML file using the F<ERDatabase.xsd> schema. In addition to | The database itself is described by an XML file. In addition to all the data required to define |
64 | all the data required to define the entities, relationships, and attributes, the schema provides | the entities, relationships, and attributes, the schema provides space for notes describing |
65 | space for notes describing the data and what it means. These notes are used by L</ShowMetaData> | the data and what it means. These notes are used by L</ShowMetaData> to generate documentation |
66 | to generate documentation for the database. | for the database. |
67 | ||
68 | Special support is provided for text searching. An entity field can be marked as <em>searchable</em>, | |
69 | in which case it will be used to generate a text search index in which the user searches for words | |
70 | in the field instead of a particular field value. | |
71 | ||
72 | Finally, every entity and relationship object has a flag indicating if it is new or old. The object | Finally, every entity and relationship object has a flag indicating if it is new or old. The object |
73 | is considered I<old> if it was loaded by the L</LoadTables> method. It is considered I<new> if it | is considered I<old> if it was loaded by the L</LoadTables> method. It is considered I<new> if it |
74 | was inserted by the L</InsertObject> method. | was inserted by the L</InsertObject> method. |
75 | ||
To facilitate testing, the ERDB module supports automatic generation of test data. This process | ||
is described in the L</GenerateEntity> and L</GenerateConnection> methods, though it is not yet | ||
fully implemented. | ||
76 | =head2 XML Database Description | =head2 XML Database Description |
77 | ||
78 | =head3 Data Types | =head3 Data Types |
# | Line 90 | Line 92 |
92 | ||
93 | 32-bit signed integer | 32-bit signed integer |
94 | ||
95 | =item counter | |
96 | ||
97 | 32-bit unsigned integer | |
98 | ||
99 | =item date | =item date |
100 | ||
101 | 64-bit unsigned integer, representing a PERL date/time value | 64-bit unsigned integer, representing a PERL date/time value |
# | Line 109 | Line 115 |
115 | compatability with certain database packages), but the only values supported are | compatability with certain database packages), but the only values supported are |
116 | 0 and 1. | 0 and 1. |
117 | ||
118 | =item id-string | |
119 | ||
120 | variable-length string, maximum 25 characters | |
121 | ||
122 | =item key-string | =item key-string |
123 | ||
124 | variable-length string, maximum 40 characters | variable-length string, maximum 40 characters |
# | Line 125 | Line 135 |
135 | ||
136 | variable-length string, maximum 255 characters | variable-length string, maximum 255 characters |
137 | ||
138 | =item hash-string | |
139 | ||
140 | variable-length string, maximum 22 characters | |
141 | ||
142 | =back | =back |
143 | ||
144 | The hash-string data type has a special meaning. The actual key passed into the loader will | |
145 | be a string, but it will be digested into a 22-character MD5 code to save space. Although the | |
146 | MD5 algorithm is not perfect, it is extremely unlikely two strings will have the same | |
147 | digest. Therefore, it is presumed the keys will be unique. When the database is actually | |
148 | in use, the hashed keys will be presented rather than the original values. For this reason, | |
149 | they should not be used for entities where the key is meaningful. | |
150 | ||
151 | =head3 Global Tags | =head3 Global Tags |
152 | ||
153 | The entire database definition must be inside a B<Database> tag. The display name of | The entire database definition must be inside a B<Database> tag. The display name of |
# | Line 170 | Line 191 |
191 | ||
192 | Name of the field. The field name should contain only letters, digits, and hyphens (C<->), | Name of the field. The field name should contain only letters, digits, and hyphens (C<->), |
193 | and the first character should be a letter. Most underlying databases are case-insensitive | and the first character should be a letter. Most underlying databases are case-insensitive |
194 | with the respect to field names, so a best practice is to use lower-case letters only. | with the respect to field names, so a best practice is to use lower-case letters only. Finally, |
195 | the name C<search-relevance> has special meaning for full-text searches and should not be | |
196 | used as a field name. | |
197 | ||
198 | =item type | =item type |
199 | ||
# | Line 189 | Line 212 |
212 | entity, the fields without a relation attribute are said to belong to the | entity, the fields without a relation attribute are said to belong to the |
213 | I<primary relation>. This relation has the same name as the entity itself. | I<primary relation>. This relation has the same name as the entity itself. |
214 | ||
215 | =item searchable | |
216 | ||
217 | If specified, then the field is a candidate for full-text searching. A single full-text | |
218 | index will be created for each relation with at least one searchable field in it. | |
219 | For best results, this option should only be used for string or text fields. | |
220 | ||
221 | =item special | |
222 | ||
223 | This attribute allows the subclass to assign special meaning for certain fields. | |
224 | The interpretation is up to the subclass itself. Currently, only entity fields | |
225 | can have this attribute. | |
226 | ||
227 | =back | =back |
228 | ||
229 | =head3 Indexes | =head3 Indexes |
230 | ||
231 | An entity can have multiple alternate indexes associated with it. The fields must | An entity can have multiple alternate indexes associated with it. The fields must |
232 | be from the primary relation. The alternate indexes assist in ordering results | all be from the same relation. The alternate indexes assist in ordering results |
233 | from a query. A relationship can have up to two indexes-- a I<to-index> and a | from a query. A relationship can have up to two indexes-- a I<to-index> and a |
234 | I<from-index>. These order the results when crossing the relationship. For | I<from-index>. These order the results when crossing the relationship. For |
235 | example, in the relationship C<HasContig> from C<Genome> to C<Contig>, the | example, in the relationship C<HasContig> from C<Genome> to C<Contig>, the |
# | Line 300 | Line 335 |
335 | ||
336 | # 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. |
337 | # "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 |
338 | # of the specified type. "dataGen" is PERL string that will be evaluated if no test data generation | # of the specified type. "avgLen" is the average byte length for estimating |
339 | # string is specified in the field definition. "avgLen" is the average byte length for estimating | # record sizes. "sort" is the key modifier for the sort command, "notes" is a type description, |
340 | # record sizes. | # and "indexMod", if non-zero, is the number of characters to use when the field is specified in an |
341 | my %TypeTable = ( char => { sqlType => 'CHAR(1)', maxLen => 1, avgLen => 1, dataGen => "StringGen('A')" }, | # index |
342 | int => { sqlType => 'INTEGER', maxLen => 20, avgLen => 4, dataGen => "IntGen(0, 99999999)" }, | my %TypeTable = ( char => { sqlType => 'CHAR(1)', maxLen => 1, avgLen => 1, sort => "", |
343 | string => { sqlType => 'VARCHAR(255)', maxLen => 255, avgLen => 100, dataGen => "StringGen(IntGen(10,250))" }, | indexMod => 0, notes => "single ASCII character"}, |
344 | text => { sqlType => 'TEXT', maxLen => 1000000000, avgLen => 500, dataGen => "StringGen(IntGen(80,1000))" }, | int => { sqlType => 'INTEGER', maxLen => 20, avgLen => 4, sort => "n", |
345 | date => { sqlType => 'BIGINT', maxLen => 80, avgLen => 8, dataGen => "DateGen(-7, 7, IntGen(0,1400))" }, | indexMod => 0, notes => "signed 32-bit integer"}, |
346 | float => { sqlType => 'DOUBLE PRECISION', maxLen => 40, avgLen => 8, dataGen => "FloatGen(0.0, 100.0)" }, | counter => { sqlType => 'INTEGER UNSIGNED', maxLen => 20, avgLen => 4, sort => "n", |
347 | boolean => { sqlType => 'SMALLINT', maxLen => 1, avgLen => 2, dataGen => "IntGen(0, 1)" }, | indexMod => 0, notes => "unsigned 32-bit integer"}, |
348 | string => { sqlType => 'VARCHAR(255)', maxLen => 255, avgLen => 100, sort => "", | |
349 | indexMod => 0, notes => "character string, 0 to 255 characters"}, | |
350 | text => { sqlType => 'TEXT', maxLen => 1000000000, avgLen => 500, sort => "", | |
351 | indexMod => 255, notes => "character string, nearly unlimited length, only first 255 characters are indexed"}, | |
352 | date => { sqlType => 'BIGINT', maxLen => 80, avgLen => 8, sort => "n", | |
353 | indexMod => 0, notes => "signed, 64-bit integer"}, | |
354 | float => { sqlType => 'DOUBLE PRECISION', maxLen => 40, avgLen => 8, sort => "g", | |
355 | indexMod => 0, notes => "64-bit double precision floating-point number"}, | |
356 | boolean => { sqlType => 'SMALLINT', maxLen => 1, avgLen => 1, sort => "n", | |
357 | indexMod => 0, notes => "boolean value: 0 if false, 1 if true"}, | |
358 | 'hash-string' => | |
359 | { sqlType => 'VARCHAR(22)', maxLen => 22, avgLen => 22, sort => "", | |
360 | indexMod => 0, notes => "string stored in digested form, used for certain types of key fields"}, | |
361 | 'id-string' => | |
362 | { sqlType => 'VARCHAR(25)', maxLen => 25, avgLen => 25, sort => "", | |
363 | indexMod => 0, notes => "character string, 0 to 25 characters"}, | |
364 | 'key-string' => | 'key-string' => |
365 | { sqlType => 'VARCHAR(40)', maxLen => 40, avgLen => 10, dataGen => "StringGen(IntGen(10,40))" }, | { sqlType => 'VARCHAR(40)', maxLen => 40, avgLen => 10, sort => "", |
366 | indexMod => 0, notes => "character string, 0 to 40 characters"}, | |
367 | 'name-string' => | 'name-string' => |
368 | { sqlType => 'VARCHAR(80)', maxLen => 80, avgLen => 40, dataGen => "StringGen(IntGen(10,80))" }, | { sqlType => 'VARCHAR(80)', maxLen => 80, avgLen => 40, sort => "", |
369 | indexMod => 0, notes => "character string, 0 to 80 characters"}, | |
370 | 'medium-string' => | 'medium-string' => |
371 | { sqlType => 'VARCHAR(160)', maxLen => 160, avgLen => 40, dataGen => "StringGen(IntGen(10,160))" }, | { sqlType => 'VARCHAR(160)', maxLen => 160, avgLen => 40, sort => "", |
372 | indexMod => 0, notes => "character string, 0 to 160 characters"}, | |
373 | ); | ); |
374 | ||
375 | # Table translating arities into natural language. | # Table translating arities into natural language. |
# | Line 324 | Line 378 |
378 | 'MM' => 'many-to-many' | 'MM' => 'many-to-many' |
379 | ); | ); |
380 | ||
381 | # Table for interpreting string patterns. | # Options for XML input and output. |
382 | ||
383 | my %XmlOptions = (GroupTags => { Relationships => 'Relationship', | |
384 | Entities => 'Entity', | |
385 | Fields => 'Field', | |
386 | Indexes => 'Index', | |
387 | IndexFields => 'IndexField' | |
388 | }, | |
389 | KeyAttr => { Relationship => 'name', | |
390 | Entity => 'name', | |
391 | Field => 'name' | |
392 | }, | |
393 | SuppressEmpty => 1, | |
394 | ); | |
395 | ||
396 | my %PictureTable = ( 'A' => "abcdefghijklmnopqrstuvwxyz", | my %XmlInOpts = ( |
397 | '9' => "0123456789", | ForceArray => ['Field', 'Index', 'IndexField'], |
398 | 'X' => "abcdefghijklmnopqrstuvwxyz0123456789", | ForceContent => 1, |
399 | 'V' => "aeiou", | NormalizeSpace => 2, |
400 | 'K' => "bcdfghjklmnoprstvwxyz" | ); |
401 | my %XmlOutOpts = ( | |
402 | RootName => 'Database', | |
403 | XMLDecl => 1, | |
404 | ); | ); |
405 | ||
406 | ||
407 | =head2 Public Methods | =head2 Public Methods |
408 | ||
409 | =head3 new | =head3 new |
# | Line 402 | Line 473 |
473 | # Write the HTML heading stuff. | # Write the HTML heading stuff. |
474 | print HTMLOUT "<html>\n<head>\n<title>$title</title>\n"; | print HTMLOUT "<html>\n<head>\n<title>$title</title>\n"; |
475 | print HTMLOUT "</head>\n<body>\n"; | print HTMLOUT "</head>\n<body>\n"; |
476 | # Write the documentation. | |
477 | print HTMLOUT $self->DisplayMetaData(); | |
478 | # Close the document. | |
479 | print HTMLOUT "</body>\n</html>\n"; | |
480 | # Close the file. | |
481 | close HTMLOUT; | |
482 | } | |
483 | ||
484 | =head3 DisplayMetaData | |
485 | ||
486 | C<< my $html = $erdb->DisplayMetaData(); >> | |
487 | ||
488 | Return an HTML description of the database. This description can be used to help users create | |
489 | the data to be loaded into the relations and form queries. The output is raw includable HTML | |
490 | without any HEAD or BODY tags. | |
491 | ||
492 | =over 4 | |
493 | ||
494 | =item filename | |
495 | ||
496 | The name of the output file. | |
497 | ||
498 | =back | |
499 | ||
500 | =cut | |
501 | ||
502 | sub DisplayMetaData { | |
503 | # Get the parameters. | |
504 | my ($self) = @_; | |
505 | # Get the metadata and the title string. | |
506 | my $metadata = $self->{_metaData}; | |
507 | # Get the title string. | |
508 | my $title = $metadata->{Title}; | |
509 | # Get the entity and relationship lists. | |
510 | my $entityList = $metadata->{Entities}; | |
511 | my $relationshipList = $metadata->{Relationships}; | |
512 | # Declare the return variable. | |
513 | my $retVal = ""; | |
514 | # Open the output file. | |
515 | Trace("Building MetaData table of contents.") if T(4); | |
516 | # Here we do the table of contents. It starts as an unordered list of section names. Each | # Here we do the table of contents. It starts as an unordered list of section names. Each |
517 | # section contains an ordered list of entity or relationship subsections. | # section contains an ordered list of entity or relationship subsections. |
518 | print HTMLOUT "<ul>\n<li><a href=\"#EntitiesSection\">Entities</a>\n<ol>\n"; | $retVal .= "<ul>\n<li><a href=\"#EntitiesSection\">Entities</a>\n<ol>\n"; |
519 | # Loop through the Entities, displaying a list item for each. | # Loop through the Entities, displaying a list item for each. |
520 | foreach my $key (sort keys %{$entityList}) { | foreach my $key (sort keys %{$entityList}) { |
521 | # Display this item. | # Display this item. |
522 | print HTMLOUT "<li><a href=\"#$key\">$key</a></li>\n"; | $retVal .= "<li><a href=\"#$key\">$key</a></li>\n"; |
523 | } | } |
524 | # Close off the entity section and start the relationship section. | # Close off the entity section and start the relationship section. |
525 | print HTMLOUT "</ol></li>\n<li><a href=\"#RelationshipsSection\">Relationships</a>\n<ol>\n"; | $retVal .= "</ol></li>\n<li><a href=\"#RelationshipsSection\">Relationships</a>\n<ol>\n"; |
526 | # Loop through the Relationships. | # Loop through the Relationships. |
527 | foreach my $key (sort keys %{$relationshipList}) { | foreach my $key (sort keys %{$relationshipList}) { |
528 | # Display this item. | # Display this item. |
529 | my $relationshipTitle = _ComputeRelationshipSentence($key, $relationshipList->{$key}); | my $relationshipTitle = _ComputeRelationshipSentence($key, $relationshipList->{$key}); |
530 | print HTMLOUT "<li><a href=\"#$key\">$relationshipTitle</a></li>\n"; | $retVal .= "<li><a href=\"#$key\">$relationshipTitle</a></li>\n"; |
531 | } | } |
532 | # Close off the relationship section and list the join table section. | # Close off the relationship section and list the join table section. |
533 | print HTMLOUT "</ol></li>\n<li><a href=\"#JoinTable\">Join Table</a></li>\n"; | $retVal .= "</ol></li>\n<li><a href=\"#JoinTable\">Join Table</a></li>\n"; |
534 | # Close off the table of contents itself. | # Close off the table of contents itself. |
535 | print HTMLOUT "</ul>\n"; | $retVal .= "</ul>\n"; |
536 | # Now we start with the actual data. Denote we're starting the entity section. | # Now we start with the actual data. Denote we're starting the entity section. |
537 | print HTMLOUT "<a name=\"EntitiesSection\"></a><h2>Entities</h2>\n"; | $retVal .= "<a name=\"EntitiesSection\"></a><h2>Entities</h2>\n"; |
538 | # Loop through the entities. | # Loop through the entities. |
539 | for my $key (sort keys %{$entityList}) { | for my $key (sort keys %{$entityList}) { |
540 | Trace("Building MetaData entry for $key entity.") if T(4); | Trace("Building MetaData entry for $key entity.") if T(4); |
541 | # Create the entity header. It contains a bookmark and the entity name. | # Create the entity header. It contains a bookmark and the entity name. |
542 | print HTMLOUT "<a name=\"$key\"></a><h3>$key</h3>\n"; | $retVal .= "<a name=\"$key\"></a><h3>$key</h3>\n"; |
543 | # Get the entity data. | # Get the entity data. |
544 | my $entityData = $entityList->{$key}; | my $entityData = $entityList->{$key}; |
545 | # If there's descriptive text, display it. | # If there's descriptive text, display it. |
546 | if (my $notes = $entityData->{Notes}) { | if (my $notes = $entityData->{Notes}) { |
547 | print HTMLOUT "<p>" . _HTMLNote($notes->{content}) . "</p>\n"; | $retVal .= "<p>" . HTMLNote($notes->{content}) . "</p>\n"; |
548 | } | } |
549 | # Now we want a list of the entity's relationships. First, we set up the relationship subsection. | # Now we want a list of the entity's relationships. First, we set up the relationship subsection. |
550 | print HTMLOUT "<h4>Relationships for <b>$key</b></h4>\n<ul>\n"; | $retVal .= "<h4>Relationships for <b>$key</b></h4>\n<ul>\n"; |
551 | # Loop through the relationships. | # Loop through the relationships. |
552 | for my $relationship (sort keys %{$relationshipList}) { | for my $relationship (sort keys %{$relationshipList}) { |
553 | # Get the relationship data. | # Get the relationship data. |
# | Line 446 | Line 557 |
557 | # Get the relationship sentence and append the arity. | # Get the relationship sentence and append the arity. |
558 | my $relationshipDescription = _ComputeRelationshipSentence($relationship, $relationshipStructure); | my $relationshipDescription = _ComputeRelationshipSentence($relationship, $relationshipStructure); |
559 | # Display the relationship data. | # Display the relationship data. |
560 | print HTMLOUT "<li><a href=\"#$relationship\">$relationshipDescription</a></li>\n"; | $retVal .= "<li><a href=\"#$relationship\">$relationshipDescription</a></li>\n"; |
561 | } | } |
562 | } | } |
563 | # Close off the relationship list. | # Close off the relationship list. |
564 | print HTMLOUT "</ul>\n"; | $retVal .= "</ul>\n"; |
565 | # Get the entity's relations. | # Get the entity's relations. |
566 | my $relationList = $entityData->{Relations}; | my $relationList = $entityData->{Relations}; |
567 | # Create a header for the relation subsection. | # Create a header for the relation subsection. |
568 | print HTMLOUT "<h4>Relations for <b>$key</b></h4>\n"; | $retVal .= "<h4>Relations for <b>$key</b></h4>\n"; |
569 | # Loop through the relations, displaying them. | # Loop through the relations, displaying them. |
570 | for my $relation (sort keys %{$relationList}) { | for my $relation (sort keys %{$relationList}) { |
571 | my $htmlString = _ShowRelationTable($relation, $relationList->{$relation}); | my $htmlString = _ShowRelationTable($relation, $relationList->{$relation}); |
572 | print HTMLOUT $htmlString; | $retVal .= $htmlString; |
573 | } | } |
574 | } | } |
575 | # Denote we're starting the relationship section. | # Denote we're starting the relationship section. |
576 | print HTMLOUT "<a name=\"RelationshipsSection\"></a><h2>Relationships</h2>\n"; | $retVal .= "<a name=\"RelationshipsSection\"></a><h2>Relationships</h2>\n"; |
577 | # Loop through the relationships. | # Loop through the relationships. |
578 | for my $key (sort keys %{$relationshipList}) { | for my $key (sort keys %{$relationshipList}) { |
579 | Trace("Building MetaData entry for $key relationship.") if T(4); | Trace("Building MetaData entry for $key relationship.") if T(4); |
# | Line 470 | Line 581 |
581 | my $relationshipStructure = $relationshipList->{$key}; | my $relationshipStructure = $relationshipList->{$key}; |
582 | # Create the relationship header. | # Create the relationship header. |
583 | my $headerText = _ComputeRelationshipHeading($key, $relationshipStructure); | my $headerText = _ComputeRelationshipHeading($key, $relationshipStructure); |
584 | print HTMLOUT "<h3><a name=\"$key\"></a>$headerText</h3>\n"; | $retVal .= "<h3><a name=\"$key\"></a>$headerText</h3>\n"; |
585 | # Get the entity names. | # Get the entity names. |
586 | my $fromEntity = $relationshipStructure->{from}; | my $fromEntity = $relationshipStructure->{from}; |
587 | my $toEntity = $relationshipStructure->{to}; | my $toEntity = $relationshipStructure->{to}; |
# | Line 480 | Line 591 |
591 | # since both sentences will say the same thing. | # since both sentences will say the same thing. |
592 | my $arity = $relationshipStructure->{arity}; | my $arity = $relationshipStructure->{arity}; |
593 | if ($arity eq "11") { | if ($arity eq "11") { |
594 | print HTMLOUT "<p>Each <b>$fromEntity</b> relates to at most one <b>$toEntity</b>.\n"; | $retVal .= "<p>Each <b>$fromEntity</b> relates to at most one <b>$toEntity</b>.\n"; |
595 | } else { | } else { |
596 | print HTMLOUT "<p>Each <b>$fromEntity</b> relates to multiple <b>$toEntity</b>s.\n"; | $retVal .= "<p>Each <b>$fromEntity</b> relates to multiple <b>$toEntity</b>s.\n"; |
597 | if ($arity eq "MM" && $fromEntity ne $toEntity) { | if ($arity eq "MM" && $fromEntity ne $toEntity) { |
598 | print HTMLOUT "Each <b>$toEntity</b> relates to multiple <b>$fromEntity</b>s.\n"; | $retVal .= "Each <b>$toEntity</b> relates to multiple <b>$fromEntity</b>s.\n"; |
599 | } | } |
600 | } | } |
601 | print HTMLOUT "</p>\n"; | $retVal .= "</p>\n"; |
602 | # If there are notes on this relationship, display them. | # If there are notes on this relationship, display them. |
603 | if (my $notes = $relationshipStructure->{Notes}) { | if (my $notes = $relationshipStructure->{Notes}) { |
604 | print HTMLOUT "<p>" . _HTMLNote($notes->{content}) . "</p>\n"; | $retVal .= "<p>" . HTMLNote($notes->{content}) . "</p>\n"; |
605 | } | } |
606 | # Generate the relationship's relation table. | # Generate the relationship's relation table. |
607 | my $htmlString = _ShowRelationTable($key, $relationshipStructure->{Relations}->{$key}); | my $htmlString = _ShowRelationTable($key, $relationshipStructure->{Relations}->{$key}); |
608 | print HTMLOUT $htmlString; | $retVal .= $htmlString; |
609 | } | } |
610 | Trace("Building MetaData join table.") if T(4); | Trace("Building MetaData join table.") if T(4); |
611 | # Denote we're starting the join table. | # Denote we're starting the join table. |
612 | print HTMLOUT "<a name=\"JoinTable\"></a><h3>Join Table</h3>\n"; | $retVal .= "<a name=\"JoinTable\"></a><h3>Join Table</h3>\n"; |
613 | # Create a table header. | # Create a table header. |
614 | print HTMLOUT _OpenTable("Join Table", "Source", "Target", "Join Condition"); | $retVal .= _OpenTable("Join Table", "Source", "Target", "Join Condition"); |
615 | # Loop through the joins. | # Loop through the joins. |
616 | my $joinTable = $metadata->{Joins}; | my $joinTable = $metadata->{Joins}; |
617 | my @joinKeys = keys %{$joinTable}; | my @joinKeys = keys %{$joinTable}; |
# | Line 508 | Line 619 |
619 | # Separate out the source, the target, and the join clause. | # Separate out the source, the target, and the join clause. |
620 | $joinKey =~ m!^([^/]+)/(.+)$!; | $joinKey =~ m!^([^/]+)/(.+)$!; |
621 | my ($sourceRelation, $targetRelation) = ($1, $2); | my ($sourceRelation, $targetRelation) = ($1, $2); |
622 | Trace("Join with key $joinKey is from $sourceRelation to $targetRelation.") if T(4); | Trace("Join with key $joinKey is from $sourceRelation to $targetRelation.") if T(Joins => 4); |
623 | my $source = $self->ComputeObjectSentence($sourceRelation); | my $source = $self->ComputeObjectSentence($sourceRelation); |
624 | my $target = $self->ComputeObjectSentence($targetRelation); | my $target = $self->ComputeObjectSentence($targetRelation); |
625 | my $clause = $joinTable->{$joinKey}; | my $clause = $joinTable->{$joinKey}; |
626 | # Display them in a table row. | # Display them in a table row. |
627 | print HTMLOUT "<tr><td>$source</td><td>$target</td><td>$clause</td></tr>\n"; | $retVal .= "<tr><td>$source</td><td>$target</td><td>$clause</td></tr>\n"; |
628 | } | } |
629 | # Close the table. | # Close the table. |
630 | print HTMLOUT _CloseTable(); | $retVal .= _CloseTable(); |
631 | # Close the document. | Trace("Built MetaData HTML.") if T(3); |
632 | print HTMLOUT "</body>\n</html>\n"; | # Return the HTML. |
633 | # Close the file. | return $retVal; |
close HTMLOUT; | ||
Trace("Built MetaData web page.") if T(3); | ||
634 | } | } |
635 | ||
636 | =head3 DumpMetaData | =head3 DumpMetaData |
# | Line 539 | Line 648 |
648 | return Data::Dumper::Dumper($self->{_metaData}); | return Data::Dumper::Dumper($self->{_metaData}); |
649 | } | } |
650 | ||
651 | =head3 FindIndexForEntity | |
652 | ||
653 | C<< my $indexFound = ERDB::FindIndexForEntity($xml, $entityName, $attributeName); >> | |
654 | ||
655 | This method locates the entry in an entity's index list that begins with the | |
656 | specified attribute name. If the entity has no index list, one will be | |
657 | created. This method works on raw XML, not a live ERDB object. | |
658 | ||
659 | =over 4 | |
660 | ||
661 | =item xml | |
662 | ||
663 | The raw XML structure defining the database. | |
664 | ||
665 | =item entityName | |
666 | ||
667 | The name of the relevant entity. | |
668 | ||
669 | =item attributeName | |
670 | ||
671 | The name of the attribute relevant to the search. | |
672 | ||
673 | =item RETURN | |
674 | ||
675 | The numerical index in the index list of the index entry for the specified entity and | |
676 | attribute, or C<undef> if no such index exists. | |
677 | ||
678 | =back | |
679 | ||
680 | =cut | |
681 | ||
682 | sub FindIndexForEntity { | |
683 | # Get the parameters. | |
684 | my ($xml, $entityName, $attributeName) = @_; | |
685 | # Declare the return variable. | |
686 | my $retVal; | |
687 | # Get the named entity. | |
688 | my $entityData = $xml->{Entities}->{$entityName}; | |
689 | if (! $entityData) { | |
690 | Confess("Entity $entityName not found in DBD structure."); | |
691 | } else { | |
692 | # Insure it has an index list. | |
693 | if (! exists $entityData->{Indexes}) { | |
694 | $entityData->{Indexes} = []; | |
695 | } else { | |
696 | # Search for the desired index. | |
697 | my $indexList = $entityData->{Indexes}; | |
698 | my $n = scalar @{$indexList}; | |
699 | Trace("Searching $n indexes in index list for $entityName.") if T(2); | |
700 | # We use an indexed FOR here because we're returning an | |
701 | # index number instead of an object. We do THAT so we can | |
702 | # delete the index from the list if needed. | |
703 | for (my $i = 0; $i < $n && !defined($retVal); $i++) { | |
704 | my $index = $indexList->[$i]; | |
705 | my $fields = $index->{IndexFields}; | |
706 | # Technically this IF should be safe (that is, we are guaranteed | |
707 | # the existence of a "$fields->[0]"), because when we load the XML | |
708 | # we have SuppressEmpty specified. | |
709 | if ($fields->[0]->{name} eq $attributeName) { | |
710 | $retVal = $i; | |
711 | } | |
712 | } | |
713 | } | |
714 | } | |
715 | Trace("Index for $attributeName of $entityName found at position $retVal.") if defined($retVal) && T(3); | |
716 | Trace("Index for $attributeName not found in $entityName.") if !defined($retVal) && T(3); | |
717 | # Return the result. | |
718 | return $retVal; | |
719 | } | |
720 | ||
721 | =head3 CreateTables | =head3 CreateTables |
722 | ||
723 | C<< $erdb->CreateTables(); >> | C<< $erdb->CreateTables(); >> |
# | Line 553 | Line 732 |
732 | sub CreateTables { | sub CreateTables { |
733 | # Get the parameters. | # Get the parameters. |
734 | my ($self) = @_; | my ($self) = @_; |
735 | my $metadata = $self->{_metaData}; | # Get the relation names. |
736 | my $dbh = $self->{_dbh}; | my @relNames = $self->GetTableNames(); |
737 | # Loop through the entities. | # Loop through the relations. |
738 | my $entityHash = $metadata->{Entities}; | for my $relationName (@relNames) { |
for my $entityName (keys %{$entityHash}) { | ||
my $entityData = $entityHash->{$entityName}; | ||
# Tell the user what we're doing. | ||
Trace("Creating relations for entity $entityName.") if T(1); | ||
# Loop through the entity's relations. | ||
for my $relationName (keys %{$entityData->{Relations}}) { | ||
739 | # Create a table for this relation. | # Create a table for this relation. |
740 | $self->CreateTable($relationName); | $self->CreateTable($relationName); |
741 | 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); | ||
742 | } | } |
743 | } | } |
744 | ||
# | Line 640 | Line 805 |
805 | Trace("Creating table $relationName: $fieldThing") if T(2); | Trace("Creating table $relationName: $fieldThing") if T(2); |
806 | $dbh->create_table(tbl => $relationName, flds => $fieldThing, estimates => $estimation); | $dbh->create_table(tbl => $relationName, flds => $fieldThing, estimates => $estimation); |
807 | Trace("Relation $relationName created in database.") if T(2); | Trace("Relation $relationName created in database.") if T(2); |
808 | # If we want to build the indexes, we do it here. | # If we want to build the indexes, we do it here. Note that the full-text search |
809 | # index will not be built until the table has been loaded. | |
810 | if ($indexFlag) { | if ($indexFlag) { |
811 | $self->CreateIndex($relationName); | $self->CreateIndex($relationName); |
812 | } | } |
813 | } | } |
814 | ||
815 | =head3 VerifyFields | |
816 | ||
817 | C<< my $count = $erdb->VerifyFields($relName, \@fieldList); >> | |
818 | ||
819 | Run through the list of proposed field values, insuring that all the character fields are | |
820 | below the maximum length. If any fields are too long, they will be truncated in place. | |
821 | ||
822 | =over 4 | |
823 | ||
824 | =item relName | |
825 | ||
826 | Name of the relation for which the specified fields are destined. | |
827 | ||
828 | =item fieldList | |
829 | ||
830 | Reference to a list, in order, of the fields to be put into the relation. | |
831 | ||
832 | =item RETURN | |
833 | ||
834 | Returns the number of fields truncated. | |
835 | ||
836 | =back | |
837 | ||
838 | =cut | |
839 | ||
840 | sub VerifyFields { | |
841 | # Get the parameters. | |
842 | my ($self, $relName, $fieldList) = @_; | |
843 | # Initialize the return value. | |
844 | my $retVal = 0; | |
845 | # Get the relation definition. | |
846 | my $relData = $self->_FindRelation($relName); | |
847 | # Get the list of field descriptors. | |
848 | my $fieldTypes = $relData->{Fields}; | |
849 | my $fieldCount = scalar @{$fieldTypes}; | |
850 | # Loop through the two lists. | |
851 | for (my $i = 0; $i < $fieldCount; $i++) { | |
852 | # Get the type of the current field. | |
853 | my $fieldType = $fieldTypes->[$i]->{type}; | |
854 | # If it's a character field, verify the length. | |
855 | if ($fieldType =~ /string/) { | |
856 | my $maxLen = $TypeTable{$fieldType}->{maxLen}; | |
857 | my $oldString = $fieldList->[$i]; | |
858 | if (length($oldString) > $maxLen) { | |
859 | # Here it's too big, so we truncate it. | |
860 | Trace("Truncating field $i in relation $relName to $maxLen characters from \"$oldString\".") if T(1); | |
861 | $fieldList->[$i] = substr $oldString, 0, $maxLen; | |
862 | $retVal++; | |
863 | } | |
864 | } | |
865 | } | |
866 | # Return the truncation count. | |
867 | return $retVal; | |
868 | } | |
869 | ||
870 | =head3 DigestFields | |
871 | ||
872 | C<< $erdb->DigestFields($relName, $fieldList); >> | |
873 | ||
874 | Digest the strings in the field list that correspond to data type C<hash-string> in the | |
875 | specified relation. | |
876 | ||
877 | =over 4 | |
878 | ||
879 | =item relName | |
880 | ||
881 | Name of the relation to which the fields belong. | |
882 | ||
883 | =item fieldList | |
884 | ||
885 | List of field contents to be loaded into the relation. | |
886 | ||
887 | =back | |
888 | ||
889 | =cut | |
890 | #: Return Type ; | |
891 | sub DigestFields { | |
892 | # Get the parameters. | |
893 | my ($self, $relName, $fieldList) = @_; | |
894 | # Get the relation definition. | |
895 | my $relData = $self->_FindRelation($relName); | |
896 | # Get the list of field descriptors. | |
897 | my $fieldTypes = $relData->{Fields}; | |
898 | my $fieldCount = scalar @{$fieldTypes}; | |
899 | # Loop through the two lists. | |
900 | for (my $i = 0; $i < $fieldCount; $i++) { | |
901 | # Get the type of the current field. | |
902 | my $fieldType = $fieldTypes->[$i]->{type}; | |
903 | # If it's a hash string, digest it in place. | |
904 | if ($fieldType eq 'hash-string') { | |
905 | $fieldList->[$i] = $self->DigestKey($fieldList->[$i]); | |
906 | } | |
907 | } | |
908 | } | |
909 | ||
910 | =head3 DigestKey | |
911 | ||
912 | C<< my $digested = $erdb->DigestKey($keyValue); >> | |
913 | ||
914 | Return the digested value of a symbolic key. The digested value can then be plugged into a | |
915 | key-based search into a table with key-type hash-string. | |
916 | ||
917 | Currently the digesting process is independent of the database structure, but that may not | |
918 | always be the case, so this is an instance method instead of a static method. | |
919 | ||
920 | =over 4 | |
921 | ||
922 | =item keyValue | |
923 | ||
924 | Key value to digest. | |
925 | ||
926 | =item RETURN | |
927 | ||
928 | Digested value of the key. | |
929 | ||
930 | =back | |
931 | ||
932 | =cut | |
933 | ||
934 | sub DigestKey { | |
935 | # Get the parameters. | |
936 | my ($self, $keyValue) = @_; | |
937 | # Compute the digest. | |
938 | my $retVal = md5_base64($keyValue); | |
939 | # Return the result. | |
940 | return $retVal; | |
941 | } | |
942 | ||
943 | =head3 CreateIndex | =head3 CreateIndex |
944 | ||
945 | C<< $erdb->CreateIndex($relationName); >> | C<< $erdb->CreateIndex($relationName); >> |
# | Line 669 | Line 963 |
963 | for my $indexName (keys %{$indexHash}) { | for my $indexName (keys %{$indexHash}) { |
964 | my $indexData = $indexHash->{$indexName}; | my $indexData = $indexHash->{$indexName}; |
965 | # Get the index's field list. | # Get the index's field list. |
966 | my @fieldList = _FixNames(@{$indexData->{IndexFields}}); | my @rawFields = @{$indexData->{IndexFields}}; |
967 | # Get a hash of the relation's field types. | |
968 | my %types = map { $_->{name} => $_->{type} } @{$relationData->{Fields}}; | |
969 | # We need to check for text fields. We need a append a length limitation for them. To do | |
970 | # that, we need the relation's field list. | |
971 | my $relFields = $relationData->{Fields}; | |
972 | for (my $i = 0; $i <= $#rawFields; $i++) { | |
973 | # Get the field type. | |
974 | my $field = $rawFields[$i]; | |
975 | my $type = $types{$field}; | |
976 | # Ask if it requires using prefix notation for the index. | |
977 | my $mod = $TypeTable{$type}->{indexMod}; | |
978 | Trace("Field $field ($i) in $relationName has type $type and indexMod $mod.") if T(3); | |
979 | if ($mod) { | |
980 | # Append the prefix length to the field name, | |
981 | $rawFields[$i] .= "($mod)"; | |
982 | } | |
983 | } | |
984 | my @fieldList = _FixNames(@rawFields); | |
985 | my $flds = join(', ', @fieldList); | my $flds = join(', ', @fieldList); |
986 | # Get the index's uniqueness flag. | # Get the index's uniqueness flag. |
987 | my $unique = (exists $indexData->{Unique} ? $indexData->{Unique} : 'false'); | my $unique = (exists $indexData->{Unique} ? 'unique' : undef); |
988 | # Create the index. | # Create the index. |
989 | $dbh->create_index(idx => $indexName, tbl => $relationName, flds => $flds, unique => $unique); | my $rv = $dbh->create_index(idx => $indexName, tbl => $relationName, |
990 | flds => $flds, kind => $unique); | |
991 | if ($rv) { | |
992 | Trace("Index created: $indexName for $relationName ($flds)") if T(1); | Trace("Index created: $indexName for $relationName ($flds)") if T(1); |
993 | } else { | |
994 | Confess("Error creating index $indexName for $relationName using ($flds): " . $dbh->error_message()); | |
995 | } | |
996 | } | |
997 | } | |
998 | ||
999 | =head3 GetSecondaryFields | |
1000 | ||
1001 | C<< my %fieldTuples = $erdb->GetSecondaryFields($entityName); >> | |
1002 | ||
1003 | This method will return a list of the name and type of each of the secondary | |
1004 | fields for a specified entity. Secondary fields are stored in two-column tables | |
1005 | in addition to the primary entity table. This enables the field to have no value | |
1006 | or to have multiple values. | |
1007 | ||
1008 | =over 4 | |
1009 | ||
1010 | =item entityName | |
1011 | ||
1012 | Name of the entity whose secondary fields are desired. | |
1013 | ||
1014 | =item RETURN | |
1015 | ||
1016 | Returns a hash mapping the field names to their field types. | |
1017 | ||
1018 | =back | |
1019 | ||
1020 | =cut | |
1021 | ||
1022 | sub GetSecondaryFields { | |
1023 | # Get the parameters. | |
1024 | my ($self, $entityName) = @_; | |
1025 | # Declare the return variable. | |
1026 | my %retVal = (); | |
1027 | # Look for the entity. | |
1028 | my $table = $self->GetFieldTable($entityName); | |
1029 | # Loop through the fields, pulling out the secondaries. | |
1030 | for my $field (sort keys %{$table}) { | |
1031 | if ($table->{$field}->{relation} ne $entityName) { | |
1032 | # Here we have a secondary field. | |
1033 | $retVal{$field} = $table->{$field}->{type}; | |
1034 | } | |
1035 | } | |
1036 | # Return the result. | |
1037 | return %retVal; | |
1038 | } | |
1039 | ||
1040 | =head3 GetFieldRelationName | |
1041 | ||
1042 | C<< my $name = $erdb->GetFieldRelationName($objectName, $fieldName); >> | |
1043 | ||
1044 | Return the name of the relation containing a specified field. | |
1045 | ||
1046 | =over 4 | |
1047 | ||
1048 | =item objectName | |
1049 | ||
1050 | Name of the entity or relationship containing the field. | |
1051 | ||
1052 | =item fieldName | |
1053 | ||
1054 | Name of the relevant field in that entity or relationship. | |
1055 | ||
1056 | =item RETURN | |
1057 | ||
1058 | Returns the name of the database relation containing the field, or C<undef> if | |
1059 | the field does not exist. | |
1060 | ||
1061 | =back | |
1062 | ||
1063 | =cut | |
1064 | ||
1065 | sub GetFieldRelationName { | |
1066 | # Get the parameters. | |
1067 | my ($self, $objectName, $fieldName) = @_; | |
1068 | # Declare the return variable. | |
1069 | my $retVal; | |
1070 | # Get the object field table. | |
1071 | my $table = $self->GetFieldTable($objectName); | |
1072 | # Only proceed if the field exists. | |
1073 | if (exists $table->{$fieldName}) { | |
1074 | # Determine the name of the relation that contains this field. | |
1075 | $retVal = $table->{$fieldName}->{relation}; | |
1076 | } | |
1077 | # Return the result. | |
1078 | return $retVal; | |
1079 | } | |
1080 | ||
1081 | =head3 DeleteValue | |
1082 | ||
1083 | C<< my $numDeleted = $erdb->DeleteValue($entityName, $id, $fieldName, $fieldValue); >> | |
1084 | ||
1085 | Delete secondary field values from the database. This method can be used to delete all | |
1086 | values of a specified field for a particular entity instance, or only a single value. | |
1087 | ||
1088 | Secondary fields are stored in two-column relations separate from an entity's primary | |
1089 | table, and as a result a secondary field can legitimately have no value or multiple | |
1090 | values. Therefore, it makes sense to talk about deleting secondary fields where it | |
1091 | would not make sense for primary fields. | |
1092 | ||
1093 | =over 4 | |
1094 | ||
1095 | =item entityName | |
1096 | ||
1097 | Name of the entity from which the fields are to be deleted. | |
1098 | ||
1099 | =item id | |
1100 | ||
1101 | ID of the entity instance to be processed. If the instance is not found, this | |
1102 | method will have no effect. If C<undef> is specified, all values for all of | |
1103 | the entity instances will be deleted. | |
1104 | ||
1105 | =item fieldName | |
1106 | ||
1107 | Name of the field whose values are to be deleted. | |
1108 | ||
1109 | =item fieldValue (optional) | |
1110 | ||
1111 | Value to be deleted. If not specified, then all values of the specified field | |
1112 | will be deleted for the entity instance. If specified, then only the values which | |
1113 | match this parameter will be deleted. | |
1114 | ||
1115 | =item RETURN | |
1116 | ||
1117 | Returns the number of rows deleted. | |
1118 | ||
1119 | =back | |
1120 | ||
1121 | =cut | |
1122 | ||
1123 | sub DeleteValue { | |
1124 | # Get the parameters. | |
1125 | my ($self, $entityName, $id, $fieldName, $fieldValue) = @_; | |
1126 | # Declare the return value. | |
1127 | my $retVal = 0; | |
1128 | # We need to set up an SQL command to do the deletion. First, we | |
1129 | # find the name of the field's relation. | |
1130 | my $table = $self->GetFieldTable($entityName); | |
1131 | my $field = $table->{$fieldName}; | |
1132 | my $relation = $field->{relation}; | |
1133 | # Make sure this is a secondary field. | |
1134 | if ($relation eq $entityName) { | |
1135 | Confess("Cannot delete values of $fieldName for $entityName."); | |
1136 | } else { | |
1137 | # Set up the SQL command to delete all values. | |
1138 | my $sql = "DELETE FROM $relation"; | |
1139 | # Build the filter. | |
1140 | my @filters = (); | |
1141 | my @parms = (); | |
1142 | # Check for a filter by ID. | |
1143 | if (defined $id) { | |
1144 | push @filters, "id = ?"; | |
1145 | push @parms, $id; | |
1146 | } | |
1147 | # Check for a filter by value. | |
1148 | if (defined $fieldValue) { | |
1149 | push @filters, "$fieldName = ?"; | |
1150 | push @parms, $fieldValue; | |
1151 | } | |
1152 | # Append the filters to the command. | |
1153 | if (@filters) { | |
1154 | $sql .= " WHERE " . join(" AND ", @filters); | |
1155 | } | |
1156 | # Execute the command. | |
1157 | my $dbh = $self->{_dbh}; | |
1158 | $retVal = $dbh->SQL($sql, 0, @parms); | |
1159 | } | } |
1160 | # Return the result. | |
1161 | return $retVal; | |
1162 | } | } |
1163 | ||
1164 | =head3 LoadTables | =head3 LoadTables |
# | Line 724 | Line 1206 |
1206 | $directoryName =~ s!/\\$!!; | $directoryName =~ s!/\\$!!; |
1207 | # Declare the return variable. | # Declare the return variable. |
1208 | my $retVal = Stats->new(); | my $retVal = Stats->new(); |
1209 | # Get the metadata structure. | # Get the relation names. |
1210 | my $metaData = $self->{_metaData}; | my @relNames = $self->GetTableNames(); |
1211 | # 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}}) { | ||
1212 | # Try to load this relation. | # Try to load this relation. |
1213 | my $result = $self->_LoadRelation($directoryName, $relationName, $rebuild); | my $result = $self->_LoadRelation($directoryName, $relationName, $rebuild); |
1214 | # Accumulate the statistics. | # Accumulate the statistics. |
1215 | $retVal->Accumulate($result); | $retVal->Accumulate($result); |
1216 | } | } |
} | ||
# 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); | ||
} | ||
1217 | # Add the duration of the load to the statistical object. | # Add the duration of the load to the statistical object. |
1218 | $retVal->Add('duration', gettimeofday - $startTime); | $retVal->Add('duration', gettimeofday - $startTime); |
1219 | # Return the accumulated statistics. | # Return the accumulated statistics. |
1220 | return $retVal; | return $retVal; |
1221 | } | } |
1222 | ||
1223 | ||
1224 | =head3 GetTableNames | =head3 GetTableNames |
1225 | ||
1226 | C<< my @names = $erdb->GetTableNames; >> | C<< my @names = $erdb->GetTableNames; >> |
# | Line 783 | Line 1255 |
1255 | return sort keys %{$entityList}; | return sort keys %{$entityList}; |
1256 | } | } |
1257 | ||
1258 | =head3 GetDataTypes | |
1259 | ||
1260 | C<< my %types = ERDB::GetDataTypes(); >> | |
1261 | ||
1262 | Return a table of ERDB data types. The table returned is a hash of hashes. | |
1263 | The keys of the big hash are the datatypes. Each smaller hash has several | |
1264 | values used to manage the data. The most interesting is the SQL type (key | |
1265 | C<sqlType>) and the descriptive node (key C<notes>). | |
1266 | ||
1267 | Note that changing the values in the smaller hashes will seriously break | |
1268 | things, so this data should be treated as read-only. | |
1269 | ||
1270 | =cut | |
1271 | ||
1272 | sub GetDataTypes { | |
1273 | return %TypeTable; | |
1274 | } | |
1275 | ||
1276 | ||
1277 | =head3 IsEntity | =head3 IsEntity |
1278 | ||
1279 | C<< my $flag = $erdb->IsEntity($entityName); >> | C<< my $flag = $erdb->IsEntity($entityName); >> |
# | Line 812 | Line 1303 |
1303 | ||
1304 | =head3 Get | =head3 Get |
1305 | ||
1306 | C<< my $query = $erdb->Get(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >> | C<< my $query = $erdb->Get(\@objectNames, $filterClause, \@params); >> |
1307 | ||
1308 | 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. |
1309 | 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 820 | Line 1311 |
1311 | 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 |
1312 | $genus. | $genus. |
1313 | ||
1314 | C<< $query = $erdb->Get(['Genome'], "Genome(genus) = ?", $genus); >> | C<< $query = $erdb->Get(['Genome'], "Genome(genus) = ?", [$genus]); >> |
1315 | ||
1316 | 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 |
1317 | parameter representing the parameter value. It would also be possible to code | parameter representing the parameter value. It would also be possible to code |
# | Line 837 | Line 1328 |
1328 | 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 |
1329 | 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, |
1330 | ||
1331 | C<< $query = $erdb->Get(['Genome', 'ComesFrom', 'Source'], "Genome(genus) = ?", $genus); >> | C<< $query = $erdb->Get(['Genome', 'ComesFrom', 'Source'], "Genome(genus) = ?", [$genus]); >> |
1332 | ||
1333 | 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 |
1334 | 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. |
1335 | In particular, you can't specify any entity or relationship more than once, and if a | In particular, if a relationship is recursive, the path is determined by the order in which |
1336 | relationship is recursive, the path is determined by the order in which the entity | the entity and the relationship appear. For example, consider a recursive relationship |
1337 | and the relationship appear. For example, consider a recursive relationship B<IsParentOf> | B<IsParentOf> which relates B<People> objects to other B<People> objects. If the join path is |
which relates B<People> objects to other B<People> objects. If the join path is | ||
1338 | coded as C<['People', 'IsParentOf']>, then the people returned will be parents. If, however, | coded as C<['People', 'IsParentOf']>, then the people returned will be parents. If, however, |
1339 | the join path is C<['IsParentOf', 'People']>, then the people returned will be children. | the join path is C<['IsParentOf', 'People']>, then the people returned will be children. |
1340 | ||
1341 | If an entity or relationship is mentioned twice, the name for the second occurrence will | |
1342 | be suffixed with C<2>, the third occurrence will be suffixed with C<3>, and so forth. So, | |
1343 | for example, if we have C<['Feature', 'HasContig', 'Contig', 'HasContig']>, then the | |
1344 | B<to-link> field of the first B<HasContig> is specified as C<HasContig(to-link)>, while | |
1345 | the B<to-link> field of the second B<HasContig> is specified as C<HasContig2(to-link)>. | |
1346 | ||
1347 | =over 4 | =over 4 |
1348 | ||
1349 | =item objectNames | =item objectNames |
# | Line 870 | Line 1366 |
1366 | ||
1367 | C<< "Genome(genus) = ? ORDER BY Genome(species)" >> | C<< "Genome(genus) = ? ORDER BY Genome(species)" >> |
1368 | ||
1369 | Note that the case is important. Only an uppercase "ORDER BY" with a single space will | |
1370 | be processed. The idea is to make it less likely to find the verb by accident. | |
1371 | ||
1372 | 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 |
1373 | 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 |
1374 | relation. | relation. |
1375 | ||
1376 | =item param1, param2, ..., paramN | Finally, you can limit the number of rows returned by adding a LIMIT clause. The LIMIT must |
1377 | be the last thing in the filter clause, and it contains only the word "LIMIT" followed by | |
1378 | a positive number. So, for example | |
1379 | ||
1380 | C<< "Genome(genus) = ? ORDER BY Genome(species) LIMIT 10" >> | |
1381 | ||
1382 | will only return the first ten genomes for the specified genus. The ORDER BY clause is not | |
1383 | required. For example, to just get the first 10 genomes in the B<Genome> table, you could | |
1384 | use | |
1385 | ||
1386 | Parameter values to be substituted into the filter clause. | C<< "LIMIT 10" >> |
1387 | ||
1388 | =item params | |
1389 | ||
1390 | Reference to a list of parameter values to be substituted into the filter clause. | |
1391 | ||
1392 | =item RETURN | =item RETURN |
1393 | ||
# | Line 888 | Line 1399 |
1399 | ||
1400 | sub Get { | sub Get { |
1401 | # Get the parameters. | # Get the parameters. |
1402 | my ($self, $objectNames, $filterClause, @params) = @_; | my ($self, $objectNames, $filterClause, $params) = @_; |
1403 | # Construct the SELECT statement. The general pattern is | # Process the SQL stuff. |
1404 | # | my ($suffix, $mappedNameListRef, $mappedNameHashRef) = |
1405 | # SELECT name1.*, name2.*, ... nameN.* FROM name1, name2, ... nameN | $self->_SetupSQL($objectNames, $filterClause); |
1406 | # | # Create the query. |
1407 | my $dbh = $self->{_dbh}; | my $command = "SELECT DISTINCT " . join(".*, ", @{$mappedNameListRef}) . |
1408 | my $command = "SELECT DISTINCT " . join('.*, ', @{$objectNames}) . ".* FROM " . | ".* $suffix"; |
1409 | join(', ', @{$objectNames}); | my $sth = $self->_GetStatementHandle($command, $params); |
1410 | # Check for a filter clause. | # Now we create the relation map, which enables DBQuery to determine the order, name |
1411 | if ($filterClause) { | # and mapped name for each object in the query. |
1412 | # Here we have one, so we convert its field names and add it to the query. First, | my @relationMap = (); |
1413 | # We create a copy of the filter string we can work with. | for my $mappedName (@{$mappedNameListRef}) { |
1414 | my $filterString = $filterClause; | push @relationMap, [$mappedName, $mappedNameHashRef->{$mappedName}]; |
# Next, we sort the object names by length. This helps protect us from finding | ||
# object names inside other object names when we're doing our search and replace. | ||
my @sortedNames = sort { length($b) - length($a) } @{$objectNames}; | ||
# We will also keep a list of conditions to add to the WHERE clause in order to link | ||
# entities and relationships as well as primary relations to secondary ones. | ||
my @joinWhere = (); | ||
# The final preparatory step is to create a hash table of relation names. The | ||
# table begins with the relation names already in the SELECT command. | ||
my %fromNames = (); | ||
for my $objectName (@sortedNames) { | ||
$fromNames{$objectName} = 1; | ||
} | ||
# We are ready to begin. We loop through the object names, replacing each | ||
# object name's field references by the corresponding SQL field reference. | ||
# Along the way, if we find a secondary relation, we will need to add it | ||
# to the FROM clause. | ||
for my $objectName (@sortedNames) { | ||
# Get the length of the object name plus 2. This is the value we add to the | ||
# size of the field name to determine the size of the field reference as a | ||
# whole. | ||
my $nameLength = 2 + length $objectName; | ||
# Get the object's field list. | ||
my $fieldList = $self->_GetFieldTable($objectName); | ||
# Find the field references for this object. | ||
while ($filterString =~ m/$objectName\(([^)]*)\)/g) { | ||
# At this point, $1 contains the field name, and the current position | ||
# is set immediately after the final parenthesis. We pull out the name of | ||
# the field and the position and length of the field reference as a whole. | ||
my $fieldName = $1; | ||
my $len = $nameLength + length $fieldName; | ||
my $pos = pos($filterString) - $len; | ||
# Insure the field exists. | ||
if (!exists $fieldList->{$fieldName}) { | ||
Confess("Field $fieldName not found for object $objectName."); | ||
} else { | ||
# Get the field's relation. | ||
my $relationName = $fieldList->{$fieldName}->{relation}; | ||
# Insure the relation is in the FROM clause. | ||
if (!exists $fromNames{$relationName}) { | ||
# Add the relation to the FROM clause. | ||
$command .= ", $relationName"; | ||
# Create its join sub-clause. | ||
push @joinWhere, "$objectName.id = $relationName.id"; | ||
# Denote we have it available for future fields. | ||
$fromNames{$relationName} = 1; | ||
} | ||
# Form an SQL field reference from the relation name and the field name. | ||
my $sqlReference = "$relationName." . _FixName($fieldName); | ||
# Put it into the filter string in place of the old value. | ||
substr($filterString, $pos, $len) = $sqlReference; | ||
# Reposition the search. | ||
pos $filterString = $pos + length $sqlReference; | ||
} | ||
} | ||
} | ||
# The next step is to join the objects together. We only need to do this if there | ||
# is more than one object in the object list. We start with the first object and | ||
# run through the objects after it. Note also that we make a safety copy of the | ||
# list before running through it. | ||
my @objectList = @{$objectNames}; | ||
my $lastObject = shift @objectList; | ||
# Get the join table. | ||
my $joinTable = $self->{_metaData}->{Joins}; | ||
# Loop through the object list. | ||
for my $thisObject (@objectList) { | ||
# Look for a join. | ||
my $joinKey = "$lastObject/$thisObject"; | ||
if (!exists $joinTable->{$joinKey}) { | ||
# Here there's no join, so we throw an error. | ||
Confess("No join exists to connect from $lastObject to $thisObject."); | ||
} else { | ||
# Get the join clause and add it to the WHERE list. | ||
push @joinWhere, $joinTable->{$joinKey}; | ||
# Save this object as the last object for the next iteration. | ||
$lastObject = $thisObject; | ||
} | ||
} | ||
# Now we need to handle the whole ORDER BY thing. We'll put the order by clause | ||
# in the following variable. | ||
my $orderClause = ""; | ||
# Locate the ORDER BY verb (if any). | ||
if ($filterString =~ m/^(.*)ORDER BY/g) { | ||
# Here we have an ORDER BY verb. Split it off of the filter string. | ||
my $pos = pos $filterString; | ||
$orderClause = substr($filterString, $pos); | ||
$filterString = $1; | ||
} | ||
# Add the filter and the join clauses (if any) to the SELECT command. | ||
if ($filterString) { | ||
push @joinWhere, "($filterString)"; | ||
} | ||
if (@joinWhere) { | ||
$command .= " WHERE " . join(' AND ', @joinWhere); | ||
} | ||
# Add the sort clause (if any) to the SELECT command. | ||
if ($orderClause) { | ||
$command .= " ORDER BY $orderClause"; | ||
} | ||
1415 | } | } |
Trace("SQL query: $command") if T(3); | ||
Trace("PARMS: '" . (join "', '", @params) . "'") if (T(4) && (@params > 0)); | ||
my $sth = $dbh->prepare_command($command); | ||
# Execute it with the parameters bound in. | ||
$sth->execute(@params) || Confess("SELECT error" . $sth->errstr()); | ||
1416 | # Return the statement object. | # Return the statement object. |
1417 | my $retVal = DBQuery::_new($self, $sth, @{$objectNames}); | my $retVal = DBQuery::_new($self, $sth, \@relationMap); |
1418 | return $retVal; | return $retVal; |
1419 | } | } |
1420 | ||
1421 | =head3 GetList | =head3 Search |
C<< my @dbObjects = $erdb->GetList(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >> | ||
1422 | ||
1423 | Return a list of object descriptors for the specified objects as determined by the | C<< my $query = $erdb->Search($searchExpression, $idx, \@objectNames, $filterClause, \@params); >> |
specified filter clause. | ||
1424 | ||
1425 | This method is essentially the same as L</Get> except it returns a list of objects rather | Perform a full text search with filtering. The search will be against a specified object |
1426 | than a query object that can be used to get the results one record at a time. | in the object name list. That object will get an extra field containing the search |
1427 | relevance. Note that except for the search expression, the parameters of this method are | |
1428 | the same as those for L</Get> and follow the same rules. | |
1429 | ||
1430 | =over 4 | =over 4 |
1431 | ||
1432 | =item searchExpression | |
1433 | ||
1434 | Boolean search expression for the text fields of the target object. The default mode for | |
1435 | a Boolean search expression is OR, but we want the default to be AND, so we will | |
1436 | add a C<+> operator to each word with no other operator before it. | |
1437 | ||
1438 | =item idx | |
1439 | ||
1440 | Index in the I<$objectNames> list of the table to be searched in full-text mode. | |
1441 | ||
1442 | =item objectNames | =item objectNames |
1443 | ||
1444 | List containing the names of the entity and relationship objects to be retrieved. | List containing the names of the entity and relationship objects to be retrieved. |
# | Line 1036 | Line 1453 |
1453 | or secondary entity relations; however, all of the entities and relationships involved must | or secondary entity relations; however, all of the entities and relationships involved must |
1454 | be included in the list of object names. | be included in the list of object names. |
1455 | ||
1456 | The filter clause can also specify a sort order. To do this, simply follow the filter string | =item params |
with an ORDER BY clause. For example, the following filter string gets all genomes for a | ||
particular genus and sorts them by species name. | ||
1457 | ||
1458 | C<< "Genome(genus) = ? ORDER BY Genome(species)" >> | Reference to a list of parameter values to be substituted into the filter clause. |
1459 | ||
1460 | The rules for field references in a sort order are the same as those for field references in the | =item RETURN |
1461 | filter clause in general; however, odd things may happen if a sort field is from a secondary | |
1462 | relation. | Returns a query object for the specified search. |
1463 | ||
1464 | =back | |
1465 | ||
1466 | =cut | |
1467 | ||
1468 | sub Search { | |
1469 | # Get the parameters. | |
1470 | my ($self, $searchExpression, $idx, $objectNames, $filterClause, $params) = @_; | |
1471 | # Declare the return variable. | |
1472 | my $retVal; | |
1473 | # Create a safety copy of the parameter list. Note we have to be careful to insure | |
1474 | # a parameter list exists before we copy it. | |
1475 | my @myParams = (); | |
1476 | if (defined $params) { | |
1477 | @myParams = @{$params}; | |
1478 | } | |
1479 | # Get the first object's structure so we have access to the searchable fields. | |
1480 | my $object1Name = $objectNames->[$idx]; | |
1481 | my $object1Structure = $self->_GetStructure($object1Name); | |
1482 | # Get the field list. | |
1483 | if (! exists $object1Structure->{searchFields}) { | |
1484 | Confess("No searchable index for $object1Name."); | |
1485 | } else { | |
1486 | # Get the field list. | |
1487 | my @fields = @{$object1Structure->{searchFields}}; | |
1488 | # Clean the search expression. | |
1489 | my $actualKeywords = $self->CleanKeywords($searchExpression); | |
1490 | # Prefix a "+" to each uncontrolled word. This converts the default | |
1491 | # search mode from OR to AND. | |
1492 | $actualKeywords =~ s/(^|\s)(\w)/$1\+$2/g; | |
1493 | Trace("Actual keywords for search are\n$actualKeywords") if T(3); | |
1494 | # We need two match expressions, one for the filter clause and one in the | |
1495 | # query itself. Both will use a parameter mark, so we need to push the | |
1496 | # search expression onto the front of the parameter list twice. | |
1497 | unshift @myParams, $actualKeywords, $actualKeywords; | |
1498 | # Build the match expression. | |
1499 | my @matchFilterFields = map { "$object1Name." . _FixName($_) } @fields; | |
1500 | my $matchClause = "MATCH (" . join(", ", @matchFilterFields) . ") AGAINST (? IN BOOLEAN MODE)"; | |
1501 | # Process the SQL stuff. | |
1502 | my ($suffix, $mappedNameListRef, $mappedNameHashRef) = | |
1503 | $self->_SetupSQL($objectNames, $filterClause, $matchClause); | |
1504 | # Create the query. Note that the match clause is inserted at the front of | |
1505 | # the select fields. | |
1506 | my $command = "SELECT DISTINCT $matchClause, " . join(".*, ", @{$mappedNameListRef}) . | |
1507 | ".* $suffix"; | |
1508 | my $sth = $self->_GetStatementHandle($command, \@myParams); | |
1509 | # Now we create the relation map, which enables DBQuery to determine the order, name | |
1510 | # and mapped name for each object in the query. | |
1511 | my @relationMap = _RelationMap($mappedNameHashRef, $mappedNameListRef); | |
1512 | # Return the statement object. | |
1513 | $retVal = DBQuery::_new($self, $sth, \@relationMap, $object1Name); | |
1514 | } | |
1515 | return $retVal; | |
1516 | } | |
1517 | ||
1518 | =head3 GetFlat | |
1519 | ||
1520 | C<< my @list = $erdb->GetFlat(\@objectNames, $filterClause, \@parameterList, $field); >> | |
1521 | ||
1522 | This is a variation of L</GetAll> that asks for only a single field per record and | |
1523 | returns a single flattened list. | |
1524 | ||
1525 | =over 4 | |
1526 | ||
1527 | =item objectNames | |
1528 | ||
1529 | List containing the names of the entity and relationship objects to be retrieved. | |
1530 | ||
1531 | =item filterClause | |
1532 | ||
1533 | WHERE/ORDER BY clause (without the WHERE) to be used to filter and sort the query. The WHERE clause can | |
1534 | be parameterized with parameter markers (C<?>). Each field used must be specified in the standard form | |
1535 | B<I<objectName>(I<fieldName>)>. Any parameters specified in the filter clause should be added to the | |
1536 | parameter list as additional parameters. The fields in a filter clause can come from primary | |
1537 | entity relations, relationship relations, or secondary entity relations; however, all of the | |
1538 | entities and relationships involved must be included in the list of object names. | |
1539 | ||
1540 | =item parameterList | |
1541 | ||
1542 | =item param1, param2, ..., paramN | List of the parameters to be substituted in for the parameters marks in the filter clause. |
1543 | ||
1544 | =item field | |
1545 | ||
1546 | Parameter values to be substituted into the filter clause. | Name of the field to be used to get the elements of the list returned. |
1547 | ||
1548 | =item RETURN | =item RETURN |
1549 | ||
1550 | Returns a list of B<DBObject>s that satisfy the query conditions. | Returns a list of values. |
1551 | ||
1552 | =back | =back |
1553 | ||
1554 | =cut | =cut |
1555 | #: Return Type @% | #: Return Type @; |
1556 | sub GetList { | sub GetFlat { |
1557 | # Get the parameters. | # Get the parameters. |
1558 | my ($self, $objectNames, $filterClause, @params) = @_; | my ($self, $objectNames, $filterClause, $parameterList, $field) = @_; |
1559 | # Declare the return variable. | # Construct the query. |
1560 | my $query = $self->Get($objectNames, $filterClause, $parameterList); | |
1561 | # Create the result list. | |
1562 | my @retVal = (); | my @retVal = (); |
1563 | # Perform the query. | # Loop through the records, adding the field values found to the result list. |
1564 | my $query = $self->Get($objectNames, $filterClause, @params); | while (my $row = $query->Fetch()) { |
1565 | # Loop through the results. | push @retVal, $row->Value($field); |
while (my $object = $query->Fetch) { | ||
push @retVal, $object; | ||
1566 | } | } |
1567 | # Return the result. | # Return the list created. |
1568 | return @retVal; | return @retVal; |
1569 | } | } |
1570 | ||
1571 | =head3 ComputeObjectSentence | =head3 SpecialFields |
1572 | ||
1573 | C<< my $sentence = $erdb->ComputeObjectSentence($objectName); >> | C<< my %specials = $erdb->SpecialFields($entityName); >> |
1574 | ||
1575 | Check an object name, and if it is a relationship convert it to a relationship sentence. | Return a hash mapping special fields in the specified entity to the value of their |
1576 | C<special> attribute. This enables the subclass to get access to the special field | |
1577 | attributes without needed to plumb the internal ERDB data structures. | |
1578 | ||
1579 | =over 4 | =over 4 |
1580 | ||
1581 | =item objectName | =item entityName |
1582 | ||
1583 | Name of the entity or relationship. | Name of the entity whose special fields are desired. |
1584 | ||
1585 | =item RETURN | =item RETURN |
1586 | ||
1587 | Returns a string containing the entity name or a relationship sentence. | Returns a hash. The keys of the hash are the special field names, and the values |
1588 | are the values from each special field's C<special> attribute. | |
1589 | ||
1590 | =back | =back |
1591 | ||
1592 | =cut | =cut |
1593 | ||
1594 | sub ComputeObjectSentence { | sub SpecialFields { |
1595 | # Get the parameters. | # Get the parameters. |
1596 | my ($self, $objectName) = @_; | my ($self, $entityName) = @_; |
1597 | # Set the default return value. | # Declare the return variable. |
1598 | my $retVal = $objectName; | my %retVal = (); |
1599 | # Look for the object as a relationship. | # Find the entity's data structure. |
1600 | my $relTable = $self->{_metaData}->{Relationships}; | my $entityData = $self->{_metaData}->{Entities}->{$entityName}; |
1601 | if (exists $relTable->{$objectName}) { | # Loop through its fields, adding each special field to the return hash. |
1602 | # Get the relationship sentence. | my $fieldHash = $entityData->{Fields}; |
1603 | $retVal = _ComputeRelationshipSentence($objectName, $relTable->{$objectName}); | for my $fieldName (keys %{$fieldHash}) { |
1604 | my $fieldData = $fieldHash->{$fieldName}; | |
1605 | if (exists $fieldData->{special}) { | |
1606 | $retVal{$fieldName} = $fieldData->{special}; | |
1607 | } | |
1608 | } | } |
1609 | # Return the result. | # Return the result. |
1610 | return $retVal; | return %retVal; |
1611 | } | } |
1612 | ||
1613 | =head3 DumpRelations | =head3 Delete |
1614 | ||
1615 | C<< $erdb->DumpRelations($outputDirectory); >> | C<< my $stats = $erdb->Delete($entityName, $objectID, $testFlag); >> |
1616 | ||
1617 | Write the contents of all the relations to tab-delimited files in the specified directory. | Delete an entity instance from the database. The instance is deleted along with all entity and |
1618 | Each file will have the same name as the relation dumped, with an extension of DTX. | relationship instances dependent on it. The definition of I<dependence> is recursive. |
1619 | ||
1620 | An object is always dependent on itself. An object is dependent if it is a 1-to-many or many-to-many | |
1621 | relationship connected to a dependent entity or if it is the "to" entity connected to a 1-to-many | |
1622 | dependent relationship. | |
1623 | ||
1624 | =over 4 | =over 4 |
1625 | ||
1626 | =item outputDirectory | =item entityName |
1627 | ||
1628 | Name of the directory into which the relation files should be dumped. | Name of the entity type for the instance being deleted. |
1629 | ||
1630 | =item objectID | |
1631 | ||
1632 | ID of the entity instance to be deleted. If the ID contains a wild card character (C<%>), | |
1633 | then it is presumed to by a LIKE pattern. | |
1634 | ||
1635 | =item testFlag | |
1636 | ||
1637 | If TRUE, the delete statements will be traced without being executed. | |
1638 | ||
1639 | =item RETURN | |
1640 | ||
1641 | Returns a statistics object indicating how many records of each particular table were | |
1642 | deleted. | |
1643 | ||
1644 | =back | =back |
1645 | ||
1646 | =cut | =cut |
1647 | #: Return Type $%; | |
1648 | sub DumpRelations { | sub Delete { |
1649 | # Get the parameters. | # Get the parameters. |
1650 | my ($self, $outputDirectory) = @_; | my ($self, $entityName, $objectID, $testFlag) = @_; |
1651 | # Now we need to run through all the relations. First, we loop through the entities. | # Declare the return variable. |
1652 | my $metaData = $self->{_metaData}; | my $retVal = Stats->new(); |
1653 | my $entities = $metaData->{Entities}; | # Get the DBKernel object. |
1654 | for my $entityName (keys %{$entities}) { | my $db = $self->{_dbh}; |
1655 | my $entityStructure = $entities->{$entityName}; | # We're going to generate all the paths branching out from the starting entity. One of |
1656 | # Get the entity's relations. | # the things we have to be careful about is preventing loops. We'll use a hash to |
1657 | my $relationList = $entityStructure->{Relations}; | # determine if we've hit a loop. |
1658 | # Loop through the relations, dumping them. | my %alreadyFound = (); |
1659 | for my $relationName (keys %{$relationList}) { | # These next lists will serve as our result stack. We start by pushing object lists onto |
1660 | my $relation = $relationList->{$relationName}; | # the stack, and then popping them off to do the deletes. This means the deletes will |
1661 | $self->_DumpRelation($outputDirectory, $relationName, $relation); | # start with the longer paths before getting to the shorter ones. That, in turn, makes |
1662 | # sure we don't delete records that might be needed to forge relationships back to the | |
1663 | # original item. We have two lists-- one for TO-relationships, and one for | |
1664 | # FROM-relationships and entities. | |
1665 | my @fromPathList = (); | |
1666 | my @toPathList = (); | |
1667 | # This final hash is used to remember what work still needs to be done. We push paths | |
1668 | # onto the list, then pop them off to extend the paths. We prime it with the starting | |
1669 | # point. Note that we will work hard to insure that the last item on a path in the | |
1670 | # to-do list is always an entity. | |
1671 | my @todoList = ([$entityName]); | |
1672 | while (@todoList) { | |
1673 | # Get the current path. | |
1674 | my $current = pop @todoList; | |
1675 | # Copy it into a list. | |
1676 | my @stackedPath = @{$current}; | |
1677 | # Pull off the last item on the path. It will always be an entity. | |
1678 | my $entityName = pop @stackedPath; | |
1679 | # Add it to the alreadyFound list. | |
1680 | $alreadyFound{$entityName} = 1; | |
1681 | # Get the entity data. | |
1682 | my $entityData = $self->_GetStructure($entityName); | |
1683 | # The first task is to loop through the entity's relation. A DELETE command will | |
1684 | # be needed for each of them. | |
1685 | my $relations = $entityData->{Relations}; | |
1686 | for my $relation (keys %{$relations}) { | |
1687 | my @augmentedList = (@stackedPath, $relation); | |
1688 | push @fromPathList, \@augmentedList; | |
1689 | } | } |
1690 | # Now we need to look for relationships connected to this entity. | |
1691 | my $relationshipList = $self->{_metaData}->{Relationships}; | |
1692 | for my $relationshipName (keys %{$relationshipList}) { | |
1693 | my $relationship = $relationshipList->{$relationshipName}; | |
1694 | # Check the FROM field. We're only interested if it's us. | |
1695 | if ($relationship->{from} eq $entityName) { | |
1696 | # Add the path to this relationship. | |
1697 | my @augmentedList = (@stackedPath, $entityName, $relationshipName); | |
1698 | push @fromPathList, \@augmentedList; | |
1699 | # Check the arity. If it's MM we're done. If it's 1M | |
1700 | # and the target hasn't been seen yet, we want to | |
1701 | # stack the entity for future processing. | |
1702 | if ($relationship->{arity} eq '1M') { | |
1703 | my $toEntity = $relationship->{to}; | |
1704 | if (! exists $alreadyFound{$toEntity}) { | |
1705 | # Here we have a new entity that's dependent on | |
1706 | # the current entity, so we need to stack it. | |
1707 | my @stackList = (@augmentedList, $toEntity); | |
1708 | push @fromPathList, \@stackList; | |
1709 | } else { | |
1710 | Trace("$toEntity ignored because it occurred previously.") if T(4); | |
1711 | } | } |
# Next, we loop through the relationships. | ||
my $relationships = $metaData->{Relationships}; | ||
for my $relationshipName (keys %{$relationships}) { | ||
my $relationshipStructure = $relationships->{$relationshipName}; | ||
# Dump this relationship's relation. | ||
$self->_DumpRelation($outputDirectory, $relationshipName, $relationshipStructure->{Relations}->{$relationshipName}); | ||
1712 | } | } |
1713 | } | } |
1714 | # Now check the TO field. In this case only the relationship needs | |
1715 | # deletion. | |
1716 | if ($relationship->{to} eq $entityName) { | |
1717 | my @augmentedList = (@stackedPath, $entityName, $relationshipName); | |
1718 | push @toPathList, \@augmentedList; | |
1719 | } | |
1720 | } | |
1721 | } | |
1722 | # Create the first qualifier for the WHERE clause. This selects the | |
1723 | # keys of the primary entity records to be deleted. When we're deleting | |
1724 | # from a dependent table, we construct a join page from the first qualifier | |
1725 | # to the table containing the dependent records to delete. | |
1726 | my $qualifier = ($objectID =~ /%/ ? "LIKE ?" : "= ?"); | |
1727 | # We need to make two passes. The first is through the to-list, and | |
1728 | # the second through the from-list. The from-list is second because | |
1729 | # the to-list may need to pass through some of the entities the | |
1730 | # from-list would delete. | |
1731 | my %stackList = ( from_link => \@fromPathList, to_link => \@toPathList ); | |
1732 | # Now it's time to do the deletes. We do it in two passes. | |
1733 | for my $keyName ('to_link', 'from_link') { | |
1734 | # Get the list for this key. | |
1735 | my @pathList = @{$stackList{$keyName}}; | |
1736 | Trace(scalar(@pathList) . " entries in path list for $keyName.") if T(3); | |
1737 | # Loop through this list. | |
1738 | while (my $path = pop @pathList) { | |
1739 | # Get the table whose rows are to be deleted. | |
1740 | my @pathTables = @{$path}; | |
1741 | # Start the DELETE statement. We need to call DBKernel because the | |
1742 | # syntax of a DELETE-USING varies among DBMSs. | |
1743 | my $target = $pathTables[$#pathTables]; | |
1744 | my $stmt = $db->SetUsing(@pathTables); | |
1745 | # Now start the WHERE. The first thing is the ID field from the starting table. That | |
1746 | # starting table will either be the entity relation or one of the entity's | |
1747 | # sub-relations. | |
1748 | $stmt .= " WHERE $pathTables[0].id $qualifier"; | |
1749 | # Now we run through the remaining entities in the path, connecting them up. | |
1750 | for (my $i = 1; $i <= $#pathTables; $i += 2) { | |
1751 | # Connect the current relationship to the preceding entity. | |
1752 | my ($entity, $rel) = @pathTables[$i-1,$i]; | |
1753 | # The style of connection depends on the direction of the relationship. | |
1754 | $stmt .= " AND $entity.id = $rel.$keyName"; | |
1755 | if ($i + 1 <= $#pathTables) { | |
1756 | # Here there's a next entity, so connect that to the relationship's | |
1757 | # to-link. | |
1758 | my $entity2 = $pathTables[$i+1]; | |
1759 | $stmt .= " AND $rel.to_link = $entity2.id"; | |
1760 | } | |
1761 | } | |
1762 | # Now we have our desired DELETE statement. | |
1763 | if ($testFlag) { | |
1764 | # Here the user wants to trace without executing. | |
1765 | Trace($stmt) if T(0); | |
1766 | } else { | |
1767 | # Here we can delete. Note that the SQL method dies with a confession | |
1768 | # if an error occurs, so we just go ahead and do it. | |
1769 | Trace("Executing delete from $target using '$objectID'.") if T(3); | |
1770 | my $rv = $db->SQL($stmt, 0, $objectID); | |
1771 | # Accumulate the statistics for this delete. The only rows deleted | |
1772 | # are from the target table, so we use its name to record the | |
1773 | # statistic. | |
1774 | $retVal->Add($target, $rv); | |
1775 | } | |
1776 | } | |
1777 | } | |
1778 | # Return the result. | |
1779 | return $retVal; | |
1780 | } | |
1781 | ||
1782 | =head3 InsertObject | =head3 SortNeeded |
1783 | ||
1784 | C<< my $ok = $erdb->InsertObject($objectType, \%fieldHash); >> | C<< my $parms = $erdb->SortNeeded($relationName); >> |
1785 | ||
1786 | Insert an object into the database. The object is defined by a type name and then a hash | Return the pipe command for the sort that should be applied to the specified |
1787 | of field names to values. Field values in the primary relation are represented by scalars. | relation when creating the load file. |
(Note that for relationships, the primary relation is the B<only> relation.) | ||
Field values for the other relations comprising the entity are always list references. For | ||
example, the following line inserts an inactive PEG feature named C<fig|188.1.peg.1> with aliases | ||
C<ZP_00210270.1> and C<gi|46206278>. | ||
1788 | ||
1789 | C<< $erdb->InsertObject('Feature', { id => 'fig|188.1.peg.1', active => 0, feature-type => 'peg', alias => ['ZP_00210270.1', 'gi|46206278']}); >> | For example, if the load file should be sorted ascending by the first |
1790 | field, this method would return | |
1791 | ||
1792 | The next statement inserts a C<HasProperty> relationship between feature C<fig|158879.1.peg.1> and | sort -k1 -t"\t" |
property C<4> with an evidence URL of C<http://seedu.uchicago.edu/query.cgi?article_id=142>. | ||
1793 | ||
1794 | C<< $erdb->InsertObject('HasProperty', { 'from-link' => 'fig|158879.1.peg.1', 'to-link' => 4, evidence = 'http://seedu.uchicago.edu/query.cgi?article_id=142'}); >> | If the first field is numeric, the method would return |
1795 | ||
1796 | =over 4 | sort -k1n -t"\t" |
1797 | ||
1798 | =item newObjectType | Unfortunately, due to a bug in the C<sort> command, we cannot eliminate duplicate |
1799 | keys using a sort. | |
1800 | ||
1801 | Type name of the object to insert. | =over 4 |
1802 | ||
1803 | =item fieldHash | =item relationName |
1804 | ||
1805 | Hash of field names to values. | Name of the relation to be examined. |
1806 | ||
1807 | =item RETURN | =item |
1808 | ||
1809 | Returns 1 if successful, 0 if an error occurred. | Returns the sort command to use for sorting the relation, suitable for piping. |
1810 | ||
1811 | =back | =back |
1812 | ||
1813 | =cut | =cut |
1814 | #: Return Type $; | |
1815 | sub InsertObject { | sub SortNeeded { |
1816 | # Get the parameters. | # Get the parameters. |
1817 | my ($self, $newObjectType, $fieldHash) = @_; | my ($self, $relationName) = @_; |
1818 | # Denote that so far we appear successful. | # Declare a descriptor to hold the names of the key fields. |
1819 | my $retVal = 1; | my @keyNames = (); |
1820 | # Get the database handle. | # Get the relation structure. |
1821 | my $dbh = $self->{_dbh}; | my $relationData = $self->_FindRelation($relationName); |
1822 | # Get the relation list. | # Find out if the relation is a primary entity relation, |
1823 | my $relationTable = $self->_GetRelationTable($newObjectType); | # a relationship relation, or a secondary entity relation. |
1824 | # Loop through the relations. We'll build insert statements for each one. If a relation is | my $entityTable = $self->{_metaData}->{Entities}; |
1825 | # secondary, we may end up generating multiple insert statements. If an error occurs, we | my $relationshipTable = $self->{_metaData}->{Relationships}; |
1826 | # stop the loop. | if (exists $entityTable->{$relationName}) { |
1827 | my @relationList = keys %{$relationTable}; | # Here we have a primary entity relation. |
1828 | for (my $i = 0; $retVal && $i <= $#relationList; $i++) { | push @keyNames, "id"; |
1829 | my $relationName = $relationList[$i]; | } elsif (exists $relationshipTable->{$relationName}) { |
1830 | my $relationDefinition = $relationTable->{$relationName}; | # Here we have a relationship. We sort using the FROM index. |
1831 | # Get the relation's fields. For each field we will collect a value in the corresponding | my $relationshipData = $relationshipTable->{$relationName}; |
1832 | # position of the @valueList array. If one of the fields is missing, we will add it to the | my $index = $relationData->{Indexes}->{idxFrom}; |
1833 | # @missing list. | push @keyNames, @{$index->{IndexFields}}; |
1834 | my @fieldList = @{$relationDefinition->{Fields}}; | } else { |
1835 | my @fieldNameList = (); | # Here we have a secondary entity relation, so we have a sort on the ID field. |
1836 | my @valueList = (); | push @keyNames, "id"; |
my @missing = (); | ||
my $recordCount = 1; | ||
for my $fieldDescriptor (@fieldList) { | ||
# Get the field name and save it. Note we need to fix it up so the hyphens | ||
# are converted to underscores. | ||
my $fieldName = $fieldDescriptor->{name}; | ||
push @fieldNameList, _FixName($fieldName); | ||
# Look for the named field in the incoming structure. Note that we are looking | ||
# for the real field name, not the fixed-up one! | ||
if (exists $fieldHash->{$fieldName}) { | ||
# Here we found the field. Stash it in the value list. | ||
my $value = $fieldHash->{$fieldName}; | ||
push @valueList, $value; | ||
# If the value is a list, we may need to increment the record count. | ||
if (ref $value eq "ARRAY") { | ||
my $thisCount = @{$value}; | ||
if ($recordCount == 1) { | ||
# Here we have our first list, so we save its count. | ||
$recordCount = $thisCount; | ||
} elsif ($recordCount != $thisCount) { | ||
# Here we have a second list, so its length has to match the | ||
# previous lists. | ||
Trace("Field $value in new $newObjectType object has an invalid list length $thisCount. Expected $recordCount.") if T(0); | ||
$retVal = 0; | ||
} | ||
1837 | } | } |
1838 | # Now we parse the key names into sort parameters. First, we prime the return | |
1839 | # string. | |
1840 | my $retVal = "sort -t\"\t\" "; | |
1841 | # Get the relation's field list. | |
1842 | my @fields = @{$relationData->{Fields}}; | |
1843 | # Loop through the keys. | |
1844 | for my $keyData (@keyNames) { | |
1845 | # Get the key and the ordering. | |
1846 | my ($keyName, $ordering); | |
1847 | if ($keyData =~ /^([^ ]+) DESC/) { | |
1848 | ($keyName, $ordering) = ($1, "descending"); | |
1849 | } else { | } else { |
1850 | # Here the field is not present. Flag it as missing. | ($keyName, $ordering) = ($keyData, "ascending"); |
push @missing, $fieldName; | ||
1851 | } | } |
1852 | # Find the key's position and type. | |
1853 | my $fieldSpec; | |
1854 | for (my $i = 0; $i <= $#fields && ! $fieldSpec; $i++) { | |
1855 | my $thisField = $fields[$i]; | |
1856 | if ($thisField->{name} eq $keyName) { | |
1857 | # Get the sort modifier for this field type. The modifier | |
1858 | # decides whether we're using a character, numeric, or | |
1859 | # floating-point sort. | |
1860 | my $modifier = $TypeTable{$thisField->{type}}->{sort}; | |
1861 | # If the index is descending for this field, denote we want | |
1862 | # to reverse the sort order on this field. | |
1863 | if ($ordering eq 'descending') { | |
1864 | $modifier .= "r"; | |
1865 | } | |
1866 | # Store the position and modifier into the field spec, which | |
1867 | # will stop the inner loop. Note that the field number is | |
1868 | # 1-based in the sort command, so we have to increment the | |
1869 | # index. | |
1870 | $fieldSpec = ($i + 1) . $modifier; | |
1871 | } | } |
# If we are the primary relation, add the new-record flag. | ||
if ($relationName eq $newObjectType) { | ||
push @valueList, 1; | ||
push @fieldNameList, "new_record"; | ||
1872 | } | } |
1873 | # Only proceed if there are no missing fields. | # Add this field to the sort command. |
1874 | if (@missing > 0) { | $retVal .= " -k$fieldSpec"; |
1875 | Trace("Relation $relationName for $newObjectType skipped due to missing fields: " . | } |
1876 | join(' ', @missing)) if T(1); | # Return the result. |
1877 | return $retVal; | |
1878 | } | |
1879 | ||
1880 | =head3 GetList | |
1881 | ||
1882 | C<< my @dbObjects = $erdb->GetList(\@objectNames, $filterClause, \@params); >> | |
1883 | ||
1884 | Return a list of object descriptors for the specified objects as determined by the | |
1885 | specified filter clause. | |
1886 | ||
1887 | This method is essentially the same as L</Get> except it returns a list of objects rather | |
1888 | than a query object that can be used to get the results one record at a time. | |
1889 | ||
1890 | =over 4 | |
1891 | ||
1892 | =item objectNames | |
1893 | ||
1894 | List containing the names of the entity and relationship objects to be retrieved. | |
1895 | ||
1896 | =item filterClause | |
1897 | ||
1898 | WHERE clause (without the WHERE) to be used to filter and sort the query. The WHERE clause can | |
1899 | be parameterized with parameter markers (C<?>). Each field used in the WHERE clause must be | |
1900 | specified in the standard form B<I<objectName>(I<fieldName>)>. Any parameters specified | |
1901 | in the filter clause should be added to the parameter list as additional parameters. The | |
1902 | fields in a filter clause can come from primary entity relations, relationship relations, | |
1903 | or secondary entity relations; however, all of the entities and relationships involved must | |
1904 | be included in the list of object names. | |
1905 | ||
1906 | The filter clause can also specify a sort order. To do this, simply follow the filter string | |
1907 | with an ORDER BY clause. For example, the following filter string gets all genomes for a | |
1908 | particular genus and sorts them by species name. | |
1909 | ||
1910 | C<< "Genome(genus) = ? ORDER BY Genome(species)" >> | |
1911 | ||
1912 | The rules for field references in a sort order are the same as those for field references in the | |
1913 | filter clause in general; however, odd things may happen if a sort field is from a secondary | |
1914 | relation. | |
1915 | ||
1916 | =item params | |
1917 | ||
1918 | Reference to a list of parameter values to be substituted into the filter clause. | |
1919 | ||
1920 | =item RETURN | |
1921 | ||
1922 | Returns a list of B<DBObject>s that satisfy the query conditions. | |
1923 | ||
1924 | =back | |
1925 | ||
1926 | =cut | |
1927 | #: Return Type @% | |
1928 | sub GetList { | |
1929 | # Get the parameters. | |
1930 | my ($self, $objectNames, $filterClause, $params) = @_; | |
1931 | # Declare the return variable. | |
1932 | my @retVal = (); | |
1933 | # Perform the query. | |
1934 | my $query = $self->Get($objectNames, $filterClause, $params); | |
1935 | # Loop through the results. | |
1936 | while (my $object = $query->Fetch) { | |
1937 | push @retVal, $object; | |
1938 | } | |
1939 | # Return the result. | |
1940 | return @retVal; | |
1941 | } | |
1942 | ||
1943 | =head3 GetCount | |
1944 | ||
1945 | C<< my $count = $erdb->GetCount(\@objectNames, $filter, \@params); >> | |
1946 | ||
1947 | Return the number of rows found by a specified query. This method would | |
1948 | normally be used to count the records in a single table. For example, in a | |
1949 | genetics database | |
1950 | ||
1951 | my $count = $erdb->GetCount(['Genome'], 'Genome(genus-species) LIKE ?', ['homo %']); | |
1952 | ||
1953 | would return the number of genomes for the genus I<homo>. It is conceivable, however, | |
1954 | to use it to return records based on a join. For example, | |
1955 | ||
1956 | my $count = $erdb->GetCount(['HasFeature', 'Genome'], 'Genome(genus-species) LIKE ?', | |
1957 | ['homo %']); | |
1958 | ||
1959 | would return the number of features for genomes in the genus I<homo>. Note that | |
1960 | only the rows from the first table are counted. If the above command were | |
1961 | ||
1962 | my $count = $erdb->GetCount(['Genome', 'Feature'], 'Genome(genus-species) LIKE ?', | |
1963 | ['homo %']); | |
1964 | ||
1965 | it would return the number of genomes, not the number of genome/feature pairs. | |
1966 | ||
1967 | =over 4 | |
1968 | ||
1969 | =item objectNames | |
1970 | ||
1971 | Reference to a list of the objects (entities and relationships) included in the | |
1972 | query. | |
1973 | ||
1974 | =item filter | |
1975 | ||
1976 | A filter clause for restricting the query. The rules are the same as for the L</Get> | |
1977 | method. | |
1978 | ||
1979 | =item params | |
1980 | ||
1981 | Reference to a list of the parameter values to be substituted for the parameter marks | |
1982 | in the filter. | |
1983 | ||
1984 | =item RETURN | |
1985 | ||
1986 | Returns a count of the number of records in the first table that would satisfy | |
1987 | the query. | |
1988 | ||
1989 | =back | |
1990 | ||
1991 | =cut | |
1992 | ||
1993 | sub GetCount { | |
1994 | # Get the parameters. | |
1995 | my ($self, $objectNames, $filter, $params) = @_; | |
1996 | # Insure the params argument is an array reference if the caller left it off. | |
1997 | if (! defined($params)) { | |
1998 | $params = []; | |
1999 | } | |
2000 | # Declare the return variable. | |
2001 | my $retVal; | |
2002 | # Find out if we're counting an entity or a relationship. | |
2003 | my $countedField; | |
2004 | if ($self->IsEntity($objectNames->[0])) { | |
2005 | $countedField = "id"; | |
2006 | } else { | } else { |
2007 | # Build the INSERT statement. | # For a relationship we count the to-link because it's usually more |
2008 | my $statement = "INSERT INTO $relationName (" . join (', ', @fieldNameList) . | # numerous. Note we're automatically converting to the SQL form |
2009 | ") VALUES ("; | # of the field name (to_link vs. to-link). |
2010 | # Create a marker list of the proper size and put it in the statement. | $countedField = "to_link"; |
2011 | my @markers = (); | } |
2012 | while (@markers < @fieldNameList) { push @markers, '?'; } | # Create the SQL command suffix to get the desired records. |
2013 | $statement .= join(', ', @markers) . ")"; | my ($suffix, $mappedNameListRef, $mappedNameHashRef) = $self->_SetupSQL($objectNames, |
2014 | # We have the insert statement, so prepare it. | $filter); |
2015 | my $sth = $dbh->prepare_command($statement); | # Prefix it with text telling it we want a record count. |
2016 | Trace("Insert statement prepared: $statement") if T(3); | my $firstObject = $mappedNameListRef->[0]; |
2017 | # Now we loop through the values. If a value is scalar, we use it unmodified. If it's | my $command = "SELECT COUNT($firstObject.$countedField) $suffix"; |
2018 | # a list, we use the current element. The values are stored in the @parameterList array. | # Prepare and execute the command. |
2019 | my $done = 0; | my $sth = $self->_GetStatementHandle($command, $params); |
2020 | for (my $i = 0; $i < $recordCount; $i++) { | # Get the count value. |
2021 | # Clear the parameter list array. | ($retVal) = $sth->fetchrow_array(); |
2022 | my @parameterList = (); | # Check for a problem. |
2023 | # Loop through the values. | if (! defined($retVal)) { |
2024 | for my $value (@valueList) { | if ($sth->err) { |
2025 | # Check to see if this is a scalar value. | # Here we had an SQL error. |
2026 | if (ref $value eq "ARRAY") { | Confess("Error retrieving row count: " . $sth->errstr()); |
# Here we have a list value. Pull the current entry. | ||
push @parameterList, $value->[$i]; | ||
2027 | } else { | } else { |
2028 | # Here we have a scalar value. Use it unmodified. | # Here we have no result. |
2029 | push @parameterList, $value; | Confess("No result attempting to retrieve row count."); |
2030 | } | |
2031 | } | |
2032 | # Return the result. | |
2033 | return $retVal; | |
2034 | } | |
2035 | ||
2036 | =head3 ComputeObjectSentence | |
2037 | ||
2038 | C<< my $sentence = $erdb->ComputeObjectSentence($objectName); >> | |
2039 | ||
2040 | Check an object name, and if it is a relationship convert it to a relationship sentence. | |
2041 | ||
2042 | =over 4 | |
2043 | ||
2044 | =item objectName | |
2045 | ||
2046 | Name of the entity or relationship. | |
2047 | ||
2048 | =item RETURN | |
2049 | ||
2050 | Returns a string containing the entity name or a relationship sentence. | |
2051 | ||
2052 | =back | |
2053 | ||
2054 | =cut | |
2055 | ||
2056 | sub ComputeObjectSentence { | |
2057 | # Get the parameters. | |
2058 | my ($self, $objectName) = @_; | |
2059 | # Set the default return value. | |
2060 | my $retVal = $objectName; | |
2061 | # Look for the object as a relationship. | |
2062 | my $relTable = $self->{_metaData}->{Relationships}; | |
2063 | if (exists $relTable->{$objectName}) { | |
2064 | # Get the relationship sentence. | |
2065 | $retVal = _ComputeRelationshipSentence($objectName, $relTable->{$objectName}); | |
2066 | } | |
2067 | # Return the result. | |
2068 | return $retVal; | |
2069 | } | |
2070 | ||
2071 | =head3 DumpRelations | |
2072 | ||
2073 | C<< $erdb->DumpRelations($outputDirectory); >> | |
2074 | ||
2075 | Write the contents of all the relations to tab-delimited files in the specified directory. | |
2076 | Each file will have the same name as the relation dumped, with an extension of DTX. | |
2077 | ||
2078 | =over 4 | |
2079 | ||
2080 | =item outputDirectory | |
2081 | ||
2082 | Name of the directory into which the relation files should be dumped. | |
2083 | ||
2084 | =back | |
2085 | ||
2086 | =cut | |
2087 | ||
2088 | sub DumpRelations { | |
2089 | # Get the parameters. | |
2090 | my ($self, $outputDirectory) = @_; | |
2091 | # Now we need to run through all the relations. First, we loop through the entities. | |
2092 | my $metaData = $self->{_metaData}; | |
2093 | my $entities = $metaData->{Entities}; | |
2094 | for my $entityName (keys %{$entities}) { | |
2095 | my $entityStructure = $entities->{$entityName}; | |
2096 | # Get the entity's relations. | |
2097 | my $relationList = $entityStructure->{Relations}; | |
2098 | # Loop through the relations, dumping them. | |
2099 | for my $relationName (keys %{$relationList}) { | |
2100 | my $relation = $relationList->{$relationName}; | |
2101 | $self->_DumpRelation($outputDirectory, $relationName, $relation); | |
2102 | } | |
2103 | } | |
2104 | # Next, we loop through the relationships. | |
2105 | my $relationships = $metaData->{Relationships}; | |
2106 | for my $relationshipName (keys %{$relationships}) { | |
2107 | my $relationshipStructure = $relationships->{$relationshipName}; | |
2108 | # Dump this relationship's relation. | |
2109 | $self->_DumpRelation($outputDirectory, $relationshipName, $relationshipStructure->{Relations}->{$relationshipName}); | |
2110 | } | |
2111 | } | |
2112 | ||
2113 | =head3 InsertValue | |
2114 | ||
2115 | C<< $erdb->InsertValue($entityID, $fieldName, $value); >> | |
2116 | ||
2117 | This method will insert a new value into the database. The value must be one | |
2118 | associated with a secondary relation, since primary values cannot be inserted: | |
2119 | they occur exactly once. Secondary values, on the other hand, can be missing | |
2120 | or multiply-occurring. | |
2121 | ||
2122 | =over 4 | |
2123 | ||
2124 | =item entityID | |
2125 | ||
2126 | ID of the object that is to receive the new value. | |
2127 | ||
2128 | =item fieldName | |
2129 | ||
2130 | Field name for the new value-- this includes the entity name, since | |
2131 | field names are of the format I<objectName>C<(>I<fieldName>C<)>. | |
2132 | ||
2133 | =item value | |
2134 | ||
2135 | New value to be put in the field. | |
2136 | ||
2137 | =back | |
2138 | ||
2139 | =cut | |
2140 | ||
2141 | sub InsertValue { | |
2142 | # Get the parameters. | |
2143 | my ($self, $entityID, $fieldName, $value) = @_; | |
2144 | # Parse the entity name and the real field name. | |
2145 | if ($fieldName =~ /^([^(]+)\(([^)]+)\)/) { | |
2146 | my $entityName = $1; | |
2147 | my $fieldTitle = $2; | |
2148 | # Get its descriptor. | |
2149 | if (!$self->IsEntity($entityName)) { | |
2150 | Confess("$entityName is not a valid entity."); | |
2151 | } else { | |
2152 | my $entityData = $self->{_metaData}->{Entities}->{$entityName}; | |
2153 | # Find the relation containing this field. | |
2154 | my $fieldHash = $entityData->{Fields}; | |
2155 | if (! exists $fieldHash->{$fieldTitle}) { | |
2156 | Confess("$fieldTitle not found in $entityName."); | |
2157 | } else { | |
2158 | my $relation = $fieldHash->{$fieldTitle}->{relation}; | |
2159 | if ($relation eq $entityName) { | |
2160 | Confess("Cannot do InsertValue on primary field $fieldTitle of $entityName."); | |
2161 | } else { | |
2162 | # Now we can create an INSERT statement. | |
2163 | my $dbh = $self->{_dbh}; | |
2164 | my $fixedName = _FixName($fieldTitle); | |
2165 | my $statement = "INSERT INTO $relation (id, $fixedName) VALUES(?, ?)"; | |
2166 | # Execute the command. | |
2167 | $dbh->SQL($statement, 0, $entityID, $value); | |
2168 | } | |
2169 | } | |
2170 | } | |
2171 | } else { | |
2172 | Confess("$fieldName is not a valid field name."); | |
2173 | } | |
2174 | } | |
2175 | ||
2176 | =head3 InsertObject | |
2177 | ||
2178 | C<< my $ok = $erdb->InsertObject($objectType, \%fieldHash); >> | |
2179 | ||
2180 | Insert an object into the database. The object is defined by a type name and then a hash | |
2181 | of field names to values. Field values in the primary relation are represented by scalars. | |
2182 | (Note that for relationships, the primary relation is the B<only> relation.) | |
2183 | Field values for the other relations comprising the entity are always list references. For | |
2184 | example, the following line inserts an inactive PEG feature named C<fig|188.1.peg.1> with aliases | |
2185 | C<ZP_00210270.1> and C<gi|46206278>. | |
2186 | ||
2187 | C<< $erdb->InsertObject('Feature', { id => 'fig|188.1.peg.1', active => 0, feature-type => 'peg', alias => ['ZP_00210270.1', 'gi|46206278']}); >> | |
2188 | ||
2189 | The next statement inserts a C<HasProperty> relationship between feature C<fig|158879.1.peg.1> and | |
2190 | property C<4> with an evidence URL of C<http://seedu.uchicago.edu/query.cgi?article_id=142>. | |
2191 | ||
2192 | C<< $erdb->InsertObject('HasProperty', { 'from-link' => 'fig|158879.1.peg.1', 'to-link' => 4, evidence => 'http://seedu.uchicago.edu/query.cgi?article_id=142'}); >> | |
2193 | ||
2194 | =over 4 | |
2195 | ||
2196 | =item newObjectType | |
2197 | ||
2198 | Type name of the object to insert. | |
2199 | ||
2200 | =item fieldHash | |
2201 | ||
2202 | Hash of field names to values. | |
2203 | ||
2204 | =item RETURN | |
2205 | ||
2206 | Returns 1 if successful, 0 if an error occurred. | |
2207 | ||
2208 | =back | |
2209 | ||
2210 | =cut | |
2211 | ||
2212 | sub InsertObject { | |
2213 | # Get the parameters. | |
2214 | my ($self, $newObjectType, $fieldHash) = @_; | |
2215 | # Denote that so far we appear successful. | |
2216 | my $retVal = 1; | |
2217 | # Get the database handle. | |
2218 | my $dbh = $self->{_dbh}; | |
2219 | # Get the relation list. | |
2220 | my $relationTable = $self->_GetRelationTable($newObjectType); | |
2221 | # Loop through the relations. We'll build insert statements for each one. If a relation is | |
2222 | # secondary, we may end up generating multiple insert statements. If an error occurs, we | |
2223 | # stop the loop. | |
2224 | my @relationList = keys %{$relationTable}; | |
2225 | for (my $i = 0; $retVal && $i <= $#relationList; $i++) { | |
2226 | my $relationName = $relationList[$i]; | |
2227 | my $relationDefinition = $relationTable->{$relationName}; | |
2228 | # Get the relation's fields. For each field we will collect a value in the corresponding | |
2229 | # position of the @valueList array. If one of the fields is missing, we will add it to the | |
2230 | # @missing list. | |
2231 | my @fieldList = @{$relationDefinition->{Fields}}; | |
2232 | my @fieldNameList = (); | |
2233 | my @valueList = (); | |
2234 | my @missing = (); | |
2235 | my $recordCount = 1; | |
2236 | for my $fieldDescriptor (@fieldList) { | |
2237 | # Get the field name and save it. Note we need to fix it up so the hyphens | |
2238 | # are converted to underscores. | |
2239 | my $fieldName = $fieldDescriptor->{name}; | |
2240 | push @fieldNameList, _FixName($fieldName); | |
2241 | # Look for the named field in the incoming structure. Note that we are looking | |
2242 | # for the real field name, not the fixed-up one! | |
2243 | if (exists $fieldHash->{$fieldName}) { | |
2244 | # Here we found the field. Stash it in the value list. | |
2245 | my $value = $fieldHash->{$fieldName}; | |
2246 | push @valueList, $value; | |
2247 | # If the value is a list, we may need to increment the record count. | |
2248 | if (ref $value eq "ARRAY") { | |
2249 | my $thisCount = @{$value}; | |
2250 | if ($recordCount == 1) { | |
2251 | # Here we have our first list, so we save its count. | |
2252 | $recordCount = $thisCount; | |
2253 | } elsif ($recordCount != $thisCount) { | |
2254 | # Here we have a second list, so its length has to match the | |
2255 | # previous lists. | |
2256 | Trace("Field $value in new $newObjectType object has an invalid list length $thisCount. Expected $recordCount.") if T(0); | |
2257 | $retVal = 0; | |
2258 | } | |
2259 | } | |
2260 | } else { | |
2261 | # Here the field is not present. Flag it as missing. | |
2262 | push @missing, $fieldName; | |
2263 | } | |
2264 | } | |
2265 | # If we are the primary relation, add the new-record flag. | |
2266 | if ($relationName eq $newObjectType) { | |
2267 | push @valueList, 1; | |
2268 | push @fieldNameList, "new_record"; | |
2269 | } | |
2270 | # Only proceed if there are no missing fields. | |
2271 | if (@missing > 0) { | |
2272 | Trace("Relation $relationName for $newObjectType skipped due to missing fields: " . | |
2273 | join(' ', @missing)) if T(1); | |
2274 | } else { | |
2275 | # Build the INSERT statement. | |
2276 | my $statement = "INSERT INTO $relationName (" . join (', ', @fieldNameList) . | |
2277 | ") VALUES ("; | |
2278 | # Create a marker list of the proper size and put it in the statement. | |
2279 | my @markers = (); | |
2280 | while (@markers < @fieldNameList) { push @markers, '?'; } | |
2281 | $statement .= join(', ', @markers) . ")"; | |
2282 | # We have the insert statement, so prepare it. | |
2283 | my $sth = $dbh->prepare_command($statement); | |
2284 | Trace("Insert statement prepared: $statement") if T(3); | |
2285 | # Now we loop through the values. If a value is scalar, we use it unmodified. If it's | |
2286 | # a list, we use the current element. The values are stored in the @parameterList array. | |
2287 | my $done = 0; | |
2288 | for (my $i = 0; $i < $recordCount; $i++) { | |
2289 | # Clear the parameter list array. | |
2290 | my @parameterList = (); | |
2291 | # Loop through the values. | |
2292 | for my $value (@valueList) { | |
2293 | # Check to see if this is a scalar value. | |
2294 | if (ref $value eq "ARRAY") { | |
2295 | # Here we have a list value. Pull the current entry. | |
2296 | push @parameterList, $value->[$i]; | |
2297 | } else { | |
2298 | # Here we have a scalar value. Use it unmodified. | |
2299 | push @parameterList, $value; | |
2300 | } | |
2301 | } | |
2302 | # Execute the INSERT statement with the specified parameter list. | |
2303 | $retVal = $sth->execute(@parameterList); | |
2304 | if (!$retVal) { | |
2305 | my $errorString = $sth->errstr(); | |
2306 | Trace("Insert error: $errorString.") if T(0); | |
2307 | } | |
2308 | } | |
2309 | } | |
2310 | } | |
2311 | # Return the success indicator. | |
2312 | return $retVal; | |
2313 | } | |
2314 | ||
2315 | =head3 LoadTable | |
2316 | ||
2317 | C<< my %results = $erdb->LoadTable($fileName, $relationName, $truncateFlag); >> | |
2318 | ||
2319 | Load data from a tab-delimited file into a specified table, optionally re-creating the table | |
2320 | first. | |
2321 | ||
2322 | =over 4 | |
2323 | ||
2324 | =item fileName | |
2325 | ||
2326 | Name of the file from which the table data should be loaded. | |
2327 | ||
2328 | =item relationName | |
2329 | ||
2330 | Name of the relation to be loaded. This is the same as the table name. | |
2331 | ||
2332 | =item truncateFlag | |
2333 | ||
2334 | TRUE if the table should be dropped and re-created, else FALSE | |
2335 | ||
2336 | =item RETURN | |
2337 | ||
2338 | Returns a statistical object containing a list of the error messages. | |
2339 | ||
2340 | =back | |
2341 | ||
2342 | =cut | |
2343 | sub LoadTable { | |
2344 | # Get the parameters. | |
2345 | my ($self, $fileName, $relationName, $truncateFlag) = @_; | |
2346 | # Create the statistical return object. | |
2347 | my $retVal = _GetLoadStats(); | |
2348 | # Trace the fact of the load. | |
2349 | Trace("Loading table $relationName from $fileName") if T(2); | |
2350 | # Get the database handle. | |
2351 | my $dbh = $self->{_dbh}; | |
2352 | # Get the input file size. | |
2353 | my $fileSize = -s $fileName; | |
2354 | # Get the relation data. | |
2355 | my $relation = $self->_FindRelation($relationName); | |
2356 | # Check the truncation flag. | |
2357 | if ($truncateFlag) { | |
2358 | Trace("Creating table $relationName") if T(2); | |
2359 | # Compute the row count estimate. We take the size of the load file, | |
2360 | # divide it by the estimated row size, and then multiply by 1.5 to | |
2361 | # leave extra room. We postulate a minimum row count of 1000 to | |
2362 | # prevent problems with incoming empty load files. | |
2363 | my $rowSize = $self->EstimateRowSize($relationName); | |
2364 | my $estimate = FIG::max($fileSize * 1.5 / $rowSize, 1000); | |
2365 | # Re-create the table without its index. | |
2366 | $self->CreateTable($relationName, 0, $estimate); | |
2367 | # If this is a pre-index DBMS, create the index here. | |
2368 | if ($dbh->{_preIndex}) { | |
2369 | eval { | |
2370 | $self->CreateIndex($relationName); | |
2371 | }; | |
2372 | if ($@) { | |
2373 | $retVal->AddMessage($@); | |
2374 | } | |
2375 | } | |
2376 | } | |
2377 | # Load the table. | |
2378 | my $rv; | |
2379 | eval { | |
2380 | $rv = $dbh->load_table(file => $fileName, tbl => $relationName); | |
2381 | }; | |
2382 | if (!defined $rv) { | |
2383 | $retVal->AddMessage($@) if ($@); | |
2384 | $retVal->AddMessage("Table load failed for $relationName using $fileName: " . $dbh->error_message); | |
2385 | Trace("Table load failed for $relationName.") if T(1); | |
2386 | } else { | |
2387 | # Here we successfully loaded the table. | |
2388 | $retVal->Add("tables"); | |
2389 | my $size = -s $fileName; | |
2390 | Trace("$size bytes loaded into $relationName.") if T(2); | |
2391 | # If we're rebuilding, we need to create the table indexes. | |
2392 | if ($truncateFlag) { | |
2393 | # Indexes are created here for PostGres. For PostGres, indexes are | |
2394 | # best built at the end. For MySQL, the reverse is true. | |
2395 | if (! $dbh->{_preIndex}) { | |
2396 | eval { | |
2397 | $self->CreateIndex($relationName); | |
2398 | }; | |
2399 | if ($@) { | |
2400 | $retVal->AddMessage($@); | |
2401 | } | |
2402 | } | |
2403 | # The full-text index (if any) is always built last, even for MySQL. | |
2404 | # First we need to see if this table has a full-text index. Only | |
2405 | # primary relations are allowed that privilege. | |
2406 | if ($self->_IsPrimary($relationName)) { | |
2407 | # Get the relation's entity/relationship structure. | |
2408 | my $structure = $self->_GetStructure($relationName); | |
2409 | # Check for a searchable fields list. | |
2410 | if (exists $structure->{searchFields}) { | |
2411 | # Here we know that we need to create a full-text search index. | |
2412 | # Get an SQL-formatted field name list. | |
2413 | my $fields = join(", ", $self->_FixNames(@{$structure->{searchFields}})); | |
2414 | # Create the index. | |
2415 | $dbh->create_index(tbl => $relationName, idx => "search_idx", | |
2416 | flds => $fields, kind => 'fulltext'); | |
2417 | } | |
2418 | } | |
2419 | } | |
2420 | } | |
2421 | # Analyze the table to improve performance. | |
2422 | Trace("Analyzing and compacting $relationName.") if T(3); | |
2423 | $dbh->vacuum_it($relationName); | |
2424 | Trace("$relationName load completed.") if T(3); | |
2425 | # Return the statistics. | |
2426 | return $retVal; | |
2427 | } | |
2428 | ||
2429 | =head3 DropRelation | |
2430 | ||
2431 | C<< $erdb->DropRelation($relationName); >> | |
2432 | ||
2433 | Physically drop a relation from the database. | |
2434 | ||
2435 | =over 4 | |
2436 | ||
2437 | =item relationName | |
2438 | ||
2439 | Name of the relation to drop. If it does not exist, this method will have | |
2440 | no effect. | |
2441 | ||
2442 | =back | |
2443 | ||
2444 | =cut | |
2445 | ||
2446 | sub DropRelation { | |
2447 | # Get the parameters. | |
2448 | my ($self, $relationName) = @_; | |
2449 | # Get the database handle. | |
2450 | my $dbh = $self->{_dbh}; | |
2451 | # Drop the relation. The method used here has no effect if the relation | |
2452 | # does not exist. | |
2453 | Trace("Invoking DB Kernel to drop $relationName.") if T(3); | |
2454 | $dbh->drop_table(tbl => $relationName); | |
2455 | } | |
2456 | ||
2457 | =head3 GetEntity | |
2458 | ||
2459 | C<< my $entityObject = $erdb->GetEntity($entityType, $ID); >> | |
2460 | ||
2461 | Return an object describing the entity instance with a specified ID. | |
2462 | ||
2463 | =over 4 | |
2464 | ||
2465 | =item entityType | |
2466 | ||
2467 | Entity type name. | |
2468 | ||
2469 | =item ID | |
2470 | ||
2471 | ID of the desired entity. | |
2472 | ||
2473 | =item RETURN | |
2474 | ||
2475 | Returns a B<DBObject> representing the desired entity instance, or an undefined value if no | |
2476 | instance is found with the specified key. | |
2477 | ||
2478 | =back | |
2479 | ||
2480 | =cut | |
2481 | ||
2482 | sub GetEntity { | |
2483 | # Get the parameters. | |
2484 | my ($self, $entityType, $ID) = @_; | |
2485 | # Create a query. | |
2486 | my $query = $self->Get([$entityType], "$entityType(id) = ?", [$ID]); | |
2487 | # Get the first (and only) object. | |
2488 | my $retVal = $query->Fetch(); | |
2489 | # Return the result. | |
2490 | return $retVal; | |
2491 | } | |
2492 | ||
2493 | =head3 GetChoices | |
2494 | ||
2495 | C<< my @values = $erdb->GetChoices($entityName, $fieldName); >> | |
2496 | ||
2497 | Return a list of all the values for the specified field that are represented in the | |
2498 | specified entity. | |
2499 | ||
2500 | Note that if the field is not indexed, then this will be a very slow operation. | |
2501 | ||
2502 | =over 4 | |
2503 | ||
2504 | =item entityName | |
2505 | ||
2506 | Name of an entity in the database. | |
2507 | ||
2508 | =item fieldName | |
2509 | ||
2510 | Name of a field belonging to the entity. This is a raw field name without | |
2511 | the standard parenthesized notation used in most calls. | |
2512 | ||
2513 | =item RETURN | |
2514 | ||
2515 | Returns a list of the distinct values for the specified field in the database. | |
2516 | ||
2517 | =back | |
2518 | ||
2519 | =cut | |
2520 | ||
2521 | sub GetChoices { | |
2522 | # Get the parameters. | |
2523 | my ($self, $entityName, $fieldName) = @_; | |
2524 | # Declare the return variable. | |
2525 | my @retVal; | |
2526 | # Get the entity data structure. | |
2527 | my $entityData = $self->_GetStructure($entityName); | |
2528 | # Get the field. | |
2529 | my $fieldHash = $entityData->{Fields}; | |
2530 | if (! exists $fieldHash->{$fieldName}) { | |
2531 | Confess("$fieldName not found in $entityName."); | |
2532 | } else { | |
2533 | # Get the name of the relation containing the field. | |
2534 | my $relation = $fieldHash->{$fieldName}->{relation}; | |
2535 | # Fix up the field name. | |
2536 | my $realName = _FixName($fieldName); | |
2537 | # Get the database handle. | |
2538 | my $dbh = $self->{_dbh}; | |
2539 | # Query the database. | |
2540 | my $results = $dbh->SQL("SELECT DISTINCT $realName FROM $relation"); | |
2541 | # Clean the results. They are stored as a list of lists, and we just want the one list. | |
2542 | @retVal = sort map { $_->[0] } @{$results}; | |
2543 | } | |
2544 | # Return the result. | |
2545 | return @retVal; | |
2546 | } | |
2547 | ||
2548 | =head3 GetEntityValues | |
2549 | ||
2550 | C<< my @values = $erdb->GetEntityValues($entityType, $ID, \@fields); >> | |
2551 | ||
2552 | Return a list of values from a specified entity instance. If the entity instance | |
2553 | does not exist, an empty list is returned. | |
2554 | ||
2555 | =over 4 | |
2556 | ||
2557 | =item entityType | |
2558 | ||
2559 | Entity type name. | |
2560 | ||
2561 | =item ID | |
2562 | ||
2563 | ID of the desired entity. | |
2564 | ||
2565 | =item fields | |
2566 | ||
2567 | List of field names, each of the form I<objectName>C<(>I<fieldName>C<)>. | |
2568 | ||
2569 | =item RETURN | |
2570 | ||
2571 | Returns a flattened list of the values of the specified fields for the specified entity. | |
2572 | ||
2573 | =back | |
2574 | ||
2575 | =cut | |
2576 | ||
2577 | sub GetEntityValues { | |
2578 | # Get the parameters. | |
2579 | my ($self, $entityType, $ID, $fields) = @_; | |
2580 | # Get the specified entity. | |
2581 | my $entity = $self->GetEntity($entityType, $ID); | |
2582 | # Declare the return list. | |
2583 | my @retVal = (); | |
2584 | # If we found the entity, push the values into the return list. | |
2585 | if ($entity) { | |
2586 | push @retVal, $entity->Values($fields); | |
2587 | } | |
2588 | # Return the result. | |
2589 | return @retVal; | |
2590 | } | |
2591 | ||
2592 | =head3 GetAll | |
2593 | ||
2594 | C<< my @list = $erdb->GetAll(\@objectNames, $filterClause, \@parameters, \@fields, $count); >> | |
2595 | ||
2596 | Return a list of values taken from the objects returned by a query. The first three | |
2597 | parameters correspond to the parameters of the L</Get> method. The final parameter is | |
2598 | a list of the fields desired from each record found by the query. The field name | |
2599 | syntax is the standard syntax used for fields in the B<ERDB> system-- | |
2600 | B<I<objectName>(I<fieldName>)>-- where I<objectName> is the name of the relevant entity | |
2601 | or relationship and I<fieldName> is the name of the field. | |
2602 | ||
2603 | The list returned will be a list of lists. Each element of the list will contain | |
2604 | the values returned for the fields specified in the fourth parameter. If one of the | |
2605 | fields specified returns multiple values, they are flattened in with the rest. For | |
2606 | example, the following call will return a list of the features in a particular | |
2607 | spreadsheet cell, and each feature will be represented by a list containing the | |
2608 | feature ID followed by all of its aliases. | |
2609 | ||
2610 | C<< $query = $erdb->Get(['ContainsFeature', 'Feature'], "ContainsFeature(from-link) = ?", [$ssCellID], ['Feature(id)', 'Feature(alias)']); >> | |
2611 | ||
2612 | =over 4 | |
2613 | ||
2614 | =item objectNames | |
2615 | ||
2616 | List containing the names of the entity and relationship objects to be retrieved. | |
2617 | ||
2618 | =item filterClause | |
2619 | ||
2620 | WHERE/ORDER BY clause (without the WHERE) to be used to filter and sort the query. The WHERE clause can | |
2621 | be parameterized with parameter markers (C<?>). Each field used must be specified in the standard form | |
2622 | B<I<objectName>(I<fieldName>)>. Any parameters specified in the filter clause should be added to the | |
2623 | parameter list as additional parameters. The fields in a filter clause can come from primary | |
2624 | entity relations, relationship relations, or secondary entity relations; however, all of the | |
2625 | entities and relationships involved must be included in the list of object names. | |
2626 | ||
2627 | =item parameterList | |
2628 | ||
2629 | List of the parameters to be substituted in for the parameters marks in the filter clause. | |
2630 | ||
2631 | =item fields | |
2632 | ||
2633 | List of the fields to be returned in each element of the list returned. | |
2634 | ||
2635 | =item count | |
2636 | ||
2637 | Maximum number of records to return. If omitted or 0, all available records will be returned. | |
2638 | ||
2639 | =item RETURN | |
2640 | ||
2641 | Returns a list of list references. Each element of the return list contains the values for the | |
2642 | fields specified in the B<fields> parameter. | |
2643 | ||
2644 | =back | |
2645 | ||
2646 | =cut | |
2647 | #: Return Type @@; | |
2648 | sub GetAll { | |
2649 | # Get the parameters. | |
2650 | my ($self, $objectNames, $filterClause, $parameterList, $fields, $count) = @_; | |
2651 | # Translate the parameters from a list reference to a list. If the parameter | |
2652 | # list is a scalar we convert it into a singleton list. | |
2653 | my @parmList = (); | |
2654 | if (ref $parameterList eq "ARRAY") { | |
2655 | Trace("GetAll parm list is an array.") if T(4); | |
2656 | @parmList = @{$parameterList}; | |
2657 | } else { | |
2658 | Trace("GetAll parm list is a scalar: $parameterList.") if T(4); | |
2659 | push @parmList, $parameterList; | |
2660 | } | |
2661 | # Insure the counter has a value. | |
2662 | if (!defined $count) { | |
2663 | $count = 0; | |
2664 | } | |
2665 | # Add the row limit to the filter clause. | |
2666 | if ($count > 0) { | |
2667 | $filterClause .= " LIMIT $count"; | |
2668 | } | |
2669 | # Create the query. | |
2670 | my $query = $self->Get($objectNames, $filterClause, \@parmList); | |
2671 | # Set up a counter of the number of records read. | |
2672 | my $fetched = 0; | |
2673 | # Loop through the records returned, extracting the fields. Note that if the | |
2674 | # counter is non-zero, we stop when the number of records read hits the count. | |
2675 | my @retVal = (); | |
2676 | while (($count == 0 || $fetched < $count) && (my $row = $query->Fetch())) { | |
2677 | my @rowData = $row->Values($fields); | |
2678 | push @retVal, \@rowData; | |
2679 | $fetched++; | |
2680 | } | |
2681 | Trace("$fetched rows returned in GetAll.") if T(SQL => 4); | |
2682 | # Return the resulting list. | |
2683 | return @retVal; | |
2684 | } | |
2685 | ||
2686 | =head3 Exists | |
2687 | ||
2688 | C<< my $found = $sprout->Exists($entityName, $entityID); >> | |
2689 | ||
2690 | Return TRUE if an entity exists, else FALSE. | |
2691 | ||
2692 | =over 4 | |
2693 | ||
2694 | =item entityName | |
2695 | ||
2696 | Name of the entity type (e.g. C<Feature>) relevant to the existence check. | |
2697 | ||
2698 | =item entityID | |
2699 | ||
2700 | ID of the entity instance whose existence is to be checked. | |
2701 | ||
2702 | =item RETURN | |
2703 | ||
2704 | Returns TRUE if the entity instance exists, else FALSE. | |
2705 | ||
2706 | =back | |
2707 | ||
2708 | =cut | |
2709 | #: Return Type $; | |
2710 | sub Exists { | |
2711 | # Get the parameters. | |
2712 | my ($self, $entityName, $entityID) = @_; | |
2713 | # Check for the entity instance. | |
2714 | Trace("Checking existence of $entityName with ID=$entityID.") if T(4); | |
2715 | my $testInstance = $self->GetEntity($entityName, $entityID); | |
2716 | # Return an existence indicator. | |
2717 | my $retVal = ($testInstance ? 1 : 0); | |
2718 | return $retVal; | |
2719 | } | |
2720 | ||
2721 | =head3 EstimateRowSize | |
2722 | ||
2723 | C<< my $rowSize = $erdb->EstimateRowSize($relName); >> | |
2724 | ||
2725 | Estimate the row size of the specified relation. The estimated row size is computed by adding | |
2726 | up the average length for each data type. | |
2727 | ||
2728 | =over 4 | |
2729 | ||
2730 | =item relName | |
2731 | ||
2732 | Name of the relation whose estimated row size is desired. | |
2733 | ||
2734 | =item RETURN | |
2735 | ||
2736 | Returns an estimate of the row size for the specified relation. | |
2737 | ||
2738 | =back | |
2739 | ||
2740 | =cut | |
2741 | #: Return Type $; | |
2742 | sub EstimateRowSize { | |
2743 | # Get the parameters. | |
2744 | my ($self, $relName) = @_; | |
2745 | # Declare the return variable. | |
2746 | my $retVal = 0; | |
2747 | # Find the relation descriptor. | |
2748 | my $relation = $self->_FindRelation($relName); | |
2749 | # Get the list of fields. | |
2750 | for my $fieldData (@{$relation->{Fields}}) { | |
2751 | # Get the field type and add its length. | |
2752 | my $fieldLen = $TypeTable{$fieldData->{type}}->{avgLen}; | |
2753 | $retVal += $fieldLen; | |
2754 | } | } |
2755 | # Return the result. | |
2756 | return $retVal; | |
2757 | } | } |
2758 | # Execute the INSERT statement with the specified parameter list. | |
2759 | $retVal = $sth->execute(@parameterList); | =head3 GetFieldTable |
2760 | if (!$retVal) { | |
2761 | my $errorString = $sth->errstr(); | C<< my $fieldHash = $self->GetFieldTable($objectnName); >> |
2762 | Trace("Insert error: $errorString.") if T(0); | |
2763 | Get the field structure for a specified entity or relationship. | |
2764 | ||
2765 | =over 4 | |
2766 | ||
2767 | =item objectName | |
2768 | ||
2769 | Name of the desired entity or relationship. | |
2770 | ||
2771 | =item RETURN | |
2772 | ||
2773 | The table containing the field descriptors for the specified object. | |
2774 | ||
2775 | =back | |
2776 | ||
2777 | =cut | |
2778 | ||
2779 | sub GetFieldTable { | |
2780 | # Get the parameters. | |
2781 | my ($self, $objectName) = @_; | |
2782 | # Get the descriptor from the metadata. | |
2783 | my $objectData = $self->_GetStructure($objectName); | |
2784 | # Return the object's field table. | |
2785 | return $objectData->{Fields}; | |
2786 | } | } |
2787 | ||
2788 | =head3 SplitKeywords | |
2789 | ||
2790 | C<< my @keywords = ERDB::SplitKeywords($keywordString); >> | |
2791 | ||
2792 | This method returns a list of the positive keywords in the specified | |
2793 | keyword string. All of the operators will have been stripped off, | |
2794 | and if the keyword is preceded by a minus operator (C<->), it will | |
2795 | not be in the list returned. The idea here is to get a list of the | |
2796 | keywords the user wants to see. The list will be processed to remove | |
2797 | duplicates. | |
2798 | ||
2799 | It is possible to create a string that confuses this method. For example | |
2800 | ||
2801 | frog toad -frog | |
2802 | ||
2803 | would return both C<frog> and C<toad>. If this is a problem we can deal | |
2804 | with it later. | |
2805 | ||
2806 | =over 4 | |
2807 | ||
2808 | =item keywordString | |
2809 | ||
2810 | The keyword string to be parsed. | |
2811 | ||
2812 | =item RETURN | |
2813 | ||
2814 | Returns a list of the words in the keyword string the user wants to | |
2815 | see. | |
2816 | ||
2817 | =back | |
2818 | ||
2819 | =cut | |
2820 | ||
2821 | sub SplitKeywords { | |
2822 | # Get the parameters. | |
2823 | my ($keywordString) = @_; | |
2824 | # Make a safety copy of the string. (This helps during debugging.) | |
2825 | my $workString = $keywordString; | |
2826 | # Convert operators we don't care about to spaces. | |
2827 | $workString =~ tr/+"()<>/ /; | |
2828 | # Split the rest of the string along space boundaries. Note that we | |
2829 | # eliminate any words that are zero length or begin with a minus sign. | |
2830 | my @wordList = grep { $_ && substr($_, 0, 1) ne "-" } split /\s+/, $workString; | |
2831 | # Use a hash to remove duplicates. | |
2832 | my %words = map { $_ => 1 } @wordList; | |
2833 | # Return the result. | |
2834 | return sort keys %words; | |
2835 | } | } |
2836 | ||
2837 | =head3 ValidateFieldName | |
2838 | ||
2839 | C<< my $okFlag = ERDB::ValidateFieldName($fieldName); >> | |
2840 | ||
2841 | Return TRUE if the specified field name is valid, else FALSE. Valid field names must | |
2842 | be hyphenated words subject to certain restrictions. | |
2843 | ||
2844 | =over 4 | |
2845 | ||
2846 | =item fieldName | |
2847 | ||
2848 | Field name to be validated. | |
2849 | ||
2850 | =item RETURN | |
2851 | ||
2852 | Returns TRUE if the field name is valid, else FALSE. | |
2853 | ||
2854 | =back | |
2855 | ||
2856 | =cut | |
2857 | ||
2858 | sub ValidateFieldName { | |
2859 | # Get the parameters. | |
2860 | my ($fieldName) = @_; | |
2861 | # Declare the return variable. The field name is valid until we hear | |
2862 | # differently. | |
2863 | my $retVal = 1; | |
2864 | # Look for bad stuff in the name. | |
2865 | if ($fieldName =~ /--/) { | |
2866 | # Here we have a doubled minus sign. | |
2867 | Trace("Field name $fieldName has a doubled hyphen.") if T(1); | |
2868 | $retVal = 0; | |
2869 | } elsif ($fieldName !~ /^[A-Za-z]/) { | |
2870 | # Here the field name is missing the initial letter. | |
2871 | Trace("Field name $fieldName does not begin with a letter.") if T(1); | |
2872 | $retVal = 0; | |
2873 | } else { | |
2874 | # Strip out the minus signs. Everything remaining must be a letter, | |
2875 | # underscore, or digit. | |
2876 | my $strippedName = $fieldName; | |
2877 | $strippedName =~ s/-//g; | |
2878 | if ($strippedName !~ /^(\w|\d)+$/) { | |
2879 | Trace("Field name $fieldName contains illegal characters.") if T(1); | |
2880 | $retVal = 0; | |
2881 | } | } |
2882 | } | } |
2883 | # Return the success indicator. | # Return the result. |
2884 | return $retVal; | return $retVal; |
2885 | } | } |
2886 | ||
2887 | =head3 LoadTable | =head3 ReadMetaXML |
2888 | ||
2889 | C<< my %results = $erdb->LoadTable($fileName, $relationName, $truncateFlag); >> | C<< my $rawMetaData = ERDB::ReadDBD($fileName); >> |
2890 | ||
2891 | Load data from a tab-delimited file into a specified table, optionally re-creating the table | This method reads a raw database definition XML file and returns it. |
2892 | first. | Normally, the metadata used by the ERDB system has been processed and |
2893 | modified to make it easier to load and retrieve the data; however, | |
2894 | this method can be used to get the data in its raw form. | |
2895 | ||
2896 | =over 4 | =over 4 |
2897 | ||
2898 | =item fileName | =item fileName |
2899 | ||
2900 | Name of the file from which the table data should be loaded. | Name of the XML file to read. |
2901 | ||
2902 | =item relationName | =item RETURN |
2903 | ||
2904 | Name of the relation to be loaded. This is the same as the table name. | Returns a hash reference containing the raw XML data from the specified file. |
2905 | ||
2906 | =item truncateFlag | =back |
2907 | ||
2908 | TRUE if the table should be dropped and re-created, else FALSE | =cut |
2909 | ||
2910 | sub ReadMetaXML { | |
2911 | # Get the parameters. | |
2912 | my ($fileName) = @_; | |
2913 | # Read the XML. | |
2914 | my $retVal = XML::Simple::XMLin($fileName, %XmlOptions, %XmlInOpts); | |
2915 | Trace("XML metadata loaded from file $fileName.") if T(1); | |
2916 | # Return the result. | |
2917 | return $retVal; | |
2918 | } | |
2919 | ||
2920 | =head3 GetEntityFieldHash | |
2921 | ||
2922 | C<< my $fieldHashRef = ERDB::GetEntityFieldHash($structure, $entityName); >> | |
2923 | ||
2924 | Get the field hash of the named entity in the specified raw XML structure. | |
2925 | The field hash may not exist, in which case we need to create it. | |
2926 | ||
2927 | =over 4 | |
2928 | ||
2929 | =item structure | |
2930 | ||
2931 | Raw XML structure defininng the database. This is not the run-time XML used by | |
2932 | an ERDB object, since that has all sorts of optimizations built-in. | |
2933 | ||
2934 | =item entityName | |
2935 | ||
2936 | Name of the entity whose field structure is desired. | |
2937 | ||
2938 | =item RETURN | =item RETURN |
2939 | ||
2940 | Returns a statistical object containing the number of records read and a list of | Returns the field hash used to define the entity's fields. |
the error messages. | ||
2941 | ||
2942 | =back | =back |
2943 | ||
2944 | =cut | =cut |
2945 | sub LoadTable { | |
2946 | sub GetEntityFieldHash { | |
2947 | # Get the parameters. | # Get the parameters. |
2948 | my ($self, $fileName, $relationName, $truncateFlag) = @_; | my ($structure, $entityName) = @_; |
2949 | # Create the statistical return object. | # Get the entity structure. |
2950 | my $retVal = _GetLoadStats(); | my $entityData = $structure->{Entities}->{$entityName}; |
2951 | # Trace the fact of the load. | # Look for a field structure. |
2952 | Trace("Loading table $relationName from $fileName") if T(2); | my $retVal = $entityData->{Fields}; |
2953 | # Get the database handle. | # If it doesn't exist, create it. |
2954 | my $dbh = $self->{_dbh}; | if (! defined($retVal)) { |
2955 | # Get the relation data. | $entityData->{Fields} = {}; |
2956 | my $relation = $self->_FindRelation($relationName); | $retVal = $entityData->{Fields}; |
# Check the truncation flag. | ||
if ($truncateFlag) { | ||
Trace("Creating table $relationName") if T(2); | ||
# Compute the row count estimate. We take the size of the load file, | ||
# divide it by the estimated row size, and then multiply by 1.5 to | ||
# leave extra room. We postulate a minimum row count of 1000 to | ||
# prevent problems with incoming empty load files. | ||
my $rowSize = $self->EstimateRowSize($relationName); | ||
my $fileSize = -s $fileName; | ||
my $estimate = FIG::max($fileSize * 1.5 / $rowSize, 1000); | ||
# Re-create the table without its index. | ||
$self->CreateTable($relationName, 0, $estimate); | ||
# If this is a pre-index DBMS, create the index here. | ||
if ($dbh->{_preIndex}) { | ||
eval { | ||
$self->CreateIndex($relationName); | ||
}; | ||
if ($@) { | ||
$retVal->AddMessage($@); | ||
2957 | } | } |
2958 | # Return the result. | |
2959 | return $retVal; | |
2960 | } | } |
2961 | ||
2962 | =head3 WriteMetaXML | |
2963 | ||
2964 | C<< ERDB::WriteMetaXML($structure, $fileName); >> | |
2965 | ||
2966 | Write the metadata XML to a file. This method is the reverse of L</ReadMetaXML>, and is | |
2967 | used to update the database definition. It must be used with care, however, since it | |
2968 | will only work on a raw structure, not on the processed structure created by an ERDB | |
2969 | constructor. | |
2970 | ||
2971 | =over 4 | |
2972 | ||
2973 | =item structure | |
2974 | ||
2975 | XML structure to be written to the file. | |
2976 | ||
2977 | =item fileName | |
2978 | ||
2979 | Name of the output file to which the updated XML should be stored. | |
2980 | ||
2981 | =back | |
2982 | ||
2983 | =cut | |
2984 | ||
2985 | sub WriteMetaXML { | |
2986 | # Get the parameters. | |
2987 | my ($structure, $fileName) = @_; | |
2988 | # Compute the output. | |
2989 | my $fileString = XML::Simple::XMLout($structure, %XmlOptions, %XmlOutOpts); | |
2990 | # Write it to the file. | |
2991 | my $xmlOut = Open(undef, ">$fileName"); | |
2992 | print $xmlOut $fileString; | |
2993 | } | |
2994 | ||
2995 | ||
2996 | =head3 HTMLNote | |
2997 | ||
2998 | Convert a note or comment to HTML by replacing some bulletin-board codes with HTML. The codes | |
2999 | supported are C<[b]> for B<bold>, C<[i]> for I<italics>, and C<[p]> for a new paragraph. | |
3000 | Except for C<[p]>, all the codes are closed by slash-codes. So, for | |
3001 | example, C<[b]Feature[/b]> displays the string C<Feature> in boldface. | |
3002 | ||
3003 | C<< my $realHtml = ERDB::HTMLNote($dataString); >> | |
3004 | ||
3005 | =over 4 | |
3006 | ||
3007 | =item dataString | |
3008 | ||
3009 | String to convert to HTML. | |
3010 | ||
3011 | =item RETURN | |
3012 | ||
3013 | An HTML string derived from the input string. | |
3014 | ||
3015 | =back | |
3016 | ||
3017 | =cut | |
3018 | ||
3019 | sub HTMLNote { | |
3020 | # Get the parameter. | |
3021 | my ($dataString) = @_; | |
3022 | # HTML-escape the text. | |
3023 | my $retVal = CGI::escapeHTML($dataString); | |
3024 | # Substitute the bulletin board codes. | |
3025 | $retVal =~ s!\[(/?[bi])\]!<$1>!g; | |
3026 | $retVal =~ s!\[p\]!</p><p>!g; | |
3027 | # Return the result. | |
3028 | return $retVal; | |
3029 | } | |
3030 | ||
3031 | ||
3032 | =head2 Data Mining Methods | |
3033 | ||
3034 | =head3 GetUsefulCrossValues | |
3035 | ||
3036 | C<< my @attrNames = $sprout->GetUsefulCrossValues($sourceEntity, $relationship); >> | |
3037 | ||
3038 | Return a list of the useful attributes that would be returned by a B<Cross> call | |
3039 | from an entity of the source entity type through the specified relationship. This | |
3040 | means it will return the fields of the target entity type and the intersection data | |
3041 | fields in the relationship. Only primary table fields are returned. In other words, | |
3042 | the field names returned will be for fields where there is always one and only one | |
3043 | value. | |
3044 | ||
3045 | =over 4 | |
3046 | ||
3047 | =item sourceEntity | |
3048 | ||
3049 | Name of the entity from which the relationship crossing will start. | |
3050 | ||
3051 | =item relationship | |
3052 | ||
3053 | Name of the relationship being crossed. | |
3054 | ||
3055 | =item RETURN | |
3056 | ||
3057 | Returns a list of field names in Sprout field format (I<objectName>C<(>I<fieldName>C<)>. | |
3058 | ||
3059 | =back | |
3060 | ||
3061 | =cut | |
3062 | #: Return Type @; | |
3063 | sub GetUsefulCrossValues { | |
3064 | # Get the parameters. | |
3065 | my ($self, $sourceEntity, $relationship) = @_; | |
3066 | # Declare the return variable. | |
3067 | my @retVal = (); | |
3068 | # Determine the target entity for the relationship. This is whichever entity is not | |
3069 | # the source entity. So, if the source entity is the FROM, we'll get the name of | |
3070 | # the TO, and vice versa. | |
3071 | my $relStructure = $self->_GetStructure($relationship); | |
3072 | my $targetEntityType = ($relStructure->{from} eq $sourceEntity ? "to" : "from"); | |
3073 | my $targetEntity = $relStructure->{$targetEntityType}; | |
3074 | # Get the field table for the entity. | |
3075 | my $entityFields = $self->GetFieldTable($targetEntity); | |
3076 | # The field table is a hash. The hash key is the field name. The hash value is a structure. | |
3077 | # For the entity fields, the key aspect of the target structure is that the {relation} value | |
3078 | # must match the entity name. | |
3079 | my @fieldList = map { "$targetEntity($_)" } grep { $entityFields->{$_}->{relation} eq $targetEntity } | |
3080 | keys %{$entityFields}; | |
3081 | # Push the fields found onto the return variable. | |
3082 | push @retVal, sort @fieldList; | |
3083 | # Get the field table for the relationship. | |
3084 | my $relationshipFields = $self->GetFieldTable($relationship); | |
3085 | # Here we have a different rule. We want all the fields other than "from-link" and "to-link". | |
3086 | # This may end up being an empty set. | |
3087 | my @fieldList2 = map { "$relationship($_)" } grep { $_ ne "from-link" && $_ ne "to-link" } | |
3088 | keys %{$relationshipFields}; | |
3089 | # Push these onto the return list. | |
3090 | push @retVal, sort @fieldList2; | |
3091 | # Return the result. | |
3092 | return @retVal; | |
3093 | } | |
3094 | ||
3095 | =head3 FindColumn | |
3096 | ||
3097 | C<< my $colIndex = ERDB::FindColumn($headerLine, $columnIdentifier); >> | |
3098 | ||
3099 | Return the location a desired column in a data mining header line. The data | |
3100 | mining header line is a tab-separated list of column names. The column | |
3101 | identifier is either the numerical index of a column or the actual column | |
3102 | name. | |
3103 | ||
3104 | =over 4 | |
3105 | ||
3106 | =item headerLine | |
3107 | ||
3108 | The header line from a data mining command, which consists of a tab-separated | |
3109 | list of column names. | |
3110 | ||
3111 | =item columnIdentifier | |
3112 | ||
3113 | Either the ordinal number of the desired column (1-based), or the name of the | |
3114 | desired column. | |
3115 | ||
3116 | =item RETURN | |
3117 | ||
3118 | Returns the array index (0-based) of the desired column. | |
3119 | ||
3120 | =back | |
3121 | ||
3122 | =cut | |
3123 | ||
3124 | sub FindColumn { | |
3125 | # Get the parameters. | |
3126 | my ($headerLine, $columnIdentifier) = @_; | |
3127 | # Declare the return variable. | |
3128 | my $retVal; | |
3129 | # Split the header line into column names. | |
3130 | my @headers = ParseColumns($headerLine); | |
3131 | # Determine whether we have a number or a name. | |
3132 | if ($columnIdentifier =~ /^\d+$/) { | |
3133 | # Here we have a number. Subtract 1 and validate the result. | |
3134 | $retVal = $columnIdentifier - 1; | |
3135 | if ($retVal < 0 || $retVal > $#headers) { | |
3136 | Confess("Invalid column identifer \"$columnIdentifier\": value out of range."); | |
3137 | } | } |
# Load the table. | ||
my $rv; | ||
eval { | ||
$rv = $dbh->load_table(file => $fileName, tbl => $relationName); | ||
}; | ||
if (!defined $rv) { | ||
$retVal->AddMessage($@) if ($@); | ||
$retVal->AddMessage("Table load failed for $relationName using $fileName."); | ||
Trace("Table load failed for $relationName.") if T(1); | ||
3138 | } else { | } else { |
3139 | # Here we successfully loaded the table. Trace the number of records loaded. | # Here we have a name. We need to find it in the list. |
3140 | Trace("$retVal->{records} records read for $relationName.") if T(2); | for (my $i = 0; $i <= $#headers && ! defined($retVal); $i++) { |
3141 | # If we're rebuilding, we need to create the table indexes. | if ($headers[$i] eq $columnIdentifier) { |
3142 | if ($truncateFlag && ! $dbh->{_preIndex}) { | $retVal = $i; |
eval { | ||
$self->CreateIndex($relationName); | ||
}; | ||
if ($@) { | ||
$retVal->AddMessage($@); | ||
3143 | } | } |
3144 | } | } |
3145 | if (! defined($retVal)) { | |
3146 | Confess("Invalid column identifier \"$columnIdentifier\": value not found."); | |
3147 | } | } |
3148 | # Commit the database changes. | } |
3149 | $dbh->commit_tran; | # Return the result. |
# Analyze the table to improve performance. | ||
$dbh->vacuum_it($relationName); | ||
# Return the statistics. | ||
3150 | return $retVal; | return $retVal; |
3151 | } | } |
3152 | ||
3153 | =head3 GenerateEntity | =head3 ParseColumns |
3154 | ||
3155 | C<< my $fieldHash = $erdb->GenerateEntity($id, $type, \%values); >> | C<< my @columns = ERDB::ParseColumns($line); >> |
3156 | ||
3157 | Generate the data for a new entity instance. This method creates a field hash suitable for | Convert the specified data line to a list of columns. |
passing as a parameter to L</InsertObject>. The ID is specified by the callr, but the rest | ||
of the fields are generated using information in the database schema. | ||
Each data type has a default algorithm for generating random test data. This can be overridden | ||
by including a B<DataGen> element in the field. If this happens, the content of the element is | ||
executed as a PERL program in the context of this module. The element may make use of a C<$this> | ||
variable which contains the field hash as it has been built up to the current point. If any | ||
fields are dependent on other fields, the C<pass> attribute can be used to control the order | ||
in which the fields are generated. A field with a high data pass number will be generated after | ||
a field with a lower one. If any external values are needed, they should be passed in via the | ||
optional third parameter, which will be available to the data generation script under the name | ||
C<$value>. Several useful utility methods are provided for generating random values, including | ||
L</IntGen>, L</StringGen>, L</FloatGen>, and L</DateGen>. Note that dates are stored and generated | ||
in the form of a timestamp number rather than a string. | ||
3158 | ||
3159 | =over 4 | =over 4 |
3160 | ||
3161 | =item id | =item line |
ID to assign to the new entity. | ||
=item type | ||
3162 | ||
3163 | Type name for the new entity. | A data mining input, consisting of a tab-separated list of columns terminated by a |
3164 | new-line. | |
3165 | ||
3166 | =item values | =item RETURN |
3167 | ||
3168 | Hash containing additional values that might be needed by the data generation methods (optional). | Returns a list consisting of the column values. |
3169 | ||
3170 | =back | =back |
3171 | ||
3172 | =cut | =cut |
3173 | ||
3174 | sub GenerateEntity { | sub ParseColumns { |
3175 | # Get the parameters. | # Get the parameters. |
3176 | my ($self, $id, $type, $values) = @_; | my ($line) = @_; |
3177 | # Create the return hash. | # Chop off the line-end. |
3178 | my $this = { id => $id }; | chomp $line; |
3179 | # Get the metadata structure. | # Split it into a list. |
3180 | my $metadata = $self->{_metaData}; | my @retVal = split(/\t/, $line); |
3181 | # Get this entity's list of fields. | # Return the result. |
3182 | if (!exists $metadata->{Entities}->{$type}) { | return @retVal; |
Confess("Unrecognized entity type $type in GenerateEntity."); | ||
} else { | ||
my $entity = $metadata->{Entities}->{$type}; | ||
my $fields = $entity->{Fields}; | ||
# Generate data from the fields. | ||
_GenerateFields($this, $fields, $type, $values); | ||
} | ||
# Return the hash created. | ||
return $this; | ||
3183 | } | } |
3184 | ||
3185 | =head3 GetEntity | =head2 Virtual Methods |
C<< my $entityObject = $erdb->GetEntity($entityType, $ID); >> | ||
3186 | ||
3187 | Return an object describing the entity instance with a specified ID. | =head3 CleanKeywords |
3188 | ||
3189 | =over 4 | C<< my $cleanedString = $erdb->CleanKeywords($searchExpression); >> |
3190 | ||
3191 | =item entityType | Clean up a search expression or keyword list. This is a virtual method that may |
3192 | be overridden by the subclass. The base-class method removes extra spaces | |
3193 | and converts everything to lower case. | |
3194 | ||
3195 | Entity type name. | =over 4 |
3196 | ||
3197 | =item ID | =item searchExpression |
3198 | ||
3199 | ID of the desired entity. | Search expression or keyword list to clean. Note that a search expression may |
3200 | contain boolean operators which need to be preserved. This includes leading | |
3201 | minus signs. | |
3202 | ||
3203 | =item RETURN | =item RETURN |
3204 | ||
3205 | Returns a B<DBObject> representing the desired entity instance, or an undefined value if no | Cleaned expression or keyword list. |
instance is found with the specified key. | ||
3206 | ||
3207 | =back | =back |
3208 | ||
3209 | =cut | =cut |
3210 | ||
3211 | sub GetEntity { | sub CleanKeywords { |
3212 | # Get the parameters. | # Get the parameters. |
3213 | my ($self, $entityType, $ID) = @_; | my ($self, $searchExpression) = @_; |
3214 | # Create a query. | # Lower-case the expression and copy it into the return variable. Note that we insure we |
3215 | my $query = $self->Get([$entityType], "$entityType(id) = ?", $ID); | # don't accidentally end up with an undefined value. |
3216 | # Get the first (and only) object. | my $retVal = lc($searchExpression || ""); |
3217 | my $retVal = $query->Fetch(); | # Remove extra spaces. |
3218 | $retVal =~ s/\s+/ /g; | |
3219 | $retVal =~ s/(^\s+)|(\s+$)//g; | |
3220 | # Return the result. | # Return the result. |
3221 | return $retVal; | return $retVal; |
3222 | } | } |
3223 | ||
3224 | =head3 GetEntityValues | =head3 GetSourceObject |
3225 | ||
3226 | C<< my @values = $erdb->GetEntityValues($entityType, $ID, \@fields); >> | C<< my $source = $erdb->GetSourceObject($entityName); >> |
3227 | ||
3228 | Return a list of values from a specified entity instance. | Return the object to be used in loading special attributes of the specified entity. The |
3229 | algorithm for loading special attributes is stored in the C<DataGen> elements of the | |
3230 | XML | |
3231 | ||
3232 | =over 4 | =head2 Internal Utility Methods |
3233 | ||
3234 | =item entityType | =head3 _RelationMap |
3235 | ||
3236 | Entity type name. | C<< my @relationMap = _RelationMap($mappedNameHashRef, $mappedNameListRef); >> |
3237 | ||
3238 | =item ID | Create the relation map for an SQL query. The relation map is used by B<DBObject> |
3239 | to determine how to interpret the results of the query. | |
3240 | ||
3241 | ID of the desired entity. | =over 4 |
3242 | ||
3243 | =item fields | =item mappedNameHashRef |
3244 | ||
3245 | List of field names, each of the form I<objectName>C<(>I<fieldName>C<)>. | Reference to a hash that maps modified object names to real object names. |
3246 | ||
3247 | =item mappedNameListRef | |
3248 | ||
3249 | Reference to a list of modified object names in the order they appear in the | |
3250 | SELECT list. | |
3251 | ||
3252 | =item RETURN | =item RETURN |
3253 | ||
3254 | Returns a flattened list of the values of the specified fields for the specified entity. | Returns a list of 2-tuples. Each tuple consists of an object name as used in the |
3255 | query followed by the actual name of that object. This enables the B<DBObject> to | |
3256 | determine the order of the tables in the query and which object name belongs to each | |
3257 | mapped object name. Most of the time these two values are the same; however, if a | |
3258 | relation occurs twice in the query, the relation name in the field list and WHERE | |
3259 | clause will use a mapped name (generally the actual relation name with a numeric | |
3260 | suffix) that does not match the actual relation name. | |
3261 | ||
3262 | =back | =back |
3263 | ||
3264 | =cut | =cut |
3265 | ||
3266 | sub GetEntityValues { | sub _RelationMap { |
3267 | # Get the parameters. | # Get the parameters. |
3268 | my ($self, $entityType, $ID, $fields) = @_; | my ($mappedNameHashRef, $mappedNameListRef) = @_; |
3269 | # Get the specified entity. | # Declare the return variable. |
my $entity = $self->GetEntity($entityType, $ID); | ||
# Declare the return list. | ||
3270 | my @retVal = (); | my @retVal = (); |
3271 | # If we found the entity, push the values into the return list. | # Build the map. |
3272 | if ($entity) { | for my $mappedName (@{$mappedNameListRef}) { |
3273 | push @retVal, $entity->Values($fields); | push @retVal, [$mappedName, $mappedNameHashRef->{$mappedName}]; |
3274 | } | } |
3275 | # Return the result. | # Return it. |
3276 | return @retVal; | return @retVal; |
3277 | } | } |
3278 | ||
=head3 GetAll | ||
C<< my @list = $erdb->GetAll(\@objectNames, $filterClause, \@parameters, \@fields, $count); >> | ||
3279 | ||
3280 | Return a list of values taken from the objects returned by a query. The first three | =head3 _SetupSQL |
parameters correspond to the parameters of the L</Get> method. The final parameter is | ||
a list of the fields desired from each record found by the query. The field name | ||
syntax is the standard syntax used for fields in the B<ERDB> system-- | ||
B<I<objectName>(I<fieldName>)>-- where I<objectName> is the name of the relevant entity | ||
or relationship and I<fieldName> is the name of the field. | ||
3281 | ||
3282 | The list returned will be a list of lists. Each element of the list will contain | Process a list of object names and a filter clause so that they can be used to |
3283 | the values returned for the fields specified in the fourth parameter. If one of the | build an SQL statement. This method takes in a reference to a list of object names |
3284 | fields specified returns multiple values, they are flattened in with the rest. For | and a filter clause. It will return a corrected filter clause, a list of mapped |
3285 | example, the following call will return a list of the features in a particular | names and the mapped name hash. |
spreadsheet cell, and each feature will be represented by a list containing the | ||
feature ID followed by all of its aliases. | ||
3286 | ||
3287 | C<< $query = $erdb->Get(['ContainsFeature', 'Feature'], "ContainsFeature(from-link) = ?", [$ssCellID], ['Feature(id)', 'Feature(alias)']); >> | This is an instance method. |
3288 | ||
3289 | =over 4 | =over 4 |
3290 | ||
3291 | =item objectNames | =item objectNames |
3292 | ||
3293 | List containing the names of the entity and relationship objects to be retrieved. | Reference to a list of the object names to be included in the query. |
3294 | ||
3295 | =item filterClause | =item filterClause |
3296 | ||
3297 | WHERE/ORDER BY clause (without the WHERE) to be used to filter and sort the query. The WHERE clause can | A string containing the WHERE clause for the query (without the C<WHERE>) and also |
3298 | be parameterized with parameter markers (C<?>). Each field used must be specified in the standard form | optionally the C<ORDER BY> and C<LIMIT> clauses. |
B<I<objectName>(I<fieldName>)>. Any parameters specified in the filter clause should be added to the | ||
parameter list as additional parameters. The fields in a filter clause can come from primary | ||
entity relations, relationship relations, or secondary entity relations; however, all of the | ||
entities and relationships involved must be included in the list of object names. | ||
=item parameterList | ||
List of the parameters to be substituted in for the parameters marks in the filter clause. | ||
=item fields | ||
List of the fields to be returned in each element of the list returned. | ||
3299 | ||
3300 | =item count | =item matchClause |
3301 | ||
3302 | Maximum number of records to return. If omitted or 0, all available records will be returned. | An optional full-text search clause. If specified, it will be inserted at the |
3303 | front of the WHERE clause. It should already be SQL-formatted; that is, the | |
3304 | field names should be in the form I<table>C<.>I<fieldName>. | |
3305 | ||
3306 | =item RETURN | =item RETURN |
3307 | ||
3308 | Returns a list of list references. Each element of the return list contains the values for the | Returns a three-element list. The first element is the SQL statement suffix, beginning |
3309 | fields specified in the B<fields> parameter. | with the FROM clause. The second element is a reference to a list of the names to be |
3310 | used in retrieving the fields. The third element is a hash mapping the names to the | |
3311 | objects they represent. | |
3312 | ||
3313 | =back | =back |
3314 | ||
3315 | =cut | =cut |
3316 | #: Return Type @@; | |
3317 | sub GetAll { | sub _SetupSQL { |
3318 | # Get the parameters. | my ($self, $objectNames, $filterClause, $matchClause) = @_; |
3319 | my ($self, $objectNames, $filterClause, $parameterList, $fields, $count) = @_; | # Adjust the list of object names to account for multiple occurrences of the |
3320 | # Translate the parameters from a list reference to a list. If the parameter | # same object. We start with a hash table keyed on object name that will |
3321 | # list is a scalar we convert it into a singleton list. | # return the object suffix. The first time an object is encountered it will |
3322 | my @parmList = (); | # not be found in the hash. The next time the hash will map the object name |
3323 | if (ref $parameterList eq "ARRAY") { | # to 2, then 3, and so forth. |
3324 | @parmList = @{$parameterList}; | my %objectHash = (); |
3325 | # This list will contain the object names as they are to appear in the | |
3326 | # FROM list. | |
3327 | my @fromList = (); | |
3328 | # This list contains the suffixed object name for each object. It is exactly | |
3329 | # parallel to the list in the $objectNames parameter. | |
3330 | my @mappedNameList = (); | |
3331 | # Finally, this hash translates from a mapped name to its original object name. | |
3332 | my %mappedNameHash = (); | |
3333 | # Now we create the lists. Note that for every single name we push something into | |
3334 | # @fromList and @mappedNameList. This insures that those two arrays are exactly | |
3335 | # parallel to $objectNames. | |
3336 | for my $objectName (@{$objectNames}) { | |
3337 | # Get the next suffix for this object. | |
3338 | my $suffix = $objectHash{$objectName}; | |
3339 | if (! $suffix) { | |
3340 | # Here we are seeing the object for the first time. The object name | |
3341 | # is used as is. | |
3342 | push @mappedNameList, $objectName; | |
3343 | push @fromList, $objectName; | |
3344 | $mappedNameHash{$objectName} = $objectName; | |
3345 | # Denote the next suffix will be 2. | |
3346 | $objectHash{$objectName} = 2; | |
3347 | } else { | } else { |
3348 | push @parmList, $parameterList; | # Here we've seen the object before. We construct a new name using |
3349 | # the suffix from the hash and update the hash. | |
3350 | my $mappedName = "$objectName$suffix"; | |
3351 | $objectHash{$objectName} = $suffix + 1; | |
3352 | # The FROM list has the object name followed by the mapped name. This | |
3353 | # tells SQL it's still the same table, but we're using a different name | |
3354 | # for it to avoid confusion. | |
3355 | push @fromList, "$objectName $mappedName"; | |
3356 | # The mapped-name list contains the real mapped name. | |
3357 | push @mappedNameList, $mappedName; | |
3358 | # Finally, enable us to get back from the mapped name to the object name. | |
3359 | $mappedNameHash{$mappedName} = $objectName; | |
3360 | } | } |
# Create the query. | ||
my $query = $self->Get($objectNames, $filterClause, @parmList); | ||
# Set up a counter of the number of records read. | ||
my $fetched = 0; | ||
# Insure the counter has a value. | ||
if (!defined $count) { | ||
$count = 0; | ||
3361 | } | } |
3362 | # Loop through the records returned, extracting the fields. Note that if the | # Begin the SELECT suffix. It starts with |
3363 | # counter is non-zero, we stop when the number of records read hits the count. | # |
3364 | my @retVal = (); | # FROM name1, name2, ... nameN |
3365 | while (($count == 0 || $fetched < $count) && (my $row = $query->Fetch())) { | # |
3366 | my @rowData = $row->Values($fields); | my $suffix = "FROM " . join(', ', @fromList); |
3367 | push @retVal, \@rowData; | # Now for the WHERE. First, we need a place for the filter string. |
3368 | $fetched++; | my $filterString = ""; |
3369 | # We will also keep a list of conditions to add to the WHERE clause in order to link | |
3370 | # entities and relationships as well as primary relations to secondary ones. | |
3371 | my @joinWhere = (); | |
3372 | # Check for a filter clause. | |
3373 | if ($filterClause) { | |
3374 | # Here we have one, so we convert its field names and add it to the query. First, | |
3375 | # We create a copy of the filter string we can work with. | |
3376 | $filterString = $filterClause; | |
3377 | # Next, we sort the object names by length. This helps protect us from finding | |
3378 | # object names inside other object names when we're doing our search and replace. | |
3379 | my @sortedNames = sort { length($b) - length($a) } @mappedNameList; | |
3380 | # The final preparatory step is to create a hash table of relation names. The | |
3381 | # table begins with the relation names already in the SELECT command. We may | |
3382 | # need to add relations later if there is filtering on a field in a secondary | |
3383 | # relation. The secondary relations are the ones that contain multiply- | |
3384 | # occurring or optional fields. | |
3385 | my %fromNames = map { $_ => 1 } @sortedNames; | |
3386 | # We are ready to begin. We loop through the object names, replacing each | |
3387 | # object name's field references by the corresponding SQL field reference. | |
3388 | # Along the way, if we find a secondary relation, we will need to add it | |
3389 | # to the FROM clause. | |
3390 | for my $mappedName (@sortedNames) { | |
3391 | # Get the length of the object name plus 2. This is the value we add to the | |
3392 | # size of the field name to determine the size of the field reference as a | |
3393 | # whole. | |
3394 | my $nameLength = 2 + length $mappedName; | |
3395 | # Get the real object name for this mapped name. | |
3396 | my $objectName = $mappedNameHash{$mappedName}; | |
3397 | Trace("Processing $mappedName for object $objectName.") if T(4); | |
3398 | # Get the object's field list. | |
3399 | my $fieldList = $self->GetFieldTable($objectName); | |
3400 | # Find the field references for this object. | |
3401 | while ($filterString =~ m/$mappedName\(([^)]*)\)/g) { | |
3402 | # At this point, $1 contains the field name, and the current position | |
3403 | # is set immediately after the final parenthesis. We pull out the name of | |
3404 | # the field and the position and length of the field reference as a whole. | |
3405 | my $fieldName = $1; | |
3406 | my $len = $nameLength + length $fieldName; | |
3407 | my $pos = pos($filterString) - $len; | |
3408 | # Insure the field exists. | |
3409 | if (!exists $fieldList->{$fieldName}) { | |
3410 | Confess("Field $fieldName not found for object $objectName."); | |
3411 | } else { | |
3412 | Trace("Processing $fieldName at position $pos.") if T(4); | |
3413 | # Get the field's relation. | |
3414 | my $relationName = $fieldList->{$fieldName}->{relation}; | |
3415 | # Now we have a secondary relation. We need to insure it matches the | |
3416 | # mapped name of the primary relation. First we peel off the suffix | |
3417 | # from the mapped name. | |
3418 | my $mappingSuffix = substr $mappedName, length($objectName); | |
3419 | # Put the mapping suffix onto the relation name to get the | |
3420 | # mapped relation name. | |
3421 | my $mappedRelationName = "$relationName$mappingSuffix"; | |
3422 | # Insure the relation is in the FROM clause. | |
3423 | if (!exists $fromNames{$mappedRelationName}) { | |
3424 | # Add the relation to the FROM clause. | |
3425 | if ($mappedRelationName eq $relationName) { | |
3426 | # The name is un-mapped, so we add it without | |
3427 | # any frills. | |
3428 | $suffix .= ", $relationName"; | |
3429 | push @joinWhere, "$objectName.id = $relationName.id"; | |
3430 | } else { | |
3431 | # Here we have a mapping situation. | |
3432 | $suffix .= ", $relationName $mappedRelationName"; | |
3433 | push @joinWhere, "$mappedRelationName.id = $mappedName.id"; | |
3434 | } | |
3435 | # Denote we have this relation available for future fields. | |
3436 | $fromNames{$mappedRelationName} = 1; | |
3437 | } | |
3438 | # Form an SQL field reference from the relation name and the field name. | |
3439 | my $sqlReference = "$mappedRelationName." . _FixName($fieldName); | |
3440 | # Put it into the filter string in place of the old value. | |
3441 | substr($filterString, $pos, $len) = $sqlReference; | |
3442 | # Reposition the search. | |
3443 | pos $filterString = $pos + length $sqlReference; | |
3444 | } | } |
3445 | # Return the resulting list. | } |
3446 | return @retVal; | } |
3447 | } | |
3448 | # The next step is to join the objects together. We only need to do this if there | |
3449 | # is more than one object in the object list. We start with the first object and | |
3450 | # run through the objects after it. Note also that we make a safety copy of the | |
3451 | # list before running through it, because we shift off the first object before | |
3452 | # processing the rest. | |
3453 | my @mappedObjectList = @mappedNameList; | |
3454 | my $lastMappedObject = shift @mappedObjectList; | |
3455 | # Get the join table. | |
3456 | my $joinTable = $self->{_metaData}->{Joins}; | |
3457 | # Loop through the object list. | |
3458 | for my $thisMappedObject (@mappedObjectList) { | |
3459 | # Look for a join using the real object names. | |
3460 | my $lastObject = $mappedNameHash{$lastMappedObject}; | |
3461 | my $thisObject = $mappedNameHash{$thisMappedObject}; | |
3462 | my $joinKey = "$lastObject/$thisObject"; | |
3463 | if (!exists $joinTable->{$joinKey}) { | |
3464 | # Here there's no join, so we throw an error. | |
3465 | Confess("No join exists to connect from $lastMappedObject to $thisMappedObject."); | |
3466 | } else { | |
3467 | # Get the join clause. | |
3468 | my $unMappedJoin = $joinTable->{$joinKey}; | |
3469 | # Fix the names. | |
3470 | $unMappedJoin =~ s/$lastObject/$lastMappedObject/; | |
3471 | $unMappedJoin =~ s/$thisObject/$thisMappedObject/; | |
3472 | push @joinWhere, $unMappedJoin; | |
3473 | # Save this object as the last object for the next iteration. | |
3474 | $lastMappedObject = $thisMappedObject; | |
3475 | } | |
3476 | } | |
3477 | # Now we need to handle the whole ORDER BY / LIMIT thing. The important part | |
3478 | # here is we want the filter clause to be empty if there's no WHERE filter. | |
3479 | # We'll put the ORDER BY / LIMIT clauses in the following variable. | |
3480 | my $orderClause = ""; | |
3481 | # This is only necessary if we have a filter string in which the ORDER BY | |
3482 | # and LIMIT clauses can live. | |
3483 | if ($filterString) { | |
3484 | # Locate the ORDER BY or LIMIT verbs (if any). We use a non-greedy | |
3485 | # operator so that we find the first occurrence of either verb. | |
3486 | if ($filterString =~ m/^(.*?)\s*(ORDER BY|LIMIT)/g) { | |
3487 | # Here we have an ORDER BY or LIMIT verb. Split it off of the filter string. | |
3488 | my $pos = pos $filterString; | |
3489 | $orderClause = $2 . substr($filterString, $pos); | |
3490 | $filterString = $1; | |
3491 | } | |
3492 | } | |
3493 | # All the things that are supposed to be in the WHERE clause of the | |
3494 | # SELECT command need to be put into @joinWhere so we can string them | |
3495 | # together. We begin with the match clause. This is important, | |
3496 | # because the match clause's parameter mark must precede any parameter | |
3497 | # marks in the filter string. | |
3498 | if ($matchClause) { | |
3499 | push @joinWhere, $matchClause; | |
3500 | } | |
3501 | # Add the filter string. We put it in parentheses to avoid operator | |
3502 | # precedence problems with the match clause or the joins. | |
3503 | if ($filterString) { | |
3504 | Trace("Filter string is \"$filterString\".") if T(4); | |
3505 | push @joinWhere, "($filterString)"; | |
3506 | } | |
3507 | # String it all together into a big filter clause. | |
3508 | if (@joinWhere) { | |
3509 | $suffix .= " WHERE " . join(' AND ', @joinWhere); | |
3510 | } | |
3511 | # Add the sort or limit clause (if any). | |
3512 | if ($orderClause) { | |
3513 | $suffix .= " $orderClause"; | |
3514 | } | |
3515 | # Return the suffix, the mapped name list, and the mapped name hash. | |
3516 | return ($suffix, \@mappedNameList, \%mappedNameHash); | |
3517 | } | } |
3518 | ||
3519 | =head3 EstimateRowSize | =head3 _GetStatementHandle |
3520 | ||
3521 | C<< my $rowSize = $erdb->EstimateRowSize($relName); >> | This method will prepare and execute an SQL query, returning the statement handle. |
3522 | The main reason for doing this here is so that everybody who does SQL queries gets | |
3523 | the benefit of tracing. | |
3524 | ||
3525 | Estimate the row size of the specified relation. The estimated row size is computed by adding | This is an instance method. |
up the average length for each data type. | ||
3526 | ||
3527 | =over 4 | =over 4 |
3528 | ||
3529 | =item relName | =item command |
3530 | ||
3531 | Name of the relation whose estimated row size is desired. | Command to prepare and execute. |
3532 | ||
3533 | =item params | |
3534 | ||
3535 | Reference to a list of the values to be substituted in for the parameter marks. | |
3536 | ||
3537 | =item RETURN | =item RETURN |
3538 | ||
3539 | Returns an estimate of the row size for the specified relation. | Returns a prepared and executed statement handle from which the caller can extract |
3540 | results. | |
3541 | ||
3542 | =back | =back |
3543 | ||
3544 | =cut | =cut |
3545 | #: Return Type $; | |
3546 | sub EstimateRowSize { | sub _GetStatementHandle { |
3547 | # Get the parameters. | # Get the parameters. |
3548 | my ($self, $relName) = @_; | my ($self, $command, $params) = @_; |
3549 | # Declare the return variable. | # Trace the query. |
3550 | my $retVal = 0; | Trace("SQL query: $command") if T(SQL => 3); |
3551 | # Find the relation descriptor. | Trace("PARMS: '" . (join "', '", @{$params}) . "'") if (T(SQL => 4) && (@{$params} > 0)); |
3552 | my $relation = $self->_FindRelation($relName); | # Get the database handle. |
3553 | # Get the list of fields. | my $dbh = $self->{_dbh}; |
3554 | for my $fieldData (@{$relation->{Fields}}) { | # Prepare the command. |
3555 | # Get the field type and add its length. | my $sth = $dbh->prepare_command($command); |
3556 | my $fieldLen = $TypeTable{$fieldData->{type}}->{avgLen}; | # Execute it with the parameters bound in. |
3557 | $retVal += $fieldLen; | $sth->execute(@{$params}) || Confess("SELECT error: " . $sth->errstr()); |
3558 | } | # Return the statement handle. |
3559 | # Return the result. | return $sth; |
return $retVal; | ||
3560 | } | } |
3561 | ||
3562 | =head2 Internal Utility Methods | =head3 _GetLoadStats |
=head3 GetLoadStats | ||
3563 | ||
3564 | Return a blank statistics object for use by the load methods. | Return a blank statistics object for use by the load methods. |
3565 | ||
3566 | This is a static method. | This is a static method. |
3567 | ||
3568 | =cut | =cut |
3569 | ||
3570 | sub _GetLoadStats { | sub _GetLoadStats{ |
3571 | return Stats->new('records'); | return Stats->new(); |
} | ||
=head3 GenerateFields | ||
Generate field values from a field structure and store in a specified table. The field names | ||
are first sorted by pass count, certain pre-defined fields are removed from the list, and | ||
then we rip through them evaluation the data generation string. Fields in the primary relation | ||
are stored as scalars; fields in secondary relations are stored as value lists. | ||
This is a static method. | ||
=over 4 | ||
=item this | ||
Hash table into which the field values should be placed. | ||
=item fields | ||
Field structure from which the field descriptors should be taken. | ||
=item type | ||
Type name of the object whose fields are being generated. | ||
=item values (optional) | ||
Reference to a value structure from which additional values can be taken. | ||
=item from (optiona) | ||
Reference to the source entity instance if relationship data is being generated. | ||
=item to (optional) | ||
Reference to the target entity instance if relationship data is being generated. | ||
=back | ||
=cut | ||
sub _GenerateFields { | ||
# Get the parameters. | ||
my ($this, $fields, $type, $values, $from, $to) = @_; | ||
# Sort the field names by pass number. | ||
my @fieldNames = sort { $fields->{$a}->{DataGen}->{pass} <=> $fields->{$b}->{DataGen}->{pass} } keys %{$fields}; | ||
# Loop through the field names, generating data. | ||
for my $name (@fieldNames) { | ||
# Only proceed if this field needs to be generated. | ||
if (!exists $this->{$name}) { | ||
# Get this field's data generation descriptor. | ||
my $fieldDescriptor = $fields->{$name}; | ||
my $data = $fieldDescriptor->{DataGen}; | ||
# Get the code to generate the field value. | ||
my $codeString = $data->{content}; | ||
# Determine whether or not this field is in the primary relation. | ||
if ($fieldDescriptor->{relation} eq $type) { | ||
# Here we have a primary relation field. Store the field value as | ||
# a scalar. | ||
$this->{$name} = eval($codeString); | ||
} else { | ||
# Here we have a secondary relation field. Create a null list | ||
# and push the desired number of field values onto it. | ||
my @fieldValues = (); | ||
my $count = IntGen(0,$data->{testCount}); | ||
for (my $i = 0; $i < $count; $i++) { | ||
my $newValue = eval($codeString); | ||
push @fieldValues, $newValue; | ||
} | ||
# Store the value list in the main hash. | ||
$this->{$name} = \@fieldValues; | ||
} | ||
} | ||
} | ||
3572 | } | } |
3573 | ||
3574 | =head3 DumpRelation | =head3 _DumpRelation |
3575 | ||
3576 | Dump the specified relation's to the specified output file in tab-delimited format. | Dump the specified relation to the specified output file in tab-delimited format. |
3577 | ||
3578 | This is an instance method. | This is an instance method. |
3579 | ||
# | Line 1781 | Line 3621 |
3621 | close DTXOUT; | close DTXOUT; |
3622 | } | } |
3623 | ||
3624 | =head3 GetStructure | =head3 _GetStructure |
3625 | ||
3626 | Get the data structure for a specified entity or relationship. | Get the data structure for a specified entity or relationship. |
3627 | ||
# | Line 1820 | Line 3660 |
3660 | return $retVal; | return $retVal; |
3661 | } | } |
3662 | ||
3663 | =head3 GetRelationTable | |
3664 | ||
3665 | =head3 _GetRelationTable | |
3666 | ||
3667 | Get the list of relations for a specified entity or relationship. | Get the list of relations for a specified entity or relationship. |
3668 | ||
# | Line 1849 | Line 3691 |
3691 | return $objectData->{Relations}; | return $objectData->{Relations}; |
3692 | } | } |
3693 | ||
3694 | =head3 GetFieldTable | =head3 _ValidateFieldNames |
Get the field structure for a specified entity or relationship. | ||
This is an instance method. | ||
=over 4 | ||
=item objectName | ||
Name of the desired entity or relationship. | ||
=item RETURN | ||
The table containing the field descriptors for the specified object. | ||
=back | ||
=cut | ||
sub _GetFieldTable { | ||
# Get the parameters. | ||
my ($self, $objectName) = @_; | ||
# Get the descriptor from the metadata. | ||
my $objectData = $self->_GetStructure($objectName); | ||
# Return the object's field table. | ||
return $objectData->{Fields}; | ||
} | ||
=head3 ValidateFieldNames | ||
3695 | ||
3696 | Determine whether or not the field names are valid. A description of the problems with the names | Determine whether or not the field names are valid. A description of the problems with the names |
3697 | will be written to the standard error output. If there is an error, this method will abort. This is | will be written to the standard error output. If there is an error, this method will abort. This is |
# | Line 1905 | Line 3718 |
3718 | for my $object (values %{$metadata->{$section}}) { | for my $object (values %{$metadata->{$section}}) { |
3719 | # Loop through the object's fields. | # Loop through the object's fields. |
3720 | for my $fieldName (keys %{$object->{Fields}}) { | for my $fieldName (keys %{$object->{Fields}}) { |
3721 | # Now we make some initial validations. | # If this field name is invalid, set the return value to zero |
3722 | if ($fieldName =~ /--/) { | # so we know we encountered an error. |
3723 | # Here we have a doubled minus sign. | if (! ValidateFieldName($fieldName)) { |
print STDERR "Field name $fieldName has a doubled hyphen.\n"; | ||
$retVal = 0; | ||
} elsif ($fieldName !~ /^[A-Za-z]/) { | ||
# Here the field name is missing the initial letter. | ||
print STDERR "Field name $fieldName does not begin with a letter.\n"; | ||
$retVal = 0; | ||
} else { | ||
# Strip out the minus signs. Everything remaining must be a letter | ||
# or digit. | ||
my $strippedName = $fieldName; | ||
$strippedName =~ s/-//g; | ||
if ($strippedName !~ /^[A-Za-z0-9]+$/) { | ||
print STDERR "Field name $fieldName contains illegal characters.\n"; | ||
3724 | $retVal = 0; | $retVal = 0; |
3725 | } | } |
3726 | } | } |
3727 | } | } |
3728 | } | } |
} | ||
3729 | # If an error was found, fail. | # If an error was found, fail. |
3730 | if ($retVal == 0) { | if ($retVal == 0) { |
3731 | Confess("Errors found in field names."); | Confess("Errors found in field names."); |
3732 | } | } |
3733 | } | } |
3734 | ||
3735 | =head3 LoadRelation | =head3 _LoadRelation |
3736 | ||
3737 | Load a relation from the data in a tab-delimited disk file. The load will only take place if a disk | Load a relation from the data in a tab-delimited disk file. The load will only take place if a disk |
3738 | file with the same name as the relation exists in the specified directory. | file with the same name as the relation exists in the specified directory. |
# | Line 1993 | Line 3792 |
3792 | return $retVal; | return $retVal; |
3793 | } | } |
3794 | ||
3795 | =head3 LoadMetaData | |
3796 | =head3 _LoadMetaData | |
3797 | ||
3798 | This method loads the data describing this database from an XML file into a metadata structure. | This method loads the data describing this database from an XML file into a metadata structure. |
3799 | The resulting structure is a set of nested hash tables containing all the information needed to | The resulting structure is a set of nested hash tables containing all the information needed to |
# | Line 2018 | Line 3818 |
3818 | sub _LoadMetaData { | sub _LoadMetaData { |
3819 | # Get the parameters. | # Get the parameters. |
3820 | my ($filename) = @_; | my ($filename) = @_; |
3821 | Trace("Reading Sprout DBD from $filename.") if T(2); | Trace("Reading DBD from $filename.") if T(2); |
3822 | # 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 |
3823 | # get the exact structure we want. | # get the exact structure we want. |
3824 | my $metadata = XML::Simple::XMLin($filename, | my $metadata = ReadMetaXML($filename); |
GroupTags => { Relationships => 'Relationship', | ||
Entities => 'Entity', | ||
Fields => 'Field', | ||
Indexes => 'Index', | ||
IndexFields => 'IndexField'}, | ||
KeyAttr => { Relationship => 'name', | ||
Entity => 'name', | ||
Field => 'name'}, | ||
ForceArray => ['Field', 'Index', 'IndexField'], | ||
ForceContent => 1, | ||
NormalizeSpace => 2 | ||
); | ||
Trace("XML metadata loaded from file $filename.") if T(1); | ||
3825 | # Before we go any farther, we need to validate the field and object names. If an error is found, | # Before we go any farther, we need to validate the field and object names. If an error is found, |
3826 | # the method below will fail. | # the method below will fail. |
3827 | _ValidateFieldNames($metadata); | _ValidateFieldNames($metadata); |
# | Line 2164 | Line 3951 |
3951 | my $count = 0; | my $count = 0; |
3952 | for my $index (@{$indexList}) { | for my $index (@{$indexList}) { |
3953 | # Add this index to the index table. | # Add this index to the index table. |
3954 | _AddIndex("idx$relationName$count", $relation, $index); | _AddIndex("idx$count", $relation, $index); |
3955 | # Increment the counter so that the next index has a different name. | # Increment the counter so that the next index has a different name. |
3956 | $count++; | $count++; |
3957 | } | } |
# | Line 2225 | Line 4012 |
4012 | my @fromList = (); | my @fromList = (); |
4013 | my @toList = (); | my @toList = (); |
4014 | my @bothList = (); | my @bothList = (); |
4015 | Trace("Join table build for $entityName.") if T(4); | Trace("Join table build for $entityName.") if T(metadata => 4); |
4016 | for my $relationshipName (keys %{$relationshipList}) { | for my $relationshipName (keys %{$relationshipList}) { |
4017 | my $relationship = $relationshipList->{$relationshipName}; | my $relationship = $relationshipList->{$relationshipName}; |
4018 | # 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. |
4019 | my $fromEntity = $relationship->{from}; | my $fromEntity = $relationship->{from}; |
4020 | my $toEntity = $relationship->{to}; | my $toEntity = $relationship->{to}; |
4021 | Trace("Join check for relationship $relationshipName from $fromEntity to $toEntity.") if T(4); | Trace("Join check for relationship $relationshipName from $fromEntity to $toEntity.") if T(Joins => 4); |
4022 | if ($fromEntity eq $entityName) { | if ($fromEntity eq $entityName) { |
4023 | if ($toEntity eq $entityName) { | if ($toEntity eq $entityName) { |
4024 | # Here the relationship is recursive. | # Here the relationship is recursive. |
4025 | push @bothList, $relationshipName; | push @bothList, $relationshipName; |
4026 | Trace("Relationship $relationshipName put in both-list.") if T(4); | Trace("Relationship $relationshipName put in both-list.") if T(metadata => 4); |
4027 | } else { | } else { |
4028 | # Here the relationship comes from the entity. | # Here the relationship comes from the entity. |
4029 | push @fromList, $relationshipName; | push @fromList, $relationshipName; |
4030 | Trace("Relationship $relationshipName put in from-list.") if T(4); | Trace("Relationship $relationshipName put in from-list.") if T(metadata => 4); |
4031 | } | } |
4032 | } elsif ($toEntity eq $entityName) { | } elsif ($toEntity eq $entityName) { |
4033 | # Here the relationship goes to the entity. | # Here the relationship goes to the entity. |
4034 | push @toList, $relationshipName; | push @toList, $relationshipName; |
4035 | Trace("Relationship $relationshipName put in to-list.") if T(4); | Trace("Relationship $relationshipName put in to-list.") if T(metadata => 4); |
4036 | } | } |
4037 | } | } |
4038 | # 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 2261 | Line 4048 |
4048 | # Create joins between the entity and this relationship. | # Create joins between the entity and this relationship. |
4049 | my $linkField = "$relationshipName.${linkType}_link"; | my $linkField = "$relationshipName.${linkType}_link"; |
4050 | my $joinClause = "$entityName.id = $linkField"; | my $joinClause = "$entityName.id = $linkField"; |
4051 | Trace("Entity join clause is $joinClause for $entityName and $relationshipName.") if T(4); | Trace("Entity join clause is $joinClause for $entityName and $relationshipName.") if T(metadata => 4); |
4052 | $joinTable{"$entityName/$relationshipName"} = $joinClause; | $joinTable{"$entityName/$relationshipName"} = $joinClause; |
4053 | $joinTable{"$relationshipName/$entityName"} = $joinClause; | $joinTable{"$relationshipName/$entityName"} = $joinClause; |
4054 | # Create joins between this relationship and the other relationships. | # Create joins between this relationship and the other relationships. |
# | Line 2282 | Line 4069 |
4069 | # relationship and itself are prohibited. | # relationship and itself are prohibited. |
4070 | my $relJoinClause = "$otherName.${otherType}_link = $linkField"; | my $relJoinClause = "$otherName.${otherType}_link = $linkField"; |
4071 | $joinTable{$joinKey} = $relJoinClause; | $joinTable{$joinKey} = $relJoinClause; |
4072 | Trace("Relationship join clause is $relJoinClause for $joinKey.") if T(4); | Trace("Relationship join clause is $relJoinClause for $joinKey.") if T(metadata => 4); |
4073 | } | } |
4074 | } | } |
4075 | } | } |
# | Line 2291 | Line 4078 |
4078 | # relationship can only be ambiguous with another recursive relationship, | # relationship can only be ambiguous with another recursive relationship, |
4079 | # and the incoming relationship from the outer loop is never recursive. | # and the incoming relationship from the outer loop is never recursive. |
4080 | for my $otherName (@bothList) { | for my $otherName (@bothList) { |
4081 | Trace("Setting up relationship joins to recursive relationship $otherName with $relationshipName.") if T(4); | Trace("Setting up relationship joins to recursive relationship $otherName with $relationshipName.") if T(metadata => 4); |
4082 | # Join from the left. | # Join from the left. |
4083 | $joinTable{"$relationshipName/$otherName"} = | $joinTable{"$relationshipName/$otherName"} = |
4084 | "$linkField = $otherName.from_link"; | "$linkField = $otherName.from_link"; |
# | Line 2306 | Line 4093 |
4093 | # 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 |
4094 | # possible to get the same effect using multiple queries. | # possible to get the same effect using multiple queries. |
4095 | for my $relationshipName (@bothList) { | for my $relationshipName (@bothList) { |
4096 | Trace("Setting up entity joins to recursive relationship $relationshipName with $entityName.") if T(4); | Trace("Setting up entity joins to recursive relationship $relationshipName with $entityName.") if T(metadata => 4); |
4097 | # Join to the entity from each direction. | # Join to the entity from each direction. |
4098 | $joinTable{"$entityName/$relationshipName"} = | $joinTable{"$entityName/$relationshipName"} = |
4099 | "$entityName.id = $relationshipName.from_link"; | "$entityName.id = $relationshipName.from_link"; |
# | Line 2320 | Line 4107 |
4107 | return $metadata; | return $metadata; |
4108 | } | } |
4109 | ||
4110 | =head3 CreateRelationshipIndex | =head3 _CreateRelationshipIndex |
4111 | ||
4112 | Create an index for a relationship's relation. | Create an index for a relationship's relation. |
4113 | ||
# | Line 2362 | Line 4149 |
4149 | $newIndex->{Unique} = 'true'; | $newIndex->{Unique} = 'true'; |
4150 | } | } |
4151 | # Add the index to the relation. | # Add the index to the relation. |
4152 | _AddIndex("idx$relationshipName$indexKey", $relationStructure, $newIndex); | _AddIndex("idx$indexKey", $relationStructure, $newIndex); |
4153 | } | } |
4154 | ||
4155 | =head3 AddIndex | =head3 _AddIndex |
4156 | ||
4157 | Add an index to a relation structure. | Add an index to a relation structure. |
4158 | ||
# | Line 2411 | Line 4198 |
4198 | $relationStructure->{Indexes}->{$indexName} = $newIndex; | $relationStructure->{Indexes}->{$indexName} = $newIndex; |
4199 | } | } |
4200 | ||
4201 | =head3 FixupFields | =head3 _FixupFields |
4202 | ||
4203 | This method fixes the field list for an entity or relationship. It will add the caller-specified | This method fixes the field list for an entity or relationship. It will add the caller-specified |
4204 | relation name to fields that do not have a name and set the C<PrettySort> value as specified. | relation name to fields that do not have a name and set the C<PrettySort> value as specified. |
# | Line 2449 | Line 4236 |
4236 | # Here it doesn't, so we create a new one. | # Here it doesn't, so we create a new one. |
4237 | $structure->{Fields} = { }; | $structure->{Fields} = { }; |
4238 | } else { | } else { |
4239 | # Here we have a field list. Loop through its fields. | # Here we have a field list. We need to track the searchable fields, so we |
4240 | # create a list for stashing them. | |
4241 | my @textFields = (); | |
4242 | # Loop through the fields. | |
4243 | my $fieldStructures = $structure->{Fields}; | my $fieldStructures = $structure->{Fields}; |
4244 | for my $fieldName (keys %{$fieldStructures}) { | for my $fieldName (keys %{$fieldStructures}) { |
4245 | Trace("Processing field $fieldName of $defaultRelationName.") if T(4); | Trace("Processing field $fieldName of $defaultRelationName.") if T(4); |
# | Line 2458 | Line 4248 |
4248 | my $type = $fieldData->{type}; | my $type = $fieldData->{type}; |
4249 | # Plug in a relation name if it is needed. | # Plug in a relation name if it is needed. |
4250 | Tracer::MergeOptions($fieldData, { relation => $defaultRelationName }); | Tracer::MergeOptions($fieldData, { relation => $defaultRelationName }); |
4251 | # Plug in a data generator if we need one. | # Check for searchability. |
4252 | if (!exists $fieldData->{DataGen}) { | if ($fieldData->{searchable}) { |
4253 | # The data generator will use the default for the field's type. | # Only allow this for a primary relation. |
4254 | $fieldData->{DataGen} = { content => $TypeTable{$type}->{dataGen} }; | if ($fieldData->{relation} ne $defaultRelationName) { |
4255 | Confess("Field $fieldName of $defaultRelationName is in secondary relations and cannot be searchable."); | |
4256 | } else { | |
4257 | push @textFields, $fieldName; | |
4258 | } | |
4259 | } | } |
# Plug in the defaults for the optional data generation parameters. | ||
Tracer::MergeOptions($fieldData->{DataGen}, { testCount => 1, pass => 0 }); | ||
4260 | # Add the PrettySortValue. | # Add the PrettySortValue. |
4261 | $fieldData->{PrettySort} = (($type eq "text") ? $textPrettySortValue : $prettySortValue); | $fieldData->{PrettySort} = (($type eq "text") ? $textPrettySortValue : $prettySortValue); |
4262 | } | } |
4263 | # If there are searchable fields, remember the fact. | |
4264 | if (@textFields) { | |
4265 | $structure->{searchFields} = \@textFields; | |
4266 | } | |
4267 | } | } |
4268 | } | } |
4269 | ||
4270 | =head3 FixName | =head3 _FixName |
4271 | ||
4272 | Fix the incoming field name so that it is a legal SQL column name. | Fix the incoming field name so that it is a legal SQL column name. |
4273 | ||
# | Line 2500 | Line 4296 |
4296 | return $fieldName; | return $fieldName; |
4297 | } | } |
4298 | ||
4299 | =head3 FixNames | =head3 _FixNames |
4300 | ||
4301 | Fix all the field names in a list. | Fix all the field names in a list. |
4302 | ||
# | Line 2531 | Line 4327 |
4327 | return @result; | return @result; |
4328 | } | } |
4329 | ||
4330 | =head3 AddField | =head3 _AddField |
4331 | ||
4332 | Add a field to a field list. | Add a field to a field list. |
4333 | ||
# | Line 2566 | Line 4362 |
4362 | $fieldList->{$fieldName} = $fieldStructure; | $fieldList->{$fieldName} = $fieldStructure; |
4363 | } | } |
4364 | ||
4365 | =head3 ReOrderRelationTable | =head3 _ReOrderRelationTable |
4366 | ||
4367 | This method will take a relation table and re-sort it according to the implicit ordering of the | This method will take a relation table and re-sort it according to the implicit ordering of the |
4368 | C<PrettySort> property. Instead of a hash based on field names, it will return a list of fields. | C<PrettySort> property. Instead of a hash based on field names, it will return a list of fields. |
# | Line 2627 | Line 4423 |
4423 | ||
4424 | } | } |
4425 | ||
4426 | =head3 IsPrimary | =head3 _IsPrimary |
4427 | ||
4428 | Return TRUE if a specified relation is a primary relation, else FALSE. A relation is primary | Return TRUE if a specified relation is a primary relation, else FALSE. A relation is primary |
4429 | if it has the same name as an entity or relationship. | if it has the same name as an entity or relationship. |
# | Line 2663 | Line 4459 |
4459 | return $retVal; | return $retVal; |
4460 | } | } |
4461 | ||
4462 | =head3 FindRelation | =head3 _FindRelation |
4463 | ||
4464 | Return the descriptor for the specified relation. | Return the descriptor for the specified relation. |
4465 | ||
# | Line 2694 | Line 4490 |
4490 | ||
4491 | =head2 HTML Documentation Utility Methods | =head2 HTML Documentation Utility Methods |
4492 | ||
4493 | =head3 ComputeRelationshipSentence | =head3 _ComputeRelationshipSentence |
4494 | ||
4495 | The relationship sentence consists of the relationship name between the names of the | The relationship sentence consists of the relationship name between the names of the |
4496 | two related entities and an arity indicator. | two related entities and an arity indicator. |
# | Line 2732 | Line 4528 |
4528 | return $result; | return $result; |
4529 | } | } |
4530 | ||
4531 | =head3 ComputeRelationshipHeading | =head3 _ComputeRelationshipHeading |
4532 | ||
4533 | The relationship heading is the L<relationship sentence|/ComputeRelationshipSentence> with the entity | The relationship heading is the L<relationship sentence|/ComputeRelationshipSentence> with the entity |
4534 | names hyperlinked to the appropriate entity sections of the document. | names hyperlinked to the appropriate entity sections of the document. |
# | Line 2769 | Line 4565 |
4565 | return $result; | return $result; |
4566 | } | } |
4567 | ||
4568 | =head3 ShowRelationTable | =head3 _ShowRelationTable |
4569 | ||
4570 | Generate the HTML string for a particular relation. The relation's data will be formatted as an HTML | Generate the HTML string for a particular relation. The relation's data will be formatted as an HTML |
4571 | table with three columns-- the field name, the field type, and the field description. | table with three columns-- the field name, the field type, and the field description. |
# | Line 2819 | Line 4615 |
4615 | $htmlString .= "<li><b>Index $fullName</b>\n<ul>\n"; | $htmlString .= "<li><b>Index $fullName</b>\n<ul>\n"; |
4616 | # Add any note text. | # Add any note text. |
4617 | if (my $note = $indexData->{Notes}) { | if (my $note = $indexData->{Notes}) { |
4618 | $htmlString .= "<li>" . _HTMLNote($note->{content}) . "</li>\n"; | $htmlString .= "<li>" . HTMLNote($note->{content}) . "</li>\n"; |
4619 | } | } |
4620 | # Add the fiield list. | # Add the fiield list. |
4621 | $htmlString .= "<li><i>" . join(', ', @{$indexData->{IndexFields}}) . "</i></li>\n"; | $htmlString .= "<li><i>" . join(', ', @{$indexData->{IndexFields}}) . "</i></li>\n"; |
# | Line 2830 | Line 4626 |
4626 | $htmlString .= "</ul>\n"; | $htmlString .= "</ul>\n"; |
4627 | } | } |
4628 | ||
4629 | =head3 OpenFieldTable | =head3 _OpenFieldTable |
4630 | ||
4631 | This method creates the header string for the field table generated by L</ShowMetaData>. | This method creates the header string for the field table generated by L</ShowMetaData>. |
4632 | ||
# | Line 2855 | Line 4651 |
4651 | return _OpenTable($tablename, 'Field', 'Type', 'Description'); | return _OpenTable($tablename, 'Field', 'Type', 'Description'); |
4652 | } | } |
4653 | ||
4654 | =head3 OpenTable | =head3 _OpenTable |
4655 | ||
4656 | This method creates the header string for an HTML table. | This method creates the header string for an HTML table. |
4657 | ||
# | Line 2895 | Line 4691 |
4691 | return $htmlString; | return $htmlString; |
4692 | } | } |
4693 | ||
4694 | =head3 CloseTable | =head3 _CloseTable |
4695 | ||
4696 | This method returns the HTML for closing a table. | This method returns the HTML for closing a table. |
4697 | ||
# | Line 2907 | Line 4703 |
4703 | return "</table></p>\n"; | return "</table></p>\n"; |
4704 | } | } |
4705 | ||
4706 | =head3 ShowField | =head3 _ShowField |
4707 | ||
4708 | This method returns the HTML for displaying a row of field information in a field table. | This method returns the HTML for displaying a row of field information in a field table. |
4709 | ||
# | Line 2934 | Line 4730 |
4730 | my $htmlString = "<tr><th align=\"left\">$fieldData->{name}</th><td>$fieldData->{type}</td>"; | my $htmlString = "<tr><th align=\"left\">$fieldData->{name}</th><td>$fieldData->{type}</td>"; |
4731 | # If we have content, add it as a third column. | # If we have content, add it as a third column. |
4732 | if (exists $fieldData->{Notes}) { | if (exists $fieldData->{Notes}) { |
4733 | $htmlString .= "<td>" . _HTMLNote($fieldData->{Notes}->{content}) . "</td>"; | $htmlString .= "<td>" . HTMLNote($fieldData->{Notes}->{content}) . "</td>"; |
4734 | } | } |
4735 | # Close off the row. | # Close off the row. |
4736 | $htmlString .= "</tr>\n"; | $htmlString .= "</tr>\n"; |
# | Line 2942 | Line 4738 |
4738 | return $htmlString; | return $htmlString; |
4739 | } | } |
4740 | ||
=head3 HTMLNote | ||
Convert a note or comment to HTML by replacing some bulletin-board codes with HTML. The codes | ||
supported are C<[b]> for B<bold>, C<[i]> for I<italics>, and C<[p]> for a new paragraph. | ||
Except for C<[p]>, all the codes are closed by slash-codes. So, for | ||
example, C<[b]Feature[/b]> displays the string C<Feature> in boldface. | ||
This is a static method. | ||
=over 4 | ||
=item dataString | ||