Parent Directory
|
Revision Log
|
Patch
revision 1.48, Wed Jun 21 03:12:20 2006 UTC | revision 1.100, Tue Aug 12 06:07:06 2008 UTC | |
---|---|---|
# | Line 6 | Line 6 |
6 | use Data::Dumper; | use Data::Dumper; |
7 | use XML::Simple; | use XML::Simple; |
8 | use DBQuery; | use DBQuery; |
9 | use DBObject; | use ERDBObject; |
10 | use Stats; | use Stats; |
11 | use Time::HiRes qw(gettimeofday); | use Time::HiRes qw(gettimeofday); |
12 | use Digest::MD5 qw(md5_base64); | use Digest::MD5 qw(md5_base64); |
13 | use FIG; | use CGI; |
14 | use WikiTools; | |
15 | ||
16 | =head1 Entity-Relationship Database Package | =head1 Entity-Relationship Database Package |
17 | ||
# | Line 59 | 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 91 | 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 186 | 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 205 | 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 in an |
232 | be from the primary relation. The alternate indexes assist in ordering results | index must all be from the same relation. The alternate indexes assist in searching |
233 | from a query. A relationship can have up to two indexes-- a I<to-index> and a | on fields other than the entity ID. A relationship has at least two indexes-- a I<to-index> and a |
234 | I<from-index>. These order the results when crossing the relationship. For | I<from-index> that 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 |
236 | from-index would order the contigs of a ganome, and the to-index would order | from-index would order the contigs of a ganome, and the to-index would order |
237 | the genomes of a contig. A relationship's index must specify only fields in | the genomes of a contig. In addition, it can have zero or more alternate |
238 | indexes. A relationship's index must specify only fields in | |
239 | the relationship. | the relationship. |
240 | ||
241 | The indexes for an entity must be listed inside the B<Indexes> tag. The from-index | The alternate indexes for an entity or relationship must be listed inside the B<Indexes> tag. |
242 | of a relationship is specified using the B<FromIndex> tag; the to-index is specified | The from-index of a relationship is specified using the B<FromIndex> tag; the to-index is |
243 | using the B<ToIndex> tag. | specified using the B<ToIndex> tag. |
244 | ||
245 | Each index can contain a B<Notes> tag. In addition, it will have an B<IndexFields> | Each index can contain a B<Notes> tag. In addition, it will have an B<IndexFields> |
246 | tag containing the B<IndexField> tags. These specify, in order, the fields used in | tag containing the B<IndexField> tags. These specify, in order, the fields used in |
# | Line 238 | Line 258 |
258 | ||
259 | =back | =back |
260 | ||
261 | The B<Index>, B<FromIndex>, and B<ToIndex> tags themselves have no attributes. | The B<FromIndex>, and B<ToIndex> tags have no attributes. The B<Index> tag can |
262 | have a B<Unique> attribute. If specified, the index will be generated as a unique | |
263 | index. | |
264 | ||
265 | =head3 Object and Field Names | =head3 Object and Field Names |
266 | ||
# | Line 282 | Line 304 |
304 | ||
305 | A relationship is described by the C<Relationship> tag. Within a relationship, | A relationship is described by the C<Relationship> tag. Within a relationship, |
306 | there can be a C<Notes> tag, a C<Fields> tag containing the intersection data | there can be a C<Notes> tag, a C<Fields> tag containing the intersection data |
307 | fields, a C<FromIndex> tag containing the from-index, and a C<ToIndex> tag containing | fields, a C<FromIndex> tag containing the from-index, a C<ToIndex> tag containing |
308 | the to-index. | the to-index, and an C<Indexes> tag containing the alternate indexes. |
309 | ||
310 | The C<Relationship> tag has the following attributes. | The C<Relationship> tag has the following attributes. |
311 | ||
# | Line 316 | Line 338 |
338 | ||
339 | # 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. |
340 | # "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 |
341 | # 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 |
342 | # 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, |
343 | # record sizes. | # and "indexMod", if non-zero, is the number of characters to use when the field is specified in an |
344 | my %TypeTable = ( char => { sqlType => 'CHAR(1)', maxLen => 1, avgLen => 1, dataGen => "StringGen('A')" }, | # index |
345 | int => { sqlType => 'INTEGER', maxLen => 20, avgLen => 4, dataGen => "IntGen(0, 99999999)" }, | my %TypeTable = ( char => { sqlType => 'CHAR(1)', maxLen => 1, avgLen => 1, sort => "", |
346 | string => { sqlType => 'VARCHAR(255)', maxLen => 255, avgLen => 100, dataGen => "StringGen(IntGen(10,250))" }, | indexMod => 0, notes => "single ASCII character"}, |
347 | text => { sqlType => 'TEXT', maxLen => 1000000000, avgLen => 500, dataGen => "StringGen(IntGen(80,1000))" }, | int => { sqlType => 'INTEGER', maxLen => 20, avgLen => 4, sort => "n", |
348 | date => { sqlType => 'BIGINT', maxLen => 80, avgLen => 8, dataGen => "DateGen(-7, 7, IntGen(0,1400))" }, | indexMod => 0, notes => "signed 32-bit integer"}, |
349 | float => { sqlType => 'DOUBLE PRECISION', maxLen => 40, avgLen => 8, dataGen => "FloatGen(0.0, 100.0)" }, | counter => { sqlType => 'INTEGER UNSIGNED', maxLen => 20, avgLen => 4, sort => "n", |
350 | boolean => { sqlType => 'SMALLINT', maxLen => 1, avgLen => 1, dataGen => "IntGen(0, 1)" }, | indexMod => 0, notes => "unsigned 32-bit integer"}, |
351 | string => { sqlType => 'VARCHAR(255)', maxLen => 255, avgLen => 100, sort => "", | |
352 | indexMod => 0, notes => "character string, 0 to 255 characters"}, | |
353 | text => { sqlType => 'TEXT', maxLen => 1000000000, avgLen => 500, sort => "", | |
354 | indexMod => 255, notes => "character string, nearly unlimited length, only first 255 characters are indexed"}, | |
355 | date => { sqlType => 'BIGINT', maxLen => 80, avgLen => 8, sort => "n", | |
356 | indexMod => 0, notes => "signed, 64-bit integer"}, | |
357 | float => { sqlType => 'DOUBLE PRECISION', maxLen => 40, avgLen => 8, sort => "g", | |
358 | indexMod => 0, notes => "64-bit double precision floating-point number"}, | |
359 | boolean => { sqlType => 'SMALLINT', maxLen => 1, avgLen => 1, sort => "n", | |
360 | indexMod => 0, notes => "boolean value: 0 if false, 1 if true"}, | |
361 | 'hash-string' => | 'hash-string' => |
362 | { sqlType => 'VARCHAR(22)', maxLen => 22, avgLen => 22, dataGen => "SringGen(22)" }, | { sqlType => 'VARCHAR(22)', maxLen => 22, avgLen => 22, sort => "", |
363 | indexMod => 0, notes => "string stored in digested form, used for certain types of key fields"}, | |
364 | 'id-string' => | 'id-string' => |
365 | { sqlType => 'VARCHAR(25)', maxLen => 25, avgLen => 25, dataGen => "SringGen(22)" }, | { sqlType => 'VARCHAR(25)', maxLen => 25, avgLen => 25, sort => "", |
366 | indexMod => 0, notes => "character string, 0 to 25 characters"}, | |
367 | 'key-string' => | 'key-string' => |
368 | { sqlType => 'VARCHAR(40)', maxLen => 40, avgLen => 10, dataGen => "StringGen(IntGen(10,40))" }, | { sqlType => 'VARCHAR(40)', maxLen => 40, avgLen => 10, sort => "", |
369 | indexMod => 0, notes => "character string, 0 to 40 characters"}, | |
370 | 'name-string' => | 'name-string' => |
371 | { sqlType => 'VARCHAR(80)', maxLen => 80, avgLen => 40, dataGen => "StringGen(IntGen(10,80))" }, | { sqlType => 'VARCHAR(80)', maxLen => 80, avgLen => 40, sort => "", |
372 | indexMod => 0, notes => "character string, 0 to 80 characters"}, | |
373 | 'medium-string' => | 'medium-string' => |
374 | { sqlType => 'VARCHAR(160)', maxLen => 160, avgLen => 40, dataGen => "StringGen(IntGen(10,160))" }, | { sqlType => 'VARCHAR(160)', maxLen => 160, avgLen => 40, sort => "", |
375 | indexMod => 0, notes => "character string, 0 to 160 characters"}, | |
376 | 'long-string' => | |
377 | { sqlType => 'VARCHAR(500)', maxLen => 500, avglen => 255, sort => "", | |
378 | indexMod => 0, notes => "character string, 0 to 500 characters"}, | |
379 | ); | ); |
380 | ||
381 | # Table translating arities into natural language. | # Table translating arities into natural language. |
# | Line 344 | Line 384 |
384 | 'MM' => 'many-to-many' | 'MM' => 'many-to-many' |
385 | ); | ); |
386 | ||
387 | # Table for interpreting string patterns. | # Options for XML input and output. |
388 | ||
389 | my %XmlOptions = (GroupTags => { Relationships => 'Relationship', | |
390 | Entities => 'Entity', | |
391 | Fields => 'Field', | |
392 | Indexes => 'Index', | |
393 | IndexFields => 'IndexField', | |
394 | Issues => 'Issue', | |
395 | Shapes => 'Shape' | |
396 | }, | |
397 | KeyAttr => { Relationship => 'name', | |
398 | Entity => 'name', | |
399 | Field => 'name', | |
400 | Shape => 'name' | |
401 | }, | |
402 | SuppressEmpty => 1, | |
403 | ); | |
404 | ||
405 | my %PictureTable = ( 'A' => "abcdefghijklmnopqrstuvwxyz", | my %XmlInOpts = ( |
406 | '9' => "0123456789", | ForceArray => [qw(Field Index IndexField Relationship Entity Shape)], |
407 | 'X' => "abcdefghijklmnopqrstuvwxyz0123456789", | ForceContent => 1, |
408 | 'V' => "aeiou", | NormalizeSpace => 2, |
409 | 'K' => "bcdfghjklmnoprstvwxyz" | ); |
410 | my %XmlOutOpts = ( | |
411 | RootName => 'Database', | |
412 | XMLDecl => 1, | |
413 | ); | ); |
414 | ||
415 | =head2 Public Methods | =head2 Public Methods |
416 | ||
417 | =head3 new | =head3 new |
418 | ||
419 | C<< my $database = ERDB->new($dbh, $metaFileName); >> | my $database = ERDB->new($dbh, $metaFileName); |
420 | ||
421 | Create a new ERDB object. | Create a new ERDB object. |
422 | ||
# | Line 377 | Line 436 |
436 | ||
437 | sub new { | sub new { |
438 | # Get the parameters. | # Get the parameters. |
439 | my ($class, $dbh, $metaFileName, $options) = @_; | my ($class, $dbh, $metaFileName, %options) = @_; |
440 | # Load the meta-data. | # Load the meta-data. |
441 | my $metaData = _LoadMetaData($metaFileName); | my $metaData = _LoadMetaData($metaFileName); |
442 | # Create the object. | # Create the object. |
# | Line 391 | Line 450 |
450 | ||
451 | =head3 ShowMetaData | =head3 ShowMetaData |
452 | ||
453 | C<< $erdb->ShowMetaData($fileName); >> | $erdb->ShowMetaData($fileName); |
454 | ||
455 | This method outputs a description of the database. This description can be used to help users create | This method outputs a description of the database. This description can be used to help users create |
456 | the data to be loaded into the relations. | the data to be loaded into the relations. |
# | Line 432 | Line 491 |
491 | ||
492 | =head3 DisplayMetaData | =head3 DisplayMetaData |
493 | ||
494 | C<< my $html = $erdb->DisplayMetaData(); >> | my $html = $erdb->DisplayMetaData(); |
495 | ||
496 | Return an HTML description of the database. This description can be used to help users create | Return an HTML description of the database. This description can be used to help users create |
497 | the data to be loaded into the relations and form queries. The output is raw includable HTML | the data to be loaded into the relations and form queries. The output is raw includable HTML |
# | Line 493 | Line 552 |
552 | my $entityData = $entityList->{$key}; | my $entityData = $entityList->{$key}; |
553 | # If there's descriptive text, display it. | # If there's descriptive text, display it. |
554 | if (my $notes = $entityData->{Notes}) { | if (my $notes = $entityData->{Notes}) { |
555 | $retVal .= "<p>" . _HTMLNote($notes->{content}) . "</p>\n"; | $retVal .= "<p>" . HTMLNote($notes->{content}) . "</p>\n"; |
556 | } | } |
557 | # Now we want a list of the entity's relationships. First, we set up the relationship subsection. | # See if we need a list of the entity's relationships. |
558 | my $relCount = keys %{$relationshipList}; | |
559 | if ($relCount > 0) { | |
560 | # First, we set up the relationship subsection. | |
561 | $retVal .= "<h4>Relationships for <b>$key</b></h4>\n<ul>\n"; | $retVal .= "<h4>Relationships for <b>$key</b></h4>\n<ul>\n"; |
562 | # Loop through the relationships. | # Loop through the relationships. |
563 | for my $relationship (sort keys %{$relationshipList}) { | for my $relationship (sort keys %{$relationshipList}) { |
# | Line 511 | Line 573 |
573 | } | } |
574 | # Close off the relationship list. | # Close off the relationship list. |
575 | $retVal .= "</ul>\n"; | $retVal .= "</ul>\n"; |
576 | } | |
577 | # Get the entity's relations. | # Get the entity's relations. |
578 | my $relationList = $entityData->{Relations}; | my $relationList = $entityData->{Relations}; |
579 | # Create a header for the relation subsection. | # Create a header for the relation subsection. |
# | Line 550 | Line 613 |
613 | $retVal .= "</p>\n"; | $retVal .= "</p>\n"; |
614 | # If there are notes on this relationship, display them. | # If there are notes on this relationship, display them. |
615 | if (my $notes = $relationshipStructure->{Notes}) { | if (my $notes = $relationshipStructure->{Notes}) { |
616 | $retVal .= "<p>" . _HTMLNote($notes->{content}) . "</p>\n"; | $retVal .= "<p>" . HTMLNote($notes->{content}) . "</p>\n"; |
617 | } | } |
618 | # Generate the relationship's relation table. | # Generate the relationship's relation table. |
619 | my $htmlString = _ShowRelationTable($key, $relationshipStructure->{Relations}->{$key}); | my $htmlString = _ShowRelationTable($key, $relationshipStructure->{Relations}->{$key}); |
# | Line 584 | Line 647 |
647 | ||
648 | =head3 DumpMetaData | =head3 DumpMetaData |
649 | ||
650 | C<< $erdb->DumpMetaData(); >> | $erdb->DumpMetaData(); |
651 | ||
652 | Return a dump of the metadata structure. | Return a dump of the metadata structure. |
653 | ||
# | Line 597 | Line 660 |
660 | return Data::Dumper::Dumper($self->{_metaData}); | return Data::Dumper::Dumper($self->{_metaData}); |
661 | } | } |
662 | ||
663 | =head3 GenerateWikiData | |
664 | ||
665 | my @wikiLines = $erdb->GenerateWikiData(); | |
666 | ||
667 | Build a description of the database for the wiki. The database will be | |
668 | organized into a single page, with sections for each entity and relationship. | |
669 | The return value is a list of text lines. | |
670 | ||
671 | =cut | |
672 | ||
673 | sub GenerateWikiData { | |
674 | # Get the parameters. | |
675 | my ($self) = @_; | |
676 | # We'll build the wiki text in here. | |
677 | my @retVal = (); | |
678 | # Get the metadata object. | |
679 | my $metadata = $self->{_metaData}; | |
680 | # Get the title string. This will become the page name. | |
681 | my $title = $metadata->{Title}->{content}; | |
682 | # Get the entity and relationship lists. | |
683 | my $entityList = $metadata->{Entities}; | |
684 | my $relationshipList = $metadata->{Relationships}; | |
685 | my $shapeList = $metadata->{Shapes}; | |
686 | # Start with the introductory text. | |
687 | push @retVal, WikiTools::Heading(2, "Introduction"); | |
688 | if (my $notes = $metadata->{Notes}) { | |
689 | push @retVal, WikiNote($notes->{content}); | |
690 | } | |
691 | # Generate issue list. | |
692 | if (my $issues = $metadata->{Issues}) { | |
693 | push @retVal, WikiTools::Heading(3, 'Issues'); | |
694 | push @retVal, WikiTools::List(map { $_->{content} } @{$issues}); | |
695 | } | |
696 | # Start the entity section. | |
697 | push @retVal, WikiTools::Heading(2, "Entities"); | |
698 | # Loop through the entities. Note that unlike the situation with HTML, we | |
699 | # don't need to generate the table of contents manually, just the data | |
700 | # itself. | |
701 | for my $key (sort keys %$entityList) { | |
702 | # Create a header for this entity. | |
703 | push @retVal, "", WikiTools::Heading(3, $key); | |
704 | # Get the entity data. | |
705 | my $entityData = $entityList->{$key}; | |
706 | # Plant the notes here, if there are any. | |
707 | push @retVal, _ObjectNotes($entityData); | |
708 | # Now we list the entity's relationships (if any). First, we build a list | |
709 | # of the relationships relevant to this entity. | |
710 | my @rels = (); | |
711 | for my $rel (sort keys %$relationshipList) { | |
712 | my $relStructure = $relationshipList->{$rel}; | |
713 | if ($relStructure->{from} eq $key || $relStructure->{to} eq $key) { | |
714 | # Get the relationship sentence. | |
715 | my $relSentence = _ComputeRelationshipSentence($rel, $relStructure); | |
716 | # Linkify it. | |
717 | my $linkedRel = WikiTools::LinkMarkup("#$rel", $rel); | |
718 | $relSentence =~ s/$rel/$linkedRel/; | |
719 | push @rels, $relSentence; | |
720 | } | |
721 | } | |
722 | # Add the relationships as a Wiki list. | |
723 | push @retVal, WikiTools::List(@rels); | |
724 | # Get the entity's relations. | |
725 | my $relationList = $entityData->{Relations}; | |
726 | # Loop through the relations, displaying them. | |
727 | for my $relation (sort keys %{$relationList}) { | |
728 | my $wikiString = _WikiRelationTable($relation, $relationList->{$relation}); | |
729 | push @retVal, $wikiString; | |
730 | } | |
731 | } | |
732 | # Now the entities are documented. Next we do the relationships. | |
733 | push @retVal, WikiTools::Heading(2, "Relationships"); | |
734 | for my $key (sort keys %$relationshipList) { | |
735 | my $relationshipData = $relationshipList->{$key}; | |
736 | # Create the relationship heading. | |
737 | push @retVal, WikiTools::Heading(3, $key); | |
738 | # Describe the relationship arity. Note there's a bit of trickiness involving recursive | |
739 | # many-to-many relationships. In a normal many-to-many we use two sentences to describe | |
740 | # the arity (one for each direction). This is a bad idea for a recursive relationship, | |
741 | # since both sentences will say the same thing. | |
742 | my $arity = $relationshipData->{arity}; | |
743 | my $fromEntity = $relationshipData->{from}; | |
744 | my $toEntity = $relationshipData->{to}; | |
745 | my @listElements = (); | |
746 | my $boldCode = WikiTools::BoldCode(); | |
747 | if ($arity eq "11") { | |
748 | push @listElements, "Each $boldCode$fromEntity$boldCode relates to at most one $boldCode$toEntity$boldCode."; | |
749 | } else { | |
750 | push @listElements, "Each $boldCode$fromEntity$boldCode relates to multiple $boldCode${toEntity}s$boldCode."; | |
751 | if ($arity eq "MM" && $fromEntity ne $toEntity) { | |
752 | push @listElements, "Each $boldCode$toEntity$boldCode relates to multiple $boldCode${fromEntity}s$boldCode."; | |
753 | } | |
754 | } | |
755 | push @retVal, WikiTools::List(@listElements); | |
756 | # Plant the notes here, if there are any. | |
757 | push @retVal, _ObjectNotes($relationshipData); | |
758 | # Finally, the relationship table. | |
759 | my $wikiString = _WikiRelationTable($key, $relationshipData->{Relations}->{$key}); | |
760 | push @retVal, $wikiString; | |
761 | } | |
762 | # Now loop through the miscellaneous shapes. | |
763 | if ($shapeList) { | |
764 | push @retVal, WikiTools::Heading(2, "Miscellaneous"); | |
765 | for my $shape (sort keys %$shapeList) { | |
766 | push @retVal, WikiTools::Heading(3, $shape); | |
767 | my $shapeData = $shapeList->{$shape}; | |
768 | push @retVal, _ObjectNotes($shapeData); | |
769 | } | |
770 | } | |
771 | # All done. Return the lines. | |
772 | return @retVal; | |
773 | } | |
774 | ||
775 | ||
776 | =head3 CreatePPO | |
777 | ||
778 | ERDB::CreatePPO($erdbXMLFile, $ppoXMLFile); | |
779 | ||
780 | Create a PPO XML file from an ERDB data definition XML file. At the | |
781 | current time, the PPO XML file can be used to create a database with | |
782 | similar functionality. Eventually, the PPO will be able to use the | |
783 | created XML to access the live ERDB database. | |
784 | ||
785 | =over 4 | |
786 | ||
787 | =item erdbXMLFile | |
788 | ||
789 | Name of the XML data definition file for the ERDB database. This | |
790 | file must exist. | |
791 | ||
792 | =item ppoXMLFile | |
793 | ||
794 | Output file for the PPO XML definition. If this file exists, it | |
795 | will be overwritten. | |
796 | ||
797 | =back | |
798 | ||
799 | =cut | |
800 | ||
801 | sub CreatePPO { | |
802 | # Get the parameters. | |
803 | my ($erdbXMLFile, $ppoXMLFile) = @_; | |
804 | # First, we want to slurp in the ERDB XML file in its raw form. | |
805 | my $xml = ReadMetaXML($erdbXMLFile); | |
806 | # Create a variable to hold all of the objects in the PPO project. | |
807 | my @objects = (); | |
808 | # Get the relationship hash. | |
809 | my $relationships = $xml->{Relationships}; | |
810 | # Loop through the entities. | |
811 | my $entities = $xml->{Entities}; | |
812 | for my $entityName (keys %{$entities}) { | |
813 | # Get the entity's data structures. | |
814 | my $entityObject = $entities->{$entityName}; | |
815 | # We put the object's fields in here, according to their type. | |
816 | my (@object_refs, @scalars, @indexes, @arrays); | |
817 | # Create the ID field for the entity. We get the key type from the | |
818 | # entity object and compute the corresponding SQL type. | |
819 | my $type = $TypeTable{$entityObject->{keyType}}->{sqlType}; | |
820 | push @scalars, { label => 'id', type => $type }; | |
821 | # Loop through the entity fields. | |
822 | for my $fieldName ( keys %{$entityObject->{Fields}} ) { | |
823 | # Get the field object. | |
824 | my $fieldObject = $entityObject->{Fields}->{$fieldName}; | |
825 | # Convert it to a scalar tag. | |
826 | my $scalar = _CreatePPOField($fieldName, $fieldObject); | |
827 | # If we have a relation, this field is stored in an array. | |
828 | # otherwise, it is a scalar. The array tag has scalars | |
829 | # stored as an XML array. In ERDB, there is only ever one, | |
830 | # but PPO can have more. | |
831 | my $relation = $fieldObject->{relation}; | |
832 | if ($relation) { | |
833 | push @arrays, { scalar => [$scalar] }; | |
834 | } else { | |
835 | push @scalars, $scalar; | |
836 | } | |
837 | } | |
838 | # Loop through the relationships. If this entity is the to-entity | |
839 | # on a relationship of 1M arity, then it is implemented as a PPO | |
840 | # object reference. | |
841 | for my $relationshipName (keys %{$relationships}) { | |
842 | # Get the relationship data. | |
843 | my $relationshipData = $relationships->{$relationshipName}; | |
844 | # If we have a from for this entity and an arity of 1M, we | |
845 | # have an object reference. | |
846 | if ($relationshipData->{to} eq $entityName && | |
847 | $relationshipData->{arity} eq '1M') { | |
848 | # Build the object reference tag. | |
849 | push @object_refs, { label => $relationshipName, | |
850 | type => $relationshipData->{from} }; | |
851 | } | |
852 | } | |
853 | # Create the indexes. | |
854 | my $indexList = $entityObject->{Indexes}; | |
855 | push @indexes, map { _CreatePPOIndex($_) } @{$indexList}; | |
856 | # Build the object XML tree. | |
857 | my $object = { label => $entityName, | |
858 | object_ref => \@object_refs, | |
859 | scalar => \@scalars, | |
860 | index => \@indexes, | |
861 | array => \@arrays | |
862 | }; | |
863 | # Push the object onto the objects list. | |
864 | push @objects, $object; | |
865 | } | |
866 | # Loop through the relationships, searching for MMs. The 1Ms were | |
867 | # already handled by the entity search above. | |
868 | for my $relationshipName (keys %{$relationships}) { | |
869 | # Get this relationship's object. | |
870 | my $relationshipObject = $relationships->{$relationshipName}; | |
871 | # Only proceed if it's many-to-many. | |
872 | if ($relationshipObject->{arity} eq 'MM') { | |
873 | # Create the tag lists for the relationship object. | |
874 | my (@object_refs, @scalars, @indexes); | |
875 | # The relationship will be created as an object with object | |
876 | # references for its links to the participating entities. | |
877 | my %links = ( from_link => $relationshipObject->{from}, | |
878 | to_link => $relationshipObject->{to} ); | |
879 | for my $link (keys %links) { | |
880 | # Create an object_ref tag for this piece of the | |
881 | # relationship (from or to). | |
882 | my $object_ref = { label => $link, | |
883 | type => $links{$link} }; | |
884 | push @object_refs, $object_ref; | |
885 | } | |
886 | # Loop through the intersection data fields, creating scalar tags. | |
887 | # There are no fancy array tags in a relationship. | |
888 | for my $fieldName (keys %{$relationshipObject->{Fields}}) { | |
889 | my $fieldObject = $relationshipObject->{Fields}->{$fieldName}; | |
890 | push @scalars, _CreatePPOField($fieldName, $fieldObject); | |
891 | } | |
892 | # Finally, the indexes: currently we cannot support the to-index and | |
893 | # from-index in PPO, so we just process the alternate indexes. | |
894 | my $indexList = $relationshipObject->{Indexes}; | |
895 | push @indexes, map { _CreatePPOIndex($_) } @{$indexList}; | |
896 | # Wrap up all the stuff about this relationship. | |
897 | my $object = { label => $relationshipName, | |
898 | scalar => \@scalars, | |
899 | object_ref => \@object_refs, | |
900 | index => \@indexes | |
901 | }; | |
902 | # Push it into the object list. | |
903 | push @objects, $object; | |
904 | } | |
905 | } | |
906 | # Compute a title. | |
907 | my $title; | |
908 | if ($erdbXMLFile =~ /(\/|^)([^\/]+)DBD\.xml/) { | |
909 | # Here we have a standard file name we can use for a title. | |
910 | $title = $2; | |
911 | } else { | |
912 | # Here the file name is non-standard, so we carve up the | |
913 | # database title. | |
914 | $title = $xml->{Title}->{content}; | |
915 | $title =~ s/\s\.,//g; | |
916 | } | |
917 | # Wrap up the XML as a project. | |
918 | my $ppoXML = { project => { label => $title, | |
919 | object => \@objects }}; | |
920 | # Write out the results. | |
921 | my $ppoString = XML::Simple::XMLout($ppoXML, | |
922 | AttrIndent => 1, | |
923 | KeepRoot => 1); | |
924 | Tracer::PutFile($ppoXMLFile, [ $ppoString ]); | |
925 | } | |
926 | ||
927 | =head3 FindIndexForEntity | |
928 | ||
929 | my $indexFound = ERDB::FindIndexForEntity($xml, $entityName, $attributeName); | |
930 | ||
931 | This method locates the entry in an entity's index list that begins with the | |
932 | specified attribute name. If the entity has no index list, one will be | |
933 | created. This method works on raw XML, not a live ERDB object. | |
934 | ||
935 | =over 4 | |
936 | ||
937 | =item xml | |
938 | ||
939 | The raw XML structure defining the database. | |
940 | ||
941 | =item entityName | |
942 | ||
943 | The name of the relevant entity. | |
944 | ||
945 | =item attributeName | |
946 | ||
947 | The name of the attribute relevant to the search. | |
948 | ||
949 | =item RETURN | |
950 | ||
951 | The numerical index in the index list of the index entry for the specified entity and | |
952 | attribute, or C<undef> if no such index exists. | |
953 | ||
954 | =back | |
955 | ||
956 | =cut | |
957 | ||
958 | sub FindIndexForEntity { | |
959 | # Get the parameters. | |
960 | my ($xml, $entityName, $attributeName) = @_; | |
961 | # Declare the return variable. | |
962 | my $retVal; | |
963 | # Get the named entity. | |
964 | my $entityData = $xml->{Entities}->{$entityName}; | |
965 | if (! $entityData) { | |
966 | Confess("Entity $entityName not found in DBD structure."); | |
967 | } else { | |
968 | # Insure it has an index list. | |
969 | if (! exists $entityData->{Indexes}) { | |
970 | $entityData->{Indexes} = []; | |
971 | } else { | |
972 | # Search for the desired index. | |
973 | my $indexList = $entityData->{Indexes}; | |
974 | my $n = scalar @{$indexList}; | |
975 | Trace("Searching $n indexes in index list for $entityName.") if T(2); | |
976 | # We use an indexed FOR here because we're returning an | |
977 | # index number instead of an object. We do THAT so we can | |
978 | # delete the index from the list if needed. | |
979 | for (my $i = 0; $i < $n && !defined($retVal); $i++) { | |
980 | my $index = $indexList->[$i]; | |
981 | my $fields = $index->{IndexFields}; | |
982 | # Technically this IF should be safe (that is, we are guaranteed | |
983 | # the existence of a "$fields->[0]"), because when we load the XML | |
984 | # we have SuppressEmpty specified. | |
985 | if ($fields->[0]->{name} eq $attributeName) { | |
986 | $retVal = $i; | |
987 | } | |
988 | } | |
989 | } | |
990 | } | |
991 | Trace("Index for $attributeName of $entityName found at position $retVal.") if defined($retVal) && T(3); | |
992 | Trace("Index for $attributeName not found in $entityName.") if !defined($retVal) && T(3); | |
993 | # Return the result. | |
994 | return $retVal; | |
995 | } | |
996 | ||
997 | =head3 CreateTables | =head3 CreateTables |
998 | ||
999 | C<< $erdb->CreateTables(); >> | $erdb->CreateTables(); |
1000 | ||
1001 | This method creates the tables for the database from the metadata structure loaded by the | This method creates the tables for the database from the metadata structure loaded by the |
1002 | constructor. It is expected this function will only be used on rare occasions, when the | constructor. It is expected this function will only be used on rare occasions, when the |
# | Line 616 | Line 1013 |
1013 | # Loop through the relations. | # Loop through the relations. |
1014 | for my $relationName (@relNames) { | for my $relationName (@relNames) { |
1015 | # Create a table for this relation. | # Create a table for this relation. |
1016 | $self->CreateTable($relationName); | $self->CreateTable($relationName, 1); |
1017 | Trace("Relation $relationName created.") if T(2); | Trace("Relation $relationName created.") if T(2); |
1018 | } | } |
1019 | } | } |
1020 | ||
1021 | =head3 CreateTable | =head3 CreateTable |
1022 | ||
1023 | C<< $erdb->CreateTable($tableName, $indexFlag, $estimatedRows); >> | $erdb->CreateTable($tableName, $indexFlag, $estimatedRows); |
1024 | ||
1025 | Create the table for a relation and optionally create its indexes. | Create the table for a relation and optionally create its indexes. |
1026 | ||
# | Line 665 | Line 1062 |
1062 | # Push the result into the field list. | # Push the result into the field list. |
1063 | push @fieldList, $fieldString; | push @fieldList, $fieldString; |
1064 | } | } |
# If this is a root table, add the "new_record" flag. It defaults to 0, so | ||
if ($rootFlag) { | ||
push @fieldList, "new_record $TypeTable{boolean}->{sqlType} NOT NULL DEFAULT 0"; | ||
} | ||
1065 | # Convert the field list into a comma-delimited string. | # Convert the field list into a comma-delimited string. |
1066 | my $fieldThing = join(', ', @fieldList); | my $fieldThing = join(', ', @fieldList); |
1067 | # Insure the table is not already there. | # Insure the table is not already there. |
# | Line 679 | Line 1072 |
1072 | my $estimation = undef; | my $estimation = undef; |
1073 | if ($estimatedRows) { | if ($estimatedRows) { |
1074 | $estimation = [$self->EstimateRowSize($relationName), $estimatedRows]; | $estimation = [$self->EstimateRowSize($relationName), $estimatedRows]; |
1075 | Trace("$estimation->[1] rows of $estimation->[0] bytes each.") if T(3); | |
1076 | } | } |
1077 | # Create the table. | # Create the table. |
1078 | Trace("Creating table $relationName: $fieldThing") if T(2); | Trace("Creating table $relationName: $fieldThing") if T(2); |
1079 | $dbh->create_table(tbl => $relationName, flds => $fieldThing, estimates => $estimation); | $dbh->create_table(tbl => $relationName, flds => $fieldThing, estimates => $estimation); |
1080 | Trace("Relation $relationName created in database.") if T(2); | Trace("Relation $relationName created in database.") if T(2); |
1081 | # 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 |
1082 | # index will not be built until the table has been loaded. | |
1083 | if ($indexFlag) { | if ($indexFlag) { |
1084 | $self->CreateIndex($relationName); | $self->CreateIndex($relationName); |
1085 | } | } |
# | Line 692 | Line 1087 |
1087 | ||
1088 | =head3 VerifyFields | =head3 VerifyFields |
1089 | ||
1090 | C<< my $count = $erdb->VerifyFields($relName, \@fieldList); >> | my $count = $erdb->VerifyFields($relName, \@fieldList); |
1091 | ||
1092 | Run through the list of proposed field values, insuring that all the character fields are | Run through the list of proposed field values, insuring that all the character fields are |
1093 | below the maximum length. If any fields are too long, they will be truncated in place. | below the maximum length. If any fields are too long, they will be truncated in place. |
# | Line 735 | Line 1130 |
1130 | my $oldString = $fieldList->[$i]; | my $oldString = $fieldList->[$i]; |
1131 | if (length($oldString) > $maxLen) { | if (length($oldString) > $maxLen) { |
1132 | # Here it's too big, so we truncate it. | # Here it's too big, so we truncate it. |
1133 | Trace("Truncating field $i in relation $relName to $maxLen characters from \"$oldString\".") if T(1); | Trace("Truncating field $i ($fieldTypes->[$i]->{name}) in relation $relName to $maxLen characters from \"$oldString\".") if T(1); |
1134 | $fieldList->[$i] = substr $oldString, 0, $maxLen; | $fieldList->[$i] = substr $oldString, 0, $maxLen; |
1135 | $retVal++; | $retVal++; |
1136 | } | } |
# | Line 747 | Line 1142 |
1142 | ||
1143 | =head3 DigestFields | =head3 DigestFields |
1144 | ||
1145 | C<< $erdb->DigestFields($relName, $fieldList); >> | $erdb->DigestFields($relName, $fieldList); |
1146 | ||
1147 | Digest the strings in the field list that correspond to data type C<hash-string> in the | Digest the strings in the field list that correspond to data type C<hash-string> in the |
1148 | specified relation. | specified relation. |
# | Line 787 | Line 1182 |
1182 | ||
1183 | =head3 DigestKey | =head3 DigestKey |
1184 | ||
1185 | C<< my $digested = $erdb->DigestKey($keyValue); >> | my $digested = $erdb->DigestKey($keyValue); |
1186 | ||
1187 | Return the digested value of a symbolic key. The digested value can then be plugged into a | Return the digested value of a symbolic key. The digested value can then be plugged into a |
1188 | key-based search into a table with key-type hash-string. | key-based search into a table with key-type hash-string. |
# | Line 820 | Line 1215 |
1215 | ||
1216 | =head3 CreateIndex | =head3 CreateIndex |
1217 | ||
1218 | C<< $erdb->CreateIndex($relationName); >> | $erdb->CreateIndex($relationName); |
1219 | ||
1220 | Create the indexes for a relation. If a table is being loaded from a large source file (as | Create the indexes for a relation. If a table is being loaded from a large source file (as |
1221 | is the case in L</LoadTable>), it is sometimes best to create the indexes after the load. | is the case in L</LoadTable>), it is sometimes best to create the indexes after the load. |
# | Line 841 | Line 1236 |
1236 | for my $indexName (keys %{$indexHash}) { | for my $indexName (keys %{$indexHash}) { |
1237 | my $indexData = $indexHash->{$indexName}; | my $indexData = $indexHash->{$indexName}; |
1238 | # Get the index's field list. | # Get the index's field list. |
1239 | my @fieldList = _FixNames(@{$indexData->{IndexFields}}); | my @rawFields = @{$indexData->{IndexFields}}; |
1240 | # Get a hash of the relation's field types. | |
1241 | my %types = map { $_->{name} => $_->{type} } @{$relationData->{Fields}}; | |
1242 | # We need to check for text fields so we can append a length limitation for them. To do | |
1243 | # that, we need the relation's field list. | |
1244 | my $relFields = $relationData->{Fields}; | |
1245 | for (my $i = 0; $i <= $#rawFields; $i++) { | |
1246 | # Get the field type. | |
1247 | my $field = $rawFields[$i]; | |
1248 | my $type = $types{$field}; | |
1249 | # Ask if it requires using prefix notation for the index. | |
1250 | my $mod = $TypeTable{$type}->{indexMod}; | |
1251 | Trace("Field $field ($i) in $relationName has type $type and indexMod $mod.") if T(3); | |
1252 | if ($mod) { | |
1253 | # Append the prefix length to the field name, | |
1254 | $rawFields[$i] .= "($mod)"; | |
1255 | } | |
1256 | } | |
1257 | my @fieldList = _FixNames(@rawFields); | |
1258 | my $flds = join(', ', @fieldList); | my $flds = join(', ', @fieldList); |
1259 | # Get the index's uniqueness flag. | # Get the index's uniqueness flag. |
1260 | my $unique = (exists $indexData->{Unique} ? $indexData->{Unique} : 'false'); | my $unique = (exists $indexData->{Unique} ? 'unique' : undef); |
1261 | # Create the index. | # Create the index. |
1262 | my $rv = $dbh->create_index(idx => $indexName, tbl => $relationName, | my $rv = $dbh->create_index(idx => $indexName, tbl => $relationName, |
1263 | flds => $flds, unique => $unique); | flds => $flds, kind => $unique); |
1264 | if ($rv) { | if ($rv) { |
1265 | Trace("Index created: $indexName for $relationName ($flds)") if T(1); | Trace("Index created: $indexName for $relationName ($flds)") if T(1); |
1266 | } else { | } else { |
# | Line 856 | Line 1269 |
1269 | } | } |
1270 | } | } |
1271 | ||
1272 | =head3 GetSecondaryFields | |
1273 | ||
1274 | my %fieldTuples = $erdb->GetSecondaryFields($entityName); | |
1275 | ||
1276 | This method will return a list of the name and type of each of the secondary | |
1277 | fields for a specified entity. Secondary fields are stored in two-column tables | |
1278 | in addition to the primary entity table. This enables the field to have no value | |
1279 | or to have multiple values. | |
1280 | ||
1281 | =over 4 | |
1282 | ||
1283 | =item entityName | |
1284 | ||
1285 | Name of the entity whose secondary fields are desired. | |
1286 | ||
1287 | =item RETURN | |
1288 | ||
1289 | Returns a hash mapping the field names to their field types. | |
1290 | ||
1291 | =back | |
1292 | ||
1293 | =cut | |
1294 | ||
1295 | sub GetSecondaryFields { | |
1296 | # Get the parameters. | |
1297 | my ($self, $entityName) = @_; | |
1298 | # Declare the return variable. | |
1299 | my %retVal = (); | |
1300 | # Look for the entity. | |
1301 | my $table = $self->GetFieldTable($entityName); | |
1302 | # Loop through the fields, pulling out the secondaries. | |
1303 | for my $field (sort keys %{$table}) { | |
1304 | if ($table->{$field}->{relation} ne $entityName) { | |
1305 | # Here we have a secondary field. | |
1306 | $retVal{$field} = $table->{$field}->{type}; | |
1307 | } | |
1308 | } | |
1309 | # Return the result. | |
1310 | return %retVal; | |
1311 | } | |
1312 | ||
1313 | =head3 GetFieldRelationName | |
1314 | ||
1315 | my $name = $erdb->GetFieldRelationName($objectName, $fieldName); | |
1316 | ||
1317 | Return the name of the relation containing a specified field. | |
1318 | ||
1319 | =over 4 | |
1320 | ||
1321 | =item objectName | |
1322 | ||
1323 | Name of the entity or relationship containing the field. | |
1324 | ||
1325 | =item fieldName | |
1326 | ||
1327 | Name of the relevant field in that entity or relationship. | |
1328 | ||
1329 | =item RETURN | |
1330 | ||
1331 | Returns the name of the database relation containing the field, or C<undef> if | |
1332 | the field does not exist. | |
1333 | ||
1334 | =back | |
1335 | ||
1336 | =cut | |
1337 | ||
1338 | sub GetFieldRelationName { | |
1339 | # Get the parameters. | |
1340 | my ($self, $objectName, $fieldName) = @_; | |
1341 | # Declare the return variable. | |
1342 | my $retVal; | |
1343 | # Get the object field table. | |
1344 | my $table = $self->GetFieldTable($objectName); | |
1345 | # Only proceed if the field exists. | |
1346 | if (exists $table->{$fieldName}) { | |
1347 | # Determine the name of the relation that contains this field. | |
1348 | $retVal = $table->{$fieldName}->{relation}; | |
1349 | } | |
1350 | # Return the result. | |
1351 | return $retVal; | |
1352 | } | |
1353 | ||
1354 | =head3 DeleteValue | |
1355 | ||
1356 | my $numDeleted = $erdb->DeleteValue($entityName, $id, $fieldName, $fieldValue); | |
1357 | ||
1358 | Delete secondary field values from the database. This method can be used to delete all | |
1359 | values of a specified field for a particular entity instance, or only a single value. | |
1360 | ||
1361 | Secondary fields are stored in two-column relations separate from an entity's primary | |
1362 | table, and as a result a secondary field can legitimately have no value or multiple | |
1363 | values. Therefore, it makes sense to talk about deleting secondary fields where it | |
1364 | would not make sense for primary fields. | |
1365 | ||
1366 | =over 4 | |
1367 | ||
1368 | =item entityName | |
1369 | ||
1370 | Name of the entity from which the fields are to be deleted. | |
1371 | ||
1372 | =item id | |
1373 | ||
1374 | ID of the entity instance to be processed. If the instance is not found, this | |
1375 | method will have no effect. If C<undef> is specified, all values for all of | |
1376 | the entity instances will be deleted. | |
1377 | ||
1378 | =item fieldName | |
1379 | ||
1380 | Name of the field whose values are to be deleted. | |
1381 | ||
1382 | =item fieldValue (optional) | |
1383 | ||
1384 | Value to be deleted. If not specified, then all values of the specified field | |
1385 | will be deleted for the entity instance. If specified, then only the values which | |
1386 | match this parameter will be deleted. | |
1387 | ||
1388 | =item RETURN | |
1389 | ||
1390 | Returns the number of rows deleted. | |
1391 | ||
1392 | =back | |
1393 | ||
1394 | =cut | |
1395 | ||
1396 | sub DeleteValue { | |
1397 | # Get the parameters. | |
1398 | my ($self, $entityName, $id, $fieldName, $fieldValue) = @_; | |
1399 | # Declare the return value. | |
1400 | my $retVal = 0; | |
1401 | # We need to set up an SQL command to do the deletion. First, we | |
1402 | # find the name of the field's relation. | |
1403 | my $table = $self->GetFieldTable($entityName); | |
1404 | my $field = $table->{$fieldName}; | |
1405 | my $relation = $field->{relation}; | |
1406 | # Make sure this is a secondary field. | |
1407 | if ($relation eq $entityName) { | |
1408 | Confess("Cannot delete values of $fieldName for $entityName."); | |
1409 | } else { | |
1410 | # Set up the SQL command to delete all values. | |
1411 | my $sql = "DELETE FROM $relation"; | |
1412 | # Build the filter. | |
1413 | my @filters = (); | |
1414 | my @parms = (); | |
1415 | # Check for a filter by ID. | |
1416 | if (defined $id) { | |
1417 | push @filters, "id = ?"; | |
1418 | push @parms, $id; | |
1419 | } | |
1420 | # Check for a filter by value. | |
1421 | if (defined $fieldValue) { | |
1422 | push @filters, "$fieldName = ?"; | |
1423 | push @parms, $fieldValue; | |
1424 | } | |
1425 | # Append the filters to the command. | |
1426 | if (@filters) { | |
1427 | $sql .= " WHERE " . join(" AND ", @filters); | |
1428 | } | |
1429 | # Execute the command. | |
1430 | my $dbh = $self->{_dbh}; | |
1431 | $retVal = $dbh->SQL($sql, 0, @parms); | |
1432 | } | |
1433 | # Return the result. | |
1434 | return $retVal; | |
1435 | } | |
1436 | ||
1437 | =head3 LoadTables | =head3 LoadTables |
1438 | ||
1439 | C<< my $stats = $erdb->LoadTables($directoryName, $rebuild); >> | my $stats = $erdb->LoadTables($directoryName, $rebuild); |
1440 | ||
1441 | This method will load the database tables from a directory. The tables must already have been created | This method will load the database tables from a directory. The tables must already have been created |
1442 | in the database. (This can be done by calling L</CreateTables>.) The caller passes in a directory name; | in the database. (This can be done by calling L</CreateTables>.) The caller passes in a directory name; |
# | Line 918 | Line 1496 |
1496 | ||
1497 | =head3 GetTableNames | =head3 GetTableNames |
1498 | ||
1499 | C<< my @names = $erdb->GetTableNames; >> | my @names = $erdb->GetTableNames; |
1500 | ||
1501 | Return a list of the relations required to implement this database. | Return a list of the relations required to implement this database. |
1502 | ||
# | Line 935 | Line 1513 |
1513 | ||
1514 | =head3 GetEntityTypes | =head3 GetEntityTypes |
1515 | ||
1516 | C<< my @names = $erdb->GetEntityTypes; >> | my @names = $erdb->GetEntityTypes; |
1517 | ||
1518 | Return a list of the entity type names. | Return a list of the entity type names. |
1519 | ||
# | Line 950 | Line 1528 |
1528 | return sort keys %{$entityList}; | return sort keys %{$entityList}; |
1529 | } | } |
1530 | ||
1531 | =head3 GetConnectingRelationships | |
1532 | ||
1533 | my @list = $erdb->GetConnectingRelationships($entityName); | |
1534 | ||
1535 | Return a list of the relationships connected to the specified entity. | |
1536 | ||
1537 | =over 4 | |
1538 | ||
1539 | =item entityName | |
1540 | ||
1541 | Entity whose connected relationships are desired. | |
1542 | ||
1543 | =item RETURN | |
1544 | ||
1545 | Returns a list of the relationships that originate from the entity. | |
1546 | If the entity is on the from end, it will return the relationship | |
1547 | name. If the entity is on the to end it will return the converse of | |
1548 | the relationship name. | |
1549 | ||
1550 | =back | |
1551 | ||
1552 | =cut | |
1553 | ||
1554 | sub GetConnectingRelationships { | |
1555 | # Get the parameters. | |
1556 | my ($self, $entityName) = @_; | |
1557 | # Declare the return variable. | |
1558 | my @retVal; | |
1559 | # Get the relationship list. | |
1560 | my $relationships = $self->{_metaData}->{Relationships}; | |
1561 | # Find the entity. | |
1562 | my $entity = $self->{_metaData}->{Entities}->{$entityName}; | |
1563 | # Only proceed if the entity exists. | |
1564 | if (! defined $entity) { | |
1565 | Trace("Entity $entityName not found.") if T(3); | |
1566 | } else { | |
1567 | # Loop through the relationships. | |
1568 | my @rels = keys %$relationships; | |
1569 | Trace(scalar(@rels) . " relationships found in connection search.") if T(3); | |
1570 | for my $relationshipName (@rels) { | |
1571 | my $relationship = $relationships->{$relationshipName}; | |
1572 | if ($relationship->{from} eq $entityName) { | |
1573 | # Here we have a forward relationship. | |
1574 | push @retVal, $relationshipName; | |
1575 | } elsif ($relationship->{to} eq $entityName) { | |
1576 | # Here we have a backward relationship. In this case, the | |
1577 | # converse relationship name is preferred if it exists. | |
1578 | my $converse = $relationship->{converse} || $relationshipName; | |
1579 | push @retVal, $converse; | |
1580 | } | |
1581 | } | |
1582 | } | |
1583 | # Return the result. | |
1584 | return @retVal; | |
1585 | } | |
1586 | ||
1587 | ||
1588 | ||
1589 | ||
1590 | =head3 GetDataTypes | |
1591 | ||
1592 | my %types = ERDB::GetDataTypes(); | |
1593 | ||
1594 | Return a table of ERDB data types. The table returned is a hash of hashes. | |
1595 | The keys of the big hash are the datatypes. Each smaller hash has several | |
1596 | values used to manage the data. The most interesting is the SQL type (key | |
1597 | C<sqlType>) and the descriptive node (key C<notes>). | |
1598 | ||
1599 | Note that changing the values in the smaller hashes will seriously break | |
1600 | things, so this data should be treated as read-only. | |
1601 | ||
1602 | =cut | |
1603 | ||
1604 | sub GetDataTypes { | |
1605 | return %TypeTable; | |
1606 | } | |
1607 | ||
1608 | ||
1609 | =head3 IsEntity | =head3 IsEntity |
1610 | ||
1611 | C<< my $flag = $erdb->IsEntity($entityName); >> | my $flag = $erdb->IsEntity($entityName); |
1612 | ||
1613 | Return TRUE if the parameter is an entity name, else FALSE. | Return TRUE if the parameter is an entity name, else FALSE. |
1614 | ||
# | Line 979 | Line 1635 |
1635 | ||
1636 | =head3 Get | =head3 Get |
1637 | ||
1638 | C<< my $query = $erdb->Get(\@objectNames, $filterClause, \@params); >> | my $query = $erdb->Get(\@objectNames, $filterClause, \@params); |
1639 | ||
1640 | 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. |
1641 | 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 987 | Line 1643 |
1643 | 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 |
1644 | $genus. | $genus. |
1645 | ||
1646 | C<< $query = $erdb->Get(['Genome'], "Genome(genus) = ?", [$genus]); >> | $query = $erdb->Get(['Genome'], "Genome(genus) = ?", [$genus]); |
1647 | ||
1648 | 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 |
1649 | parameter representing the parameter value. It would also be possible to code | parameter representing the parameter value. It would also be possible to code |
1650 | ||
1651 | C<< $query = $erdb->Get(['Genome'], "Genome(genus) = \'$genus\'"); >> | $query = $erdb->Get(['Genome'], "Genome(genus) = \'$genus\'"); |
1652 | ||
1653 | however, this version of the call would generate a syntax error if there were any quote | however, this version of the call would generate a syntax error if there were any quote |
1654 | characters inside the variable C<$genus>. | characters inside the variable C<$genus>. |
# | Line 1004 | Line 1660 |
1660 | 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 |
1661 | 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, |
1662 | ||
1663 | C<< $query = $erdb->Get(['Genome', 'ComesFrom', 'Source'], "Genome(genus) = ?", [$genus]); >> | $query = $erdb->Get(['Genome', 'ComesFrom', 'Source'], "Genome(genus) = ?", [$genus]); |
1664 | ||
1665 | 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 |
1666 | join path between the entities and relationships. The algorithm used is very simplistic. | join path between the entities and relationships. The algorithm used is very simplistic. |
# | Line 1040 | Line 1696 |
1696 | with an ORDER BY clause. For example, the following filter string gets all genomes for a | with an ORDER BY clause. For example, the following filter string gets all genomes for a |
1697 | particular genus and sorts them by species name. | particular genus and sorts them by species name. |
1698 | ||
1699 | C<< "Genome(genus) = ? ORDER BY Genome(species)" >> | "Genome(genus) = ? ORDER BY Genome(species)" |
1700 | ||
1701 | Note that the case is important. Only an uppercase "ORDER BY" with a single space will | Note that the case is important. Only an uppercase "ORDER BY" with a single space will |
1702 | be processed. The idea is to make it less likely to find the verb by accident. | be processed. The idea is to make it less likely to find the verb by accident. |
# | Line 1053 | Line 1709 |
1709 | be the last thing in the filter clause, and it contains only the word "LIMIT" followed by | be the last thing in the filter clause, and it contains only the word "LIMIT" followed by |
1710 | a positive number. So, for example | a positive number. So, for example |
1711 | ||
1712 | C<< "Genome(genus) = ? ORDER BY Genome(species) LIMIT 10" >> | "Genome(genus) = ? ORDER BY Genome(species) LIMIT 10" |
1713 | ||
1714 | will only return the first ten genomes for the specified genus. The ORDER BY clause is not | will only return the first ten genomes for the specified genus. The ORDER BY clause is not |
1715 | required. For example, to just get the first 10 genomes in the B<Genome> table, you could | required. For example, to just get the first 10 genomes in the B<Genome> table, you could |
1716 | use | use |
1717 | ||
1718 | C<< "LIMIT 10" >> | "LIMIT 10" |
1719 | ||
1720 | =item params | =item params |
1721 | ||
# | Line 1080 | Line 1736 |
1736 | my ($suffix, $mappedNameListRef, $mappedNameHashRef) = | my ($suffix, $mappedNameListRef, $mappedNameHashRef) = |
1737 | $self->_SetupSQL($objectNames, $filterClause); | $self->_SetupSQL($objectNames, $filterClause); |
1738 | # Create the query. | # Create the query. |
1739 | my $command = "SELECT DISTINCT " . join(".*, ", @{$mappedNameListRef}) . | my $command = "SELECT " . join(".*, ", @{$mappedNameListRef}) . |
1740 | ".* $suffix"; | ".* $suffix"; |
1741 | my $sth = $self->_GetStatementHandle($command, $params); | my $sth = $self->_GetStatementHandle($command, $params); |
1742 | # Now we create the relation map, which enables DBQuery to determine the order, name | # Now we create the relation map, which enables DBQuery to determine the order, name |
# | Line 1094 | Line 1750 |
1750 | return $retVal; | return $retVal; |
1751 | } | } |
1752 | ||
=head3 GetFlat | ||
1753 | ||
C<< my @list = $erdb->GetFlat(\@objectNames, $filterClause, \@parameterList, $field); >> | ||
1754 | ||
1755 | This is a variation of L</GetAll> that asks for only a single field per record and | =head3 Search |
1756 | returns a single flattened list. | |
1757 | my $query = $erdb->Search($searchExpression, $idx, \@objectNames, $filterClause, \@params); | |
1758 | ||
1759 | Perform a full text search with filtering. The search will be against a specified object | |
1760 | in the object name list. That object will get an extra field containing the search | |
1761 | relevance. Note that except for the search expression, the parameters of this method are | |
1762 | the same as those for L</Get> and follow the same rules. | |
1763 | ||
1764 | =over 4 | |
1765 | ||
1766 | =item searchExpression | |
1767 | ||
1768 | Boolean search expression for the text fields of the target object. The default mode for | |
1769 | a Boolean search expression is OR, but we want the default to be AND, so we will | |
1770 | add a C<+> operator to each word with no other operator before it. | |
1771 | ||
1772 | =item idx | |
1773 | ||
1774 | Index in the I<$objectNames> list of the table to be searched in full-text mode. | |
1775 | ||
1776 | =item objectNames | |
1777 | ||
1778 | List containing the names of the entity and relationship objects to be retrieved. | |
1779 | ||
1780 | =item filterClause | |
1781 | ||
1782 | WHERE clause (without the WHERE) to be used to filter and sort the query. The WHERE clause can | |
1783 | be parameterized with parameter markers (C<?>). Each field used in the WHERE clause must be | |
1784 | specified in the standard form B<I<objectName>(I<fieldName>)>. Any parameters specified | |
1785 | in the filter clause should be added to the parameter list as additional parameters. The | |
1786 | fields in a filter clause can come from primary entity relations, relationship relations, | |
1787 | or secondary entity relations; however, all of the entities and relationships involved must | |
1788 | be included in the list of object names. | |
1789 | ||
1790 | =item params | |
1791 | ||
1792 | Reference to a list of parameter values to be substituted into the filter clause. | |
1793 | ||
1794 | =item RETURN | |
1795 | ||
1796 | Returns a query object for the specified search. | |
1797 | ||
1798 | =back | |
1799 | ||
1800 | =cut | |
1801 | ||
1802 | sub Search { | |
1803 | # Get the parameters. | |
1804 | my ($self, $searchExpression, $idx, $objectNames, $filterClause, $params) = @_; | |
1805 | # Declare the return variable. | |
1806 | my $retVal; | |
1807 | # Create a safety copy of the parameter list. Note we have to be careful to insure | |
1808 | # a parameter list exists before we copy it. | |
1809 | my @myParams = (); | |
1810 | if (defined $params) { | |
1811 | @myParams = @{$params}; | |
1812 | } | |
1813 | # Get the first object's structure so we have access to the searchable fields. | |
1814 | my $object1Name = $objectNames->[$idx]; | |
1815 | my $object1Structure = $self->_GetStructure($object1Name); | |
1816 | # Get the field list. | |
1817 | if (! exists $object1Structure->{searchFields}) { | |
1818 | Confess("No searchable index for $object1Name."); | |
1819 | } else { | |
1820 | # Get the field list. | |
1821 | my @fields = @{$object1Structure->{searchFields}}; | |
1822 | # Clean the search expression. | |
1823 | my $actualKeywords = $self->CleanKeywords($searchExpression); | |
1824 | # Prefix a "+" to each uncontrolled word. This converts the default | |
1825 | # search mode from OR to AND. | |
1826 | $actualKeywords =~ s/(^|\s)(\w|")/$1\+$2/g; | |
1827 | Trace("Actual keywords for search are\n$actualKeywords") if T(3); | |
1828 | # We need two match expressions, one for the filter clause and one in the | |
1829 | # query itself. Both will use a parameter mark, so we need to push the | |
1830 | # search expression onto the front of the parameter list twice. | |
1831 | unshift @myParams, $actualKeywords, $actualKeywords; | |
1832 | # Build the match expression. | |
1833 | my @matchFilterFields = map { "$object1Name." . _FixName($_) } @fields; | |
1834 | my $matchClause = "MATCH (" . join(", ", @matchFilterFields) . ") AGAINST (? IN BOOLEAN MODE)"; | |
1835 | # Process the SQL stuff. | |
1836 | my ($suffix, $mappedNameListRef, $mappedNameHashRef) = | |
1837 | $self->_SetupSQL($objectNames, $filterClause, $matchClause); | |
1838 | # Create the query. Note that the match clause is inserted at the front of | |
1839 | # the select fields. | |
1840 | my $command = "SELECT $matchClause, " . join(".*, ", @{$mappedNameListRef}) . | |
1841 | ".* $suffix"; | |
1842 | my $sth = $self->_GetStatementHandle($command, \@myParams); | |
1843 | # Now we create the relation map, which enables DBQuery to determine the order, name | |
1844 | # and mapped name for each object in the query. | |
1845 | my @relationMap = _RelationMap($mappedNameHashRef, $mappedNameListRef); | |
1846 | # Return the statement object. | |
1847 | $retVal = DBQuery::_new($self, $sth, \@relationMap, $object1Name); | |
1848 | } | |
1849 | return $retVal; | |
1850 | } | |
1851 | ||
1852 | =head3 GetFlat | |
1853 | ||
1854 | my @list = $erdb->GetFlat(\@objectNames, $filterClause, \@parameterList, $field); | |
1855 | ||
1856 | This is a variation of L</GetAll> that asks for only a single field per record and | |
1857 | returns a single flattened list. | |
1858 | ||
1859 | =over 4 | =over 4 |
1860 | ||
# | Line 1147 | Line 1902 |
1902 | return @retVal; | return @retVal; |
1903 | } | } |
1904 | ||
1905 | =head3 SpecialFields | |
1906 | ||
1907 | my %specials = $erdb->SpecialFields($entityName); | |
1908 | ||
1909 | Return a hash mapping special fields in the specified entity to the value of their | |
1910 | C<special> attribute. This enables the subclass to get access to the special field | |
1911 | attributes without needed to plumb the internal ERDB data structures. | |
1912 | ||
1913 | =over 4 | |
1914 | ||
1915 | =item entityName | |
1916 | ||
1917 | Name of the entity whose special fields are desired. | |
1918 | ||
1919 | =item RETURN | |
1920 | ||
1921 | Returns a hash. The keys of the hash are the special field names, and the values | |
1922 | are the values from each special field's C<special> attribute. | |
1923 | ||
1924 | =back | |
1925 | ||
1926 | =cut | |
1927 | ||
1928 | sub SpecialFields { | |
1929 | # Get the parameters. | |
1930 | my ($self, $entityName) = @_; | |
1931 | # Declare the return variable. | |
1932 | my %retVal = (); | |
1933 | # Find the entity's data structure. | |
1934 | my $entityData = $self->{_metaData}->{Entities}->{$entityName}; | |
1935 | # Loop through its fields, adding each special field to the return hash. | |
1936 | my $fieldHash = $entityData->{Fields}; | |
1937 | for my $fieldName (keys %{$fieldHash}) { | |
1938 | my $fieldData = $fieldHash->{$fieldName}; | |
1939 | if (exists $fieldData->{special}) { | |
1940 | $retVal{$fieldName} = $fieldData->{special}; | |
1941 | } | |
1942 | } | |
1943 | # Return the result. | |
1944 | return %retVal; | |
1945 | } | |
1946 | ||
1947 | =head3 Delete | =head3 Delete |
1948 | ||
1949 | C<< my $stats = $erdb->Delete($entityName, $objectID); >> | my $stats = $erdb->Delete($entityName, $objectID, %options); |
1950 | ||
1951 | Delete an entity instance from the database. The instance is deleted along with all entity and | Delete an entity instance from the database. The instance is deleted along with all entity and |
1952 | relationship instances dependent on it. The idea of dependence here is recursive. An object is | relationship instances dependent on it. The definition of I<dependence> is recursive. |
1953 | always dependent on itself. An object is dependent if it is a 1-to-many or many-to-many | |
1954 | relationship connected to a dependent entity or the "to" entity connected to a 1-to-many | An object is always dependent on itself. An object is dependent if it is a 1-to-many or many-to-many |
1955 | relationship connected to a dependent entity or if it is the "to" entity connected to a 1-to-many | |
1956 | dependent relationship. | dependent relationship. |
1957 | ||
1958 | =over 4 | =over 4 |
# | Line 1168 | Line 1966 |
1966 | ID of the entity instance to be deleted. If the ID contains a wild card character (C<%>), | ID of the entity instance to be deleted. If the ID contains a wild card character (C<%>), |
1967 | then it is presumed to by a LIKE pattern. | then it is presumed to by a LIKE pattern. |
1968 | ||
1969 | =item testFlag | =item options |
1970 | ||
1971 | If TRUE, the delete statements will be traced without being executed. | A hash detailing the options for this delete operation. |
1972 | ||
1973 | =item RETURN | =item RETURN |
1974 | ||
# | Line 1179 | Line 1977 |
1977 | ||
1978 | =back | =back |
1979 | ||
1980 | The permissible options for this method are as follows. | |
1981 | ||
1982 | =over 4 | |
1983 | ||
1984 | =item testMode | |
1985 | ||
1986 | If TRUE, then the delete statements will be traced, but no changes will be made to the database. | |
1987 | ||
1988 | =item keepRoot | |
1989 | ||
1990 | If TRUE, then the entity instances will not be deleted, only the dependent records. | |
1991 | ||
1992 | =back | |
1993 | ||
1994 | =cut | =cut |
1995 | #: Return Type $%; | #: Return Type $%; |
1996 | sub Delete { | sub Delete { |
1997 | # Get the parameters. | # Get the parameters. |
1998 | my ($self, $entityName, $objectID, $testFlag) = @_; | my ($self, $entityName, $objectID, %options) = @_; |
1999 | # Declare the return variable. | # Declare the return variable. |
2000 | my $retVal = Stats->new(); | my $retVal = Stats->new(); |
2001 | # Get the DBKernel object. | # Get the DBKernel object. |
# | Line 1200 | Line 2012 |
2012 | # FROM-relationships and entities. | # FROM-relationships and entities. |
2013 | my @fromPathList = (); | my @fromPathList = (); |
2014 | my @toPathList = (); | my @toPathList = (); |
2015 | # This final hash is used to remember what work still needs to be done. We push paths | # This final list is used to remember what work still needs to be done. We push paths |
2016 | # onto the list, then pop them off to extend the paths. We prime it with the starting | # onto the list, then pop them off to extend the paths. We prime it with the starting |
2017 | # point. Note that we will work hard to insure that the last item on a path in the | # point. Note that we will work hard to insure that the last item on a path in the |
2018 | # TODO list is always an entity. | # to-do list is always an entity. |
2019 | my @todoList = ([$entityName]); | my @todoList = ([$entityName]); |
2020 | while (@todoList) { | while (@todoList) { |
2021 | # Get the current path. | # Get the current path. |
# | Line 1211 | Line 2023 |
2023 | # Copy it into a list. | # Copy it into a list. |
2024 | my @stackedPath = @{$current}; | my @stackedPath = @{$current}; |
2025 | # Pull off the last item on the path. It will always be an entity. | # Pull off the last item on the path. It will always be an entity. |
2026 | my $entityName = pop @stackedPath; | my $myEntityName = pop @stackedPath; |
2027 | # Add it to the alreadyFound list. | # Add it to the alreadyFound list. |
2028 | $alreadyFound{$entityName} = 1; | $alreadyFound{$myEntityName} = 1; |
2029 | # Figure out if we need to delete this entity. | |
2030 | if ($myEntityName ne $entityName || ! $options{keepRoot}) { | |
2031 | # Get the entity data. | # Get the entity data. |
2032 | my $entityData = $self->_GetStructure($entityName); | my $entityData = $self->_GetStructure($myEntityName); |
2033 | # The first task is to loop through the entity's relation. A DELETE command will | # Loop through the entity's relations. A DELETE command will be needed for each of them. |
# be needed for each of them. | ||
2034 | my $relations = $entityData->{Relations}; | my $relations = $entityData->{Relations}; |
2035 | for my $relation (keys %{$relations}) { | for my $relation (keys %{$relations}) { |
2036 | my @augmentedList = (@stackedPath, $relation); | my @augmentedList = (@stackedPath, $relation); |
2037 | push @fromPathList, \@augmentedList; | push @fromPathList, \@augmentedList; |
2038 | } | } |
2039 | } | |
2040 | # Now we need to look for relationships connected to this entity. | # Now we need to look for relationships connected to this entity. |
2041 | my $relationshipList = $self->{_metaData}->{Relationships}; | my $relationshipList = $self->{_metaData}->{Relationships}; |
2042 | for my $relationshipName (keys %{$relationshipList}) { | for my $relationshipName (keys %{$relationshipList}) { |
2043 | my $relationship = $relationshipList->{$relationshipName}; | my $relationship = $relationshipList->{$relationshipName}; |
2044 | # Check the FROM field. We're only interested if it's us. | # Check the FROM field. We're only interested if it's us. |
2045 | if ($relationship->{from} eq $entityName) { | if ($relationship->{from} eq $myEntityName) { |
2046 | # Add the path to this relationship. | # Add the path to this relationship. |
2047 | my @augmentedList = (@stackedPath, $entityName, $relationshipName); | my @augmentedList = (@stackedPath, $myEntityName, $relationshipName); |
2048 | push @fromPathList, \@augmentedList; | push @fromPathList, \@augmentedList; |
2049 | # Check the arity. If it's MM we're done. If it's 1M | # Check the arity. If it's MM we're done. If it's 1M |
2050 | # and the target hasn't been seen yet, we want to | # and the target hasn't been seen yet, we want to |
# | Line 1249 | Line 2063 |
2063 | } | } |
2064 | # Now check the TO field. In this case only the relationship needs | # Now check the TO field. In this case only the relationship needs |
2065 | # deletion. | # deletion. |
2066 | if ($relationship->{to} eq $entityName) { | if ($relationship->{to} eq $myEntityName) { |
2067 | my @augmentedList = (@stackedPath, $entityName, $relationshipName); | my @augmentedList = (@stackedPath, $myEntityName, $relationshipName); |
2068 | push @toPathList, \@augmentedList; | push @toPathList, \@augmentedList; |
2069 | } | } |
2070 | } | } |
2071 | } | } |
2072 | # Create the first qualifier for the WHERE clause. This selects the | # Create the first qualifier for the WHERE clause. This selects the |
2073 | # keys of the primary entity records to be deleted. When we're deleting | # keys of the primary entity records to be deleted. When we're deleting |
2074 | # from a dependent table, we construct a join page from the first qualifier | # from a dependent table, we construct a join path from the first qualifier |
2075 | # to the table containing the dependent records to delete. | # to the table containing the dependent records to delete. |
2076 | my $qualifier = ($objectID =~ /%/ ? "LIKE ?" : "= ?"); | my $qualifier = ($objectID =~ /%/ ? "LIKE ?" : "= ?"); |
2077 | # We need to make two passes. The first is through the to-list, and | # We need to make two passes. The first is through the to-list, and |
# | Line 1296 | Line 2110 |
2110 | } | } |
2111 | } | } |
2112 | # Now we have our desired DELETE statement. | # Now we have our desired DELETE statement. |
2113 | if ($testFlag) { | if ($options{testMode}) { |
2114 | # Here the user wants to trace without executing. | # Here the user wants to trace without executing. |
2115 | Trace($stmt) if T(0); | Trace($stmt) if T(0); |
2116 | } else { | } else { |
2117 | # Here we can delete. Note that the SQL method dies with a confessing | # Here we can delete. Note that the SQL method dies with a confession |
2118 | # if an error occurs, so we just go ahead and do it. | # if an error occurs, so we just go ahead and do it. |
2119 | Trace("Executing delete from $target using '$objectID'.") if T(3); | Trace("Executing delete from $target using '$objectID'.") if T(3); |
2120 | my $rv = $db->SQL($stmt, 0, $objectID); | my $rv = $db->SQL($stmt, 0, $objectID); |
# | Line 1315 | Line 2129 |
2129 | return $retVal; | return $retVal; |
2130 | } | } |
2131 | ||
2132 | =head3 Disconnect | |
2133 | ||
2134 | $erdb->Disconnect($relationshipName, $originEntityName, $originEntityID); | |
2135 | ||
2136 | Disconnect an entity instance from all the objects to which it is related. This | |
2137 | will delete each relationship instance that connects to the specified entity. | |
2138 | ||
2139 | =over 4 | |
2140 | ||
2141 | =item relationshipName | |
2142 | ||
2143 | Name of the relationship whose instances are to be deleted. | |
2144 | ||
2145 | =item originEntityName | |
2146 | ||
2147 | Name of the entity that is to be disconnected. | |
2148 | ||
2149 | =item originEntityID | |
2150 | ||
2151 | ID of the entity that is to be disconnected. | |
2152 | ||
2153 | =back | |
2154 | ||
2155 | =cut | |
2156 | ||
2157 | sub Disconnect { | |
2158 | # Get the parameters. | |
2159 | my ($self, $relationshipName, $originEntityName, $originEntityID) = @_; | |
2160 | # Get the relationship descriptor. | |
2161 | my $structure = $self->_GetStructure($relationshipName); | |
2162 | # Insure we have a relationship. | |
2163 | if (! exists $structure->{from}) { | |
2164 | Confess("$relationshipName is not a relationship in the database."); | |
2165 | } else { | |
2166 | # Get the database handle. | |
2167 | my $dbh = $self->{_dbh}; | |
2168 | # We'll set this value to 1 if we find our entity. | |
2169 | my $found = 0; | |
2170 | # Loop through the ends of the relationship. | |
2171 | for my $dir ('from', 'to') { | |
2172 | if ($structure->{$dir} eq $originEntityName) { | |
2173 | $found = 1; | |
2174 | # Here we want to delete all relationship instances on this side of the | |
2175 | # entity instance. | |
2176 | Trace("Disconnecting in $dir direction with ID \"$originEntityID\"."); | |
2177 | # We do this delete in batches to keep it from dragging down the | |
2178 | # server. | |
2179 | my $limitClause = ($FIG_Config::delete_limit ? "LIMIT $FIG_Config::delete_limit" : ""); | |
2180 | my $done = 0; | |
2181 | while (! $done) { | |
2182 | # Do the delete. | |
2183 | my $rows = $dbh->SQL("DELETE FROM $relationshipName WHERE ${dir}_link = ? $limitClause", 0, $originEntityID); | |
2184 | # See if we're done. We're done if no rows were found or the delete is unlimited. | |
2185 | $done = ($rows == 0 || ! $limitClause); | |
2186 | } | |
2187 | } | |
2188 | } | |
2189 | # Insure we found the entity on at least one end. | |
2190 | if (! $found) { | |
2191 | Confess("Entity \"$originEntityName\" does not use $relationshipName."); | |
2192 | } | |
2193 | } | |
2194 | } | |
2195 | ||
2196 | =head3 DeleteRow | |
2197 | ||
2198 | $erdb->DeleteRow($relationshipName, $fromLink, $toLink, \%values); | |
2199 | ||
2200 | Delete a row from a relationship. In most cases, only the from-link and to-link are | |
2201 | needed; however, for relationships with intersection data values can be specified | |
2202 | for the other fields using a hash. | |
2203 | ||
2204 | =over 4 | |
2205 | ||
2206 | =item relationshipName | |
2207 | ||
2208 | Name of the relationship from which the row is to be deleted. | |
2209 | ||
2210 | =item fromLink | |
2211 | ||
2212 | ID of the entity instance in the From direction. | |
2213 | ||
2214 | =item toLink | |
2215 | ||
2216 | ID of the entity instance in the To direction. | |
2217 | ||
2218 | =item values | |
2219 | ||
2220 | Reference to a hash of other values to be used for filtering the delete. | |
2221 | ||
2222 | =back | |
2223 | ||
2224 | =cut | |
2225 | ||
2226 | sub DeleteRow { | |
2227 | # Get the parameters. | |
2228 | my ($self, $relationshipName, $fromLink, $toLink, $values) = @_; | |
2229 | # Create a hash of all the filter information. | |
2230 | my %filter = ('from-link' => $fromLink, 'to-link' => $toLink); | |
2231 | if (defined $values) { | |
2232 | for my $key (keys %{$values}) { | |
2233 | $filter{$key} = $values->{$key}; | |
2234 | } | |
2235 | } | |
2236 | # Build an SQL statement out of the hash. | |
2237 | my @filters = (); | |
2238 | my @parms = (); | |
2239 | for my $key (keys %filter) { | |
2240 | push @filters, _FixName($key) . " = ?"; | |
2241 | push @parms, $filter{$key}; | |
2242 | } | |
2243 | Trace("Parms for delete row are " . join(", ", map { "\"$_\"" } @parms) . ".") if T(SQL => 4); | |
2244 | my $command = "DELETE FROM $relationshipName WHERE " . | |
2245 | join(" AND ", @filters); | |
2246 | # Execute it. | |
2247 | my $dbh = $self->{_dbh}; | |
2248 | $dbh->SQL($command, undef, @parms); | |
2249 | } | |
2250 | ||
2251 | =head3 DeleteLike | |
2252 | ||
2253 | my $deleteCount = $erdb->DeleteLike($relName, $filter, \@parms); | |
2254 | ||
2255 | Delete all the relationship rows that satisfy a particular filter condition. Unlike a normal | |
2256 | filter, only fields from the relationship itself can be used. | |
2257 | ||
2258 | =over 4 | |
2259 | ||
2260 | =item relName | |
2261 | ||
2262 | Name of the relationship whose records are to be deleted. | |
2263 | ||
2264 | =item filter | |
2265 | ||
2266 | A filter clause (L</Get>-style) for the delete query. | |
2267 | ||
2268 | =item parms | |
2269 | ||
2270 | Reference to a list of parameters for the filter clause. | |
2271 | ||
2272 | =item RETURN | |
2273 | ||
2274 | Returns a count of the number of rows deleted. | |
2275 | ||
2276 | =back | |
2277 | ||
2278 | =cut | |
2279 | ||
2280 | sub DeleteLike { | |
2281 | # Get the parameters. | |
2282 | my ($self, $objectName, $filter, $parms) = @_; | |
2283 | # Declare the return variable. | |
2284 | my $retVal; | |
2285 | # Insure the parms argument is an array reference if the caller left it off. | |
2286 | if (! defined($parms)) { | |
2287 | $parms = []; | |
2288 | } | |
2289 | # Insure we have a relationship. The main reason for this is if we delete an entity | |
2290 | # instance we have to yank out a bunch of other stuff with it. | |
2291 | if ($self->IsEntity($objectName)) { | |
2292 | Confess("Cannot use DeleteLike on $objectName, because it is not a relationship."); | |
2293 | } else { | |
2294 | # Create the SQL command suffix to get the desierd records. | |
2295 | my ($suffix) = $self->_SetupSQL([$objectName], $filter); | |
2296 | # Convert it to a DELETE command. | |
2297 | my $command = "DELETE $suffix"; | |
2298 | # Execute the command. | |
2299 | my $dbh = $self->{_dbh}; | |
2300 | my $result = $dbh->SQL($command, 0, @{$parms}); | |
2301 | # Check the results. Note we convert the "0D0" result to a real zero. | |
2302 | # A failure causes an abnormal termination, so the caller isn't going to | |
2303 | # worry about it. | |
2304 | if (! defined $result) { | |
2305 | Confess("Error deleting from $objectName: " . $dbh->errstr()); | |
2306 | } elsif ($result == 0) { | |
2307 | $retVal = 0; | |
2308 | } else { | |
2309 | $retVal = $result; | |
2310 | } | |
2311 | } | |
2312 | # Return the result count. | |
2313 | return $retVal; | |
2314 | } | |
2315 | ||
2316 | =head3 SortNeeded | |
2317 | ||
2318 | my $parms = $erdb->SortNeeded($relationName); | |
2319 | ||
2320 | Return the pipe command for the sort that should be applied to the specified | |
2321 | relation when creating the load file. | |
2322 | ||
2323 | For example, if the load file should be sorted ascending by the first | |
2324 | field, this method would return | |
2325 | ||
2326 | sort -k1 -t"\t" | |
2327 | ||
2328 | If the first field is numeric, the method would return | |
2329 | ||
2330 | sort -k1n -t"\t" | |
2331 | ||
2332 | Unfortunately, due to a bug in the C<sort> command, we cannot eliminate duplicate | |
2333 | keys using a sort. | |
2334 | ||
2335 | =over 4 | |
2336 | ||
2337 | =item relationName | |
2338 | ||
2339 | Name of the relation to be examined. | |
2340 | ||
2341 | =item | |
2342 | ||
2343 | Returns the sort command to use for sorting the relation, suitable for piping. | |
2344 | ||
2345 | =back | |
2346 | ||
2347 | =cut | |
2348 | #: Return Type $; | |
2349 | sub SortNeeded { | |
2350 | # Get the parameters. | |
2351 | my ($self, $relationName) = @_; | |
2352 | # Declare a descriptor to hold the names of the key fields. | |
2353 | my @keyNames = (); | |
2354 | # Get the relation structure. | |
2355 | my $relationData = $self->_FindRelation($relationName); | |
2356 | # Find out if the relation is a primary entity relation, | |
2357 | # a relationship relation, or a secondary entity relation. | |
2358 | my $entityTable = $self->{_metaData}->{Entities}; | |
2359 | my $relationshipTable = $self->{_metaData}->{Relationships}; | |
2360 | if (exists $entityTable->{$relationName}) { | |
2361 | # Here we have a primary entity relation. | |
2362 | push @keyNames, "id"; | |
2363 | } elsif (exists $relationshipTable->{$relationName}) { | |
2364 | # Here we have a relationship. We sort using the FROM index. | |
2365 | my $relationshipData = $relationshipTable->{$relationName}; | |
2366 | my $index = $relationData->{Indexes}->{idxFrom}; | |
2367 | push @keyNames, @{$index->{IndexFields}}; | |
2368 | } else { | |
2369 | # Here we have a secondary entity relation, so we have a sort on the ID field. | |
2370 | push @keyNames, "id"; | |
2371 | } | |
2372 | # Now we parse the key names into sort parameters. First, we prime the return | |
2373 | # string. | |
2374 | my $retVal = "sort -T\"$FIG_Config::temp\" -t\"\t\" "; | |
2375 | # Get the relation's field list. | |
2376 | my @fields = @{$relationData->{Fields}}; | |
2377 | # Loop through the keys. | |
2378 | for my $keyData (@keyNames) { | |
2379 | # Get the key and the ordering. | |
2380 | my ($keyName, $ordering); | |
2381 | if ($keyData =~ /^([^ ]+) DESC/) { | |
2382 | ($keyName, $ordering) = ($1, "descending"); | |
2383 | } else { | |
2384 | ($keyName, $ordering) = ($keyData, "ascending"); | |
2385 | } | |
2386 | # Find the key's position and type. | |
2387 | my $fieldSpec; | |
2388 | for (my $i = 0; $i <= $#fields && ! $fieldSpec; $i++) { | |
2389 | my $thisField = $fields[$i]; | |
2390 | if ($thisField->{name} eq $keyName) { | |
2391 | # Get the sort modifier for this field type. The modifier | |
2392 | # decides whether we're using a character, numeric, or | |
2393 | # floating-point sort. | |
2394 | my $modifier = $TypeTable{$thisField->{type}}->{sort}; | |
2395 | # If the index is descending for this field, denote we want | |
2396 | # to reverse the sort order on this field. | |
2397 | if ($ordering eq 'descending') { | |
2398 | $modifier .= "r"; | |
2399 | } | |
2400 | # Store the position and modifier into the field spec, which | |
2401 | # will stop the inner loop. Note that the field number is | |
2402 | # 1-based in the sort command, so we have to increment the | |
2403 | # index. | |
2404 | my $realI = $i + 1; | |
2405 | $fieldSpec = "$realI,$realI$modifier"; | |
2406 | } | |
2407 | } | |
2408 | # Add this field to the sort command. | |
2409 | $retVal .= " -k$fieldSpec"; | |
2410 | } | |
2411 | # Return the result. | |
2412 | return $retVal; | |
2413 | } | |
2414 | ||
2415 | =head3 GetList | =head3 GetList |
2416 | ||
2417 | C<< my @dbObjects = $erdb->GetList(\@objectNames, $filterClause, \@params); >> | my @dbObjects = $erdb->GetList(\@objectNames, $filterClause, \@params); |
2418 | ||
2419 | Return a list of object descriptors for the specified objects as determined by the | Return a list of object descriptors for the specified objects as determined by the |
2420 | specified filter clause. | specified filter clause. |
# | Line 1345 | Line 2442 |
2442 | with an ORDER BY clause. For example, the following filter string gets all genomes for a | with an ORDER BY clause. For example, the following filter string gets all genomes for a |
2443 | particular genus and sorts them by species name. | particular genus and sorts them by species name. |
2444 | ||
2445 | C<< "Genome(genus) = ? ORDER BY Genome(species)" >> | "Genome(genus) = ? ORDER BY Genome(species)" |
2446 | ||
2447 | 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 |
2448 | 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 |
# | Line 1357 | Line 2454 |
2454 | ||
2455 | =item RETURN | =item RETURN |
2456 | ||
2457 | Returns a list of B<DBObject>s that satisfy the query conditions. | Returns a list of B<ERDBObject>s that satisfy the query conditions. |
2458 | ||
2459 | =back | =back |
2460 | ||
# | Line 1380 | Line 2477 |
2477 | ||
2478 | =head3 GetCount | =head3 GetCount |
2479 | ||
2480 | C<< my $count = $erdb->GetCount(\@objectNames, $filter, \@params); >> | my $count = $erdb->GetCount(\@objectNames, $filter, \@params); |
2481 | ||
2482 | Return the number of rows found by a specified query. This method would | Return the number of rows found by a specified query. This method would |
2483 | normally be used to count the records in a single table. For example, in a | normally be used to count the records in a single table. For example, in a |
# | Line 1431 | Line 2528 |
2528 | sub GetCount { | sub GetCount { |
2529 | # Get the parameters. | # Get the parameters. |
2530 | my ($self, $objectNames, $filter, $params) = @_; | my ($self, $objectNames, $filter, $params) = @_; |
2531 | # Insure the params argument is an array reference if the caller left it off. | |
2532 | if (! defined($params)) { | |
2533 | $params = []; | |
2534 | } | |
2535 | # Declare the return variable. | # Declare the return variable. |
2536 | my $retVal; | my $retVal; |
2537 | # Find out if we're counting an entity or a relationship. | # Find out if we're counting an entity or a relationship. |
# | Line 1469 | Line 2570 |
2570 | ||
2571 | =head3 ComputeObjectSentence | =head3 ComputeObjectSentence |
2572 | ||
2573 | C<< my $sentence = $erdb->ComputeObjectSentence($objectName); >> | my $sentence = $erdb->ComputeObjectSentence($objectName); |
2574 | ||
2575 | Check an object name, and if it is a relationship convert it to a relationship sentence. | Check an object name, and if it is a relationship convert it to a relationship sentence. |
2576 | ||
# | Line 1504 | Line 2605 |
2605 | ||
2606 | =head3 DumpRelations | =head3 DumpRelations |
2607 | ||
2608 | C<< $erdb->DumpRelations($outputDirectory); >> | $erdb->DumpRelations($outputDirectory); |
2609 | ||
2610 | Write the contents of all the relations to tab-delimited files in the specified directory. | Write the contents of all the relations to tab-delimited files in the specified directory. |
2611 | Each file will have the same name as the relation dumped, with an extension of DTX. | Each file will have the same name as the relation dumped, with an extension of DTX. |
# | Line 1544 | Line 2645 |
2645 | } | } |
2646 | } | } |
2647 | ||
2648 | =head3 InsertValue | |
2649 | ||
2650 | $erdb->InsertValue($entityID, $fieldName, $value); | |
2651 | ||
2652 | This method will insert a new value into the database. The value must be one | |
2653 | associated with a secondary relation, since primary values cannot be inserted: | |
2654 | they occur exactly once. Secondary values, on the other hand, can be missing | |
2655 | or multiply-occurring. | |
2656 | ||
2657 | =over 4 | |
2658 | ||
2659 | =item entityID | |
2660 | ||
2661 | ID of the object that is to receive the new value. | |
2662 | ||
2663 | =item fieldName | |
2664 | ||
2665 | Field name for the new value-- this includes the entity name, since | |
2666 | field names are of the format I<objectName>C<(>I<fieldName>C<)>. | |
2667 | ||
2668 | =item value | |
2669 | ||
2670 | New value to be put in the field. | |
2671 | ||
2672 | =back | |
2673 | ||
2674 | =cut | |
2675 | ||
2676 | sub InsertValue { | |
2677 | # Get the parameters. | |
2678 | my ($self, $entityID, $fieldName, $value) = @_; | |
2679 | # Parse the entity name and the real field name. | |
2680 | if ($fieldName =~ /^([^(]+)\(([^)]+)\)/) { | |
2681 | my $entityName = $1; | |
2682 | my $fieldTitle = $2; | |
2683 | # Get its descriptor. | |
2684 | if (!$self->IsEntity($entityName)) { | |
2685 | Confess("$entityName is not a valid entity."); | |
2686 | } else { | |
2687 | my $entityData = $self->{_metaData}->{Entities}->{$entityName}; | |
2688 | # Find the relation containing this field. | |
2689 | my $fieldHash = $entityData->{Fields}; | |
2690 | if (! exists $fieldHash->{$fieldTitle}) { | |
2691 | Confess("$fieldTitle not found in $entityName."); | |
2692 | } else { | |
2693 | my $relation = $fieldHash->{$fieldTitle}->{relation}; | |
2694 | if ($relation eq $entityName) { | |
2695 | Confess("Cannot do InsertValue on primary field $fieldTitle of $entityName."); | |
2696 | } else { | |
2697 | # Now we can create an INSERT statement. | |
2698 | my $dbh = $self->{_dbh}; | |
2699 | my $fixedName = _FixName($fieldTitle); | |
2700 | my $statement = "INSERT INTO $relation (id, $fixedName) VALUES(?, ?)"; | |
2701 | # Execute the command. | |
2702 | $dbh->SQL($statement, 0, $entityID, $value); | |
2703 | } | |
2704 | } | |
2705 | } | |
2706 | } else { | |
2707 | Confess("$fieldName is not a valid field name."); | |
2708 | } | |
2709 | } | |
2710 | ||
2711 | =head3 InsertObject | =head3 InsertObject |
2712 | ||
2713 | C<< my $ok = $erdb->InsertObject($objectType, \%fieldHash); >> | $erdb->InsertObject($objectType, \%fieldHash); |
2714 | ||
2715 | Insert an object into the database. The object is defined by a type name and then a hash | Insert an object into the database. The object is defined by a type name and then a hash |
2716 | of field names to values. Field values in the primary relation are represented by scalars. | of field names to values. Field values in the primary relation are represented by scalars. |
# | Line 1555 | Line 2719 |
2719 | example, the following line inserts an inactive PEG feature named C<fig|188.1.peg.1> with aliases | example, the following line inserts an inactive PEG feature named C<fig|188.1.peg.1> with aliases |
2720 | C<ZP_00210270.1> and C<gi|46206278>. | C<ZP_00210270.1> and C<gi|46206278>. |
2721 | ||
2722 | C<< $erdb->InsertObject('Feature', { id => 'fig|188.1.peg.1', active => 0, feature-type => 'peg', alias => ['ZP_00210270.1', 'gi|46206278']}); >> | $erdb->InsertObject('Feature', { id => 'fig|188.1.peg.1', active => 0, feature-type => 'peg', alias => ['ZP_00210270.1', 'gi|46206278']}); |
2723 | ||
2724 | The next statement inserts a C<HasProperty> relationship between feature C<fig|158879.1.peg.1> and | The next statement inserts a C<HasProperty> relationship between feature C<fig|158879.1.peg.1> and |
2725 | property C<4> with an evidence URL of C<http://seedu.uchicago.edu/query.cgi?article_id=142>. | property C<4> with an evidence URL of C<http://seedu.uchicago.edu/query.cgi?article_id=142>. |
2726 | ||
2727 | C<< $erdb->InsertObject('HasProperty', { 'from-link' => 'fig|158879.1.peg.1', 'to-link' => 4, evidence = 'http://seedu.uchicago.edu/query.cgi?article_id=142'}); >> | $erdb->InsertObject('HasProperty', { 'from-link' => 'fig|158879.1.peg.1', 'to-link' => 4, evidence => 'http://seedu.uchicago.edu/query.cgi?article_id=142'}); |
2728 | ||
2729 | =over 4 | =over 4 |
2730 | ||
# | Line 1572 | Line 2736 |
2736 | ||
2737 | Hash of field names to values. | Hash of field names to values. |
2738 | ||
=item RETURN | ||
Returns 1 if successful, 0 if an error occurred. | ||
2739 | =back | =back |
2740 | ||
2741 | =cut | =cut |
# | Line 1633 | Line 2793 |
2793 | push @missing, $fieldName; | push @missing, $fieldName; |
2794 | } | } |
2795 | } | } |
# If we are the primary relation, add the new-record flag. | ||
if ($relationName eq $newObjectType) { | ||
push @valueList, 1; | ||
push @fieldNameList, "new_record"; | ||
} | ||
2796 | # Only proceed if there are no missing fields. | # Only proceed if there are no missing fields. |
2797 | if (@missing > 0) { | if (@missing > 0) { |
2798 | Trace("Relation $relationName for $newObjectType skipped due to missing fields: " . | Trace("Relation $relationName for $newObjectType skipped due to missing fields: " . |
# | Line 1674 | Line 2829 |
2829 | $retVal = $sth->execute(@parameterList); | $retVal = $sth->execute(@parameterList); |
2830 | if (!$retVal) { | if (!$retVal) { |
2831 | my $errorString = $sth->errstr(); | my $errorString = $sth->errstr(); |
2832 | Trace("Insert error: $errorString.") if T(0); | Confess("Error inserting into $relationName: $errorString"); |
2833 | } else { | |
2834 | Trace("Insert successful using $parameterList[0].") if T(3); | |
2835 | } | } |
2836 | } | } |
2837 | } | } |
2838 | } | } |
2839 | # Return the success indicator. | # Return a 1 for backward compatability. |
2840 | return $retVal; | return 1; |
2841 | } | } |
2842 | ||
2843 | =head3 LoadTable | =head3 UpdateEntity |
2844 | ||
2845 | C<< my %results = $erdb->LoadTable($fileName, $relationName, $truncateFlag); >> | $erdb->UpdateEntity($entityName, $id, \%fields); |
2846 | ||
2847 | Load data from a tab-delimited file into a specified table, optionally re-creating the table | Update the values of an entity. This is an unprotected update, so it should only be |
2848 | first. | done if the database resides on a database server. |
2849 | ||
2850 | =over 4 | =over 4 |
2851 | ||
2852 | =item fileName | =item entityName |
2853 | ||
2854 | Name of the file from which the table data should be loaded. | Name of the entity to update. (This is the entity type.) |
2855 | ||
2856 | =item relationName | =item id |
2857 | ||
2858 | Name of the relation to be loaded. This is the same as the table name. | ID of the entity to update. If no entity exists with this ID, an error will be thrown. |
2859 | ||
2860 | =item truncateFlag | =item fields |
2861 | ||
2862 | TRUE if the table should be dropped and re-created, else FALSE | Reference to a hash mapping field names to their new values. All of the fields named |
2863 | must be in the entity's primary relation, and they cannot any of them be the ID field. | |
2864 | ||
2865 | =back | |
2866 | ||
2867 | =cut | |
2868 | ||
2869 | sub UpdateEntity { | |
2870 | # Get the parameters. | |
2871 | my ($self, $entityName, $id, $fields) = @_; | |
2872 | # Get a list of the field names being updated. | |
2873 | my @fieldList = keys %{$fields}; | |
2874 | # Verify that the fields exist. | |
2875 | my $checker = $self->GetFieldTable($entityName); | |
2876 | for my $field (@fieldList) { | |
2877 | if ($field eq 'id') { | |
2878 | Confess("Cannot update the ID field for entity $entityName."); | |
2879 | } elsif ($checker->{$field}->{relation} ne $entityName) { | |
2880 | Confess("Cannot find $field in primary relation of $entityName."); | |
2881 | } | |
2882 | } | |
2883 | # Build the SQL statement. | |
2884 | my @sets = (); | |
2885 | my @valueList = (); | |
2886 | for my $field (@fieldList) { | |
2887 | push @sets, _FixName($field) . " = ?"; | |
2888 | push @valueList, $fields->{$field}; | |
2889 | } | |
2890 | my $command = "UPDATE $entityName SET " . join(", ", @sets) . " WHERE id = ?"; | |
2891 | # Add the ID to the list of binding values. | |
2892 | push @valueList, $id; | |
2893 | # Call SQL to do the work. | |
2894 | my $rows = $self->{_dbh}->SQL($command, 0, @valueList); | |
2895 | # Check for errors. | |
2896 | if ($rows == 0) { | |
2897 | Confess("Entity $id of type $entityName not found."); | |
2898 | } | |
2899 | } | |
2900 | ||
2901 | =head3 LoadTable | |
2902 | ||
2903 | my $results = $erdb->LoadTable($fileName, $relationName, %options); | |
2904 | ||
2905 | Load data from a tab-delimited file into a specified table, optionally re-creating the table | |
2906 | first. | |
2907 | ||
2908 | =over 4 | |
2909 | ||
2910 | =item fileName | |
2911 | ||
2912 | Name of the file from which the table data should be loaded. | |
2913 | ||
2914 | =item relationName | |
2915 | ||
2916 | Name of the relation to be loaded. This is the same as the table name. | |
2917 | ||
2918 | =item options | |
2919 | ||
2920 | A hash of load options. | |
2921 | ||
2922 | =item RETURN | =item RETURN |
2923 | ||
# | Line 1710 | Line 2925 |
2925 | ||
2926 | =back | =back |
2927 | ||
2928 | The permissible options are as follows. | |
2929 | ||
2930 | =over 4 | |
2931 | ||
2932 | =item truncate | |
2933 | ||
2934 | If TRUE, then the table will be erased before loading. | |
2935 | ||
2936 | =item mode | |
2937 | ||
2938 | Mode in which the load should operate, either C<low_priority> or C<concurrent>. | |
2939 | This option is only applicable to a MySQL database. | |
2940 | ||
2941 | =item partial | |
2942 | ||
2943 | If TRUE, then it is assumed that this is a partial load, and the table will not | |
2944 | be analyzed and compacted at the end. | |
2945 | ||
2946 | =back | |
2947 | ||
2948 | =cut | =cut |
2949 | sub LoadTable { | sub LoadTable { |
2950 | # Get the parameters. | # Get the parameters. |
2951 | my ($self, $fileName, $relationName, $truncateFlag) = @_; | my ($self, $fileName, $relationName, %options) = @_; |
2952 | # Create the statistical return object. | # Create the statistical return object. |
2953 | my $retVal = _GetLoadStats(); | my $retVal = _GetLoadStats(); |
2954 | # Trace the fact of the load. | # Trace the fact of the load. |
# | Line 1725 | Line 2960 |
2960 | # Get the relation data. | # Get the relation data. |
2961 | my $relation = $self->_FindRelation($relationName); | my $relation = $self->_FindRelation($relationName); |
2962 | # Check the truncation flag. | # Check the truncation flag. |
2963 | if ($truncateFlag) { | if ($options{truncate}) { |
2964 | Trace("Creating table $relationName") if T(2); | Trace("Creating table $relationName") if T(2); |
2965 | # Compute the row count estimate. We take the size of the load file, | # Compute the row count estimate. We take the size of the load file, |
2966 | # divide it by the estimated row size, and then multiply by 1.5 to | # divide it by the estimated row size, and then multiply by 2 to |
2967 | # leave extra room. We postulate a minimum row count of 1000 to | # leave extra room. We postulate a minimum row count of 1000 to |
2968 | # prevent problems with incoming empty load files. | # prevent problems with incoming empty load files. |
2969 | my $rowSize = $self->EstimateRowSize($relationName); | my $rowSize = $self->EstimateRowSize($relationName); |
2970 | my $estimate = FIG::max($fileSize * 1.5 / $rowSize, 1000); | my $estimate = $fileSize * 8 / $rowSize; |
2971 | if ($estimate < 1000) { | |
2972 | $estimate = 1000; | |
2973 | } | |
2974 | # Re-create the table without its index. | # Re-create the table without its index. |
2975 | $self->CreateTable($relationName, 0, $estimate); | $self->CreateTable($relationName, 0, $estimate); |
2976 | # If this is a pre-index DBMS, create the index here. | # If this is a pre-index DBMS, create the index here. |
# | Line 1748 | Line 2986 |
2986 | # Load the table. | # Load the table. |
2987 | my $rv; | my $rv; |
2988 | eval { | eval { |
2989 | $rv = $dbh->load_table(file => $fileName, tbl => $relationName); | $rv = $dbh->load_table(file => $fileName, tbl => $relationName, style => $options{mode}); |
2990 | }; | }; |
2991 | if (!defined $rv) { | if (!defined $rv) { |
2992 | $retVal->AddMessage($@) if ($@); | $retVal->AddMessage($@) if ($@); |
2993 | $retVal->AddMessage("Table load failed for $relationName using $fileName."); | $retVal->AddMessage("Table load failed for $relationName using $fileName: " . $dbh->error_message); |
2994 | Trace("Table load failed for $relationName.") if T(1); | Trace("Table load failed for $relationName.") if T(1); |
2995 | } else { | } else { |
2996 | # Here we successfully loaded the table. | # Here we successfully loaded the table. |
2997 | $retVal->Add("tables"); | $retVal->Add("tables"); |
2998 | my $size = -s $fileName; | my $size = -s $fileName; |
2999 | Trace("$size bytes loaded into $relationName.") if T(2); | Trace("$size bytes loaded into $relationName.") if T(2); |
3000 | $retVal->Add("bytes", $size); | |
3001 | # If we're rebuilding, we need to create the table indexes. | # If we're rebuilding, we need to create the table indexes. |
3002 | if ($truncateFlag && ! $dbh->{_preIndex}) { | if ($options{truncate}) { |
3003 | # Indexes are created here for PostGres. For PostGres, indexes are | |
3004 | # best built at the end. For MySQL, the reverse is true. | |
3005 | if (! $dbh->{_preIndex}) { | |
3006 | eval { | eval { |
3007 | $self->CreateIndex($relationName); | $self->CreateIndex($relationName); |
3008 | }; | }; |
# | Line 1768 | Line 3010 |
3010 | $retVal->AddMessage($@); | $retVal->AddMessage($@); |
3011 | } | } |
3012 | } | } |
3013 | # The full-text index (if any) is always built last, even for MySQL. | |
3014 | # First we need to see if this table has a full-text index. Only | |
3015 | # primary relations are allowed that privilege. | |
3016 | Trace("Checking for full-text index on $relationName.") if T(2); | |
3017 | if ($self->_IsPrimary($relationName)) { | |
3018 | $self->CreateSearchIndex($relationName); | |
3019 | } | |
3020 | } | |
3021 | } | } |
3022 | # Analyze the table to improve performance. | # Analyze the table to improve performance. |
3023 | $dbh->vacuum_it($relationName); | if (! $options{partial}) { |
3024 | Trace("Analyzing and compacting $relationName.") if T(3); | |
3025 | $self->Analyze($relationName); | |
3026 | } | |
3027 | Trace("$relationName load completed.") if T(3); | |
3028 | # Return the statistics. | # Return the statistics. |
3029 | return $retVal; | return $retVal; |
3030 | } | } |
3031 | ||
3032 | =head3 GenerateEntity | =head3 Analyze |
3033 | ||
3034 | C<< my $fieldHash = $erdb->GenerateEntity($id, $type, \%values); >> | $erdb->Analyze($tableName); |
3035 | ||
3036 | Generate the data for a new entity instance. This method creates a field hash suitable for | Analyze and compact a table in the database. This is useful after a load |
3037 | passing as a parameter to L</InsertObject>. The ID is specified by the callr, but the rest | to improve the performance of the indexes. |
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. | ||
3038 | ||
3039 | =over 4 | =over 4 |
3040 | ||
3041 | =item id | =item tableName |
3042 | ||
3043 | ID to assign to the new entity. | Name of the table to be analyzed and compacted. |
3044 | ||
3045 | =item type | =back |
3046 | ||
3047 | Type name for the new entity. | =cut |
3048 | ||
3049 | =item values | sub Analyze { |
3050 | # Get the parameters. | |
3051 | my ($self, $tableName) = @_; | |
3052 | # Analyze the table. | |
3053 | $self->{_dbh}->vacuum_it($tableName); | |
3054 | } | |
3055 | ||
3056 | =head3 TruncateTable | |
3057 | ||
3058 | $erdb->TruncateTable($table); | |
3059 | ||
3060 | Delete all rows from a table quickly. This uses the built-in SQL | |
3061 | C<TRUNCATE> statement, which effectively drops and re-creates a table | |
3062 | with all its settings intact. | |
3063 | ||
3064 | =over 4 | |
3065 | ||
3066 | =item table | |
3067 | ||
3068 | Hash containing additional values that might be needed by the data generation methods (optional). | Name of the table to be cleared. |
3069 | ||
3070 | =back | =back |
3071 | ||
3072 | =cut | =cut |
3073 | ||
3074 | sub GenerateEntity { | sub TruncateTable { |
3075 | # Get the parameters. | # Get the parameters. |
3076 | my ($self, $id, $type, $values) = @_; | my ($self, $table) = @_; |
3077 | # Create the return hash. | # Get the database handle. |
3078 | my $this = { id => $id }; | my $dbh = $self->{_dbh}; |
3079 | # Get the metadata structure. | # Execute a truncation comment. |
3080 | my $metadata = $self->{_metaData}; | $dbh->SQL("TRUNCATE TABLE $table"); |
3081 | # Get this entity's list of fields. | } |
3082 | if (!exists $metadata->{Entities}->{$type}) { | |
3083 | Confess("Unrecognized entity type $type in GenerateEntity."); | |
3084 | } else { | =head3 CreateSearchIndex |
3085 | my $entity = $metadata->{Entities}->{$type}; | |
3086 | my $fields = $entity->{Fields}; | $erdb->CreateSearchIndex($objectName); |
3087 | # Generate data from the fields. | |
3088 | _GenerateFields($this, $fields, $type, $values); | Check for a full-text search index on the specified entity or relationship object, and |
3089 | if one is required, rebuild it. | |
3090 | ||
3091 | =over 4 | |
3092 | ||
3093 | =item objectName | |
3094 | ||
3095 | Name of the entity or relationship to be indexed. | |
3096 | ||
3097 | =back | |
3098 | ||
3099 | =cut | |
3100 | ||
3101 | sub CreateSearchIndex { | |
3102 | # Get the parameters. | |
3103 | my ($self, $objectName) = @_; | |
3104 | # Get the relation's entity/relationship structure. | |
3105 | my $structure = $self->_GetStructure($objectName); | |
3106 | # Get the database handle. | |
3107 | my $dbh = $self->{_dbh}; | |
3108 | Trace("Checking for search fields in $objectName.") if T(3); | |
3109 | # Check for a searchable fields list. | |
3110 | if (exists $structure->{searchFields}) { | |
3111 | # Here we know that we need to create a full-text search index. | |
3112 | # Get an SQL-formatted field name list. | |
3113 | my $fields = join(", ", _FixNames(@{$structure->{searchFields}})); | |
3114 | # Create the index. If it already exists, it will be dropped. | |
3115 | $dbh->create_index(tbl => $objectName, idx => "search_idx", | |
3116 | flds => $fields, kind => 'fulltext'); | |
3117 | Trace("Index created for $fields in $objectName.") if T(2); | |
3118 | } | } |
3119 | # Return the hash created. | } |
3120 | return $this; | |
3121 | =head3 DropRelation | |
3122 | ||
3123 | $erdb->DropRelation($relationName); | |
3124 | ||
3125 | Physically drop a relation from the database. | |
3126 | ||
3127 | =over 4 | |
3128 | ||
3129 | =item relationName | |
3130 | ||
3131 | Name of the relation to drop. If it does not exist, this method will have | |
3132 | no effect. | |
3133 | ||
3134 | =back | |
3135 | ||
3136 | =cut | |
3137 | ||
3138 | sub DropRelation { | |
3139 | # Get the parameters. | |
3140 | my ($self, $relationName) = @_; | |
3141 | # Get the database handle. | |
3142 | my $dbh = $self->{_dbh}; | |
3143 | # Drop the relation. The method used here has no effect if the relation | |
3144 | # does not exist. | |
3145 | Trace("Invoking DB Kernel to drop $relationName.") if T(3); | |
3146 | $dbh->drop_table(tbl => $relationName); | |
3147 | } | |
3148 | ||
3149 | =head3 MatchSqlPattern | |
3150 | ||
3151 | my $matched = ERDB::MatchSqlPattern($value, $pattern); | |
3152 | ||
3153 | Determine whether or not a specified value matches an SQL pattern. An SQL | |
3154 | pattern has two wild card characters: C<%> that matches multiple characters, | |
3155 | and C<_> that matches a single character. These can be escaped using a | |
3156 | backslash (C<\>). We pull this off by converting the SQL pattern to a | |
3157 | PERL regular expression. As per SQL rules, the match is case-insensitive. | |
3158 | ||
3159 | =over 4 | |
3160 | ||
3161 | =item value | |
3162 | ||
3163 | Value to be matched against the pattern. Note that an undefined or empty | |
3164 | value will not match anything. | |
3165 | ||
3166 | =item pattern | |
3167 | ||
3168 | SQL pattern against which to match the value. An undefined or empty pattern will | |
3169 | match everything. | |
3170 | ||
3171 | =item RETURN | |
3172 | ||
3173 | Returns TRUE if the value and pattern match, else FALSE. | |
3174 | ||
3175 | =back | |
3176 | ||
3177 | =cut | |
3178 | ||
3179 | sub MatchSqlPattern { | |
3180 | # Get the parameters. | |
3181 | my ($value, $pattern) = @_; | |
3182 | # Declare the return variable. | |
3183 | my $retVal; | |
3184 | # Insure we have a pattern. | |
3185 | if (! defined($pattern) || $pattern eq "") { | |
3186 | $retVal = 1; | |
3187 | } else { | |
3188 | # Break the pattern into pieces around the wildcard characters. Because we | |
3189 | # use parentheses in the split function's delimiter expression, we'll get | |
3190 | # list elements for the delimiters as well as the rest of the string. | |
3191 | my @pieces = split /([_%]|\\[_%])/, $pattern; | |
3192 | # Check some fast special cases. | |
3193 | if ($pattern eq '%') { | |
3194 | # A null pattern matches everything. | |
3195 | $retVal = 1; | |
3196 | } elsif (@pieces == 1) { | |
3197 | # No wildcards, so we have a literal comparison. Note we're case-insensitive. | |
3198 | $retVal = (lc($value) eq lc($pattern)); | |
3199 | } elsif (@pieces == 2 && $pieces[1] eq '%') { | |
3200 | # A wildcard at the end, so we have a substring match. This is also case-insensitive. | |
3201 | $retVal = (lc(substr($value, 0, length($pieces[0]))) eq lc($pieces[0])); | |
3202 | } else { | |
3203 | # Okay, we have to do it the hard way. Convert each piece to a PERL pattern. | |
3204 | my $realPattern = ""; | |
3205 | for my $piece (@pieces) { | |
3206 | # Determine the type of piece. | |
3207 | if ($piece eq "") { | |
3208 | # Empty pieces are ignored. | |
3209 | } elsif ($piece eq "%") { | |
3210 | # Here we have a multi-character wildcard. Note that it can match | |
3211 | # zero or more characters. | |
3212 | $realPattern .= ".*" | |
3213 | } elsif ($piece eq "_") { | |
3214 | # Here we have a single-character wildcard. | |
3215 | $realPattern .= "."; | |
3216 | } elsif ($piece eq "\\%" || $piece eq "\\_") { | |
3217 | # This is an escape sequence (which is a rare thing, actually). | |
3218 | $realPattern .= substr($piece, 1, 1); | |
3219 | } else { | |
3220 | # Here we have raw text. | |
3221 | $realPattern .= quotemeta($piece); | |
3222 | } | |
3223 | } | |
3224 | # Do the match. | |
3225 | $retVal = ($value =~ /^$realPattern$/i ? 1 : 0); | |
3226 | } | |
3227 | } | |
3228 | # Return the result. | |
3229 | return $retVal; | |
3230 | } | } |
3231 | ||
3232 | =head3 GetEntity | =head3 GetEntity |
3233 | ||
3234 | C<< my $entityObject = $erdb->GetEntity($entityType, $ID); >> | my $entityObject = $erdb->GetEntity($entityType, $ID); |
3235 | ||
3236 | Return an object describing the entity instance with a specified ID. | Return an object describing the entity instance with a specified ID. |
3237 | ||
# | Line 1851 | Line 3247 |
3247 | ||
3248 | =item RETURN | =item RETURN |
3249 | ||
3250 | Returns a B<DBObject> representing the desired entity instance, or an undefined value if no | Returns a B<ERDBObject> representing the desired entity instance, or an undefined value if no |
3251 | instance is found with the specified key. | instance is found with the specified key. |
3252 | ||
3253 | =back | =back |
# | Line 1869 | Line 3265 |
3265 | return $retVal; | return $retVal; |
3266 | } | } |
3267 | ||
3268 | =head3 GetChoices | |
3269 | ||
3270 | my @values = $erdb->GetChoices($entityName, $fieldName); | |
3271 | ||
3272 | Return a list of all the values for the specified field that are represented in the | |
3273 | specified entity. | |
3274 | ||
3275 | Note that if the field is not indexed, then this will be a very slow operation. | |
3276 | ||
3277 | =over 4 | |
3278 | ||
3279 | =item entityName | |
3280 | ||
3281 | Name of an entity in the database. | |
3282 | ||
3283 | =item fieldName | |
3284 | ||
3285 | Name of a field belonging to the entity. This is a raw field name without | |
3286 | the standard parenthesized notation used in most calls. | |
3287 | ||
3288 | =item RETURN | |
3289 | ||
3290 | Returns a list of the distinct values for the specified field in the database. | |
3291 | ||
3292 | =back | |
3293 | ||
3294 | =cut | |
3295 | ||
3296 | sub GetChoices { | |
3297 | # Get the parameters. | |
3298 | my ($self, $entityName, $fieldName) = @_; | |
3299 | # Declare the return variable. | |
3300 | my @retVal; | |
3301 | # Get the entity data structure. | |
3302 | my $entityData = $self->_GetStructure($entityName); | |
3303 | # Get the field. | |
3304 | my $fieldHash = $entityData->{Fields}; | |
3305 | if (! exists $fieldHash->{$fieldName}) { | |
3306 | Confess("$fieldName not found in $entityName."); | |
3307 | } else { | |
3308 | # Get the name of the relation containing the field. | |
3309 | my $relation = $fieldHash->{$fieldName}->{relation}; | |
3310 | # Fix up the field name. | |
3311 | my $realName = _FixName($fieldName); | |
3312 | # Get the database handle. | |
3313 | my $dbh = $self->{_dbh}; | |
3314 | # Query the database. | |
3315 | my $results = $dbh->SQL("SELECT DISTINCT $realName FROM $relation"); | |
3316 | # Clean the results. They are stored as a list of lists, and we just want the one list. | |
3317 | @retVal = sort map { $_->[0] } @{$results}; | |
3318 | } | |
3319 | # Return the result. | |
3320 | return @retVal; | |
3321 | } | |
3322 | ||
3323 | =head3 GetEntityValues | =head3 GetEntityValues |
3324 | ||
3325 | C<< my @values = $erdb->GetEntityValues($entityType, $ID, \@fields); >> | my @values = $erdb->GetEntityValues($entityType, $ID, \@fields); |
3326 | ||
3327 | Return a list of values from a specified entity instance. | Return a list of values from a specified entity instance. If the entity instance |
3328 | does not exist, an empty list is returned. | |
3329 | ||
3330 | =over 4 | =over 4 |
3331 | ||
# | Line 1914 | Line 3366 |
3366 | ||
3367 | =head3 GetAll | =head3 GetAll |
3368 | ||
3369 | C<< my @list = $erdb->GetAll(\@objectNames, $filterClause, \@parameters, \@fields, $count); >> | my @list = $erdb->GetAll(\@objectNames, $filterClause, \@parameters, \@fields, $count); |
3370 | ||
3371 | Return a list of values taken from the objects returned by a query. The first three | Return a list of values taken from the objects returned by a query. The first three |
3372 | parameters correspond to the parameters of the L</Get> method. The final parameter is | parameters correspond to the parameters of the L</Get> method. The final parameter is |
# | Line 1928 | Line 3380 |
3380 | fields specified returns multiple values, they are flattened in with the rest. For | fields specified returns multiple values, they are flattened in with the rest. For |
3381 | example, the following call will return a list of the features in a particular | example, the following call will return a list of the features in a particular |
3382 | spreadsheet cell, and each feature will be represented by a list containing the | spreadsheet cell, and each feature will be represented by a list containing the |
3383 | feature ID followed by all of its aliases. | feature ID followed by all of its essentiality determinations. |
3384 | ||
3385 | C<< $query = $erdb->Get(['ContainsFeature', 'Feature'], "ContainsFeature(from-link) = ?", [$ssCellID], ['Feature(id)', 'Feature(alias)']); >> | @query = $erdb->Get(['ContainsFeature', 'Feature'], "ContainsFeature(from-link) = ?", [$ssCellID], ['Feature(id)', 'Feature(essential)']); |
3386 | ||
3387 | =over 4 | =over 4 |
3388 | ||
# | Line 2001 | Line 3453 |
3453 | push @retVal, \@rowData; | push @retVal, \@rowData; |
3454 | $fetched++; | $fetched++; |
3455 | } | } |
3456 | Trace("$fetched rows returned in GetAll.") if T(SQL => 4); | |
3457 | # Return the resulting list. | # Return the resulting list. |
3458 | return @retVal; | return @retVal; |
3459 | } | } |
3460 | ||
3461 | =head3 Exists | |
3462 | ||
3463 | my $found = $sprout->Exists($entityName, $entityID); | |
3464 | ||
3465 | Return TRUE if an entity exists, else FALSE. | |
3466 | ||
3467 | =over 4 | |
3468 | ||
3469 | =item entityName | |
3470 | ||
3471 | Name of the entity type (e.g. C<Feature>) relevant to the existence check. | |
3472 | ||
3473 | =item entityID | |
3474 | ||
3475 | ID of the entity instance whose existence is to be checked. | |
3476 | ||
3477 | =item RETURN | |
3478 | ||
3479 | Returns TRUE if the entity instance exists, else FALSE. | |
3480 | ||
3481 | =back | |
3482 | ||
3483 | =cut | |
3484 | #: Return Type $; | |
3485 | sub Exists { | |
3486 | # Get the parameters. | |
3487 | my ($self, $entityName, $entityID) = @_; | |
3488 | # Check for the entity instance. | |
3489 | Trace("Checking existence of $entityName with ID=$entityID.") if T(4); | |
3490 | my $testInstance = $self->GetEntity($entityName, $entityID); | |
3491 | # Return an existence indicator. | |
3492 | my $retVal = ($testInstance ? 1 : 0); | |
3493 | return $retVal; | |
3494 | } | |
3495 | ||
3496 | =head3 EstimateRowSize | =head3 EstimateRowSize |
3497 | ||
3498 | C<< my $rowSize = $erdb->EstimateRowSize($relName); >> | my $rowSize = $erdb->EstimateRowSize($relName); |
3499 | ||
3500 | Estimate the row size of the specified relation. The estimated row size is computed by adding | Estimate the row size of the specified relation. The estimated row size is computed by adding |
3501 | up the average length for each data type. | up the average length for each data type. |
# | Line 2018 | Line 3506 |
3506 | ||
3507 | Name of the relation whose estimated row size is desired. | Name of the relation whose estimated row size is desired. |
3508 | ||
3509 | =item RETURN | =item RETURN |
3510 | ||
3511 | Returns an estimate of the row size for the specified relation. | |
3512 | ||
3513 | =back | |
3514 | ||
3515 | =cut | |
3516 | #: Return Type $; | |
3517 | sub EstimateRowSize { | |
3518 | # Get the parameters. | |
3519 | my ($self, $relName) = @_; | |
3520 | # Declare the return variable. | |
3521 | my $retVal = 0; | |
3522 | # Find the relation descriptor. | |
3523 | my $relation = $self->_FindRelation($relName); | |
3524 | # Get the list of fields. | |
3525 | for my $fieldData (@{$relation->{Fields}}) { | |
3526 | # Get the field type and add its length. | |
3527 | my $fieldLen = $TypeTable{$fieldData->{type}}->{avgLen}; | |
3528 | $retVal += $fieldLen; | |
3529 | } | |
3530 | # Return the result. | |
3531 | return $retVal; | |
3532 | } | |
3533 | ||
3534 | =head3 GetFieldTable | |
3535 | ||
3536 | my $fieldHash = $self->GetFieldTable($objectnName); | |
3537 | ||
3538 | Get the field structure for a specified entity or relationship. | |
3539 | ||
3540 | =over 4 | |
3541 | ||
3542 | =item objectName | |
3543 | ||
3544 | Name of the desired entity or relationship. | |
3545 | ||
3546 | =item RETURN | |
3547 | ||
3548 | The table containing the field descriptors for the specified object. | |
3549 | ||
3550 | =back | |
3551 | ||
3552 | =cut | |
3553 | ||
3554 | sub GetFieldTable { | |
3555 | # Get the parameters. | |
3556 | my ($self, $objectName) = @_; | |
3557 | # Get the descriptor from the metadata. | |
3558 | my $objectData = $self->_GetStructure($objectName); | |
3559 | # Return the object's field table. | |
3560 | return $objectData->{Fields}; | |
3561 | } | |
3562 | ||
3563 | =head3 SplitKeywords | |
3564 | ||
3565 | my @keywords = ERDB::SplitKeywords($keywordString); | |
3566 | ||
3567 | This method returns a list of the positive keywords in the specified | |
3568 | keyword string. All of the operators will have been stripped off, | |
3569 | and if the keyword is preceded by a minus operator (C<->), it will | |
3570 | not be in the list returned. The idea here is to get a list of the | |
3571 | keywords the user wants to see. The list will be processed to remove | |
3572 | duplicates. | |
3573 | ||
3574 | It is possible to create a string that confuses this method. For example | |
3575 | ||
3576 | frog toad -frog | |
3577 | ||
3578 | would return both C<frog> and C<toad>. If this is a problem we can deal | |
3579 | with it later. | |
3580 | ||
3581 | =over 4 | |
3582 | ||
3583 | =item keywordString | |
3584 | ||
3585 | The keyword string to be parsed. | |
3586 | ||
3587 | =item RETURN | |
3588 | ||
3589 | Returns a list of the words in the keyword string the user wants to | |
3590 | see. | |
3591 | ||
3592 | =back | |
3593 | ||
3594 | =cut | |
3595 | ||
3596 | sub SplitKeywords { | |
3597 | # Get the parameters. | |
3598 | my ($keywordString) = @_; | |
3599 | # Make a safety copy of the string. (This helps during debugging.) | |
3600 | my $workString = $keywordString; | |
3601 | # Convert operators we don't care about to spaces. | |
3602 | $workString =~ tr/+"()<>/ /; | |
3603 | # Split the rest of the string along space boundaries. Note that we | |
3604 | # eliminate any words that are zero length or begin with a minus sign. | |
3605 | my @wordList = grep { $_ && substr($_, 0, 1) ne "-" } split /\s+/, $workString; | |
3606 | # Use a hash to remove duplicates. | |
3607 | my %words = map { $_ => 1 } @wordList; | |
3608 | # Return the result. | |
3609 | return sort keys %words; | |
3610 | } | |
3611 | ||
3612 | =head3 ValidateFieldName | |
3613 | ||
3614 | my $okFlag = ERDB::ValidateFieldName($fieldName); | |
3615 | ||
3616 | Return TRUE if the specified field name is valid, else FALSE. Valid field names must | |
3617 | be hyphenated words subject to certain restrictions. | |
3618 | ||
3619 | =over 4 | |
3620 | ||
3621 | =item fieldName | |
3622 | ||
3623 | Field name to be validated. | |
3624 | ||
3625 | =item RETURN | |
3626 | ||
3627 | Returns TRUE if the field name is valid, else FALSE. | |
3628 | ||
3629 | =back | |
3630 | ||
3631 | =cut | |
3632 | ||
3633 | sub ValidateFieldName { | |
3634 | # Get the parameters. | |
3635 | my ($fieldName) = @_; | |
3636 | # Declare the return variable. The field name is valid until we hear | |
3637 | # differently. | |
3638 | my $retVal = 1; | |
3639 | # Compute the maximum name length. | |
3640 | my $maxLen = $TypeTable{'name-string'}->{maxLen}; | |
3641 | # Look for bad stuff in the name. | |
3642 | if ($fieldName =~ /--/) { | |
3643 | # Here we have a doubled minus sign. | |
3644 | Trace("Field name $fieldName has a doubled hyphen.") if T(1); | |
3645 | $retVal = 0; | |
3646 | } elsif ($fieldName !~ /^[A-Za-z]/) { | |
3647 | # Here the field name is missing the initial letter. | |
3648 | Trace("Field name $fieldName does not begin with a letter.") if T(1); | |
3649 | $retVal = 0; | |
3650 | } elsif (length($fieldName) > $maxLen) { | |
3651 | # Here the field name is too long. | |
3652 | Trace("Maximum field name length is $maxLen. Field name must be truncated to " . substr($fieldName,0, $maxLen) . "."); | |
3653 | } else { | |
3654 | # Strip out the minus signs. Everything remaining must be a letter, | |
3655 | # underscore, or digit. | |
3656 | my $strippedName = $fieldName; | |
3657 | $strippedName =~ s/-//g; | |
3658 | if ($strippedName !~ /^(\w|\d)+$/) { | |
3659 | Trace("Field name $fieldName contains illegal characters.") if T(1); | |
3660 | $retVal = 0; | |
3661 | } | |
3662 | } | |
3663 | # Return the result. | |
3664 | return $retVal; | |
3665 | } | |
3666 | ||
3667 | =head3 ReadMetaXML | |
3668 | ||
3669 | my $rawMetaData = ERDB::ReadDBD($fileName); | |
3670 | ||
3671 | This method reads a raw database definition XML file and returns it. | |
3672 | Normally, the metadata used by the ERDB system has been processed and | |
3673 | modified to make it easier to load and retrieve the data; however, | |
3674 | this method can be used to get the data in its raw form. | |
3675 | ||
3676 | =over 4 | |
3677 | ||
3678 | =item fileName | |
3679 | ||
3680 | Name of the XML file to read. | |
3681 | ||
3682 | =item RETURN | |
3683 | ||
3684 | Returns a hash reference containing the raw XML data from the specified file. | |
3685 | ||
3686 | =back | |
3687 | ||
3688 | =cut | |
3689 | ||
3690 | sub ReadMetaXML { | |
3691 | # Get the parameters. | |
3692 | my ($fileName) = @_; | |
3693 | # Read the XML. | |
3694 | my $retVal = XML::Simple::XMLin($fileName, %XmlOptions, %XmlInOpts); | |
3695 | Trace("XML metadata loaded from file $fileName.") if T(1); | |
3696 | # Return the result. | |
3697 | return $retVal; | |
3698 | } | |
3699 | ||
3700 | =head3 GetEntityFieldHash | |
3701 | ||
3702 | my $fieldHashRef = ERDB::GetEntityFieldHash($structure, $entityName); | |
3703 | ||
3704 | Get the field hash of the named entity in the specified raw XML structure. | |
3705 | The field hash may not exist, in which case we need to create it. | |
3706 | ||
3707 | =over 4 | |
3708 | ||
3709 | =item structure | |
3710 | ||
3711 | Raw XML structure defininng the database. This is not the run-time XML used by | |
3712 | an ERDB object, since that has all sorts of optimizations built-in. | |
3713 | ||
3714 | =item entityName | |
3715 | ||
3716 | Name of the entity whose field structure is desired. | |
3717 | ||
3718 | =item RETURN | |
3719 | ||
3720 | Returns the field hash used to define the entity's fields. | |
3721 | ||
3722 | =back | |
3723 | ||
3724 | =cut | |
3725 | ||
3726 | sub GetEntityFieldHash { | |
3727 | # Get the parameters. | |
3728 | my ($structure, $entityName) = @_; | |
3729 | # Get the entity structure. | |
3730 | my $entityData = $structure->{Entities}->{$entityName}; | |
3731 | # Look for a field structure. | |
3732 | my $retVal = $entityData->{Fields}; | |
3733 | # If it doesn't exist, create it. | |
3734 | if (! defined($retVal)) { | |
3735 | $entityData->{Fields} = {}; | |
3736 | $retVal = $entityData->{Fields}; | |
3737 | } | |
3738 | # Return the result. | |
3739 | return $retVal; | |
3740 | } | |
3741 | ||
3742 | =head3 WriteMetaXML | |
3743 | ||
3744 | ERDB::WriteMetaXML($structure, $fileName); | |
3745 | ||
3746 | Write the metadata XML to a file. This method is the reverse of L</ReadMetaXML>, and is | |
3747 | used to update the database definition. It must be used with care, however, since it | |
3748 | will only work on a raw structure, not on the processed structure created by an ERDB | |
3749 | constructor. | |
3750 | ||
3751 | =over 4 | |
3752 | ||
3753 | =item structure | |
3754 | ||
3755 | XML structure to be written to the file. | |
3756 | ||
3757 | =item fileName | |
3758 | ||
3759 | Name of the output file to which the updated XML should be stored. | |
3760 | ||
3761 | =back | |
3762 | ||
3763 | =cut | |
3764 | ||
3765 | sub WriteMetaXML { | |
3766 | # Get the parameters. | |
3767 | my ($structure, $fileName) = @_; | |
3768 | # Compute the output. | |
3769 | my $fileString = XML::Simple::XMLout($structure, %XmlOptions, %XmlOutOpts); | |
3770 | # Write it to the file. | |
3771 | my $xmlOut = Open(undef, ">$fileName"); | |
3772 | print $xmlOut $fileString; | |
3773 | } | |
3774 | ||
3775 | ||
3776 | =head3 HTMLNote | |
3777 | ||
3778 | Convert a note or comment to HTML by replacing some bulletin-board codes with HTML. The codes | |
3779 | supported are C<[b]> for B<bold>, C<[i]> for I<italics>, and C<[p]> for a new paragraph. | |
3780 | Except for C<[p]>, all the codes are closed by slash-codes. So, for | |
3781 | example, C<[b]Feature[/b]> displays the string C<Feature> in boldface. | |
3782 | ||
3783 | my $realHtml = ERDB::HTMLNote($dataString); | |
3784 | ||
3785 | =over 4 | |
3786 | ||
3787 | =item dataString | |
3788 | ||
3789 | String to convert to HTML. | |
3790 | ||
3791 | =item RETURN | |
3792 | ||
3793 | An HTML string derived from the input string. | |
3794 | ||
3795 | =back | |
3796 | ||
3797 | =cut | |
3798 | ||
3799 | sub HTMLNote { | |
3800 | # Get the parameter. | |
3801 | my ($dataString) = @_; | |
3802 | # HTML-escape the text. | |
3803 | my $retVal = CGI::escapeHTML($dataString); | |
3804 | # Substitute the bulletin board codes. | |
3805 | $retVal =~ s!\[(/?[bi])\]!<$1>!g; | |
3806 | $retVal =~ s!\[p\]!</p><p>!g; | |
3807 | $retVal =~ s!\[link\s+([^\]]+)\]!<a href="$1">!g; | |
3808 | $retVal =~ s!\[/link\]!</a>!g; | |
3809 | # Return the result. | |
3810 | return $retVal; | |
3811 | } | |
3812 | ||
3813 | =head3 WikiNote | |
3814 | ||
3815 | Convert a note or comment to Wiki text by replacing some bulletin-board codes with HTML. The codes | |
3816 | supported are C<[b]> for B<bold>, C<[i]> for I<italics>, and C<[p]> for a new paragraph. | |
3817 | Except for C<[p]>, all the codes are closed by slash-codes. So, for | |
3818 | example, C<[b]Feature[/b]> displays the string C<Feature> in boldface. | |
3819 | ||
3820 | my $wikiText = ERDB::WikiNote($dataString); | |
3821 | ||
3822 | =over 4 | |
3823 | ||
3824 | =item dataString | |
3825 | ||
3826 | String to convert to Wiki text. | |
3827 | ||
3828 | =item RETURN | |
3829 | ||
3830 | An Wiki text string derived from the input string. | |
3831 | ||
3832 | =back | |
3833 | ||
3834 | =cut | |
3835 | ||
3836 | sub WikiNote { | |
3837 | # Get the parameter. | |
3838 | my ($dataString) = @_; | |
3839 | # HTML-escape the text. | |
3840 | my $retVal = CGI::escapeHTML($dataString); | |
3841 | # Substitute the bulletin board codes. | |
3842 | my $italic = WikiTools::ItalicCode(); | |
3843 | $retVal =~ s/\[\/?i\]/$italic/g; | |
3844 | my $bold = WikiTools::BoldCode(); | |
3845 | $retVal =~ s/\[\/?b\]/$bold/g; | |
3846 | # Paragraph breaks are the same no matter which Wiki you're using. | |
3847 | $retVal =~ s!\[p\]!\n\n!g; | |
3848 | # Now we do the links, which are complicated by the need to know two | |
3849 | # things: the target URL and the text. | |
3850 | while ($retVal =~ /\[link\s+([^\]]+)\]([^\[]+)\[\/link\]/g) { | |
3851 | # Replace the matched string with the Wiki markup for links. Note that | |
3852 | # $-[0] is the starting position of the match for the entire expression, | |
3853 | # and $+[0] is past the ending position. | |
3854 | substr $retVal, $-[0], $+[0] - $-[0], WikiTools::LinkMarkup($1, $2); | |
3855 | } | |
3856 | # Return the result. | |
3857 | return $retVal; | |
3858 | } | |
3859 | ||
3860 | =head3 BeginTran | |
3861 | ||
3862 | $erdb->BeginTran(); | |
3863 | ||
3864 | Start a database transaction. | |
3865 | ||
3866 | =cut | |
3867 | ||
3868 | sub BeginTran { | |
3869 | my ($self) = @_; | |
3870 | $self->{_dbh}->begin_tran(); | |
3871 | ||
3872 | } | |
3873 | ||
3874 | =head3 CommitTran | |
3875 | ||
3876 | $erdb->CommitTran(); | |
3877 | ||
3878 | Commit an active database transaction. | |
3879 | ||
3880 | =cut | |
3881 | ||
3882 | sub CommitTran { | |
3883 | my ($self) = @_; | |
3884 | $self->{_dbh}->commit_tran(); | |
3885 | } | |
3886 | ||
3887 | =head3 RollbackTran | |
3888 | ||
3889 | $erdb->RollbackTran(); | |
3890 | ||
3891 | Roll back an active database transaction. | |
3892 | ||
3893 | =cut | |
3894 | ||
3895 | sub RollbackTran { | |
3896 | my ($self) = @_; | |
3897 | $self->{_dbh}->roll_tran(); | |
3898 | } | |
3899 | ||
3900 | =head3 UpdateField | |
3901 | ||
3902 | my $count = $erdb->UpdateField($objectNames, $fieldName, $oldValue, $newValue, $filter, $parms); | |
3903 | ||
3904 | Update all occurrences of a specific field value to a new value. The number of rows changed will be | |
3905 | returned. | |
3906 | ||
3907 | =over 4 | |
3908 | ||
3909 | =item fieldName | |
3910 | ||
3911 | Returns an estimate of the row size for the specified relation. | Name of the field in standard I<objectName>C<(>I<fieldName>C<)> format. |
3912 | ||
3913 | =back | =item oldValue |
3914 | ||
3915 | =cut | Value to be modified. All occurrences of this value in the named field will be replaced by the |
3916 | #: Return Type $; | new value. |
sub EstimateRowSize { | ||
# Get the parameters. | ||
my ($self, $relName) = @_; | ||
# Declare the return variable. | ||
my $retVal = 0; | ||
# Find the relation descriptor. | ||
my $relation = $self->_FindRelation($relName); | ||
# Get the list of fields. | ||
for my $fieldData (@{$relation->{Fields}}) { | ||
# Get the field type and add its length. | ||
my $fieldLen = $TypeTable{$fieldData->{type}}->{avgLen}; | ||
$retVal += $fieldLen; | ||
} | ||
# Return the result. | ||
return $retVal; | ||
} | ||
3917 | ||
3918 | =head3 GetFieldTable | =item newValue |
3919 | ||
3920 | C<< my $fieldHash = $self->GetFieldTable($objectnName); >> | New value to be substituted for the old value when it's found. |
3921 | ||
3922 | Get the field structure for a specified entity or relationship. | =item filter |
3923 | ||
3924 | =over 4 | A standard ERDB filter clause (see L</Get>). The filter will be applied before any substitutions take place. |
3925 | ||
3926 | =item objectName | =item parms |
3927 | ||
3928 | Name of the desired entity or relationship. | Reference to a list of parameter values in the filter. |
3929 | ||
3930 | =item RETURN | =item RETURN |
3931 | ||
3932 | The table containing the field descriptors for the specified object. | Returns the number of rows modified. |
3933 | ||
3934 | =back | =back |
3935 | ||
3936 | =cut | =cut |
3937 | ||
3938 | sub GetFieldTable { | sub UpdateField { |
3939 | # Get the parameters. | # Get the parameters. |
3940 | my ($self, $objectName) = @_; | my ($self, $fieldName, $oldValue, $newValue, $filter, $parms) = @_; |
3941 | # Get the descriptor from the metadata. | # Get the object and field names from the field name parameter. |
3942 | my $objectData = $self->_GetStructure($objectName); | $fieldName =~ /^([^(]+)\(([^)]+)\)/; |
3943 | # Return the object's field table. | my $objectName = $1; |
3944 | return $objectData->{Fields}; | my $realFieldName = _FixName($2); |
3945 | # Add the old value to the filter. Note we allow the possibility that no | |
3946 | # filter was specified. | |
3947 | my $realFilter = "$fieldName = ?"; | |
3948 | if ($filter) { | |
3949 | $realFilter .= " AND $filter"; | |
3950 | } | |
3951 | # Format the query filter. | |
3952 | my ($suffix, $mappedNameListRef, $mappedNameHashRef) = | |
3953 | $self->_SetupSQL([$objectName], $realFilter); | |
3954 | # Create the query. Since there is only one object name, the mapped-name data is not | |
3955 | # necessary. Neither is the FROM clause. | |
3956 | $suffix =~ s/^FROM.+WHERE\s+//; | |
3957 | # Create the update statement. | |
3958 | my $command = "UPDATE $objectName SET $realFieldName = ? WHERE $suffix"; | |
3959 | # Get the database handle. | |
3960 | my $dbh = $self->{_dbh}; | |
3961 | # Add the old and new values to the parameter list. Note we allow the possibility that | |
3962 | # there are no user-supplied parameters. | |
3963 | my @params = ($newValue, $oldValue); | |
3964 | if (defined $parms) { | |
3965 | push @params, @{$parms}; | |
3966 | } | |
3967 | # Execute the update. | |
3968 | my $retVal = $dbh->SQL($command, 0, @params); | |
3969 | # Make the funky zero a real zero. | |
3970 | if ($retVal == 0) { | |
3971 | $retVal = 0; | |
3972 | } | |
3973 | # Return the result. | |
3974 | return $retVal; | |
3975 | } | } |
3976 | ||
3977 | ||
3978 | =head2 Data Mining Methods | =head2 Data Mining Methods |
3979 | ||
3980 | =head3 GetUsefulCrossValues | =head3 GetUsefulCrossValues |
3981 | ||
3982 | C<< my @attrNames = $sprout->GetUsefulCrossValues($sourceEntity, $relationship); >> | my @attrNames = $sprout->GetUsefulCrossValues($sourceEntity, $relationship); |
3983 | ||
3984 | Return a list of the useful attributes that would be returned by a B<Cross> call | Return a list of the useful attributes that would be returned by a B<Cross> call |
3985 | from an entity of the source entity type through the specified relationship. This | from an entity of the source entity type through the specified relationship. This |
# | Line 2137 | Line 4040 |
4040 | ||
4041 | =head3 FindColumn | =head3 FindColumn |
4042 | ||
4043 | C<< my $colIndex = ERDB::FindColumn($headerLine, $columnIdentifier); >> | my $colIndex = ERDB::FindColumn($headerLine, $columnIdentifier); |
4044 | ||
4045 | Return the location a desired column in a data mining header line. The data | Return the location a desired column in a data mining header line. The data |
4046 | mining header line is a tab-separated list of column names. The column | mining header line is a tab-separated list of column names. The column |
# | Line 2195 | Line 4098 |
4098 | ||
4099 | =head3 ParseColumns | =head3 ParseColumns |
4100 | ||
4101 | C<< my @columns = ERDB->ParseColumns($line); >> | my @columns = ERDB::ParseColumns($line); |
4102 | ||
4103 | Convert the specified data line to a list of columns. | Convert the specified data line to a list of columns. |
4104 | ||
# | Line 2216 | Line 4119 |
4119 | ||
4120 | sub ParseColumns { | sub ParseColumns { |
4121 | # Get the parameters. | # Get the parameters. |
4122 | my ($self, $line) = @_; | my ($line) = @_; |
4123 | # Chop off the line-end. | # Chop off the line-end. |
4124 | chomp $line; | chomp $line; |
4125 | # Split it into a list. | # Split it into a list. |
# | Line 2225 | Line 4128 |
4128 | return @retVal; | return @retVal; |
4129 | } | } |
4130 | ||
4131 | =head2 Virtual Methods | |
4132 | ||
4133 | =head3 _CreatePPOIndex | |
4134 | ||
4135 | my $index = ERDB::_CreatePPOIndex($indexObject); | |
4136 | ||
4137 | Convert the XML for an ERDB index to the XML structure for a PPO | |
4138 | index. | |
4139 | ||
4140 | =over 4 | |
4141 | ||
4142 | =item indexObject | |
4143 | ||
4144 | ERDB XML structure for an index. | |
4145 | ||
4146 | =item RETURN | |
4147 | ||
4148 | PPO XML structure for the same index. | |
4149 | ||
4150 | =back | |
4151 | ||
4152 | =cut | |
4153 | ||
4154 | sub _CreatePPOIndex { | |
4155 | # Get the parameters. | |
4156 | my ($indexObject) = @_; | |
4157 | # The incoming index contains a list of the index fields in the IndexFields | |
4158 | # member. We loop through it to create the index tags. | |
4159 | my @fields = map { { label => _FixName($_->{name}) } } @{$indexObject->{IndexFields}}; | |
4160 | # Wrap the fields in attribute tags. | |
4161 | my $retVal = { attribute => \@fields }; | |
4162 | # Return the result. | |
4163 | return $retVal; | |
4164 | } | |
4165 | ||
4166 | =head3 _CreatePPOField | |
4167 | ||
4168 | my $fieldXML = ERDB::_CreatePPOField($fieldName, $fieldObject); | |
4169 | ||
4170 | Convert the ERDB XML structure for a field to a PPO scalar XML structure. | |
4171 | ||
4172 | =over 4 | |
4173 | ||
4174 | =item fieldName | |
4175 | ||
4176 | Name of the scalar field. | |
4177 | ||
4178 | =item fieldObject | |
4179 | ||
4180 | ERDB XML structure describing the field. | |
4181 | ||
4182 | =item RETURN | |
4183 | ||
4184 | Returns a PPO XML structure for the same field. | |
4185 | ||
4186 | =back | |
4187 | ||
4188 | =cut | |
4189 | ||
4190 | sub _CreatePPOField { | |
4191 | # Get the parameters. | |
4192 | my ($fieldName, $fieldObject) = @_; | |
4193 | # Get the field type. | |
4194 | my $type = $TypeTable{$fieldObject->{type}}->{sqlType}; | |
4195 | # Fix up the field name. | |
4196 | $fieldName = _FixName($fieldName); | |
4197 | # Build the scalar tag. | |
4198 | my $retVal = { label => $fieldName, type => $type }; | |
4199 | # Return the result. | |
4200 | return $retVal; | |
4201 | } | |
4202 | ||
4203 | =head3 CleanKeywords | |
4204 | ||
4205 | my $cleanedString = $erdb->CleanKeywords($searchExpression); | |
4206 | ||
4207 | Clean up a search expression or keyword list. This is a virtual method that may | |
4208 | be overridden by the subclass. The base-class method removes extra spaces | |
4209 | and converts everything to lower case. | |
4210 | ||
4211 | =over 4 | |
4212 | ||
4213 | =item searchExpression | |
4214 | ||
4215 | Search expression or keyword list to clean. Note that a search expression may | |
4216 | contain boolean operators which need to be preserved. This includes leading | |
4217 | minus signs. | |
4218 | ||
4219 | =item RETURN | |
4220 | ||
4221 | Cleaned expression or keyword list. | |
4222 | ||
4223 | =back | |
4224 | ||
4225 | =cut | |
4226 | ||
4227 | sub CleanKeywords { | |
4228 | # Get the parameters. | |
4229 | my ($self, $searchExpression) = @_; | |
4230 | # Lower-case the expression and copy it into the return variable. Note that we insure we | |
4231 | # don't accidentally end up with an undefined value. | |
4232 | my $retVal = lc($searchExpression || ""); | |
4233 | # Remove extra spaces. | |
4234 | $retVal =~ s/\s+/ /g; | |
4235 | $retVal =~ s/(^\s+)|(\s+$)//g; | |
4236 | # Return the result. | |
4237 | return $retVal; | |
4238 | } | |
4239 | ||
4240 | =head3 GetSourceObject | |
4241 | ||
4242 | my $source = $erdb->GetSourceObject($entityName); | |
4243 | ||
4244 | Return the object to be used in loading special attributes of the specified entity. The | |
4245 | algorithm for loading special attributes is stored in the C<DataGen> elements of the | |
4246 | XML | |
4247 | ||
4248 | =head2 Internal Utility Methods | =head2 Internal Utility Methods |
4249 | ||
4250 | =head3 SetupSQL | =head3 _RelationMap |
4251 | ||
4252 | my @relationMap = _RelationMap($mappedNameHashRef, $mappedNameListRef); | |
4253 | ||
4254 | Create the relation map for an SQL query. The relation map is used by B<ERDBObject> | |
4255 | to determine how to interpret the results of the query. | |
4256 | ||
4257 | =over 4 | |
4258 | ||
4259 | =item mappedNameHashRef | |
4260 | ||
4261 | Reference to a hash that maps modified object names to real object names. | |
4262 | ||
4263 | =item mappedNameListRef | |
4264 | ||
4265 | Reference to a list of modified object names in the order they appear in the | |
4266 | SELECT list. | |
4267 | ||
4268 | =item RETURN | |
4269 | ||
4270 | Returns a list of 2-tuples. Each tuple consists of an object name as used in the | |
4271 | query followed by the actual name of that object. This enables the B<ERDBObject> to | |
4272 | determine the order of the tables in the query and which object name belongs to each | |
4273 | mapped object name. Most of the time these two values are the same; however, if a | |
4274 | relation occurs twice in the query, the relation name in the field list and WHERE | |
4275 | clause will use a mapped name (generally the actual relation name with a numeric | |
4276 | suffix) that does not match the actual relation name. | |
4277 | ||
4278 | =back | |
4279 | ||
4280 | =cut | |
4281 | ||
4282 | sub _RelationMap { | |
4283 | # Get the parameters. | |
4284 | my ($mappedNameHashRef, $mappedNameListRef) = @_; | |
4285 | # Declare the return variable. | |
4286 | my @retVal = (); | |
4287 | # Build the map. | |
4288 | for my $mappedName (@{$mappedNameListRef}) { | |
4289 | push @retVal, [$mappedName, $mappedNameHashRef->{$mappedName}]; | |
4290 | } | |
4291 | # Return it. | |
4292 | return @retVal; | |
4293 | } | |
4294 | ||
4295 | ||
4296 | =head3 _SetupSQL | |
4297 | ||
4298 | Process a list of object names and a filter clause so that they can be used to | Process a list of object names and a filter clause so that they can be used to |
4299 | build an SQL statement. This method takes in a reference to a list of object names | build an SQL statement. This method takes in a reference to a list of object names |
# | Line 2247 | Line 4313 |
4313 | A string containing the WHERE clause for the query (without the C<WHERE>) and also | A string containing the WHERE clause for the query (without the C<WHERE>) and also |
4314 | optionally the C<ORDER BY> and C<LIMIT> clauses. | optionally the C<ORDER BY> and C<LIMIT> clauses. |
4315 | ||
4316 | =item matchClause | |
4317 | ||
4318 | An optional full-text search clause. If specified, it will be inserted at the | |
4319 | front of the WHERE clause. It should already be SQL-formatted; that is, the | |
4320 | field names should be in the form I<table>C<.>I<fieldName>. | |
4321 | ||
4322 | =item RETURN | =item RETURN |
4323 | ||
4324 | Returns a three-element list. The first element is the SQL statement suffix, beginning | Returns a three-element list. The first element is the SQL statement suffix, beginning |
# | Line 2259 | Line 4331 |
4331 | =cut | =cut |
4332 | ||
4333 | sub _SetupSQL { | sub _SetupSQL { |
4334 | my ($self, $objectNames, $filterClause) = @_; | my ($self, $objectNames, $filterClause, $matchClause) = @_; |
4335 | # Adjust the list of object names to account for multiple occurrences of the | # Adjust the list of object names to account for multiple occurrences of the |
4336 | # same object. We start with a hash table keyed on object name that will | # same object. We start with a hash table keyed on object name that will |
4337 | # return the object suffix. The first time an object is encountered it will | # return the object suffix. The first time an object is encountered it will |
# | Line 2308 | Line 4380 |
4380 | # FROM name1, name2, ... nameN | # FROM name1, name2, ... nameN |
4381 | # | # |
4382 | my $suffix = "FROM " . join(', ', @fromList); | my $suffix = "FROM " . join(', ', @fromList); |
4383 | # Now for the WHERE. First, we need a place for the filter string. | |
4384 | my $filterString = ""; | |
4385 | # We will also keep a list of conditions to add to the WHERE clause in order to link | |
4386 | # entities and relationships as well as primary relations to secondary ones. | |
4387 | my @joinWhere = (); | |
4388 | # Check for a filter clause. | # Check for a filter clause. |
4389 | if ($filterClause) { | if ($filterClause) { |
4390 | # Here we have one, so we convert its field names and add it to the query. First, | # Here we have one, so we convert its field names and add it to the query. First, |
4391 | # We create a copy of the filter string we can work with. | # We create a copy of the filter string we can work with. |
4392 | my $filterString = $filterClause; | $filterString = $filterClause; |
4393 | # Next, we sort the object names by length. This helps protect us from finding | # Next, we sort the object names by length. This helps protect us from finding |
4394 | # object names inside other object names when we're doing our search and replace. | # object names inside other object names when we're doing our search and replace. |
4395 | my @sortedNames = sort { length($b) - length($a) } @mappedNameList; | my @sortedNames = sort { length($b) - length($a) } @mappedNameList; |
# 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 = (); | ||
4396 | # The final preparatory step is to create a hash table of relation names. The | # The final preparatory step is to create a hash table of relation names. The |
4397 | # table begins with the relation names already in the SELECT command. We may | # table begins with the relation names already in the SELECT command. We may |
4398 | # need to add relations later if there is filtering on a field in a secondary | # need to add relations later if there is filtering on a field in a secondary |
# | Line 2386 | Line 4460 |
4460 | } | } |
4461 | } | } |
4462 | } | } |
4463 | } | |
4464 | # The next step is to join the objects together. We only need to do this if there | # The next step is to join the objects together. We only need to do this if there |
4465 | # is more than one object in the object list. We start with the first object and | # is more than one object in the object list. We start with the first object and |
4466 | # run through the objects after it. Note also that we make a safety copy of the | # run through the objects after it. Note also that we make a safety copy of the |
4467 | # list before running through it. | # list before running through it, because we shift off the first object before |
4468 | # processing the rest. | |
4469 | my @mappedObjectList = @mappedNameList; | my @mappedObjectList = @mappedNameList; |
4470 | my $lastMappedObject = shift @mappedObjectList; | my $lastMappedObject = shift @mappedObjectList; |
4471 | # Get the join table. | # Get the join table. |
# | Line 2418 | Line 4494 |
4494 | # here is we want the filter clause to be empty if there's no WHERE filter. | # here is we want the filter clause to be empty if there's no WHERE filter. |
4495 | # We'll put the ORDER BY / LIMIT clauses in the following variable. | # We'll put the ORDER BY / LIMIT clauses in the following variable. |
4496 | my $orderClause = ""; | my $orderClause = ""; |
4497 | # This is only necessary if we have a filter string in which the ORDER BY | |
4498 | # and LIMIT clauses can live. | |
4499 | if ($filterString) { | |
4500 | # Locate the ORDER BY or LIMIT verbs (if any). We use a non-greedy | # Locate the ORDER BY or LIMIT verbs (if any). We use a non-greedy |
4501 | # operator so that we find the first occurrence of either verb. | # operator so that we find the first occurrence of either verb. |
4502 | if ($filterString =~ m/^(.*?)\s*(ORDER BY|LIMIT)/g) { | if ($filterString =~ m/^(.*?)\s*(ORDER BY|LIMIT)/g) { |
# | Line 2426 | Line 4505 |
4505 | $orderClause = $2 . substr($filterString, $pos); | $orderClause = $2 . substr($filterString, $pos); |
4506 | $filterString = $1; | $filterString = $1; |
4507 | } | } |
4508 | # Add the filter and the join clauses (if any) to the SELECT command. | } |
4509 | # All the things that are supposed to be in the WHERE clause of the | |
4510 | # SELECT command need to be put into @joinWhere so we can string them | |
4511 | # together. We begin with the match clause. This is important, | |
4512 | # because the match clause's parameter mark must precede any parameter | |
4513 | # marks in the filter string. | |
4514 | if ($matchClause) { | |
4515 | push @joinWhere, $matchClause; | |
4516 | } | |
4517 | # Add the filter string. We put it in parentheses to avoid operator | |
4518 | # precedence problems with the match clause or the joins. | |
4519 | if ($filterString) { | if ($filterString) { |
4520 | Trace("Filter string is \"$filterString\".") if T(4); | Trace("Filter string is \"$filterString\".") if T(4); |
4521 | push @joinWhere, "($filterString)"; | push @joinWhere, "($filterString)"; |
4522 | } | } |
4523 | # String it all together into a big filter clause. | |
4524 | if (@joinWhere) { | if (@joinWhere) { |
4525 | $suffix .= " WHERE " . join(' AND ', @joinWhere); | $suffix .= " WHERE " . join(' AND ', @joinWhere); |
4526 | } | } |
4527 | # Add the sort or limit clause (if any) to the SELECT command. | # Add the sort or limit clause (if any). |
4528 | if ($orderClause) { | if ($orderClause) { |
4529 | $suffix .= " $orderClause"; | $suffix .= " $orderClause"; |
4530 | } | } |
} | ||
4531 | # Return the suffix, the mapped name list, and the mapped name hash. | # Return the suffix, the mapped name list, and the mapped name hash. |
4532 | return ($suffix, \@mappedNameList, \%mappedNameHash); | return ($suffix, \@mappedNameList, \%mappedNameHash); |
4533 | } | } |
4534 | ||
4535 | =head3 GetStatementHandle | =head3 _GetStatementHandle |
4536 | ||
4537 | This method will prepare and execute an SQL query, returning the statement handle. | This method will prepare and execute an SQL query, returning the statement handle. |
4538 | The main reason for doing this here is so that everybody who does SQL queries gets | The main reason for doing this here is so that everybody who does SQL queries gets |
# | Line 2473 | Line 4562 |
4562 | sub _GetStatementHandle { | sub _GetStatementHandle { |
4563 | # Get the parameters. | # Get the parameters. |
4564 | my ($self, $command, $params) = @_; | my ($self, $command, $params) = @_; |
4565 | Confess("Invalid parameter list.") if (! defined($params) || ref($params) ne 'ARRAY'); | |
4566 | # Trace the query. | # Trace the query. |
4567 | Trace("SQL query: $command") if T(SQL => 3); | Trace("SQL query: $command") if T(SQL => 3); |
4568 | Trace("PARMS: '" . (join "', '", @{$params}) . "'") if (T(SQL => 4) && (@{$params} > 0)); | Trace("PARMS: '" . (join "', '", @{$params}) . "'") if (T(SQL => 4) && (@{$params} > 0)); |
# | Line 2481 | Line 4571 |
4571 | # Prepare the command. | # Prepare the command. |
4572 | my $sth = $dbh->prepare_command($command); | my $sth = $dbh->prepare_command($command); |
4573 | # Execute it with the parameters bound in. | # Execute it with the parameters bound in. |
4574 | $sth->execute(@{$params}) || Confess("SELECT error" . $sth->errstr()); | $sth->execute(@{$params}) || Confess("SELECT error: " . $sth->errstr()); |
4575 | # Return the statement handle. | # Return the statement handle. |
4576 | return $sth; | return $sth; |
4577 | } | } |
4578 | ||
4579 | =head3 GetLoadStats | =head3 _GetLoadStats |
4580 | ||
4581 | Return a blank statistics object for use by the load methods. | Return a blank statistics object for use by the load methods. |
4582 | ||
# | Line 2498 | Line 4588 |
4588 | return Stats->new(); | return Stats->new(); |
4589 | } | } |
4590 | ||
4591 | =head3 GenerateFields | =head3 _DumpRelation |
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; | ||
} | ||
} | ||
} | ||
} | ||
=head3 DumpRelation | ||
4592 | ||
4593 | 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. |
4594 | ||
4595 | This is an instance method. | This is an instance method. |
4596 | ||
# | Line 2622 | Line 4638 |
4638 | close DTXOUT; | close DTXOUT; |
4639 | } | } |
4640 | ||
4641 | =head3 GetStructure | =head3 _GetStructure |
4642 | ||
4643 | Get the data structure for a specified entity or relationship. | Get the data structure for a specified entity or relationship. |
4644 | ||
# | Line 2661 | Line 4677 |
4677 | return $retVal; | return $retVal; |
4678 | } | } |
4679 | ||
4680 | =head3 GetRelationTable | |
4681 | ||
4682 | =head3 _GetRelationTable | |
4683 | ||
4684 | Get the list of relations for a specified entity or relationship. | Get the list of relations for a specified entity or relationship. |
4685 | ||
# | Line 2690 | Line 4708 |
4708 | return $objectData->{Relations}; | return $objectData->{Relations}; |
4709 | } | } |
4710 | ||
4711 | =head3 ValidateFieldNames | =head3 _ValidateFieldNames |
4712 | ||
4713 | 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 |
4714 | 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 2717 | Line 4735 |
4735 | for my $object (values %{$metadata->{$section}}) { | for my $object (values %{$metadata->{$section}}) { |
4736 | # Loop through the object's fields. | # Loop through the object's fields. |
4737 | for my $fieldName (keys %{$object->{Fields}}) { | for my $fieldName (keys %{$object->{Fields}}) { |
4738 | # Now we make some initial validations. | # If this field name is invalid, set the return value to zero |
4739 | if ($fieldName =~ /--/) { | # so we know we encountered an error. |
4740 | # 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"; | ||
4741 | $retVal = 0; | $retVal = 0; |
4742 | } | } |
4743 | } | } |
4744 | } | } |
4745 | } | } |
} | ||
4746 | # If an error was found, fail. | # If an error was found, fail. |
4747 | if ($retVal == 0) { | if ($retVal == 0) { |
4748 | Confess("Errors found in field names."); | Confess("Errors found in field names."); |
4749 | } | } |
4750 | } | } |
4751 | ||
4752 | =head3 LoadRelation | =head3 _LoadRelation |
4753 | ||
4754 | 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 |
4755 | 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 2796 | Line 4800 |
4800 | # be a null string. | # be a null string. |
4801 | if ($fileName ne "") { | if ($fileName ne "") { |
4802 | # Load the relation from the file. | # Load the relation from the file. |
4803 | $retVal = $self->LoadTable($fileName, $relationName, $rebuild); | $retVal = $self->LoadTable($fileName, $relationName, truncate => $rebuild); |
4804 | } elsif ($rebuild) { | } elsif ($rebuild) { |
4805 | # Here we are rebuilding, but no file exists, so we just re-create the table. | # Here we are rebuilding, but no file exists, so we just re-create the table. |
4806 | $self->CreateTable($relationName, 1); | $self->CreateTable($relationName, 1); |
# | Line 2805 | Line 4809 |
4809 | return $retVal; | return $retVal; |
4810 | } | } |
4811 | ||
4812 | =head3 LoadMetaData | |
4813 | =head3 _LoadMetaData | |
4814 | ||
4815 | my $metadata = ERDB::_LoadMetaData($filename); | |
4816 | ||
4817 | 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. |
4818 | 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 2830 | Line 4837 |
4837 | sub _LoadMetaData { | sub _LoadMetaData { |
4838 | # Get the parameters. | # Get the parameters. |
4839 | my ($filename) = @_; | my ($filename) = @_; |
4840 | Trace("Reading Sprout DBD from $filename.") if T(2); | Trace("Reading DBD from $filename.") if T(2); |
4841 | # 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 |
4842 | # get the exact structure we want. | # get the exact structure we want. |
4843 | 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); | ||
4844 | # 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, |
4845 | # the method below will fail. | # the method below will fail. |
4846 | _ValidateFieldNames($metadata); | _ValidateFieldNames($metadata); |
# | Line 2969 | Line 4963 |
4963 | if ($found == 0) { | if ($found == 0) { |
4964 | push @{$indexList}, { IndexFields => [ {name => 'id', order => 'ascending'} ] }; | push @{$indexList}, { IndexFields => [ {name => 'id', order => 'ascending'} ] }; |
4965 | } | } |
4966 | # Now we need to convert the relation's index list to an index table. We begin by creating | # Attach all the indexes to the relation. |
4967 | # an empty table in the relation structure. | _ProcessIndexes($indexList, $relation); |
$relation->{Indexes} = { }; | ||
# Loop through the indexes. | ||
my $count = 0; | ||
for my $index (@{$indexList}) { | ||
# Add this index to the index table. | ||
_AddIndex("idx$relationName$count", $relation, $index); | ||
# Increment the counter so that the next index has a different name. | ||
$count++; | ||
} | ||
4968 | } | } |
4969 | # Finally, we add the relation structure to the entity. | # Finally, we add the relation structure to the entity. |
4970 | $entityStructure->{Relations} = $relationTable; | $entityStructure->{Relations} = $relationTable; |
# | Line 2993 | Line 4978 |
4978 | _FixupFields($relationshipStructure, $relationshipName, 2, 3); | _FixupFields($relationshipStructure, $relationshipName, 2, 3); |
4979 | # Format a description for the FROM field. | # Format a description for the FROM field. |
4980 | my $fromEntity = $relationshipStructure->{from}; | my $fromEntity = $relationshipStructure->{from}; |
4981 | my $fromComment = "<b>id</b> of the source <b><a href=\"#$fromEntity\">$fromEntity</a></b>."; | my $fromComment = "[b]id[/b] of the source [b][link #$fromEntity]$fromEntity\[/link][/b]."; |
4982 | # Get the FROM entity's key type. | # Get the FROM entity's key type. |
4983 | my $fromType = $entityList->{$fromEntity}->{keyType}; | my $fromType = $entityList->{$fromEntity}->{keyType}; |
4984 | # Add the FROM field. | # Add the FROM field. |
# | Line 3003 | Line 4988 |
4988 | PrettySort => 1}); | PrettySort => 1}); |
4989 | # Format a description for the TO field. | # Format a description for the TO field. |
4990 | my $toEntity = $relationshipStructure->{to}; | my $toEntity = $relationshipStructure->{to}; |
4991 | my $toComment = "<b>id</b> of the target <b><a href=\"#$toEntity\">$toEntity</a></b>."; | my $toComment = "[b]id[/b] of the target [b][link #$toEntity]$toEntity\[/link][/b]."; |
4992 | # Get the TO entity's key type. | # Get the TO entity's key type. |
4993 | my $toType = $entityList->{$toEntity}->{keyType}; | my $toType = $entityList->{$toEntity}->{keyType}; |
4994 | # Add the TO field. | # Add the TO field. |
# | Line 3015 | Line 5000 |
5000 | my $thisRelation = { Fields => _ReOrderRelationTable($relationshipStructure->{Fields}), | my $thisRelation = { Fields => _ReOrderRelationTable($relationshipStructure->{Fields}), |
5001 | Indexes => { } }; | Indexes => { } }; |
5002 | $relationshipStructure->{Relations} = { $relationshipName => $thisRelation }; | $relationshipStructure->{Relations} = { $relationshipName => $thisRelation }; |
5003 | ||
5004 | # Add the alternate indexes (if any). This MUST be done before the FROM and | |
5005 | # TO indexes, because it erases the relation's index list. | |
5006 | if (exists $relationshipStructure->{Indexes}) { | |
5007 | _ProcessIndexes($relationshipStructure->{Indexes}, $thisRelation); | |
5008 | } | |
5009 | # Add the relation to the master table. | |
5010 | # Create the FROM and TO indexes. | # Create the FROM and TO indexes. |
5011 | _CreateRelationshipIndex("From", $relationshipName, $relationshipStructure); | _CreateRelationshipIndex("From", $relationshipName, $relationshipStructure); |
5012 | _CreateRelationshipIndex("To", $relationshipName, $relationshipStructure); | _CreateRelationshipIndex("To", $relationshipName, $relationshipStructure); |
# Add the relation to the master table. | ||
5013 | $masterRelationTable{$relationshipName} = $thisRelation; | $masterRelationTable{$relationshipName} = $thisRelation; |
5014 | } | } |
5015 | # Now store the master relation table in the metadata structure. | # Now store the master relation table in the metadata structure. |
# | Line 3117 | Line 5108 |
5108 | # joins, the direction makes a difference with the recursive joins. This can give | # joins, the direction makes a difference with the recursive joins. This can give |
5109 | # 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 |
5110 | # possible to get the same effect using multiple queries. | # possible to get the same effect using multiple queries. |
5111 | for my $relationshipName (@bothList) { | for my $relationshipName (@bothList) { |
5112 | Trace("Setting up entity joins to recursive relationship $relationshipName with $entityName.") if T(metadata => 4); | Trace("Setting up entity joins to recursive relationship $relationshipName with $entityName.") if T(metadata => 4); |
5113 | # Join to the entity from each direction. | # Join to the entity from each direction. |
5114 | $joinTable{"$entityName/$relationshipName"} = | $joinTable{"$entityName/$relationshipName"} = |
5115 | "$entityName.id = $relationshipName.from_link"; | "$entityName.id = $relationshipName.from_link"; |
5116 | $joinTable{"$relationshipName/$entityName"} = | $joinTable{"$relationshipName/$entityName"} = |
5117 | "$relationshipName.to_link = $entityName.id"; | "$relationshipName.to_link = $entityName.id"; |
} | ||
} | ||
# Add the join table to the structure. | ||
$metadata->{Joins} = \%joinTable; | ||
# Return the slurped and fixed-up structure. | ||
return $metadata; | ||
} | ||
=head3 SortNeeded | ||
C<< my $flag = $erdb->SortNeeded($relationName); >> | ||
Return TRUE if the specified relation should be sorted during loading to remove duplicate keys, | ||
else FALSE. | ||
=over 4 | ||
=item relationName | ||
Name of the relation to be examined. | ||
=item RETURN | ||
Returns TRUE if the relation needs a sort, else FALSE. | ||
=back | ||
=cut | ||
#: Return Type $; | ||
sub SortNeeded { | ||
# Get the parameters. | ||
my ($self, $relationName) = @_; | ||
# Declare the return variable. | ||
my $retVal = 0; | ||
# Find out if the relation is a primary entity relation. | ||
my $entityTable = $self->{_metaData}->{Entities}; | ||
if (exists $entityTable->{$relationName}) { | ||
my $keyType = $entityTable->{$relationName}->{keyType}; | ||
Trace("Relation $relationName found in entity table with key type $keyType.") if T(3); | ||
# If the key is not a hash string, we must do the sort. | ||
if ($keyType ne 'hash-string') { | ||
$retVal = 1; | ||
5118 | } | } |
5119 | } | } |
5120 | # Return the result. | # Add the join table to the structure. |
5121 | return $retVal; | $metadata->{Joins} = \%joinTable; |
5122 | # Return the slurped and fixed-up structure. | |
5123 | return $metadata; | |
5124 | } | } |
5125 | ||
5126 | =head3 CreateRelationshipIndex | =head3 _CreateRelationshipIndex |
5127 | ||
5128 | Create an index for a relationship's relation. | Create an index for a relationship's relation. |
5129 | ||
# | Line 3214 | Line 5165 |
5165 | $newIndex->{Unique} = 'true'; | $newIndex->{Unique} = 'true'; |
5166 | } | } |
5167 | # Add the index to the relation. | # Add the index to the relation. |
5168 | _AddIndex("idx$relationshipName$indexKey", $relationStructure, $newIndex); | _AddIndex("idx$indexKey", $relationStructure, $newIndex); |
5169 | } | |
5170 | ||
5171 | =head3 _ProcessIndexes | |
5172 | ||
5173 | ERDB::_ProcessIndexes($indexList, $relation); | |
5174 | ||
5175 | Build the data structures for the specified indexes in the specified relation. | |
5176 | ||
5177 | =over 4 | |
5178 | ||
5179 | =item indexList | |
5180 | ||
5181 | Reference to a list of indexes. Each index is a hash reference containing an optional | |
5182 | C<Notes> value that describes the index and an C<IndexFields> value that is a reference | |
5183 | to a list of index field structures. An index field structure, in turn, is a reference | |
5184 | to a hash that contains a C<name> attribute for the field name and an C<order> | |
5185 | attribute that specifies either C<ascending> or C<descending>. In this sense the | |
5186 | index list encapsulates the XML C<Indexes> structure in the database definition. | |
5187 | ||
5188 | =item relation | |
5189 | ||
5190 | The structure that describes the current relation. The new index descriptors will | |
5191 | be stored in the structure's C<Indexes> member. Any previous data in the structure | |
5192 | will be lost. | |
5193 | ||
5194 | =back | |
5195 | ||
5196 | =cut | |
5197 | ||
5198 | sub _ProcessIndexes { | |
5199 | # Get the parameters. | |
5200 | my ($indexList, $relation) = @_; | |
5201 | # Now we need to convert the relation's index list to an index table. We begin by creating | |
5202 | # an empty table in the relation structure. | |
5203 | $relation->{Indexes} = { }; | |
5204 | # Loop through the indexes. | |
5205 | my $count = 0; | |
5206 | for my $index (@{$indexList}) { | |
5207 | # Add this index to the index table. | |
5208 | _AddIndex("idx$count", $relation, $index); | |
5209 | # Increment the counter so that the next index has a different name. | |
5210 | $count++; | |
5211 | } | |
5212 | } | } |
5213 | ||
5214 | =head3 AddIndex | =head3 _AddIndex |
5215 | ||
5216 | Add an index to a relation structure. | Add an index to a relation structure. |
5217 | ||
# | Line 3263 | Line 5257 |
5257 | $relationStructure->{Indexes}->{$indexName} = $newIndex; | $relationStructure->{Indexes}->{$indexName} = $newIndex; |
5258 | } | } |
5259 | ||
5260 | =head3 FixupFields | =head3 _FixupFields |
5261 | ||
5262 | 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 |
5263 | 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 3301 | Line 5295 |
5295 | # Here it doesn't, so we create a new one. | # Here it doesn't, so we create a new one. |
5296 | $structure->{Fields} = { }; | $structure->{Fields} = { }; |
5297 | } else { | } else { |
5298 | # 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 |
5299 | # create a list for stashing them. | |
5300 | my @textFields = (); | |
5301 | # Loop through the fields. | |
5302 | my $fieldStructures = $structure->{Fields}; | my $fieldStructures = $structure->{Fields}; |
5303 | for my $fieldName (keys %{$fieldStructures}) { | for my $fieldName (keys %{$fieldStructures}) { |
5304 | Trace("Processing field $fieldName of $defaultRelationName.") if T(4); | Trace("Processing field $fieldName of $defaultRelationName.") if T(4); |
# | Line 3310 | Line 5307 |
5307 | my $type = $fieldData->{type}; | my $type = $fieldData->{type}; |
5308 | # Plug in a relation name if it is needed. | # Plug in a relation name if it is needed. |
5309 | Tracer::MergeOptions($fieldData, { relation => $defaultRelationName }); | Tracer::MergeOptions($fieldData, { relation => $defaultRelationName }); |
5310 | # Plug in a data generator if we need one. | # Check for searchability. |
5311 | if (!exists $fieldData->{DataGen}) { | if ($fieldData->{searchable}) { |
5312 | # The data generator will use the default for the field's type. | # Only allow this for a primary relation. |
5313 | $fieldData->{DataGen} = { content => $TypeTable{$type}->{dataGen} }; | if ($fieldData->{relation} ne $defaultRelationName) { |
5314 | Confess("Field $fieldName of $defaultRelationName is in secondary relations and cannot be searchable."); | |
5315 | } else { | |
5316 | push @textFields, $fieldName; | |
5317 | } | |
5318 | } | } |
# Plug in the defaults for the optional data generation parameters. | ||
Tracer::MergeOptions($fieldData->{DataGen}, { testCount => 1, pass => 0 }); | ||
5319 | # Add the PrettySortValue. | # Add the PrettySortValue. |
5320 | $fieldData->{PrettySort} = (($type eq "text") ? $textPrettySortValue : $prettySortValue); | $fieldData->{PrettySort} = (($type eq "text") ? $textPrettySortValue : $prettySortValue); |
5321 | } | } |
5322 | # If there are searchable fields, remember the fact. | |
5323 | if (@textFields) { | |
5324 | $structure->{searchFields} = \@textFields; | |
5325 | } | |
5326 | } | } |
5327 | } | } |
5328 | ||
5329 | =head3 FixName | =head3 _FixName |
5330 | ||
5331 | 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. |
5332 | ||
# | Line 3352 | Line 5355 |
5355 | return $fieldName; | return $fieldName; |
5356 | } | } |
5357 | ||
5358 | =head3 FixNames | =head3 _FixNames |
5359 | ||
5360 | Fix all the field names in a list. | Fix all the field names in a list. |
5361 | ||
# | Line 3383 | Line 5386 |
5386 | return @result; | return @result; |
5387 | } | } |
5388 | ||
5389 | =head3 AddField | =head3 _AddField |
5390 | ||
5391 | Add a field to a field list. | Add a field to a field list. |
5392 | ||
# | Line 3418 | Line 5421 |
5421 | $fieldList->{$fieldName} = $fieldStructure; | $fieldList->{$fieldName} = $fieldStructure; |
5422 | } | } |
5423 | ||
5424 | =head3 ReOrderRelationTable | =head3 _ReOrderRelationTable |
5425 | ||
5426 | 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 |
5427 | 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 3479 | Line 5482 |
5482 | ||
5483 | } | } |
5484 | ||
5485 | =head3 IsPrimary | =head3 _IsPrimary |
5486 | ||
5487 | 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 |
5488 | if it has the same name as an entity or relationship. | if it has the same name as an entity or relationship. |
# | Line 3515 | Line 5518 |
5518 | return $retVal; | return $retVal; |
5519 | } | } |
5520 | ||
5521 | =head3 FindRelation | =head3 _FindRelation |
5522 | ||
5523 | Return the descriptor for the specified relation. | Return the descriptor for the specified relation. |
5524 | ||
# | Line 3544 | Line 5547 |
5547 | return $retVal; | return $retVal; |
5548 | } | } |
5549 | ||
5550 | =head2 HTML Documentation Utility Methods | =head2 Documentation Utility Methods |
5551 | ||
5552 | =head3 ComputeRelationshipSentence | =head3 _ComputeRelationshipSentence |
5553 | ||
5554 | 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 |
5555 | two related entities and an arity indicator. | two related entities and an arity indicator. |
# | Line 3576 | Line 5579 |
5579 | # Get the parameters. | # Get the parameters. |
5580 | my ($relationshipName, $relationshipStructure) = @_; | my ($relationshipName, $relationshipStructure) = @_; |
5581 | # Format the relationship sentence. | # Format the relationship sentence. |
5582 | my $result = "$relationshipStructure->{from} <b>$relationshipName</b> $relationshipStructure->{to}"; | my $result = "$relationshipStructure->{from} $relationshipName $relationshipStructure->{to}"; |
5583 | # Compute the arity. | # Compute the arity. |
5584 | my $arityCode = $relationshipStructure->{arity}; | my $arityCode = $relationshipStructure->{arity}; |
5585 | my $arity = $ArityTable{$arityCode}; | my $arity = $ArityTable{$arityCode}; |
# | Line 3584 | Line 5587 |
5587 | return $result; | return $result; |
5588 | } | } |
5589 | ||
5590 | =head3 ComputeRelationshipHeading | =head3 _ComputeRelationshipHeading |
5591 | ||
5592 | The relationship heading is the L<relationship sentence|/ComputeRelationshipSentence> with the entity | The relationship heading is the L<relationship sentence|/ComputeRelationshipSentence> with the entity |
5593 | names hyperlinked to the appropriate entity sections of the document. | names hyperlinked to the appropriate entity sections of the document. |
# | Line 3621 | Line 5624 |
5624 | return $result; | return $result; |
5625 | } | } |
5626 | ||
5627 | =head3 ShowRelationTable | =head3 _WikiRelationTable |
5628 | ||
5629 | Generate the Wiki text for a particular relation. The relation's data will be formatted as a | |
5630 | table with three columns-- the field name, the field type, and the field description. | |
5631 | ||
5632 | This is a static method. | |
5633 | ||
5634 | =over 4 | |
5635 | ||
5636 | =item relationName | |
5637 | ||
5638 | Name of the relation being formatted. | |
5639 | ||
5640 | =item relationData | |
5641 | ||
5642 | Hash containing the relation's fields and indexes. | |
5643 | ||
5644 | =item RETURN | |
5645 | ||
5646 | Returns a Wiki string that can be used to display the relation name and all of its fields. | |
5647 | ||
5648 | =back | |
5649 | ||
5650 | =cut | |
5651 | ||
5652 | sub _WikiRelationTable { | |
5653 | # Get the parameters. | |
5654 | my ($relationName, $relationData) = @_; | |
5655 | # We'll create a list of lists in here, then call WikiTools::Table to | |
5656 | # convert it into a table. | |
5657 | my @rows = (); | |
5658 | # Push in the header row. | |
5659 | push @rows, [qw(Field Type Description)]; | |
5660 | # Loop through the fields. | |
5661 | for my $field (@{$relationData->{Fields}}) { | |
5662 | # Create this field's row. We always have a name and type. | |
5663 | my @row = ($field->{name}, $field->{type}); | |
5664 | # If we have a description, add it as the third column. | |
5665 | if (exists $field->{Notes}) { | |
5666 | push @row, WikiNote($field->{Notes}->{content}); | |
5667 | } | |
5668 | # Push this row onto the table list. | |
5669 | push @rows, \@row; | |
5670 | } | |
5671 | # Store the rows as a Wiki table with a level-4 heading. | |
5672 | my $retVal = join("\n\n", WikiTools::Heading(4, "$relationName Table"), | |
5673 | WikiTools::Table(@rows)); | |
5674 | # Now we show the relation's indexes. These are formatted as another | |
5675 | # table. | |
5676 | @rows = (); | |
5677 | # Push in the header row. | |
5678 | push @rows, [qw(Index Unique Fields Notes)]; | |
5679 | # Get the index hash. | |
5680 | my $indexTable = $relationData->{Indexes}; | |
5681 | # Loop through the indexes. For an entity, there is always at least one index. | |
5682 | # For a relationship, there are at least two. The upshot is we don't need to | |
5683 | # worry about accidentally generating a frivolous table here. | |
5684 | for my $indexName (sort keys %$indexTable) { | |
5685 | my $indexData = $indexTable->{$indexName}; | |
5686 | # Determine whether or not the index is unique. | |
5687 | my $unique = ((exists $indexData->{Unique} && $indexData->{Unique} eq "true") ? | |
5688 | "yes" : ""); | |
5689 | # Get the field list. | |
5690 | my $fields = join(', ', @{$indexData->{IndexFields}}); | |
5691 | # Get the note text. | |
5692 | my $description = ""; | |
5693 | if (my $note = $indexData->{Notes}) { | |
5694 | $description = WikiNote($note->{content}); | |
5695 | } | |
5696 | # Format this row. | |
5697 | my @row = ($indexName, $unique, $fields, $description); | |
5698 | push @rows, \@row; | |
5699 | } | |
5700 | # Add the index list to the result. | |
5701 | $retVal .= "\n\n" . WikiTools::Table(@rows); | |
5702 | } | |
5703 | ||
5704 | =head3 _ShowRelationTable | |
5705 | ||
5706 | 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 |
5707 | 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 3671 | Line 5751 |
5751 | $htmlString .= "<li><b>Index $fullName</b>\n<ul>\n"; | $htmlString .= "<li><b>Index $fullName</b>\n<ul>\n"; |
5752 | # Add any note text. | # Add any note text. |
5753 | if (my $note = $indexData->{Notes}) { | if (my $note = $indexData->{Notes}) { |
5754 | $htmlString .= "<li>" . _HTMLNote($note->{content}) . "</li>\n"; | $htmlString .= "<li>" . HTMLNote($note->{content}) . "</li>\n"; |
5755 | } | } |
5756 | # Add the fiield list. | # Add the fiield list. |
5757 | $htmlString .= "<li><i>" . join(', ', @{$indexData->{IndexFields}}) . "</i></li>\n"; | $htmlString .= "<li><i>" . join(', ', @{$indexData->{IndexFields}}) . "</i></li>\n"; |
# | Line 3682 | Line 5762 |
5762 | $htmlString .= "</ul>\n"; | $htmlString .= "</ul>\n"; |
5763 | } | } |
5764 | ||
5765 | =head3 OpenFieldTable | =head3 _OpenFieldTable |
5766 | ||
5767 | 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>. |
5768 | ||
# | Line 3707 | Line 5787 |
5787 | return _OpenTable($tablename, 'Field', 'Type', 'Description'); | return _OpenTable($tablename, 'Field', 'Type', 'Description'); |
5788 | } | } |
5789 | ||
5790 | =head3 OpenTable | =head3 _OpenTable |
5791 | ||
5792 | This method creates the header string for an HTML table. | This method creates the header string for an HTML table. |
5793 | ||
# | Line 3737 | Line 5817 |
5817 | # Compute the number of columns. | # Compute the number of columns. |
5818 | my $colCount = @colNames; | my $colCount = @colNames; |
5819 | # Generate the title row. | # Generate the title row. |
5820 | my $htmlString = "<p><table border=\"2\"><tr><td colspan=\"$colCount\" align=\"center\">$tablename</td></tr>\n"; | my $htmlString = "<table border=\"2\"><tr><td colspan=\"$colCount\" align=\"center\">$tablename</td></tr>\n"; |
5821 | # Loop through the columns, adding the column header rows. | # Loop through the columns, adding the column header rows. |
5822 | $htmlString .= "<tr>"; | $htmlString .= "<tr>"; |
5823 | for my $colName (@colNames) { | for my $colName (@colNames) { |
# | Line 3747 | Line 5827 |
5827 | return $htmlString; | return $htmlString; |
5828 | } | } |
5829 | ||
5830 | =head3 CloseTable | =head3 _CloseTable |
5831 | ||
5832 | This method returns the HTML for closing a table. | This method returns the HTML for closing a table. |
5833 | ||
# | Line 3756 | Line 5836 |
5836 | =cut | =cut |
5837 | ||
5838 | sub _CloseTable { | sub _CloseTable { |
5839 | return "</table></p>\n"; | return "</table>\n"; |
5840 | } | } |
5841 | ||
5842 | =head3 ShowField | =head3 _ShowField |
5843 | ||
5844 | 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. |
5845 | ||
# | Line 3786 | Line 5866 |
5866 | 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>"; |
5867 | # If we have content, add it as a third column. | # If we have content, add it as a third column. |
5868 | if (exists $fieldData->{Notes}) { | if (exists $fieldData->{Notes}) { |
5869 | $htmlString .= "<td>" . _HTMLNote($fieldData->{Notes}->{content}) . "</td>"; | $htmlString .= "<td>" . HTMLNote($fieldData->{Notes}->{content}) . "</td>"; |
5870 | } | } |
5871 | # Close off the row. | # Close off the row. |
5872 | $htmlString .= "</tr>\n"; | $htmlString .= "</tr>\n"; |
# | Line 3794 | Line 5874 |
5874 | return $htmlString; | return $htmlString; |
5875 | } | } |
5876 | ||
5877 | =head3 HTMLNote | =head3 _ObjectNotes |
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 | ||
String to convert to HTML. | ||
=item RETURN | ||
An HTML string derived from the input string. | ||
=back | ||
=cut | ||
sub _HTMLNote { | ||
# Get the parameter. | ||
my ($dataString) = @_; | ||
# Substitute the codes. | ||
$dataString =~ s!\[(/?[bi])\]!<$1>!g; | ||
$dataString =~ s!\[p\]!</p><p>!g; | ||
# Return the result. | ||