4 |
|
|
5 |
require Exporter; |
require Exporter; |
6 |
use ERDB; |
use ERDB; |
7 |
@ISA = qw(Exporter ERDB); |
@ISA = qw(ERDB); |
|
@EXPORT = qw(GetAttributes AddAttribute DeleteAttribute ChangeAttribute MatchSqlPattern); |
|
8 |
use strict; |
use strict; |
9 |
use Tracer; |
use Tracer; |
|
use FIG; |
|
10 |
use ERDBLoad; |
use ERDBLoad; |
11 |
|
|
12 |
=head1 Custom SEED Attribute Manager |
=head1 Custom SEED Attribute Manager |
122 |
return $retVal; |
return $retVal; |
123 |
} |
} |
124 |
|
|
|
=head3 GetAttributeValues |
|
|
|
|
|
C<< my @values = $attrDB->GetAttributeValues($id, $entityName => $attributeName); >> |
|
|
|
|
|
Return all the values of the specified attribute for the specified entity instance. |
|
|
A list of vaues will be returned. If the entity instance does not exist or the |
|
|
attribute has no values, an empty list will be returned. If the attribute name |
|
|
does not exist, an SQL error will occur. |
|
|
|
|
|
A typical invocation would look like this: |
|
|
|
|
|
my @values = $sttrDB->GetAttributeValues($fid, Feature => 'essential'); |
|
|
|
|
|
Here the user is asking for the values of the C<essential> attribute for the |
|
|
B<Feature> with the specified ID. If the identified feature is not essential, |
|
|
the list returned will be empty. If it is essential, then one or more values |
|
|
will be returned that describe the essentiality. |
|
|
|
|
|
=over 4 |
|
|
|
|
|
=item id |
|
|
|
|
|
ID of the desired entity instance. This identifies the specific object to |
|
|
be interrogated for attribute values. |
|
|
|
|
|
=item entityName |
|
|
|
|
|
Name of the entity. This identifies the the type of the object to be |
|
|
interrogated for attribute values. |
|
|
|
|
|
=item attributeName |
|
|
|
|
|
Name of the desired attribute. |
|
|
|
|
|
=item RETURN |
|
|
|
|
|
Returns zero or more strings, each representing a value of the named attribute |
|
|
for the specified entity instance. |
|
|
|
|
|
=back |
|
|
|
|
|
=cut |
|
|
|
|
|
sub GetAttributeValues { |
|
|
# Get the parameters. |
|
|
my ($self, $id, $entityName, $attributeName) = @_; |
|
|
# Get the data. |
|
|
my @retVal = $self->GetEntityValues($entityName, $id, ["$entityName($attributeName)"]); |
|
|
# Return the result. |
|
|
return @retVal; |
|
|
} |
|
|
|
|
125 |
=head3 StoreAttributeKey |
=head3 StoreAttributeKey |
126 |
|
|
127 |
C<< my $attrDB = CustomAttributes::StoreAttributeKey($entityName, $attributeName, $type, $notes); >> |
C<< my $attrDB = CustomAttributes::StoreAttributeKey($entityName, $attributeName, $type, $notes); >> |
660 |
|
|
661 |
=head3 MatchSqlPattern |
=head3 MatchSqlPattern |
662 |
|
|
663 |
C<< my $matched = MatchSqlPattern($value, $pattern); >> |
C<< my $matched = CustomAttributes::MatchSqlPattern($value, $pattern); >> |
664 |
|
|
665 |
Determine whether or not a specified value matches an SQL pattern. An SQL |
Determine whether or not a specified value matches an SQL pattern. An SQL |
666 |
pattern has two wild card characters: C<%> that matches multiple characters, |
pattern has two wild card characters: C<%> that matches multiple characters, |
672 |
|
|
673 |
=item value |
=item value |
674 |
|
|
675 |
Value to be matched against the pattern. Note that an undefined value will |
Value to be matched against the pattern. Note that an undefined or empty |
676 |
not match anything. |
value will not match anything. |
677 |
|
|
678 |
=item pattern |
=item pattern |
679 |
|
|
680 |
SQL pattern against which to match the value. An undefined pattern will |
SQL pattern against which to match the value. An undefined or empty pattern will |
681 |
match everything. |
match everything. |
682 |
|
|
683 |
=item RETURN |
=item RETURN |
694 |
# Declare the return variable. |
# Declare the return variable. |
695 |
my $retVal; |
my $retVal; |
696 |
# Insure we have a pattern. |
# Insure we have a pattern. |
697 |
if (! defined($pattern)) { |
if (! defined($pattern) || $pattern eq "") { |
698 |
$retVal = 1; |
$retVal = 1; |
699 |
} else { |
} else { |
700 |
# Break the pattern into pieces around the wildcard characters. Because we |
# Break the pattern into pieces around the wildcard characters. Because we |
876 |
Trace("Migration complete.") if T(2); |
Trace("Migration complete.") if T(2); |
877 |
} |
} |
878 |
|
|
879 |
|
=head3 ComputeObjectTypeFromID |
880 |
|
|
881 |
|
C<< my ($entityName, $id) = CustomAttributes::ComputeObjectTypeFromID($objectID); >> |
882 |
|
|
883 |
|
This method will compute the entity type corresponding to a specified object ID. |
884 |
|
If the object ID begins with C<fig|>, it is presumed to be a feature ID. If it |
885 |
|
is all digits with a single period, it is presumed to by a genome ID. Otherwise, |
886 |
|
it must be a list reference. In this last case the first list element will be |
887 |
|
taken as the entity type and the second will be taken as the actual ID. |
888 |
|
|
889 |
|
=over 4 |
890 |
|
|
891 |
|
=item objectID |
892 |
|
|
893 |
|
Object ID to examine. |
894 |
|
|
895 |
|
=item RETURN |
896 |
|
|
897 |
|
Returns a 2-element list consisting of the entity type followed by the specified ID. |
898 |
|
|
899 |
|
=back |
900 |
|
|
901 |
|
=cut |
902 |
|
|
903 |
|
sub ComputeObjectTypeFromID { |
904 |
|
# Get the parameters. |
905 |
|
my ($objectID) = @_; |
906 |
|
# Declare the return variables. |
907 |
|
my ($entityName, $id); |
908 |
|
# Only proceed if the object ID is defined. If it's not, we'll be returning a |
909 |
|
# pair of undefs. |
910 |
|
if ($objectID) { |
911 |
|
if (ref $objectID eq 'ARRAY') { |
912 |
|
# Here we have the new-style list reference. Pull out its pieces. |
913 |
|
($entityName, $id) = @{$objectID}; |
914 |
|
} else { |
915 |
|
# Here the ID is the outgoing ID, and we need to look at its structure |
916 |
|
# to determine the entity type. |
917 |
|
$id = $objectID; |
918 |
|
if ($objectID =~ /^\d+\.\d+/) { |
919 |
|
# Digits with a single period is a genome. |
920 |
|
$entityName = 'Genome'; |
921 |
|
} elsif ($objectID =~ /^fig\|/) { |
922 |
|
# The "fig|" prefix indicates a feature. |
923 |
|
$entityName = 'Feature'; |
924 |
|
} else { |
925 |
|
# Anything else is illegal! |
926 |
|
Confess("Invalid attribute ID specification \"$objectID\"."); |
927 |
|
} |
928 |
|
} |
929 |
|
} |
930 |
|
# Return the result. |
931 |
|
return ($entityName, $id); |
932 |
|
} |
933 |
|
|
934 |
=head2 FIG Method Replacements |
=head2 FIG Method Replacements |
935 |
|
|
936 |
The following methods are used by B<FIG.pm> to replace the previous attribute functionality. |
The following methods are used by B<FIG.pm> to replace the previous attribute functionality. |
938 |
supported and there is no longer any searching by URL. Fortunately, neither of these |
supported and there is no longer any searching by URL. Fortunately, neither of these |
939 |
capabilities were used in the old system. |
capabilities were used in the old system. |
940 |
|
|
941 |
|
The methods here are the only ones supported by the B<RemoteCustomAttributes> object. |
942 |
|
The idea is that these methods represent attribute manipulation allowed by all users, while |
943 |
|
the others are only for privileged users with access to the attribute server. |
944 |
|
|
945 |
In the previous implementation, an attribute had a value and a URL. In the new implementation, |
In the previous implementation, an attribute had a value and a URL. In the new implementation, |
946 |
there is only a value. In this implementation, each attribute has only a value. These |
there is only a value. In this implementation, each attribute has only a value. These |
947 |
methods will treat the value as a list with the individual elements separated by the |
methods will treat the value as a list with the individual elements separated by the |
959 |
|
|
960 |
=head3 GetAttributes |
=head3 GetAttributes |
961 |
|
|
|
C<< my @attributeList = GetAttributes($objectID, $key, @valuePatterns); >> |
|
|
|
|
|
or |
|
|
|
|
962 |
C<< my @attributeList = $attrDB->GetAttributes($objectID, $key, @valuePatterns); >> |
C<< my @attributeList = $attrDB->GetAttributes($objectID, $key, @valuePatterns); >> |
963 |
|
|
|
The first form will connect to the database and release it. The second form |
|
|
uses the database connection contained in the object. |
|
|
|
|
964 |
In the database, attribute values are sectioned into pieces using a splitter |
In the database, attribute values are sectioned into pieces using a splitter |
965 |
value specified in the constructor (L</new>). This is not a requirement of |
value specified in the constructor (L</new>). This is not a requirement of |
966 |
the attribute system as a whole, merely a convenience for the purpose of |
the attribute system as a whole, merely a convenience for the purpose of |
1027 |
starts with C<fig|> is treated as a feature ID, and an ID that is all digits with a |
starts with C<fig|> is treated as a feature ID, and an ID that is all digits with a |
1028 |
single period is treated as a genome ID. For other entity types, use a list reference; in |
single period is treated as a genome ID. For other entity types, use a list reference; in |
1029 |
this case the first list element is the entity type and the second is the ID. A value of |
this case the first list element is the entity type and the second is the ID. A value of |
1030 |
C<undef> here will match all objects. |
C<undef> or an empty string here will match all objects. |
1031 |
|
|
1032 |
=item key |
=item key |
1033 |
|
|
1035 |
field name equal to the key name, it is very fast to find a list of all the |
field name equal to the key name, it is very fast to find a list of all the |
1036 |
matching keys. Each key's values require a separate query, however, which may |
matching keys. Each key's values require a separate query, however, which may |
1037 |
be a performance problem if the pattern matches a lot of keys. Wild cards are |
be a performance problem if the pattern matches a lot of keys. Wild cards are |
1038 |
acceptable here, and a value of C<undef> will match all attribute keys. |
acceptable here, and a value of C<undef> or an empty string will match all |
1039 |
|
attribute keys. |
1040 |
|
|
1041 |
=item valuePatterns |
=item valuePatterns |
1042 |
|
|
1043 |
List of the desired attribute values, section by section. If C<undef> |
List of the desired attribute values, section by section. If C<undef> |
1044 |
is specified, all values in that section will match. |
or an empty string is specified, all values in that section will match. |
1045 |
|
|
1046 |
=item RETURN |
=item RETURN |
1047 |
|
|
1055 |
=cut |
=cut |
1056 |
|
|
1057 |
sub GetAttributes { |
sub GetAttributes { |
1058 |
# Connect to the database. The tricky part is knowing whether or not we |
# Get the parameters. |
1059 |
# are an instance method (in which case the first parameter is a |
my ($self, $objectID, $key, @valuePatterns) = @_; |
|
# CustomAttributes object) or a static method (in which case we must |
|
|
# connect manually. |
|
|
my $self = (UNIVERSAL::isa($_[0],__PACKAGE__) ? shift @_ : CustomAttributes->new()); |
|
|
# Get the remaining parameters. |
|
|
my ($objectID, $key, @valuePatterns) = @_; |
|
1060 |
# Declare the return variable. |
# Declare the return variable. |
1061 |
my @retVal = (); |
my @retVal = (); |
1062 |
# Determine the entity types for our search. |
# Determine the entity types for our search. |
1063 |
my @objects = (); |
my @objects = (); |
1064 |
my ($actualObjectID, $computedType); |
my ($actualObjectID, $computedType); |
1065 |
if (! defined($objectID)) { |
if (! $objectID) { |
1066 |
push @objects, $self->GetEntityTypes(); |
push @objects, $self->GetEntityTypes(); |
1067 |
} else { |
} else { |
1068 |
($computedType, $actualObjectID) = ComputeObjectTypeFromID($objectID); |
($computedType, $actualObjectID) = ComputeObjectTypeFromID($objectID); |
1078 |
# Now we figure out whether or not we need to filter by object. |
# Now we figure out whether or not we need to filter by object. |
1079 |
my $filter = ""; |
my $filter = ""; |
1080 |
my @params = (); |
my @params = (); |
1081 |
if (defined($actualObjectID)) { |
if (! $actualObjectID) { |
1082 |
# Here the caller wants to filter on object ID. |
# Here the caller wants to filter on object ID. |
1083 |
$filter = "$entityType(id) = ?"; |
$filter = "$entityType(id) = ?"; |
1084 |
push @params, $actualObjectID; |
push @params, $actualObjectID; |
1133 |
|
|
1134 |
C<< $attrDB->AddAttribute($objectID, $key, @values); >> |
C<< $attrDB->AddAttribute($objectID, $key, @values); >> |
1135 |
|
|
|
or |
|
|
|
|
|
C<< AddAttribute($objectID, $key, @values); >> |
|
|
|
|
1136 |
Add an attribute key/value pair to an object. This method cannot add a new key, merely |
Add an attribute key/value pair to an object. This method cannot add a new key, merely |
1137 |
add a value to an existing key. Use L</StoreAttributeKey> to create a new key. |
add a value to an existing key. Use L</StoreAttributeKey> to create a new key. |
1138 |
|
|
|
The first form will connect to the database and release it. The second form |
|
|
uses the database connection contained in the object. |
|
|
|
|
1139 |
=over 4 |
=over 4 |
1140 |
|
|
1141 |
=item objectID |
=item objectID |
1160 |
=cut |
=cut |
1161 |
|
|
1162 |
sub AddAttribute { |
sub AddAttribute { |
|
# Connect to the database. The tricky part is knowing whether or not we |
|
|
# are an instance method (in which case the first parameter is a |
|
|
# CustomAttributes object) or a static method (in which case we must |
|
|
# connect manually. |
|
|
my $self = (UNIVERSAL::isa($_[0],__PACKAGE__) ? shift @_ : CustomAttributes->new()); |
|
1163 |
# Get the parameters. |
# Get the parameters. |
1164 |
my ($objectID, $key, @values) = @_; |
my ($self, $objectID, $key, @values) = @_; |
1165 |
# Don't allow undefs. |
# Don't allow undefs. |
1166 |
if (! defined($objectID)) { |
if (! defined($objectID)) { |
1167 |
Confess("No object ID specified for AddAttribute call."); |
Confess("No object ID specified for AddAttribute call."); |
1186 |
|
|
1187 |
C<< $attrDB->DeleteAttribute($objectID, $key, @values); >> |
C<< $attrDB->DeleteAttribute($objectID, $key, @values); >> |
1188 |
|
|
|
or |
|
|
|
|
|
C<< DeleteAttribute($objectID, $key, @values); >> |
|
|
|
|
1189 |
Delete the specified attribute key/value combination from the database. |
Delete the specified attribute key/value combination from the database. |
1190 |
|
|
1191 |
The first form will connect to the database and release it. The second form |
The first form will connect to the database and release it. The second form |
1213 |
=cut |
=cut |
1214 |
|
|
1215 |
sub DeleteAttribute { |
sub DeleteAttribute { |
|
# Connect to the database. The tricky part is knowing whether or not we |
|
|
# are an instance method (in which case the first parameter is a |
|
|
# CustomAttributes object) or a static method (in which case we must |
|
|
# connect manually. |
|
|
my $self = (UNIVERSAL::isa($_[0],__PACKAGE__) ? shift @_ : CustomAttributes->new()); |
|
1216 |
# Get the parameters. |
# Get the parameters. |
1217 |
my ($objectID, $key, @values) = @_; |
my ($self, $objectID, $key, @values) = @_; |
1218 |
# Don't allow undefs. |
# Don't allow undefs. |
1219 |
if (! defined($objectID)) { |
if (! defined($objectID)) { |
1220 |
Confess("No object ID specified for DeleteAttribute call."); |
Confess("No object ID specified for DeleteAttribute call."); |
1234 |
return 1; |
return 1; |
1235 |
} |
} |
1236 |
|
|
|
=head3 ComputeObjectTypeFromID |
|
|
|
|
|
C<< my ($entityName, $id) = CustomAttributes::ComputeObjectTypeFromID($objectID); >> |
|
|
|
|
|
This method will compute the entity type corresponding to a specified object ID. |
|
|
If the object ID begins with C<fig|>, it is presumed to be a feature ID. If it |
|
|
is all digits with a single period, it is presumed to by a genome ID. Otherwise, |
|
|
it must be a list reference. In this last case the first list element will be |
|
|
taken as the entity type and the second will be taken as the actual ID. |
|
|
|
|
|
=over 4 |
|
|
|
|
|
=item objectID |
|
|
|
|
|
Object ID to examine. |
|
|
|
|
|
=item RETURN |
|
|
|
|
|
Returns a 2-element list consisting of the entity type followed by the specified ID. |
|
|
|
|
|
=back |
|
|
|
|
|
=cut |
|
|
|
|
|
sub ComputeObjectTypeFromID { |
|
|
# Get the parameters. |
|
|
my ($objectID) = @_; |
|
|
# Declare the return variables. |
|
|
my ($entityName, $id); |
|
|
# Only proceed if the object ID is defined. If it's not, we'll be returning a |
|
|
# pair of undefs. |
|
|
if (defined($objectID)) { |
|
|
if (ref $objectID eq 'ARRAY') { |
|
|
# Here we have the new-style list reference. Pull out its pieces. |
|
|
($entityName, $id) = @{$objectID}; |
|
|
} else { |
|
|
# Here the ID is the outgoing ID, and we need to look at its structure |
|
|
# to determine the entity type. |
|
|
$id = $objectID; |
|
|
if ($objectID =~ /^\d+\.\d+/) { |
|
|
# Digits with a single period is a genome. |
|
|
$entityName = 'Genome'; |
|
|
} elsif ($objectID =~ /^fig\|/) { |
|
|
# The "fig|" prefix indicates a feature. |
|
|
$entityName = 'Feature'; |
|
|
} else { |
|
|
# Anything else is illegal! |
|
|
Confess("Invalid attribute ID specification \"$objectID\"."); |
|
|
} |
|
|
} |
|
|
} |
|
|
# Return the result. |
|
|
return ($entityName, $id); |
|
|
} |
|
|
|
|
1237 |
=head3 ChangeAttribute |
=head3 ChangeAttribute |
1238 |
|
|
1239 |
C<< $attrDB->ChangeAttribute($objectID, $key, \@oldValues, \@newValues); >> |
C<< $attrDB->ChangeAttribute($objectID, $key, \@oldValues, \@newValues); >> |
1240 |
|
|
|
or |
|
|
|
|
|
C<< ChangeAttribute($objectID, $key, \@oldValues, \@newValues); >> |
|
|
|
|
1241 |
Change the value of an attribute key/value pair for an object. |
Change the value of an attribute key/value pair for an object. |
1242 |
|
|
|
The first form will connect to the database and release it. The second form |
|
|
uses the database connection contained in the object. |
|
|
|
|
1243 |
=over 4 |
=over 4 |
1244 |
|
|
1245 |
=item objectID |
=item objectID |
1266 |
=cut |
=cut |
1267 |
|
|
1268 |
sub ChangeAttribute { |
sub ChangeAttribute { |
|
# Connect to the database. The tricky part is knowing whether or not we |
|
|
# are an instance method (in which case the first parameter is a |
|
|
# CustomAttributes object) or a static method (in which case we must |
|
|
# connect manually. |
|
|
my $self = (UNIVERSAL::isa($_[0],__PACKAGE__) ? shift @_ : CustomAttributes->new()); |
|
1269 |
# Get the parameters. |
# Get the parameters. |
1270 |
my ($objectID, $key, $oldValues, $newValues) = @_; |
my ($self, $objectID, $key, $oldValues, $newValues) = @_; |
1271 |
# Don't allow undefs. |
# Don't allow undefs. |
1272 |
if (! defined($objectID)) { |
if (! defined($objectID)) { |
1273 |
Confess("No object ID specified for ChangeAttribute call."); |
Confess("No object ID specified for ChangeAttribute call."); |