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); |
|
use FIG; |
|
13 |
use CGI; |
use CGI; |
14 |
|
|
15 |
=head1 Entity-Relationship Database Package |
=head1 Entity-Relationship Database Package |
227 |
|
|
228 |
=head3 Indexes |
=head3 Indexes |
229 |
|
|
230 |
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 |
231 |
all be from the same relation. The alternate indexes assist in ordering results |
index must all be from the same relation. The alternate indexes assist in searching |
232 |
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 |
233 |
I<from-index>. These order the results when crossing the relationship. For |
I<from-index> that order the results when crossing the relationship. For |
234 |
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 |
235 |
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 |
236 |
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 |
237 |
|
indexes. A relationship's index must specify only fields in |
238 |
the relationship. |
the relationship. |
239 |
|
|
240 |
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. |
241 |
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 |
242 |
using the B<ToIndex> tag. |
specified using the B<ToIndex> tag. |
243 |
|
|
244 |
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> |
245 |
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 |
257 |
|
|
258 |
=back |
=back |
259 |
|
|
260 |
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 |
261 |
|
have a B<Unique> attribute. If specified, the index will be generated as a unique |
262 |
|
index. |
263 |
|
|
264 |
=head3 Object and Field Names |
=head3 Object and Field Names |
265 |
|
|
303 |
|
|
304 |
A relationship is described by the C<Relationship> tag. Within a relationship, |
A relationship is described by the C<Relationship> tag. Within a relationship, |
305 |
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 |
306 |
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 |
307 |
the to-index. |
the to-index, and an C<Indexes> tag containing the alternate indexes. |
308 |
|
|
309 |
The C<Relationship> tag has the following attributes. |
The C<Relationship> tag has the following attributes. |
310 |
|
|
372 |
'medium-string' => |
'medium-string' => |
373 |
{ sqlType => 'VARCHAR(160)', maxLen => 160, avgLen => 40, sort => "", |
{ sqlType => 'VARCHAR(160)', maxLen => 160, avgLen => 40, sort => "", |
374 |
indexMod => 0, notes => "character string, 0 to 160 characters"}, |
indexMod => 0, notes => "character string, 0 to 160 characters"}, |
375 |
|
'long-string' => |
376 |
|
{ sqlType => 'VARCHAR(500)', maxLen => 500, avglen => 255, sort => "", |
377 |
|
indexMod => 0, notes => "character string, 0 to 500 characters"}, |
378 |
); |
); |
379 |
|
|
380 |
# Table translating arities into natural language. |
# Table translating arities into natural language. |
399 |
); |
); |
400 |
|
|
401 |
my %XmlInOpts = ( |
my %XmlInOpts = ( |
402 |
ForceArray => ['Field', 'Index', 'IndexField'], |
ForceArray => ['Field', 'Index', 'IndexField', 'Relationship', 'Entity'], |
403 |
ForceContent => 1, |
ForceContent => 1, |
404 |
NormalizeSpace => 2, |
NormalizeSpace => 2, |
405 |
); |
); |
413 |
|
|
414 |
=head3 new |
=head3 new |
415 |
|
|
416 |
C<< my $database = ERDB->new($dbh, $metaFileName); >> |
my $database = ERDB->new($dbh, $metaFileName); |
417 |
|
|
418 |
Create a new ERDB object. |
Create a new ERDB object. |
419 |
|
|
447 |
|
|
448 |
=head3 ShowMetaData |
=head3 ShowMetaData |
449 |
|
|
450 |
C<< $erdb->ShowMetaData($fileName); >> |
$erdb->ShowMetaData($fileName); |
451 |
|
|
452 |
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 |
453 |
the data to be loaded into the relations. |
the data to be loaded into the relations. |
488 |
|
|
489 |
=head3 DisplayMetaData |
=head3 DisplayMetaData |
490 |
|
|
491 |
C<< my $html = $erdb->DisplayMetaData(); >> |
my $html = $erdb->DisplayMetaData(); |
492 |
|
|
493 |
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 |
494 |
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 |
551 |
if (my $notes = $entityData->{Notes}) { |
if (my $notes = $entityData->{Notes}) { |
552 |
$retVal .= "<p>" . HTMLNote($notes->{content}) . "</p>\n"; |
$retVal .= "<p>" . HTMLNote($notes->{content}) . "</p>\n"; |
553 |
} |
} |
554 |
# 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. |
555 |
|
my $relCount = keys %{$relationshipList}; |
556 |
|
if ($relCount > 0) { |
557 |
|
# First, we set up the relationship subsection. |
558 |
$retVal .= "<h4>Relationships for <b>$key</b></h4>\n<ul>\n"; |
$retVal .= "<h4>Relationships for <b>$key</b></h4>\n<ul>\n"; |
559 |
# Loop through the relationships. |
# Loop through the relationships. |
560 |
for my $relationship (sort keys %{$relationshipList}) { |
for my $relationship (sort keys %{$relationshipList}) { |
570 |
} |
} |
571 |
# Close off the relationship list. |
# Close off the relationship list. |
572 |
$retVal .= "</ul>\n"; |
$retVal .= "</ul>\n"; |
573 |
|
} |
574 |
# Get the entity's relations. |
# Get the entity's relations. |
575 |
my $relationList = $entityData->{Relations}; |
my $relationList = $entityData->{Relations}; |
576 |
# Create a header for the relation subsection. |
# Create a header for the relation subsection. |
644 |
|
|
645 |
=head3 DumpMetaData |
=head3 DumpMetaData |
646 |
|
|
647 |
C<< $erdb->DumpMetaData(); >> |
$erdb->DumpMetaData(); |
648 |
|
|
649 |
Return a dump of the metadata structure. |
Return a dump of the metadata structure. |
650 |
|
|
657 |
return Data::Dumper::Dumper($self->{_metaData}); |
return Data::Dumper::Dumper($self->{_metaData}); |
658 |
} |
} |
659 |
|
|
660 |
|
=head3 CreatePPO |
661 |
|
|
662 |
|
ERDB::CreatePPO($erdbXMLFile, $ppoXMLFile); |
663 |
|
|
664 |
|
Create a PPO XML file from an ERDB data definition XML file. At the |
665 |
|
current time, the PPO XML file can be used to create a database with |
666 |
|
similar functionality. Eventually, the PPO will be able to use the |
667 |
|
created XML to access the live ERDB database. |
668 |
|
|
669 |
|
=over 4 |
670 |
|
|
671 |
|
=item erdbXMLFile |
672 |
|
|
673 |
|
Name of the XML data definition file for the ERDB database. This |
674 |
|
file must exist. |
675 |
|
|
676 |
|
=item ppoXMLFile |
677 |
|
|
678 |
|
Output file for the PPO XML definition. If this file exists, it |
679 |
|
will be overwritten. |
680 |
|
|
681 |
|
=back |
682 |
|
|
683 |
|
=cut |
684 |
|
|
685 |
|
sub CreatePPO { |
686 |
|
# Get the parameters. |
687 |
|
my ($erdbXMLFile, $ppoXMLFile) = @_; |
688 |
|
# First, we want to slurp in the ERDB XML file in its raw form. |
689 |
|
my $xml = ReadMetaXML($erdbXMLFile); |
690 |
|
# Create a variable to hold all of the objects in the PPO project. |
691 |
|
my @objects = (); |
692 |
|
# Get the relationship hash. |
693 |
|
my $relationships = $xml->{Relationships}; |
694 |
|
# Loop through the entities. |
695 |
|
my $entities = $xml->{Entities}; |
696 |
|
for my $entityName (keys %{$entities}) { |
697 |
|
# Get the entity's data structures. |
698 |
|
my $entityObject = $entities->{$entityName}; |
699 |
|
# We put the object's fields in here, according to their type. |
700 |
|
my (@object_refs, @scalars, @indexes, @arrays); |
701 |
|
# Create the ID field for the entity. We get the key type from the |
702 |
|
# entity object and compute the corresponding SQL type. |
703 |
|
my $type = $TypeTable{$entityObject->{keyType}}->{sqlType}; |
704 |
|
push @scalars, { label => 'id', type => $type }; |
705 |
|
# Loop through the entity fields. |
706 |
|
for my $fieldName ( keys %{$entityObject->{Fields}} ) { |
707 |
|
# Get the field object. |
708 |
|
my $fieldObject = $entityObject->{Fields}->{$fieldName}; |
709 |
|
# Convert it to a scalar tag. |
710 |
|
my $scalar = _CreatePPOField($fieldName, $fieldObject); |
711 |
|
# If we have a relation, this field is stored in an array. |
712 |
|
# otherwise, it is a scalar. The array tag has scalars |
713 |
|
# stored as an XML array. In ERDB, there is only ever one, |
714 |
|
# but PPO can have more. |
715 |
|
my $relation = $fieldObject->{relation}; |
716 |
|
if ($relation) { |
717 |
|
push @arrays, { scalar => [$scalar] }; |
718 |
|
} else { |
719 |
|
push @scalars, $scalar; |
720 |
|
} |
721 |
|
} |
722 |
|
# Loop through the relationships. If this entity is the to-entity |
723 |
|
# on a relationship of 1M arity, then it is implemented as a PPO |
724 |
|
# object reference. |
725 |
|
for my $relationshipName (keys %{$relationships}) { |
726 |
|
# Get the relationship data. |
727 |
|
my $relationshipData = $relationships->{$relationshipName}; |
728 |
|
# If we have a from for this entity and an arity of 1M, we |
729 |
|
# have an object reference. |
730 |
|
if ($relationshipData->{to} eq $entityName && |
731 |
|
$relationshipData->{arity} eq '1M') { |
732 |
|
# Build the object reference tag. |
733 |
|
push @object_refs, { label => $relationshipName, |
734 |
|
type => $relationshipData->{from} }; |
735 |
|
} |
736 |
|
} |
737 |
|
# Create the indexes. |
738 |
|
my $indexList = $entityObject->{Indexes}; |
739 |
|
push @indexes, map { _CreatePPOIndex($_) } @{$indexList}; |
740 |
|
# Build the object XML tree. |
741 |
|
my $object = { label => $entityName, |
742 |
|
object_ref => \@object_refs, |
743 |
|
scalar => \@scalars, |
744 |
|
index => \@indexes, |
745 |
|
array => \@arrays |
746 |
|
}; |
747 |
|
# Push the object onto the objects list. |
748 |
|
push @objects, $object; |
749 |
|
} |
750 |
|
# Loop through the relationships, searching for MMs. The 1Ms were |
751 |
|
# already handled by the entity search above. |
752 |
|
for my $relationshipName (keys %{$relationships}) { |
753 |
|
# Get this relationship's object. |
754 |
|
my $relationshipObject = $relationships->{$relationshipName}; |
755 |
|
# Only proceed if it's many-to-many. |
756 |
|
if ($relationshipObject->{arity} eq 'MM') { |
757 |
|
# Create the tag lists for the relationship object. |
758 |
|
my (@object_refs, @scalars, @indexes); |
759 |
|
# The relationship will be created as an object with object |
760 |
|
# references for its links to the participating entities. |
761 |
|
my %links = ( from_link => $relationshipObject->{from}, |
762 |
|
to_link => $relationshipObject->{to} ); |
763 |
|
for my $link (keys %links) { |
764 |
|
# Create an object_ref tag for this piece of the |
765 |
|
# relationship (from or to). |
766 |
|
my $object_ref = { label => $link, |
767 |
|
type => $links{$link} }; |
768 |
|
push @object_refs, $object_ref; |
769 |
|
} |
770 |
|
# Loop through the intersection data fields, creating scalar tags. |
771 |
|
# There are no fancy array tags in a relationship. |
772 |
|
for my $fieldName (keys %{$relationshipObject->{Fields}}) { |
773 |
|
my $fieldObject = $relationshipObject->{Fields}->{$fieldName}; |
774 |
|
push @scalars, _CreatePPOField($fieldName, $fieldObject); |
775 |
|
} |
776 |
|
# Finally, the indexes: currently we cannot support the to-index and |
777 |
|
# from-index in PPO, so we just process the alternate indexes. |
778 |
|
my $indexList = $relationshipObject->{Indexes}; |
779 |
|
push @indexes, map { _CreatePPOIndex($_) } @{$indexList}; |
780 |
|
# Wrap up all the stuff about this relationship. |
781 |
|
my $object = { label => $relationshipName, |
782 |
|
scalar => \@scalars, |
783 |
|
object_ref => \@object_refs, |
784 |
|
index => \@indexes |
785 |
|
}; |
786 |
|
# Push it into the object list. |
787 |
|
push @objects, $object; |
788 |
|
} |
789 |
|
} |
790 |
|
# Compute a title. |
791 |
|
my $title; |
792 |
|
if ($erdbXMLFile =~ /(\/|^)([^\/]+)DBD\.xml/) { |
793 |
|
# Here we have a standard file name we can use for a title. |
794 |
|
$title = $2; |
795 |
|
} else { |
796 |
|
# Here the file name is non-standard, so we carve up the |
797 |
|
# database title. |
798 |
|
$title = $xml->{Title}->{content}; |
799 |
|
$title =~ s/\s\.,//g; |
800 |
|
} |
801 |
|
# Wrap up the XML as a project. |
802 |
|
my $ppoXML = { project => { label => $title, |
803 |
|
object => \@objects }}; |
804 |
|
# Write out the results. |
805 |
|
my $ppoString = XML::Simple::XMLout($ppoXML, |
806 |
|
AttrIndent => 1, |
807 |
|
KeepRoot => 1); |
808 |
|
Tracer::PutFile($ppoXMLFile, [ $ppoString ]); |
809 |
|
} |
810 |
|
|
811 |
=head3 FindIndexForEntity |
=head3 FindIndexForEntity |
812 |
|
|
813 |
C<< my $indexFound = ERDB::FindIndexForEntity($xml, $entityName, $attributeName); >> |
my $indexFound = ERDB::FindIndexForEntity($xml, $entityName, $attributeName); |
814 |
|
|
815 |
This method locates the entry in an entity's index list that begins with the |
This method locates the entry in an entity's index list that begins with the |
816 |
specified attribute name. If the entity has no index list, one will be |
specified attribute name. If the entity has no index list, one will be |
880 |
|
|
881 |
=head3 CreateTables |
=head3 CreateTables |
882 |
|
|
883 |
C<< $erdb->CreateTables(); >> |
$erdb->CreateTables(); |
884 |
|
|
885 |
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 |
886 |
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 |
897 |
# Loop through the relations. |
# Loop through the relations. |
898 |
for my $relationName (@relNames) { |
for my $relationName (@relNames) { |
899 |
# Create a table for this relation. |
# Create a table for this relation. |
900 |
$self->CreateTable($relationName); |
$self->CreateTable($relationName, 1); |
901 |
Trace("Relation $relationName created.") if T(2); |
Trace("Relation $relationName created.") if T(2); |
902 |
} |
} |
903 |
} |
} |
904 |
|
|
905 |
=head3 CreateTable |
=head3 CreateTable |
906 |
|
|
907 |
C<< $erdb->CreateTable($tableName, $indexFlag, $estimatedRows); >> |
$erdb->CreateTable($tableName, $indexFlag, $estimatedRows); |
908 |
|
|
909 |
Create the table for a relation and optionally create its indexes. |
Create the table for a relation and optionally create its indexes. |
910 |
|
|
960 |
my $estimation = undef; |
my $estimation = undef; |
961 |
if ($estimatedRows) { |
if ($estimatedRows) { |
962 |
$estimation = [$self->EstimateRowSize($relationName), $estimatedRows]; |
$estimation = [$self->EstimateRowSize($relationName), $estimatedRows]; |
963 |
|
Trace("$estimation->[1] rows of $estimation->[0] bytes each.") if T(3); |
964 |
} |
} |
965 |
# Create the table. |
# Create the table. |
966 |
Trace("Creating table $relationName: $fieldThing") if T(2); |
Trace("Creating table $relationName: $fieldThing") if T(2); |
975 |
|
|
976 |
=head3 VerifyFields |
=head3 VerifyFields |
977 |
|
|
978 |
C<< my $count = $erdb->VerifyFields($relName, \@fieldList); >> |
my $count = $erdb->VerifyFields($relName, \@fieldList); |
979 |
|
|
980 |
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 |
981 |
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. |
1018 |
my $oldString = $fieldList->[$i]; |
my $oldString = $fieldList->[$i]; |
1019 |
if (length($oldString) > $maxLen) { |
if (length($oldString) > $maxLen) { |
1020 |
# Here it's too big, so we truncate it. |
# Here it's too big, so we truncate it. |
1021 |
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); |
1022 |
$fieldList->[$i] = substr $oldString, 0, $maxLen; |
$fieldList->[$i] = substr $oldString, 0, $maxLen; |
1023 |
$retVal++; |
$retVal++; |
1024 |
} |
} |
1030 |
|
|
1031 |
=head3 DigestFields |
=head3 DigestFields |
1032 |
|
|
1033 |
C<< $erdb->DigestFields($relName, $fieldList); >> |
$erdb->DigestFields($relName, $fieldList); |
1034 |
|
|
1035 |
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 |
1036 |
specified relation. |
specified relation. |
1070 |
|
|
1071 |
=head3 DigestKey |
=head3 DigestKey |
1072 |
|
|
1073 |
C<< my $digested = $erdb->DigestKey($keyValue); >> |
my $digested = $erdb->DigestKey($keyValue); |
1074 |
|
|
1075 |
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 |
1076 |
key-based search into a table with key-type hash-string. |
key-based search into a table with key-type hash-string. |
1103 |
|
|
1104 |
=head3 CreateIndex |
=head3 CreateIndex |
1105 |
|
|
1106 |
C<< $erdb->CreateIndex($relationName); >> |
$erdb->CreateIndex($relationName); |
1107 |
|
|
1108 |
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 |
1109 |
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. |
1127 |
my @rawFields = @{$indexData->{IndexFields}}; |
my @rawFields = @{$indexData->{IndexFields}}; |
1128 |
# Get a hash of the relation's field types. |
# Get a hash of the relation's field types. |
1129 |
my %types = map { $_->{name} => $_->{type} } @{$relationData->{Fields}}; |
my %types = map { $_->{name} => $_->{type} } @{$relationData->{Fields}}; |
1130 |
# We need to check for text fields. We need a append a length limitation for them. To do |
# We need to check for text fields so we can append a length limitation for them. To do |
1131 |
# that, we need the relation's field list. |
# that, we need the relation's field list. |
1132 |
my $relFields = $relationData->{Fields}; |
my $relFields = $relationData->{Fields}; |
1133 |
for (my $i = 0; $i <= $#rawFields; $i++) { |
for (my $i = 0; $i <= $#rawFields; $i++) { |
1159 |
|
|
1160 |
=head3 GetSecondaryFields |
=head3 GetSecondaryFields |
1161 |
|
|
1162 |
C<< my %fieldTuples = $erdb->GetSecondaryFields($entityName); >> |
my %fieldTuples = $erdb->GetSecondaryFields($entityName); |
1163 |
|
|
1164 |
This method will return a list of the name and type of each of the secondary |
This method will return a list of the name and type of each of the secondary |
1165 |
fields for a specified entity. Secondary fields are stored in two-column tables |
fields for a specified entity. Secondary fields are stored in two-column tables |
1200 |
|
|
1201 |
=head3 GetFieldRelationName |
=head3 GetFieldRelationName |
1202 |
|
|
1203 |
C<< my $name = $erdb->GetFieldRelationName($objectName, $fieldName); >> |
my $name = $erdb->GetFieldRelationName($objectName, $fieldName); |
1204 |
|
|
1205 |
Return the name of the relation containing a specified field. |
Return the name of the relation containing a specified field. |
1206 |
|
|
1241 |
|
|
1242 |
=head3 DeleteValue |
=head3 DeleteValue |
1243 |
|
|
1244 |
C<< my $numDeleted = $erdb->DeleteValue($entityName, $id, $fieldName, $fieldValue); >> |
my $numDeleted = $erdb->DeleteValue($entityName, $id, $fieldName, $fieldValue); |
1245 |
|
|
1246 |
Delete secondary field values from the database. This method can be used to delete all |
Delete secondary field values from the database. This method can be used to delete all |
1247 |
values of a specified field for a particular entity instance, or only a single value. |
values of a specified field for a particular entity instance, or only a single value. |
1324 |
|
|
1325 |
=head3 LoadTables |
=head3 LoadTables |
1326 |
|
|
1327 |
C<< my $stats = $erdb->LoadTables($directoryName, $rebuild); >> |
my $stats = $erdb->LoadTables($directoryName, $rebuild); |
1328 |
|
|
1329 |
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 |
1330 |
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; |
1384 |
|
|
1385 |
=head3 GetTableNames |
=head3 GetTableNames |
1386 |
|
|
1387 |
C<< my @names = $erdb->GetTableNames; >> |
my @names = $erdb->GetTableNames; |
1388 |
|
|
1389 |
Return a list of the relations required to implement this database. |
Return a list of the relations required to implement this database. |
1390 |
|
|
1401 |
|
|
1402 |
=head3 GetEntityTypes |
=head3 GetEntityTypes |
1403 |
|
|
1404 |
C<< my @names = $erdb->GetEntityTypes; >> |
my @names = $erdb->GetEntityTypes; |
1405 |
|
|
1406 |
Return a list of the entity type names. |
Return a list of the entity type names. |
1407 |
|
|
1418 |
|
|
1419 |
=head3 GetDataTypes |
=head3 GetDataTypes |
1420 |
|
|
1421 |
C<< my %types = ERDB::GetDataTypes(); >> |
my %types = ERDB::GetDataTypes(); |
1422 |
|
|
1423 |
Return a table of ERDB data types. The table returned is a hash of hashes. |
Return a table of ERDB data types. The table returned is a hash of hashes. |
1424 |
The keys of the big hash are the datatypes. Each smaller hash has several |
The keys of the big hash are the datatypes. Each smaller hash has several |
1437 |
|
|
1438 |
=head3 IsEntity |
=head3 IsEntity |
1439 |
|
|
1440 |
C<< my $flag = $erdb->IsEntity($entityName); >> |
my $flag = $erdb->IsEntity($entityName); |
1441 |
|
|
1442 |
Return TRUE if the parameter is an entity name, else FALSE. |
Return TRUE if the parameter is an entity name, else FALSE. |
1443 |
|
|
1464 |
|
|
1465 |
=head3 Get |
=head3 Get |
1466 |
|
|
1467 |
C<< my $query = $erdb->Get(\@objectNames, $filterClause, \@params); >> |
my $query = $erdb->Get(\@objectNames, $filterClause, \@params); |
1468 |
|
|
1469 |
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. |
1470 |
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 |
1472 |
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 |
1473 |
$genus. |
$genus. |
1474 |
|
|
1475 |
C<< $query = $erdb->Get(['Genome'], "Genome(genus) = ?", [$genus]); >> |
$query = $erdb->Get(['Genome'], "Genome(genus) = ?", [$genus]); |
1476 |
|
|
1477 |
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 |
1478 |
parameter representing the parameter value. It would also be possible to code |
parameter representing the parameter value. It would also be possible to code |
1479 |
|
|
1480 |
C<< $query = $erdb->Get(['Genome'], "Genome(genus) = \'$genus\'"); >> |
$query = $erdb->Get(['Genome'], "Genome(genus) = \'$genus\'"); |
1481 |
|
|
1482 |
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 |
1483 |
characters inside the variable C<$genus>. |
characters inside the variable C<$genus>. |
1489 |
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 |
1490 |
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, |
1491 |
|
|
1492 |
C<< $query = $erdb->Get(['Genome', 'ComesFrom', 'Source'], "Genome(genus) = ?", [$genus]); >> |
$query = $erdb->Get(['Genome', 'ComesFrom', 'Source'], "Genome(genus) = ?", [$genus]); |
1493 |
|
|
1494 |
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 |
1495 |
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. |
1525 |
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 |
1526 |
particular genus and sorts them by species name. |
particular genus and sorts them by species name. |
1527 |
|
|
1528 |
C<< "Genome(genus) = ? ORDER BY Genome(species)" >> |
"Genome(genus) = ? ORDER BY Genome(species)" |
1529 |
|
|
1530 |
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 |
1531 |
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. |
1538 |
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 |
1539 |
a positive number. So, for example |
a positive number. So, for example |
1540 |
|
|
1541 |
C<< "Genome(genus) = ? ORDER BY Genome(species) LIMIT 10" >> |
"Genome(genus) = ? ORDER BY Genome(species) LIMIT 10" |
1542 |
|
|
1543 |
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 |
1544 |
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 |
1545 |
use |
use |
1546 |
|
|
1547 |
C<< "LIMIT 10" >> |
"LIMIT 10" |
1548 |
|
|
1549 |
=item params |
=item params |
1550 |
|
|
1565 |
my ($suffix, $mappedNameListRef, $mappedNameHashRef) = |
my ($suffix, $mappedNameListRef, $mappedNameHashRef) = |
1566 |
$self->_SetupSQL($objectNames, $filterClause); |
$self->_SetupSQL($objectNames, $filterClause); |
1567 |
# Create the query. |
# Create the query. |
1568 |
my $command = "SELECT DISTINCT " . join(".*, ", @{$mappedNameListRef}) . |
my $command = "SELECT " . join(".*, ", @{$mappedNameListRef}) . |
1569 |
".* $suffix"; |
".* $suffix"; |
1570 |
my $sth = $self->_GetStatementHandle($command, $params); |
my $sth = $self->_GetStatementHandle($command, $params); |
1571 |
# 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 |
1579 |
return $retVal; |
return $retVal; |
1580 |
} |
} |
1581 |
|
|
1582 |
|
|
1583 |
|
|
1584 |
=head3 Search |
=head3 Search |
1585 |
|
|
1586 |
C<< my $query = $erdb->Search($searchExpression, $idx, \@objectNames, $filterClause, \@params); >> |
my $query = $erdb->Search($searchExpression, $idx, \@objectNames, $filterClause, \@params); |
1587 |
|
|
1588 |
Perform a full text search with filtering. The search will be against a specified object |
Perform a full text search with filtering. The search will be against a specified object |
1589 |
in the object name list. That object will get an extra field containing the search |
in the object name list. That object will get an extra field containing the search |
1652 |
my $actualKeywords = $self->CleanKeywords($searchExpression); |
my $actualKeywords = $self->CleanKeywords($searchExpression); |
1653 |
# Prefix a "+" to each uncontrolled word. This converts the default |
# Prefix a "+" to each uncontrolled word. This converts the default |
1654 |
# search mode from OR to AND. |
# search mode from OR to AND. |
1655 |
$actualKeywords =~ s/(^|\s)(\w)/$1\+$2/g; |
$actualKeywords =~ s/(^|\s)(\w|")/$1\+$2/g; |
1656 |
Trace("Actual keywords for search are\n$actualKeywords") if T(3); |
Trace("Actual keywords for search are\n$actualKeywords") if T(3); |
1657 |
# We need two match expressions, one for the filter clause and one in the |
# We need two match expressions, one for the filter clause and one in the |
1658 |
# query itself. Both will use a parameter mark, so we need to push the |
# query itself. Both will use a parameter mark, so we need to push the |
1666 |
$self->_SetupSQL($objectNames, $filterClause, $matchClause); |
$self->_SetupSQL($objectNames, $filterClause, $matchClause); |
1667 |
# Create the query. Note that the match clause is inserted at the front of |
# Create the query. Note that the match clause is inserted at the front of |
1668 |
# the select fields. |
# the select fields. |
1669 |
my $command = "SELECT DISTINCT $matchClause, " . join(".*, ", @{$mappedNameListRef}) . |
my $command = "SELECT $matchClause, " . join(".*, ", @{$mappedNameListRef}) . |
1670 |
".* $suffix"; |
".* $suffix"; |
1671 |
my $sth = $self->_GetStatementHandle($command, \@myParams); |
my $sth = $self->_GetStatementHandle($command, \@myParams); |
1672 |
# 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 |
1680 |
|
|
1681 |
=head3 GetFlat |
=head3 GetFlat |
1682 |
|
|
1683 |
C<< my @list = $erdb->GetFlat(\@objectNames, $filterClause, \@parameterList, $field); >> |
my @list = $erdb->GetFlat(\@objectNames, $filterClause, \@parameterList, $field); |
1684 |
|
|
1685 |
This is a variation of L</GetAll> that asks for only a single field per record and |
This is a variation of L</GetAll> that asks for only a single field per record and |
1686 |
returns a single flattened list. |
returns a single flattened list. |
1733 |
|
|
1734 |
=head3 SpecialFields |
=head3 SpecialFields |
1735 |
|
|
1736 |
C<< my %specials = $erdb->SpecialFields($entityName); >> |
my %specials = $erdb->SpecialFields($entityName); |
1737 |
|
|
1738 |
Return a hash mapping special fields in the specified entity to the value of their |
Return a hash mapping special fields in the specified entity to the value of their |
1739 |
C<special> attribute. This enables the subclass to get access to the special field |
C<special> attribute. This enables the subclass to get access to the special field |
1775 |
|
|
1776 |
=head3 Delete |
=head3 Delete |
1777 |
|
|
1778 |
C<< my $stats = $erdb->Delete($entityName, $objectID); >> |
my $stats = $erdb->Delete($entityName, $objectID, %options); |
1779 |
|
|
1780 |
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 |
1781 |
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. |
1782 |
always dependent on itself. An object is dependent if it is a 1-to-many or many-to-many |
|
1783 |
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 |
1784 |
|
relationship connected to a dependent entity or if it is the "to" entity connected to a 1-to-many |
1785 |
dependent relationship. |
dependent relationship. |
1786 |
|
|
1787 |
=over 4 |
=over 4 |
1795 |
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<%>), |
1796 |
then it is presumed to by a LIKE pattern. |
then it is presumed to by a LIKE pattern. |
1797 |
|
|
1798 |
=item testFlag |
=item options |
1799 |
|
|
1800 |
If TRUE, the delete statements will be traced without being executed. |
A hash detailing the options for this delete operation. |
1801 |
|
|
1802 |
=item RETURN |
=item RETURN |
1803 |
|
|
1806 |
|
|
1807 |
=back |
=back |
1808 |
|
|
1809 |
|
The permissible options for this method are as follows. |
1810 |
|
|
1811 |
|
=over 4 |
1812 |
|
|
1813 |
|
=item testMode |
1814 |
|
|
1815 |
|
If TRUE, then the delete statements will be traced, but no changes will be made to the database. |
1816 |
|
|
1817 |
|
=item keepRoot |
1818 |
|
|
1819 |
|
If TRUE, then the entity instances will not be deleted, only the dependent records. |
1820 |
|
|
1821 |
|
=back |
1822 |
|
|
1823 |
=cut |
=cut |
1824 |
#: Return Type $%; |
#: Return Type $%; |
1825 |
sub Delete { |
sub Delete { |
1826 |
# Get the parameters. |
# Get the parameters. |
1827 |
my ($self, $entityName, $objectID, $testFlag) = @_; |
my ($self, $entityName, $objectID, %options) = @_; |
1828 |
# Declare the return variable. |
# Declare the return variable. |
1829 |
my $retVal = Stats->new(); |
my $retVal = Stats->new(); |
1830 |
# Get the DBKernel object. |
# Get the DBKernel object. |
1841 |
# FROM-relationships and entities. |
# FROM-relationships and entities. |
1842 |
my @fromPathList = (); |
my @fromPathList = (); |
1843 |
my @toPathList = (); |
my @toPathList = (); |
1844 |
# 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 |
1845 |
# 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 |
1846 |
# 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 |
1847 |
# to-do list is always an entity. |
# to-do list is always an entity. |
1852 |
# Copy it into a list. |
# Copy it into a list. |
1853 |
my @stackedPath = @{$current}; |
my @stackedPath = @{$current}; |
1854 |
# 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. |
1855 |
my $entityName = pop @stackedPath; |
my $myEntityName = pop @stackedPath; |
1856 |
# Add it to the alreadyFound list. |
# Add it to the alreadyFound list. |
1857 |
$alreadyFound{$entityName} = 1; |
$alreadyFound{$myEntityName} = 1; |
1858 |
|
# Figure out if we need to delete this entity. |
1859 |
|
if ($myEntityName ne $entityName || ! $options{keepRoot}) { |
1860 |
# Get the entity data. |
# Get the entity data. |
1861 |
my $entityData = $self->_GetStructure($entityName); |
my $entityData = $self->_GetStructure($myEntityName); |
1862 |
# 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. |
|
1863 |
my $relations = $entityData->{Relations}; |
my $relations = $entityData->{Relations}; |
1864 |
for my $relation (keys %{$relations}) { |
for my $relation (keys %{$relations}) { |
1865 |
my @augmentedList = (@stackedPath, $relation); |
my @augmentedList = (@stackedPath, $relation); |
1866 |
push @fromPathList, \@augmentedList; |
push @fromPathList, \@augmentedList; |
1867 |
} |
} |
1868 |
|
} |
1869 |
# Now we need to look for relationships connected to this entity. |
# Now we need to look for relationships connected to this entity. |
1870 |
my $relationshipList = $self->{_metaData}->{Relationships}; |
my $relationshipList = $self->{_metaData}->{Relationships}; |
1871 |
for my $relationshipName (keys %{$relationshipList}) { |
for my $relationshipName (keys %{$relationshipList}) { |
1872 |
my $relationship = $relationshipList->{$relationshipName}; |
my $relationship = $relationshipList->{$relationshipName}; |
1873 |
# Check the FROM field. We're only interested if it's us. |
# Check the FROM field. We're only interested if it's us. |
1874 |
if ($relationship->{from} eq $entityName) { |
if ($relationship->{from} eq $myEntityName) { |
1875 |
# Add the path to this relationship. |
# Add the path to this relationship. |
1876 |
my @augmentedList = (@stackedPath, $entityName, $relationshipName); |
my @augmentedList = (@stackedPath, $myEntityName, $relationshipName); |
1877 |
push @fromPathList, \@augmentedList; |
push @fromPathList, \@augmentedList; |
1878 |
# 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 |
1879 |
# and the target hasn't been seen yet, we want to |
# and the target hasn't been seen yet, we want to |
1892 |
} |
} |
1893 |
# Now check the TO field. In this case only the relationship needs |
# Now check the TO field. In this case only the relationship needs |
1894 |
# deletion. |
# deletion. |
1895 |
if ($relationship->{to} eq $entityName) { |
if ($relationship->{to} eq $myEntityName) { |
1896 |
my @augmentedList = (@stackedPath, $entityName, $relationshipName); |
my @augmentedList = (@stackedPath, $myEntityName, $relationshipName); |
1897 |
push @toPathList, \@augmentedList; |
push @toPathList, \@augmentedList; |
1898 |
} |
} |
1899 |
} |
} |
1900 |
} |
} |
1901 |
# Create the first qualifier for the WHERE clause. This selects the |
# Create the first qualifier for the WHERE clause. This selects the |
1902 |
# 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 |
1903 |
# 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 |
1904 |
# to the table containing the dependent records to delete. |
# to the table containing the dependent records to delete. |
1905 |
my $qualifier = ($objectID =~ /%/ ? "LIKE ?" : "= ?"); |
my $qualifier = ($objectID =~ /%/ ? "LIKE ?" : "= ?"); |
1906 |
# 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 |
1939 |
} |
} |
1940 |
} |
} |
1941 |
# Now we have our desired DELETE statement. |
# Now we have our desired DELETE statement. |
1942 |
if ($testFlag) { |
if ($options{testMode}) { |
1943 |
# Here the user wants to trace without executing. |
# Here the user wants to trace without executing. |
1944 |
Trace($stmt) if T(0); |
Trace($stmt) if T(0); |
1945 |
} else { |
} else { |
1946 |
# 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 |
1947 |
# if an error occurs, so we just go ahead and do it. |
# if an error occurs, so we just go ahead and do it. |
1948 |
Trace("Executing delete from $target using '$objectID'.") if T(3); |
Trace("Executing delete from $target using '$objectID'.") if T(3); |
1949 |
my $rv = $db->SQL($stmt, 0, $objectID); |
my $rv = $db->SQL($stmt, 0, $objectID); |
1958 |
return $retVal; |
return $retVal; |
1959 |
} |
} |
1960 |
|
|
1961 |
|
=head3 Disconnect |
1962 |
|
|
1963 |
|
$erdb->Disconnect($relationshipName, $originEntityName, $originEntityID); |
1964 |
|
|
1965 |
|
Disconnect an entity instance from all the objects to which it is related. This |
1966 |
|
will delete each relationship instance that connects to the specified entity. |
1967 |
|
|
1968 |
|
=over 4 |
1969 |
|
|
1970 |
|
=item relationshipName |
1971 |
|
|
1972 |
|
Name of the relationship whose instances are to be deleted. |
1973 |
|
|
1974 |
|
=item originEntityName |
1975 |
|
|
1976 |
|
Name of the entity that is to be disconnected. |
1977 |
|
|
1978 |
|
=item originEntityID |
1979 |
|
|
1980 |
|
ID of the entity that is to be disconnected. |
1981 |
|
|
1982 |
|
=back |
1983 |
|
|
1984 |
|
=cut |
1985 |
|
|
1986 |
|
sub Disconnect { |
1987 |
|
# Get the parameters. |
1988 |
|
my ($self, $relationshipName, $originEntityName, $originEntityID) = @_; |
1989 |
|
# Get the relationship descriptor. |
1990 |
|
my $structure = $self->_GetStructure($relationshipName); |
1991 |
|
# Insure we have a relationship. |
1992 |
|
if (! exists $structure->{from}) { |
1993 |
|
Confess("$relationshipName is not a relationship in the database."); |
1994 |
|
} else { |
1995 |
|
# Get the database handle. |
1996 |
|
my $dbh = $self->{_dbh}; |
1997 |
|
# We'll set this value to 1 if we find our entity. |
1998 |
|
my $found = 0; |
1999 |
|
# Loop through the ends of the relationship. |
2000 |
|
for my $dir ('from', 'to') { |
2001 |
|
if ($structure->{$dir} eq $originEntityName) { |
2002 |
|
# Delete all relationship instances on this side of the entity instance. |
2003 |
|
Trace("Disconnecting in $dir direction with ID \"$originEntityID\"."); |
2004 |
|
$dbh->SQL("DELETE FROM $relationshipName WHERE ${dir}_link = ?", 0, $originEntityID); |
2005 |
|
$found = 1; |
2006 |
|
} |
2007 |
|
} |
2008 |
|
# Insure we found the entity on at least one end. |
2009 |
|
if (! $found) { |
2010 |
|
Confess("Entity \"$originEntityName\" does not use $relationshipName."); |
2011 |
|
} |
2012 |
|
} |
2013 |
|
} |
2014 |
|
|
2015 |
|
=head3 DeleteRow |
2016 |
|
|
2017 |
|
$erdb->DeleteRow($relationshipName, $fromLink, $toLink, \%values); |
2018 |
|
|
2019 |
|
Delete a row from a relationship. In most cases, only the from-link and to-link are |
2020 |
|
needed; however, for relationships with intersection data values can be specified |
2021 |
|
for the other fields using a hash. |
2022 |
|
|
2023 |
|
=over 4 |
2024 |
|
|
2025 |
|
=item relationshipName |
2026 |
|
|
2027 |
|
Name of the relationship from which the row is to be deleted. |
2028 |
|
|
2029 |
|
=item fromLink |
2030 |
|
|
2031 |
|
ID of the entity instance in the From direction. |
2032 |
|
|
2033 |
|
=item toLink |
2034 |
|
|
2035 |
|
ID of the entity instance in the To direction. |
2036 |
|
|
2037 |
|
=item values |
2038 |
|
|
2039 |
|
Reference to a hash of other values to be used for filtering the delete. |
2040 |
|
|
2041 |
|
=back |
2042 |
|
|
2043 |
|
=cut |
2044 |
|
|
2045 |
|
sub DeleteRow { |
2046 |
|
# Get the parameters. |
2047 |
|
my ($self, $relationshipName, $fromLink, $toLink, $values) = @_; |
2048 |
|
# Create a hash of all the filter information. |
2049 |
|
my %filter = ('from-link' => $fromLink, 'to-link' => $toLink); |
2050 |
|
if (defined $values) { |
2051 |
|
for my $key (keys %{$values}) { |
2052 |
|
$filter{$key} = $values->{$key}; |
2053 |
|
} |
2054 |
|
} |
2055 |
|
# Build an SQL statement out of the hash. |
2056 |
|
my @filters = (); |
2057 |
|
my @parms = (); |
2058 |
|
for my $key (keys %filter) { |
2059 |
|
push @filters, _FixName($key) . " = ?"; |
2060 |
|
push @parms, $filter{$key}; |
2061 |
|
} |
2062 |
|
Trace("Parms for delete row are " . join(", ", map { "\"$_\"" } @parms) . ".") if T(SQL => 4); |
2063 |
|
my $command = "DELETE FROM $relationshipName WHERE " . |
2064 |
|
join(" AND ", @filters); |
2065 |
|
# Execute it. |
2066 |
|
my $dbh = $self->{_dbh}; |
2067 |
|
$dbh->SQL($command, undef, @parms); |
2068 |
|
} |
2069 |
|
|
2070 |
|
=head3 DeleteLike |
2071 |
|
|
2072 |
|
my $deleteCount = $erdb->DeleteLike($relName, $filter, \@parms); |
2073 |
|
|
2074 |
|
Delete all the relationship rows that satisfy a particular filter condition. Unlike a normal |
2075 |
|
filter, only fields from the relationship itself can be used. |
2076 |
|
|
2077 |
|
=over 4 |
2078 |
|
|
2079 |
|
=item relName |
2080 |
|
|
2081 |
|
Name of the relationship whose records are to be deleted. |
2082 |
|
|
2083 |
|
=item filter |
2084 |
|
|
2085 |
|
A filter clause (L</Get>-style) for the delete query. |
2086 |
|
|
2087 |
|
=item parms |
2088 |
|
|
2089 |
|
Reference to a list of parameters for the filter clause. |
2090 |
|
|
2091 |
|
=item RETURN |
2092 |
|
|
2093 |
|
Returns a count of the number of rows deleted. |
2094 |
|
|
2095 |
|
=back |
2096 |
|
|
2097 |
|
=cut |
2098 |
|
|
2099 |
|
sub DeleteLike { |
2100 |
|
# Get the parameters. |
2101 |
|
my ($self, $objectName, $filter, $parms) = @_; |
2102 |
|
# Declare the return variable. |
2103 |
|
my $retVal; |
2104 |
|
# Insure the parms argument is an array reference if the caller left it off. |
2105 |
|
if (! defined($parms)) { |
2106 |
|
$parms = []; |
2107 |
|
} |
2108 |
|
# Insure we have a relationship. The main reason for this is if we delete an entity |
2109 |
|
# instance we have to yank out a bunch of other stuff with it. |
2110 |
|
if ($self->IsEntity($objectName)) { |
2111 |
|
Confess("Cannot use DeleteLike on $objectName, because it is not a relationship."); |
2112 |
|
} else { |
2113 |
|
# Create the SQL command suffix to get the desierd records. |
2114 |
|
my ($suffix) = $self->_SetupSQL([$objectName], $filter); |
2115 |
|
# Convert it to a DELETE command. |
2116 |
|
my $command = "DELETE $suffix"; |
2117 |
|
# Execute the command. |
2118 |
|
my $dbh = $self->{_dbh}; |
2119 |
|
my $result = $dbh->SQL($command, 0, @{$parms}); |
2120 |
|
# Check the results. Note we convert the "0D0" result to a real zero. |
2121 |
|
# A failure causes an abnormal termination, so the caller isn't going to |
2122 |
|
# worry about it. |
2123 |
|
if (! defined $result) { |
2124 |
|
Confess("Error deleting from $objectName: " . $dbh->errstr()); |
2125 |
|
} elsif ($result == 0) { |
2126 |
|
$retVal = 0; |
2127 |
|
} else { |
2128 |
|
$retVal = $result; |
2129 |
|
} |
2130 |
|
} |
2131 |
|
# Return the result count. |
2132 |
|
return $retVal; |
2133 |
|
} |
2134 |
|
|
2135 |
=head3 SortNeeded |
=head3 SortNeeded |
2136 |
|
|
2137 |
C<< my $parms = $erdb->SortNeeded($relationName); >> |
my $parms = $erdb->SortNeeded($relationName); |
2138 |
|
|
2139 |
Return the pipe command for the sort that should be applied to the specified |
Return the pipe command for the sort that should be applied to the specified |
2140 |
relation when creating the load file. |
relation when creating the load file. |
2232 |
|
|
2233 |
=head3 GetList |
=head3 GetList |
2234 |
|
|
2235 |
C<< my @dbObjects = $erdb->GetList(\@objectNames, $filterClause, \@params); >> |
my @dbObjects = $erdb->GetList(\@objectNames, $filterClause, \@params); |
2236 |
|
|
2237 |
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 |
2238 |
specified filter clause. |
specified filter clause. |
2260 |
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 |
2261 |
particular genus and sorts them by species name. |
particular genus and sorts them by species name. |
2262 |
|
|
2263 |
C<< "Genome(genus) = ? ORDER BY Genome(species)" >> |
"Genome(genus) = ? ORDER BY Genome(species)" |
2264 |
|
|
2265 |
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 |
2266 |
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 |
2272 |
|
|
2273 |
=item RETURN |
=item RETURN |
2274 |
|
|
2275 |
Returns a list of B<DBObject>s that satisfy the query conditions. |
Returns a list of B<ERDBObject>s that satisfy the query conditions. |
2276 |
|
|
2277 |
=back |
=back |
2278 |
|
|
2295 |
|
|
2296 |
=head3 GetCount |
=head3 GetCount |
2297 |
|
|
2298 |
C<< my $count = $erdb->GetCount(\@objectNames, $filter, \@params); >> |
my $count = $erdb->GetCount(\@objectNames, $filter, \@params); |
2299 |
|
|
2300 |
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 |
2301 |
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 |
2388 |
|
|
2389 |
=head3 ComputeObjectSentence |
=head3 ComputeObjectSentence |
2390 |
|
|
2391 |
C<< my $sentence = $erdb->ComputeObjectSentence($objectName); >> |
my $sentence = $erdb->ComputeObjectSentence($objectName); |
2392 |
|
|
2393 |
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. |
2394 |
|
|
2423 |
|
|
2424 |
=head3 DumpRelations |
=head3 DumpRelations |
2425 |
|
|
2426 |
C<< $erdb->DumpRelations($outputDirectory); >> |
$erdb->DumpRelations($outputDirectory); |
2427 |
|
|
2428 |
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. |
2429 |
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. |
2465 |
|
|
2466 |
=head3 InsertValue |
=head3 InsertValue |
2467 |
|
|
2468 |
C<< $erdb->InsertValue($entityID, $fieldName, $value); >> |
$erdb->InsertValue($entityID, $fieldName, $value); |
2469 |
|
|
2470 |
This method will insert a new value into the database. The value must be one |
This method will insert a new value into the database. The value must be one |
2471 |
associated with a secondary relation, since primary values cannot be inserted: |
associated with a secondary relation, since primary values cannot be inserted: |
2528 |
|
|
2529 |
=head3 InsertObject |
=head3 InsertObject |
2530 |
|
|
2531 |
C<< my $ok = $erdb->InsertObject($objectType, \%fieldHash); >> |
$erdb->InsertObject($objectType, \%fieldHash); |
2532 |
|
|
2533 |
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 |
2534 |
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. |
2537 |
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 |
2538 |
C<ZP_00210270.1> and C<gi|46206278>. |
C<ZP_00210270.1> and C<gi|46206278>. |
2539 |
|
|
2540 |
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']}); |
2541 |
|
|
2542 |
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 |
2543 |
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>. |
2544 |
|
|
2545 |
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'}); |
2546 |
|
|
2547 |
=over 4 |
=over 4 |
2548 |
|
|
2554 |
|
|
2555 |
Hash of field names to values. |
Hash of field names to values. |
2556 |
|
|
|
=item RETURN |
|
|
|
|
|
Returns 1 if successful, 0 if an error occurred. |
|
|
|
|
2557 |
=back |
=back |
2558 |
|
|
2559 |
=cut |
=cut |
2652 |
$retVal = $sth->execute(@parameterList); |
$retVal = $sth->execute(@parameterList); |
2653 |
if (!$retVal) { |
if (!$retVal) { |
2654 |
my $errorString = $sth->errstr(); |
my $errorString = $sth->errstr(); |
2655 |
Trace("Insert error: $errorString.") if T(0); |
Confess("Error inserting into $relationName: $errorString"); |
2656 |
|
} else { |
2657 |
|
Trace("Insert successful using $parameterList[0].") if T(3); |
2658 |
} |
} |
2659 |
} |
} |
2660 |
} |
} |
2661 |
} |
} |
2662 |
# Return the success indicator. |
# Return a 1 for backward compatability. |
2663 |
return $retVal; |
return 1; |
2664 |
|
} |
2665 |
|
|
2666 |
|
=head3 UpdateEntity |
2667 |
|
|
2668 |
|
$erdb->UpdateEntity($entityName, $id, \%fields); |
2669 |
|
|
2670 |
|
Update the values of an entity. This is an unprotected update, so it should only be |
2671 |
|
done if the database resides on a database server. |
2672 |
|
|
2673 |
|
=over 4 |
2674 |
|
|
2675 |
|
=item entityName |
2676 |
|
|
2677 |
|
Name of the entity to update. (This is the entity type.) |
2678 |
|
|
2679 |
|
=item id |
2680 |
|
|
2681 |
|
ID of the entity to update. If no entity exists with this ID, an error will be thrown. |
2682 |
|
|
2683 |
|
=item fields |
2684 |
|
|
2685 |
|
Reference to a hash mapping field names to their new values. All of the fields named |
2686 |
|
must be in the entity's primary relation, and they cannot any of them be the ID field. |
2687 |
|
|
2688 |
|
=back |
2689 |
|
|
2690 |
|
=cut |
2691 |
|
|
2692 |
|
sub UpdateEntity { |
2693 |
|
# Get the parameters. |
2694 |
|
my ($self, $entityName, $id, $fields) = @_; |
2695 |
|
# Get a list of the field names being updated. |
2696 |
|
my @fieldList = keys %{$fields}; |
2697 |
|
# Verify that the fields exist. |
2698 |
|
my $checker = $self->GetFieldTable($entityName); |
2699 |
|
for my $field (@fieldList) { |
2700 |
|
if ($field eq 'id') { |
2701 |
|
Confess("Cannot update the ID field for entity $entityName."); |
2702 |
|
} elsif ($checker->{$field}->{relation} ne $entityName) { |
2703 |
|
Confess("Cannot find $field in primary relation of $entityName."); |
2704 |
|
} |
2705 |
|
} |
2706 |
|
# Build the SQL statement. |
2707 |
|
my @sets = (); |
2708 |
|
my @valueList = (); |
2709 |
|
for my $field (@fieldList) { |
2710 |
|
push @sets, _FixName($field) . " = ?"; |
2711 |
|
push @valueList, $fields->{$field}; |
2712 |
|
} |
2713 |
|
my $command = "UPDATE $entityName SET " . join(", ", @sets) . " WHERE id = ?"; |
2714 |
|
# Add the ID to the list of binding values. |
2715 |
|
push @valueList, $id; |
2716 |
|
# Call SQL to do the work. |
2717 |
|
my $rows = $self->{_dbh}->SQL($command, 0, @valueList); |
2718 |
|
# Check for errors. |
2719 |
|
if ($rows == 0) { |
2720 |
|
Confess("Entity $id of type $entityName not found."); |
2721 |
|
} |
2722 |
} |
} |
2723 |
|
|
2724 |
=head3 LoadTable |
=head3 LoadTable |
2725 |
|
|
2726 |
C<< my %results = $erdb->LoadTable($fileName, $relationName, $truncateFlag); >> |
my $results = $erdb->LoadTable($fileName, $relationName, $truncateFlag); |
2727 |
|
|
2728 |
Load data from a tab-delimited file into a specified table, optionally re-creating the table |
Load data from a tab-delimited file into a specified table, optionally re-creating the table |
2729 |
first. |
first. |
2766 |
if ($truncateFlag) { |
if ($truncateFlag) { |
2767 |
Trace("Creating table $relationName") if T(2); |
Trace("Creating table $relationName") if T(2); |
2768 |
# 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, |
2769 |
# 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 |
2770 |
# leave extra room. We postulate a minimum row count of 1000 to |
# leave extra room. We postulate a minimum row count of 1000 to |
2771 |
# prevent problems with incoming empty load files. |
# prevent problems with incoming empty load files. |
2772 |
my $rowSize = $self->EstimateRowSize($relationName); |
my $rowSize = $self->EstimateRowSize($relationName); |
2773 |
my $estimate = FIG::max($fileSize * 1.5 / $rowSize, 1000); |
my $estimate = $fileSize * 8 / $rowSize; |
2774 |
|
if ($estimate < 1000) { |
2775 |
|
$estimate = 1000; |
2776 |
|
} |
2777 |
# Re-create the table without its index. |
# Re-create the table without its index. |
2778 |
$self->CreateTable($relationName, 0, $estimate); |
$self->CreateTable($relationName, 0, $estimate); |
2779 |
# If this is a pre-index DBMS, create the index here. |
# If this is a pre-index DBMS, create the index here. |
2815 |
# The full-text index (if any) is always built last, even for MySQL. |
# The full-text index (if any) is always built last, even for MySQL. |
2816 |
# First we need to see if this table has a full-text index. Only |
# First we need to see if this table has a full-text index. Only |
2817 |
# primary relations are allowed that privilege. |
# primary relations are allowed that privilege. |
2818 |
|
Trace("Checking for full-text index on $relationName.") if T(2); |
2819 |
if ($self->_IsPrimary($relationName)) { |
if ($self->_IsPrimary($relationName)) { |
2820 |
# Get the relation's entity/relationship structure. |
$self->CreateSearchIndex($relationName); |
|
my $structure = $self->_GetStructure($relationName); |
|
|
# Check for a searchable fields list. |
|
|
if (exists $structure->{searchFields}) { |
|
|
# Here we know that we need to create a full-text search index. |
|
|
# Get an SQL-formatted field name list. |
|
|
my $fields = join(", ", $self->_FixNames(@{$structure->{searchFields}})); |
|
|
# Create the index. |
|
|
$dbh->create_index(tbl => $relationName, idx => "search_idx", |
|
|
flds => $fields, kind => 'fulltext'); |
|
|
} |
|
2821 |
} |
} |
2822 |
} |
} |
2823 |
} |
} |
2829 |
return $retVal; |
return $retVal; |
2830 |
} |
} |
2831 |
|
|
2832 |
|
=head3 CreateSearchIndex |
2833 |
|
|
2834 |
|
$erdb->CreateSearchIndex($objectName); |
2835 |
|
|
2836 |
|
Check for a full-text search index on the specified entity or relationship object, and |
2837 |
|
if one is required, rebuild it. |
2838 |
|
|
2839 |
|
=over 4 |
2840 |
|
|
2841 |
|
=item objectName |
2842 |
|
|
2843 |
|
Name of the entity or relationship to be indexed. |
2844 |
|
|
2845 |
|
=back |
2846 |
|
|
2847 |
|
=cut |
2848 |
|
|
2849 |
|
sub CreateSearchIndex { |
2850 |
|
# Get the parameters. |
2851 |
|
my ($self, $objectName) = @_; |
2852 |
|
# Get the relation's entity/relationship structure. |
2853 |
|
my $structure = $self->_GetStructure($objectName); |
2854 |
|
# Get the database handle. |
2855 |
|
my $dbh = $self->{_dbh}; |
2856 |
|
Trace("Checking for search fields in $objectName.") if T(3); |
2857 |
|
# Check for a searchable fields list. |
2858 |
|
if (exists $structure->{searchFields}) { |
2859 |
|
# Here we know that we need to create a full-text search index. |
2860 |
|
# Get an SQL-formatted field name list. |
2861 |
|
my $fields = join(", ", _FixNames(@{$structure->{searchFields}})); |
2862 |
|
# Create the index. If it already exists, it will be dropped. |
2863 |
|
$dbh->create_index(tbl => $objectName, idx => "search_idx", |
2864 |
|
flds => $fields, kind => 'fulltext'); |
2865 |
|
Trace("Index created for $fields in $objectName.") if T(2); |
2866 |
|
} |
2867 |
|
} |
2868 |
|
|
2869 |
=head3 DropRelation |
=head3 DropRelation |
2870 |
|
|
2871 |
C<< $erdb->DropRelation($relationName); >> |
$erdb->DropRelation($relationName); |
2872 |
|
|
2873 |
Physically drop a relation from the database. |
Physically drop a relation from the database. |
2874 |
|
|
2894 |
$dbh->drop_table(tbl => $relationName); |
$dbh->drop_table(tbl => $relationName); |
2895 |
} |
} |
2896 |
|
|
2897 |
|
=head3 MatchSqlPattern |
2898 |
|
|
2899 |
|
my $matched = ERDB::MatchSqlPattern($value, $pattern); |
2900 |
|
|
2901 |
|
Determine whether or not a specified value matches an SQL pattern. An SQL |
2902 |
|
pattern has two wild card characters: C<%> that matches multiple characters, |
2903 |
|
and C<_> that matches a single character. These can be escaped using a |
2904 |
|
backslash (C<\>). We pull this off by converting the SQL pattern to a |
2905 |
|
PERL regular expression. As per SQL rules, the match is case-insensitive. |
2906 |
|
|
2907 |
|
=over 4 |
2908 |
|
|
2909 |
|
=item value |
2910 |
|
|
2911 |
|
Value to be matched against the pattern. Note that an undefined or empty |
2912 |
|
value will not match anything. |
2913 |
|
|
2914 |
|
=item pattern |
2915 |
|
|
2916 |
|
SQL pattern against which to match the value. An undefined or empty pattern will |
2917 |
|
match everything. |
2918 |
|
|
2919 |
|
=item RETURN |
2920 |
|
|
2921 |
|
Returns TRUE if the value and pattern match, else FALSE. |
2922 |
|
|
2923 |
|
=back |
2924 |
|
|
2925 |
|
=cut |
2926 |
|
|
2927 |
|
sub MatchSqlPattern { |
2928 |
|
# Get the parameters. |
2929 |
|
my ($value, $pattern) = @_; |
2930 |
|
# Declare the return variable. |
2931 |
|
my $retVal; |
2932 |
|
# Insure we have a pattern. |
2933 |
|
if (! defined($pattern) || $pattern eq "") { |
2934 |
|
$retVal = 1; |
2935 |
|
} else { |
2936 |
|
# Break the pattern into pieces around the wildcard characters. Because we |
2937 |
|
# use parentheses in the split function's delimiter expression, we'll get |
2938 |
|
# list elements for the delimiters as well as the rest of the string. |
2939 |
|
my @pieces = split /([_%]|\\[_%])/, $pattern; |
2940 |
|
# Check some fast special cases. |
2941 |
|
if ($pattern eq '%') { |
2942 |
|
# A null pattern matches everything. |
2943 |
|
$retVal = 1; |
2944 |
|
} elsif (@pieces == 1) { |
2945 |
|
# No wildcards, so we have a literal comparison. Note we're case-insensitive. |
2946 |
|
$retVal = (lc($value) eq lc($pattern)); |
2947 |
|
} elsif (@pieces == 2 && $pieces[1] eq '%') { |
2948 |
|
# A wildcard at the end, so we have a substring match. This is also case-insensitive. |
2949 |
|
$retVal = (lc(substr($value, 0, length($pieces[0]))) eq lc($pieces[0])); |
2950 |
|
} else { |
2951 |
|
# Okay, we have to do it the hard way. Convert each piece to a PERL pattern. |
2952 |
|
my $realPattern = ""; |
2953 |
|
for my $piece (@pieces) { |
2954 |
|
# Determine the type of piece. |
2955 |
|
if ($piece eq "") { |
2956 |
|
# Empty pieces are ignored. |
2957 |
|
} elsif ($piece eq "%") { |
2958 |
|
# Here we have a multi-character wildcard. Note that it can match |
2959 |
|
# zero or more characters. |
2960 |
|
$realPattern .= ".*" |
2961 |
|
} elsif ($piece eq "_") { |
2962 |
|
# Here we have a single-character wildcard. |
2963 |
|
$realPattern .= "."; |
2964 |
|
} elsif ($piece eq "\\%" || $piece eq "\\_") { |
2965 |
|
# This is an escape sequence (which is a rare thing, actually). |
2966 |
|
$realPattern .= substr($piece, 1, 1); |
2967 |
|
} else { |
2968 |
|
# Here we have raw text. |
2969 |
|
$realPattern .= quotemeta($piece); |
2970 |
|
} |
2971 |
|
} |
2972 |
|
# Do the match. |
2973 |
|
$retVal = ($value =~ /^$realPattern$/i ? 1 : 0); |
2974 |
|
} |
2975 |
|
} |
2976 |
|
# Return the result. |
2977 |
|
return $retVal; |
2978 |
|
} |
2979 |
|
|
2980 |
=head3 GetEntity |
=head3 GetEntity |
2981 |
|
|
2982 |
C<< my $entityObject = $erdb->GetEntity($entityType, $ID); >> |
my $entityObject = $erdb->GetEntity($entityType, $ID); |
2983 |
|
|
2984 |
Return an object describing the entity instance with a specified ID. |
Return an object describing the entity instance with a specified ID. |
2985 |
|
|
2995 |
|
|
2996 |
=item RETURN |
=item RETURN |
2997 |
|
|
2998 |
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 |
2999 |
instance is found with the specified key. |
instance is found with the specified key. |
3000 |
|
|
3001 |
=back |
=back |
3015 |
|
|
3016 |
=head3 GetChoices |
=head3 GetChoices |
3017 |
|
|
3018 |
C<< my @values = $erdb->GetChoices($entityName, $fieldName); >> |
my @values = $erdb->GetChoices($entityName, $fieldName); |
3019 |
|
|
3020 |
Return a list of all the values for the specified field that are represented in the |
Return a list of all the values for the specified field that are represented in the |
3021 |
specified entity. |
specified entity. |
3070 |
|
|
3071 |
=head3 GetEntityValues |
=head3 GetEntityValues |
3072 |
|
|
3073 |
C<< my @values = $erdb->GetEntityValues($entityType, $ID, \@fields); >> |
my @values = $erdb->GetEntityValues($entityType, $ID, \@fields); |
3074 |
|
|
3075 |
Return a list of values from a specified entity instance. If the entity instance |
Return a list of values from a specified entity instance. If the entity instance |
3076 |
does not exist, an empty list is returned. |
does not exist, an empty list is returned. |
3114 |
|
|
3115 |
=head3 GetAll |
=head3 GetAll |
3116 |
|
|
3117 |
C<< my @list = $erdb->GetAll(\@objectNames, $filterClause, \@parameters, \@fields, $count); >> |
my @list = $erdb->GetAll(\@objectNames, $filterClause, \@parameters, \@fields, $count); |
3118 |
|
|
3119 |
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 |
3120 |
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 |
3128 |
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 |
3129 |
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 |
3130 |
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 |
3131 |
feature ID followed by all of its aliases. |
feature ID followed by all of its essentiality determinations. |
3132 |
|
|
3133 |
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)']); |
3134 |
|
|
3135 |
=over 4 |
=over 4 |
3136 |
|
|
3208 |
|
|
3209 |
=head3 Exists |
=head3 Exists |
3210 |
|
|
3211 |
C<< my $found = $sprout->Exists($entityName, $entityID); >> |
my $found = $sprout->Exists($entityName, $entityID); |
3212 |
|
|
3213 |
Return TRUE if an entity exists, else FALSE. |
Return TRUE if an entity exists, else FALSE. |
3214 |
|
|
3243 |
|
|
3244 |
=head3 EstimateRowSize |
=head3 EstimateRowSize |
3245 |
|
|
3246 |
C<< my $rowSize = $erdb->EstimateRowSize($relName); >> |
my $rowSize = $erdb->EstimateRowSize($relName); |
3247 |
|
|
3248 |
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 |
3249 |
up the average length for each data type. |
up the average length for each data type. |
3281 |
|
|
3282 |
=head3 GetFieldTable |
=head3 GetFieldTable |
3283 |
|
|
3284 |
C<< my $fieldHash = $self->GetFieldTable($objectnName); >> |
my $fieldHash = $self->GetFieldTable($objectnName); |
3285 |
|
|
3286 |
Get the field structure for a specified entity or relationship. |
Get the field structure for a specified entity or relationship. |
3287 |
|
|
3310 |
|
|
3311 |
=head3 SplitKeywords |
=head3 SplitKeywords |
3312 |
|
|
3313 |
C<< my @keywords = ERDB::SplitKeywords($keywordString); >> |
my @keywords = ERDB::SplitKeywords($keywordString); |
3314 |
|
|
3315 |
This method returns a list of the positive keywords in the specified |
This method returns a list of the positive keywords in the specified |
3316 |
keyword string. All of the operators will have been stripped off, |
keyword string. All of the operators will have been stripped off, |
3359 |
|
|
3360 |
=head3 ValidateFieldName |
=head3 ValidateFieldName |
3361 |
|
|
3362 |
C<< my $okFlag = ERDB::ValidateFieldName($fieldName); >> |
my $okFlag = ERDB::ValidateFieldName($fieldName); |
3363 |
|
|
3364 |
Return TRUE if the specified field name is valid, else FALSE. Valid field names must |
Return TRUE if the specified field name is valid, else FALSE. Valid field names must |
3365 |
be hyphenated words subject to certain restrictions. |
be hyphenated words subject to certain restrictions. |
3384 |
# Declare the return variable. The field name is valid until we hear |
# Declare the return variable. The field name is valid until we hear |
3385 |
# differently. |
# differently. |
3386 |
my $retVal = 1; |
my $retVal = 1; |
3387 |
|
# Compute the maximum name length. |
3388 |
|
my $maxLen = $TypeTable{'name-string'}->{maxLen}; |
3389 |
# Look for bad stuff in the name. |
# Look for bad stuff in the name. |
3390 |
if ($fieldName =~ /--/) { |
if ($fieldName =~ /--/) { |
3391 |
# Here we have a doubled minus sign. |
# Here we have a doubled minus sign. |
3395 |
# Here the field name is missing the initial letter. |
# Here the field name is missing the initial letter. |
3396 |
Trace("Field name $fieldName does not begin with a letter.") if T(1); |
Trace("Field name $fieldName does not begin with a letter.") if T(1); |
3397 |
$retVal = 0; |
$retVal = 0; |
3398 |
|
} elsif (length($fieldName) > $maxLen) { |
3399 |
|
# Here the field name is too long. |
3400 |
|
Trace("Maximum field name length is $maxLen. Field name must be truncated to " . substr($fieldName,0, $maxLen) . "."); |
3401 |
} else { |
} else { |
3402 |
# Strip out the minus signs. Everything remaining must be a letter, |
# Strip out the minus signs. Everything remaining must be a letter, |
3403 |
# underscore, or digit. |
# underscore, or digit. |
3414 |
|
|
3415 |
=head3 ReadMetaXML |
=head3 ReadMetaXML |
3416 |
|
|
3417 |
C<< my $rawMetaData = ERDB::ReadDBD($fileName); >> |
my $rawMetaData = ERDB::ReadDBD($fileName); |
3418 |
|
|
3419 |
This method reads a raw database definition XML file and returns it. |
This method reads a raw database definition XML file and returns it. |
3420 |
Normally, the metadata used by the ERDB system has been processed and |
Normally, the metadata used by the ERDB system has been processed and |
3447 |
|
|
3448 |
=head3 GetEntityFieldHash |
=head3 GetEntityFieldHash |
3449 |
|
|
3450 |
C<< my $fieldHashRef = ERDB::GetEntityFieldHash($structure, $entityName); >> |
my $fieldHashRef = ERDB::GetEntityFieldHash($structure, $entityName); |
3451 |
|
|
3452 |
Get the field hash of the named entity in the specified raw XML structure. |
Get the field hash of the named entity in the specified raw XML structure. |
3453 |
The field hash may not exist, in which case we need to create it. |
The field hash may not exist, in which case we need to create it. |
3489 |
|
|
3490 |
=head3 WriteMetaXML |
=head3 WriteMetaXML |
3491 |
|
|
3492 |
C<< ERDB::WriteMetaXML($structure, $fileName); >> |
ERDB::WriteMetaXML($structure, $fileName); |
3493 |
|
|
3494 |
Write the metadata XML to a file. This method is the reverse of L</ReadMetaXML>, and is |
Write the metadata XML to a file. This method is the reverse of L</ReadMetaXML>, and is |
3495 |
used to update the database definition. It must be used with care, however, since it |
used to update the database definition. It must be used with care, however, since it |
3528 |
Except for C<[p]>, all the codes are closed by slash-codes. So, for |
Except for C<[p]>, all the codes are closed by slash-codes. So, for |
3529 |
example, C<[b]Feature[/b]> displays the string C<Feature> in boldface. |
example, C<[b]Feature[/b]> displays the string C<Feature> in boldface. |
3530 |
|
|
3531 |
C<< my $realHtml = ERDB::HTMLNote($dataString); >> |
my $realHtml = ERDB::HTMLNote($dataString); |
3532 |
|
|
3533 |
=over 4 |
=over 4 |
3534 |
|
|
3552 |
# Substitute the bulletin board codes. |
# Substitute the bulletin board codes. |
3553 |
$retVal =~ s!\[(/?[bi])\]!<$1>!g; |
$retVal =~ s!\[(/?[bi])\]!<$1>!g; |
3554 |
$retVal =~ s!\[p\]!</p><p>!g; |
$retVal =~ s!\[p\]!</p><p>!g; |
3555 |
|
$retVal =~ s!\[link\s+([^\]]+)\]!<a href="$1">!g; |
3556 |
|
$retVal =~ s!\[/link\]!</a>!g; |
3557 |
|
# Return the result. |
3558 |
|
return $retVal; |
3559 |
|
} |
3560 |
|
|
3561 |
|
=head3 BeginTran |
3562 |
|
|
3563 |
|
$erdb->BeginTran(); |
3564 |
|
|
3565 |
|
Start a database transaction. |
3566 |
|
|
3567 |
|
=cut |
3568 |
|
|
3569 |
|
sub BeginTran { |
3570 |
|
my ($self) = @_; |
3571 |
|
$self->{_dbh}->begin_tran(); |
3572 |
|
|
3573 |
|
} |
3574 |
|
|
3575 |
|
=head3 CommitTran |
3576 |
|
|
3577 |
|
$erdb->CommitTran(); |
3578 |
|
|
3579 |
|
Commit an active database transaction. |
3580 |
|
|
3581 |
|
=cut |
3582 |
|
|
3583 |
|
sub CommitTran { |
3584 |
|
my ($self) = @_; |
3585 |
|
$self->{_dbh}->commit_tran(); |
3586 |
|
} |
3587 |
|
|
3588 |
|
=head3 RollbackTran |
3589 |
|
|
3590 |
|
$erdb->RollbackTran(); |
3591 |
|
|
3592 |
|
Roll back an active database transaction. |
3593 |
|
|
3594 |
|
=cut |
3595 |
|
|
3596 |
|
sub RollbackTran { |
3597 |
|
my ($self) = @_; |
3598 |
|
$self->{_dbh}->roll_tran(); |
3599 |
|
} |
3600 |
|
|
3601 |
|
=head3 UpdateField |
3602 |
|
|
3603 |
|
my $count = $erdb->UpdateField($objectNames, $fieldName, $oldValue, $newValue, $filter, $parms); |
3604 |
|
|
3605 |
|
Update all occurrences of a specific field value to a new value. The number of rows changed will be |
3606 |
|
returned. |
3607 |
|
|
3608 |
|
=over 4 |
3609 |
|
|
3610 |
|
=item fieldName |
3611 |
|
|
3612 |
|
Name of the field in standard I<objectName>C<(>I<fieldName>C<)> format. |
3613 |
|
|
3614 |
|
=item oldValue |
3615 |
|
|
3616 |
|
Value to be modified. All occurrences of this value in the named field will be replaced by the |
3617 |
|
new value. |
3618 |
|
|
3619 |
|
=item newValue |
3620 |
|
|
3621 |
|
New value to be substituted for the old value when it's found. |
3622 |
|
|
3623 |
|
=item filter |
3624 |
|
|
3625 |
|
A standard ERDB filter clause (see L</Get>). The filter will be applied before any substitutions take place. |
3626 |
|
|
3627 |
|
=item parms |
3628 |
|
|
3629 |
|
Reference to a list of parameter values in the filter. |
3630 |
|
|
3631 |
|
=item RETURN |
3632 |
|
|
3633 |
|
Returns the number of rows modified. |
3634 |
|
|
3635 |
|
=back |
3636 |
|
|
3637 |
|
=cut |
3638 |
|
|
3639 |
|
sub UpdateField { |
3640 |
|
# Get the parameters. |
3641 |
|
my ($self, $fieldName, $oldValue, $newValue, $filter, $parms) = @_; |
3642 |
|
# Get the object and field names from the field name parameter. |
3643 |
|
$fieldName =~ /^([^(]+)\(([^)]+)\)/; |
3644 |
|
my $objectName = $1; |
3645 |
|
my $realFieldName = _FixName($2); |
3646 |
|
# Add the old value to the filter. Note we allow the possibility that no |
3647 |
|
# filter was specified. |
3648 |
|
my $realFilter = "$fieldName = ?"; |
3649 |
|
if ($filter) { |
3650 |
|
$realFilter .= " AND $filter"; |
3651 |
|
} |
3652 |
|
# Format the query filter. |
3653 |
|
my ($suffix, $mappedNameListRef, $mappedNameHashRef) = |
3654 |
|
$self->_SetupSQL([$objectName], $realFilter); |
3655 |
|
# Create the query. Since there is only one object name, the mapped-name data is not |
3656 |
|
# necessary. Neither is the FROM clause. |
3657 |
|
$suffix =~ s/^FROM.+WHERE\s+//; |
3658 |
|
# Create the update statement. |
3659 |
|
my $command = "UPDATE $objectName SET $realFieldName = ? WHERE $suffix"; |
3660 |
|
# Get the database handle. |
3661 |
|
my $dbh = $self->{_dbh}; |
3662 |
|
# Add the old and new values to the parameter list. Note we allow the possibility that |
3663 |
|
# there are no user-supplied parameters. |
3664 |
|
my @params = ($newValue, $oldValue); |
3665 |
|
if (defined $parms) { |
3666 |
|
push @params, @{$parms}; |
3667 |
|
} |
3668 |
|
# Execute the update. |
3669 |
|
my $retVal = $dbh->SQL($command, 0, @params); |
3670 |
|
# Make the funky zero a real zero. |
3671 |
|
if ($retVal == 0) { |
3672 |
|
$retVal = 0; |
3673 |
|
} |
3674 |
# Return the result. |
# Return the result. |
3675 |
return $retVal; |
return $retVal; |
3676 |
} |
} |
3680 |
|
|
3681 |
=head3 GetUsefulCrossValues |
=head3 GetUsefulCrossValues |
3682 |
|
|
3683 |
C<< my @attrNames = $sprout->GetUsefulCrossValues($sourceEntity, $relationship); >> |
my @attrNames = $sprout->GetUsefulCrossValues($sourceEntity, $relationship); |
3684 |
|
|
3685 |
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 |
3686 |
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 |
3741 |
|
|
3742 |
=head3 FindColumn |
=head3 FindColumn |
3743 |
|
|
3744 |
C<< my $colIndex = ERDB::FindColumn($headerLine, $columnIdentifier); >> |
my $colIndex = ERDB::FindColumn($headerLine, $columnIdentifier); |
3745 |
|
|
3746 |
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 |
3747 |
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 |
3799 |
|
|
3800 |
=head3 ParseColumns |
=head3 ParseColumns |
3801 |
|
|
3802 |
C<< my @columns = ERDB::ParseColumns($line); >> |
my @columns = ERDB::ParseColumns($line); |
3803 |
|
|
3804 |
Convert the specified data line to a list of columns. |
Convert the specified data line to a list of columns. |
3805 |
|
|
3831 |
|
|
3832 |
=head2 Virtual Methods |
=head2 Virtual Methods |
3833 |
|
|
3834 |
|
=head3 _CreatePPOIndex |
3835 |
|
|
3836 |
|
my $index = ERDB::_CreatePPOIndex($indexObject); |
3837 |
|
|
3838 |
|
Convert the XML for an ERDB index to the XML structure for a PPO |
3839 |
|
index. |
3840 |
|
|
3841 |
|
=over 4 |
3842 |
|
|
3843 |
|
ERDB XML structure for an index. |
3844 |
|
|
3845 |
|
=item RETURN |
3846 |
|
|
3847 |
|
PPO XML structure for the same index. |
3848 |
|
|
3849 |
|
=back |
3850 |
|
|
3851 |
|
=cut |
3852 |
|
|
3853 |
|
sub _CreatePPOIndex { |
3854 |
|
# Get the parameters. |
3855 |
|
my ($indexObject) = @_; |
3856 |
|
# The incoming index contains a list of the index fields in the IndexFields |
3857 |
|
# member. We loop through it to create the index tags. |
3858 |
|
my @fields = map { { label => _FixName($_->{name}) } } @{$indexObject->{IndexFields}}; |
3859 |
|
# Wrap the fields in attribute tags. |
3860 |
|
my $retVal = { attribute => \@fields }; |
3861 |
|
# Return the result. |
3862 |
|
return $retVal; |
3863 |
|
} |
3864 |
|
|
3865 |
|
=head3 _CreatePPOField |
3866 |
|
|
3867 |
|
my $fieldXML = ERDB::_CreatePPOField($fieldName, $fieldObject); |
3868 |
|
|
3869 |
|
Convert the ERDB XML structure for a field to a PPO scalar XML structure. |
3870 |
|
|
3871 |
|
=over 4 |
3872 |
|
|
3873 |
|
=item fieldName |
3874 |
|
|
3875 |
|
Name of the scalar field. |
3876 |
|
|
3877 |
|
=item fieldObject |
3878 |
|
|
3879 |
|
ERDB XML structure describing the field. |
3880 |
|
|
3881 |
|
=item RETURN |
3882 |
|
|
3883 |
|
Returns a PPO XML structure for the same field. |
3884 |
|
|
3885 |
|
=back |
3886 |
|
|
3887 |
|
=cut |
3888 |
|
|
3889 |
|
sub _CreatePPOField { |
3890 |
|
# Get the parameters. |
3891 |
|
my ($fieldName, $fieldObject) = @_; |
3892 |
|
# Get the field type. |
3893 |
|
my $type = $TypeTable{$fieldObject->{type}}->{sqlType}; |
3894 |
|
# Fix up the field name. |
3895 |
|
$fieldName = _FixName($fieldName); |
3896 |
|
# Build the scalar tag. |
3897 |
|
my $retVal = { label => $fieldName, type => $type }; |
3898 |
|
# Return the result. |
3899 |
|
return $retVal; |
3900 |
|
} |
3901 |
|
|
3902 |
=head3 CleanKeywords |
=head3 CleanKeywords |
3903 |
|
|
3904 |
C<< my $cleanedString = $erdb->CleanKeywords($searchExpression); >> |
my $cleanedString = $erdb->CleanKeywords($searchExpression); |
3905 |
|
|
3906 |
Clean up a search expression or keyword list. This is a virtual method that may |
Clean up a search expression or keyword list. This is a virtual method that may |
3907 |
be overridden by the subclass. The base-class method removes extra spaces |
be overridden by the subclass. The base-class method removes extra spaces |
3938 |
|
|
3939 |
=head3 GetSourceObject |
=head3 GetSourceObject |
3940 |
|
|
3941 |
C<< my $source = $erdb->GetSourceObject($entityName); >> |
my $source = $erdb->GetSourceObject($entityName); |
3942 |
|
|
3943 |
Return the object to be used in loading special attributes of the specified entity. The |
Return the object to be used in loading special attributes of the specified entity. The |
3944 |
algorithm for loading special attributes is stored in the C<DataGen> elements of the |
algorithm for loading special attributes is stored in the C<DataGen> elements of the |
3948 |
|
|
3949 |
=head3 _RelationMap |
=head3 _RelationMap |
3950 |
|
|
3951 |
C<< my @relationMap = _RelationMap($mappedNameHashRef, $mappedNameListRef); >> |
my @relationMap = _RelationMap($mappedNameHashRef, $mappedNameListRef); |
3952 |
|
|
3953 |
Create the relation map for an SQL query. The relation map is used by B<DBObject> |
Create the relation map for an SQL query. The relation map is used by B<ERDBObject> |
3954 |
to determine how to interpret the results of the query. |
to determine how to interpret the results of the query. |
3955 |
|
|
3956 |
=over 4 |
=over 4 |
3967 |
=item RETURN |
=item RETURN |
3968 |
|
|
3969 |
Returns a list of 2-tuples. Each tuple consists of an object name as used in the |
Returns a list of 2-tuples. Each tuple consists of an object name as used in the |
3970 |
query followed by the actual name of that object. This enables the B<DBObject> to |
query followed by the actual name of that object. This enables the B<ERDBObject> to |
3971 |
determine the order of the tables in the query and which object name belongs to each |
determine the order of the tables in the query and which object name belongs to each |
3972 |
mapped object name. Most of the time these two values are the same; however, if a |
mapped object name. Most of the time these two values are the same; however, if a |
3973 |
relation occurs twice in the query, the relation name in the field list and WHERE |
relation occurs twice in the query, the relation name in the field list and WHERE |
4261 |
sub _GetStatementHandle { |
sub _GetStatementHandle { |
4262 |
# Get the parameters. |
# Get the parameters. |
4263 |
my ($self, $command, $params) = @_; |
my ($self, $command, $params) = @_; |
4264 |
|
Confess("Invalid parameter list.") if (! defined($params) || ref($params) ne 'ARRAY'); |
4265 |
# Trace the query. |
# Trace the query. |
4266 |
Trace("SQL query: $command") if T(SQL => 3); |
Trace("SQL query: $command") if T(SQL => 3); |
4267 |
Trace("PARMS: '" . (join "', '", @{$params}) . "'") if (T(SQL => 4) && (@{$params} > 0)); |
Trace("PARMS: '" . (join "', '", @{$params}) . "'") if (T(SQL => 4) && (@{$params} > 0)); |
4511 |
|
|
4512 |
=head3 _LoadMetaData |
=head3 _LoadMetaData |
4513 |
|
|
4514 |
|
my $metadata = ERDB::_LoadMetaData($filename); |
4515 |
|
|
4516 |
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. |
4517 |
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 |
4518 |
load or use the database. The schema for the XML file is F<ERDatabase.xml>. |
load or use the database. The schema for the XML file is F<ERDatabase.xml>. |
4662 |
if ($found == 0) { |
if ($found == 0) { |
4663 |
push @{$indexList}, { IndexFields => [ {name => 'id', order => 'ascending'} ] }; |
push @{$indexList}, { IndexFields => [ {name => 'id', order => 'ascending'} ] }; |
4664 |
} |
} |
4665 |
# 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. |
4666 |
# 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$count", $relation, $index); |
|
|
# Increment the counter so that the next index has a different name. |
|
|
$count++; |
|
|
} |
|
4667 |
} |
} |
4668 |
# Finally, we add the relation structure to the entity. |
# Finally, we add the relation structure to the entity. |
4669 |
$entityStructure->{Relations} = $relationTable; |
$entityStructure->{Relations} = $relationTable; |
4677 |
_FixupFields($relationshipStructure, $relationshipName, 2, 3); |
_FixupFields($relationshipStructure, $relationshipName, 2, 3); |
4678 |
# Format a description for the FROM field. |
# Format a description for the FROM field. |
4679 |
my $fromEntity = $relationshipStructure->{from}; |
my $fromEntity = $relationshipStructure->{from}; |
4680 |
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]."; |
4681 |
# Get the FROM entity's key type. |
# Get the FROM entity's key type. |
4682 |
my $fromType = $entityList->{$fromEntity}->{keyType}; |
my $fromType = $entityList->{$fromEntity}->{keyType}; |
4683 |
# Add the FROM field. |
# Add the FROM field. |
4687 |
PrettySort => 1}); |
PrettySort => 1}); |
4688 |
# Format a description for the TO field. |
# Format a description for the TO field. |
4689 |
my $toEntity = $relationshipStructure->{to}; |
my $toEntity = $relationshipStructure->{to}; |
4690 |
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]."; |
4691 |
# Get the TO entity's key type. |
# Get the TO entity's key type. |
4692 |
my $toType = $entityList->{$toEntity}->{keyType}; |
my $toType = $entityList->{$toEntity}->{keyType}; |
4693 |
# Add the TO field. |
# Add the TO field. |
4699 |
my $thisRelation = { Fields => _ReOrderRelationTable($relationshipStructure->{Fields}), |
my $thisRelation = { Fields => _ReOrderRelationTable($relationshipStructure->{Fields}), |
4700 |
Indexes => { } }; |
Indexes => { } }; |
4701 |
$relationshipStructure->{Relations} = { $relationshipName => $thisRelation }; |
$relationshipStructure->{Relations} = { $relationshipName => $thisRelation }; |
4702 |
|
|
4703 |
|
# Add the alternate indexes (if any). This MUST be done before the FROM and |
4704 |
|
# TO indexes, because it erases the relation's index list. |
4705 |
|
if (exists $relationshipStructure->{Indexes}) { |
4706 |
|
_ProcessIndexes($relationshipStructure->{Indexes}, $thisRelation); |
4707 |
|
} |
4708 |
|
# Add the relation to the master table. |
4709 |
# Create the FROM and TO indexes. |
# Create the FROM and TO indexes. |
4710 |
_CreateRelationshipIndex("From", $relationshipName, $relationshipStructure); |
_CreateRelationshipIndex("From", $relationshipName, $relationshipStructure); |
4711 |
_CreateRelationshipIndex("To", $relationshipName, $relationshipStructure); |
_CreateRelationshipIndex("To", $relationshipName, $relationshipStructure); |
|
# Add the relation to the master table. |
|
4712 |
$masterRelationTable{$relationshipName} = $thisRelation; |
$masterRelationTable{$relationshipName} = $thisRelation; |
4713 |
} |
} |
4714 |
# Now store the master relation table in the metadata structure. |
# Now store the master relation table in the metadata structure. |
4867 |
_AddIndex("idx$indexKey", $relationStructure, $newIndex); |
_AddIndex("idx$indexKey", $relationStructure, $newIndex); |
4868 |
} |
} |
4869 |
|
|
4870 |
|
=head3 _ProcessIndexes |
4871 |
|
|
4872 |
|
ERDB::_ProcessIndexes($indexList, $relation); |
4873 |
|
|
4874 |
|
Build the data structures for the specified indexes in the specified relation. |
4875 |
|
|
4876 |
|
=over 4 |
4877 |
|
|
4878 |
|
=item indexList |
4879 |
|
|
4880 |
|
Reference to a list of indexes. Each index is a hash reference containing an optional |
4881 |
|
C<Notes> value that describes the index and an C<IndexFields> value that is a reference |
4882 |
|
to a list of index field structures. An index field structure, in turn, is a reference |
4883 |
|
to a hash that contains a C<name> attribute for the field name and an C<order> |
4884 |
|
attribute that specifies either C<ascending> or C<descending>. In this sense the |
4885 |
|
index list encapsulates the XML C<Indexes> structure in the database definition. |
4886 |
|
|
4887 |
|
=item relation |
4888 |
|
|
4889 |
|
The structure that describes the current relation. The new index descriptors will |
4890 |
|
be stored in the structure's C<Indexes> member. Any previous data in the structure |
4891 |
|
will be lost. |
4892 |
|
|
4893 |
|
=back |
4894 |
|
|
4895 |
|
=cut |
4896 |
|
|
4897 |
|
sub _ProcessIndexes { |
4898 |
|
# Get the parameters. |
4899 |
|
my ($indexList, $relation) = @_; |
4900 |
|
# Now we need to convert the relation's index list to an index table. We begin by creating |
4901 |
|
# an empty table in the relation structure. |
4902 |
|
$relation->{Indexes} = { }; |
4903 |
|
# Loop through the indexes. |
4904 |
|
my $count = 0; |
4905 |
|
for my $index (@{$indexList}) { |
4906 |
|
# Add this index to the index table. |
4907 |
|
_AddIndex("idx$count", $relation, $index); |
4908 |
|
# Increment the counter so that the next index has a different name. |
4909 |
|
$count++; |
4910 |
|
} |
4911 |
|
} |
4912 |
|
|
4913 |
=head3 _AddIndex |
=head3 _AddIndex |
4914 |
|
|
4915 |
Add an index to a relation structure. |
Add an index to a relation structure. |
5439 |
# Compute the number of columns. |
# Compute the number of columns. |
5440 |
my $colCount = @colNames; |
my $colCount = @colNames; |
5441 |
# Generate the title row. |
# Generate the title row. |
5442 |
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"; |
5443 |
# Loop through the columns, adding the column header rows. |
# Loop through the columns, adding the column header rows. |
5444 |
$htmlString .= "<tr>"; |
$htmlString .= "<tr>"; |
5445 |
for my $colName (@colNames) { |
for my $colName (@colNames) { |
5458 |
=cut |
=cut |
5459 |
|
|
5460 |
sub _CloseTable { |
sub _CloseTable { |
5461 |
return "</table></p>\n"; |
return "</table>\n"; |
5462 |
} |
} |
5463 |
|
|
5464 |
=head3 _ShowField |
=head3 _ShowField |