[MOBY-guts] biomoby commit
Mark Wilkinson
mwilkinson at pub.open-bio.org
Tue Jul 26 23:32:49 UTC 2005
mwilkinson
Tue Jul 26 19:32:48 EDT 2005
Update of /home/repository/moby/moby-live/Perl/MOBY/Adaptor/moby/queryapi
In directory pub.open-bio.org:/tmp/cvs-serv25766/MOBY/Adaptor/moby/queryapi
Modified Files:
mysql.pm
Log Message:
adaptor API should now be complete
moby-live/Perl/MOBY/Adaptor/moby/queryapi mysql.pm,1.38,1.39
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/Adaptor/moby/queryapi/mysql.pm,v
retrieving revision 1.38
retrieving revision 1.39
diff -u -r1.38 -r1.39
--- /home/repository/moby/moby-live/Perl/MOBY/Adaptor/moby/queryapi/mysql.pm 2005/07/25 23:45:29 1.38
+++ /home/repository/moby/moby-live/Perl/MOBY/Adaptor/moby/queryapi/mysql.pm 2005/07/26 23:32:48 1.39
@@ -1034,40 +1034,37 @@
return 0;
}
}
-
-# custom query subroutine for Moby::Central.pm->deregisterObjectClass()
-# MARK LOOK HERE!!!
-# may need two different adaptors for this... one for the object table and other for the mobycentral table
+# pass type as LSID or term
sub check_object_usage{
my ($self, %args) = @_;
my $dbh = $self->dbh;
my $errorMsg = 1;
my $type = $args{type};
return 0 unless $type;
- my $result = $self->query_namespace(type => $type);
+ my $result = $self->query_object(type => $type);
my $row = shift @$result;
my $lsid = $row->{object_lsid};
my ($id) = $dbh->selectrow_array(q{select service_instance.service_instance_id from service_instance natural join simple_input where object_type_uri = ?},
- undef, $existingURI
+ undef, $lsid
);
return $errorMsg
if ($id);
($id) = $dbh->selectrow_array(q{select service_instance.service_instance_id from service_instance natural join simple_output where object_type_uri = ?},
- undef, $existingURI
+ undef, $lsid
);
return $errorMsg
if ($id);
($id) = $dbh->selectrow_array(q{select service_instance.service_instance_id from service_instance natural join collection_input natural join simple_input where object_type_uri = ?},
- undef, $existingURI
+ undef, $lsid
);
return $errorMsg
if ($id);
($id) = $dbh->selectrow_array(q{select service_instance.service_instance_id from service_instance natural join collection_output natural join simple_output where object_type_uri = ?},
- undef, $existingURI
+ undef, $lsid
);
return $errorMsg
if ($id);
@@ -1076,15 +1073,17 @@
}
# custom query routine for Moby::Central.pm -> deregisterNamespace()
-sub checkNamespaceUsedByService{
- my ($self, @args) = @_;
- my $dbh = $self->dbh;
- my $existingURI = get_value('namespace_type_uris', @args);
- my $term = get_value('term', @args);
- my $errstr;
+sub check_namespace_usage{
+ my ($self, %args) = @_;
+ my $dbh = $self->dbh;
+ my $errorMsg = 1;
+ my $type = $args{type};
+ return 0 unless $type;
+ my $result = $self->query_namespace(type => $type);
+ my $row = shift @$result;
+ my $lsid = $row->{namespace_lsid};
- my $sth = $dbh->prepare(
-"select service_instance.service_instance_id, namespace_type_uris from service_instance natural join simple_input where INSTR(namespace_type_uris,'$existingURI')"
+ my $sth = $dbh->prepare("select service_instance.service_instance_id, namespace_type_uris from service_instance natural join simple_input where INSTR(namespace_type_uris,'$lsid')"
);
$sth->execute;
@@ -1092,89 +1091,84 @@
my @nss = split ",", $ns;
foreach (@nss) {
$_ =~ s/\s//g;
- my $errstr = "Namespace Type $term ($_) is used by a service (service ID number $id) and may not be deregistered";
+ my $errstr = "Namespace Type $type ($_) is used by a service (service ID number $id) and may not be deregistered";
return (1, $errstr)
- if ( $_ eq $existingURI );
+ if ( $_ eq $lsid );
}
}
- $sth = $dbh->prepare(
-"select service_instance.service_instance_id, namespace_type_uris from service_instance natural join simple_output where INSTR(namespace_type_uris,'$existingURI')"
+ $sth = $dbh->prepare("select service_instance.service_instance_id, namespace_type_uris from service_instance natural join simple_output where INSTR(namespace_type_uris,'$lsid')"
);
$sth->execute;
while ( my ( $id, $ns ) = $sth->fetchrow_array() ) {
my @nss = split ",", $ns;
foreach (@nss) {
$_ =~ s/\s//g;
- my $errstr = "Namespace Type $term ($_) is used by a service (service ID number $id) and may not be deregistered";
+ my $errstr = "Namespace Type $type ($_) is used by a service (service ID number $id) and may not be deregistered";
return (1, $errstr)
- if ( $_ eq $existingURI );
+ if ( $_ eq $lsid );
}
}
$sth =
- $dbh->prepare(
-"select service_instance.service_instance_id, namespace_type_uris from service_instance natural join collection_input natural join simple_input where INSTR(namespace_type_uris, '$existingURI')"
+ $dbh->prepare("select service_instance.service_instance_id, namespace_type_uris from service_instance natural join collection_input natural join simple_input where INSTR(namespace_type_uris, '$lsid')"
);
$sth->execute;
while ( my ( $id, $ns ) = $sth->fetchrow_array() ) {
my @nss = split ",", $ns;
foreach (@nss) {
$_ =~ s/\s//g;
- my $errstr = "Namespace Type $term ($_) is used by a service (service ID number $id) and may not be deregistered";
+ my $errstr = "Namespace Type $type ($_) is used by a service (service ID number $id) and may not be deregistered";
return (1, $errstr)
- if ( $_ eq $existingURI );
+ if ( $_ eq $lsid );
}
}
$sth =
- $dbh->prepare(
-"select service_instance.service_instance_id, namespace_type_uris from service_instance natural join collection_output natural join simple_output where INSTR(namespace_type_uris, '$existingURI')"
+ $dbh->prepare("select service_instance.service_instance_id, namespace_type_uris from service_instance natural join collection_output natural join simple_output where INSTR(namespace_type_uris, '$lsid')"
);
$sth->execute;
while ( my ( $id, $ns ) = $sth->fetchrow_array() ) {
my @nss = split ",", $ns;
foreach (@nss) {
$_ =~ s/\s//g;
- my $errstr = "Namespace Type $term ($_) is used by a service (service ID number $id) and may not be deregistered";
+ my $errstr = "Namespace Type $type ($_) is used by a service (service ID number $id) and may not be deregistered";
return (1, $errstr)
- if ( $_ eq $existingURI );
+ if ( $_ eq $lsid );
}
}
return (0, "");
}
# custom query routine for Moby::Central.pm -> findService()
-sub checkKeywords{
- my ($self, @args) = @_;
+sub check_keywords{
+ my ($self, %args) = @_;
my $dbh = $self->dbh;
- my $param = get_value('findme', @args);
+ my $param = $args{keywords};
+ return ([{}]) unless (ref($param) =~ /ARRAY/);
+ my @keywords = @$param;
my %findme = %$param;
my $searchstring;
-
- foreach my $kw ( @{ $findme{keywords} } ) {
-# $debug && &_LOG("KEYWORD $kw\n");
+ foreach my $kw ( @keywords ) {
$kw =~ s/\*//g;
$kw = $dbh->quote("%$kw%");
$searchstring .= " OR description like $kw ";
}
$searchstring =~ s/OR//; # remove just the first OR in the longer statement
-# $debug && &_LOG("search $searchstring\n");
my $statement = "select service_instance_id,category, servicename, service_type_uri, authority_id, url, contact_email, authoritative, description, signatureURL, lsid from service_instance where $searchstring";
my @bindvalues = ();
my $ids = do_query($dbh, $statement, @bindvalues);
- return ($ids, $searchstring);
+ return ($ids);
}
# custom query subroutine for Moby::Central.pm->_searchForSimple()
-sub getFromSimple{
- my ($self, @args) = @_;
+sub find_by_simple{
+ my ($self, %args) = @_;
my $dbh = $self->dbh;
- my $inout = get_value('inout', @args);
- my $ancestor_string = get_value('ancestor_string', @args);
- my $namespaceURIs = get_value('namespaceURIs', @args);
+ my $inout = $args{'inout'};
+ my $ancestor_string = $args{'ancestor_string'};
+ my $namespaceURIs = $args{'namespaceURIs'};
- my $query =
-"select service_instance_id, namespace_type_uris from simple_$inout where object_type_uri in ($ancestor_string) and service_instance_id IS NOT NULL "
+ my $query ="select service_instance_id, namespace_type_uris from simple_$inout where object_type_uri in ($ancestor_string) and service_instance_id IS NOT NULL "
; # if service_instance_id is null then it must be a collection input.
my $nsquery;
foreach my $ns ( @{$namespaceURIs} ) { # namespaces are already URI's
@@ -1191,12 +1185,12 @@
}
# custom query subroutine for Moby::Central.pm->_searchForCollection()
-sub getFromCollection{
- my ($self, @args) = @_;
+sub find_by_collection{
+ my ($self, %args) = @_;
my $dbh = $self->dbh;
- my $inout = get_value('inout', @args);
- my $objectURI = get_value('objectURI', @args);
- my $namespaceURIs = get_value('namespaceURIs', @args);
+ my $inout = $args{'inout'};
+ my $objectURI = $args{'objectURI'};
+ my $namespaceURIs = $args{'namespaceURIs'};
my $query = "select
c.service_instance_id,
@@ -1223,8 +1217,8 @@
}
# custom query subroutine for Moby::Central.pm->RetrieveServiceNames
-sub getServiceNames{
- my ($self, @args) = @_;
+sub get_service_names{
+ my ($self, %args) = @_;
my $dbh = $self->dbh;
my $statement = "select authority_uri, servicename from authority as a, service_instance as s where s.authority_id = a.authority_id";
my @bindvalues = ();
@@ -1234,11 +1228,11 @@
}
# custom query for Moby::Central.pm->_flatten
-sub getParentTerms{
- my ($self, @args) = @_;
+sub get_parent_terms{
+ my ($self, %args) = @_;
my $dbh = $self->dbh;
- my $type_id = get_value('relationship_type_id', @args);
+ my $type_id = $args{'relationship_type_id'};
my $statement = "
select
OE1.term
@@ -1253,7 +1247,7 @@
and OE2.term = ?";
my @bindvalues = ();
- push(@bindvalues, get_value('term', @args));
+ push(@bindvalues, $args{'term'});
my $result = do_query($dbh, $statement, @bindvalues);
return $result;
@@ -1261,10 +1255,15 @@
# custom query subroutine for selecting from object_term2term and object tables
# used in Moby::OntologyServer.pm->retrieveObject()
-sub getObjectRelationships{
- my ($self, @args) = @_;
+sub get_object_relationships{
+ my ($self, %args) = @_;
my $dbh = $self->dbh;
-
+ my $type = $args{type};
+ return 0 unless $type;
+ my $result = $self->query_object(type => $type);
+ my $row = shift @$result;
+ my $id = $row->{object_id};
+
my $statement = "select
relationship_type,
object_lsid,
@@ -1272,22 +1271,24 @@
from object_term2term, object
where object1_id = ? and object2_id = object_id";
- my @bindvalues = ();
- push(@bindvalues, get_value('object1_id', @args));
-
- my $result = do_query($dbh, $statement, @bindvalues);
- return $result;
+ my $result2 = do_query($dbh, $statement, ($id));
+ return $result2;
}
# relationship query for any table used in Moby::OntologyServer->_doRelationshipQuery()
# note: returns a reference to an array containing ARRAY references
-sub getRelationship{
- my ($self, @args) = @_;
+sub get_relationship{
+ my ($self, %args) = @_;
my $dbh = $self->dbh;
- my $direction = get_value('direction', @args);
- my $ontology = get_value('ontology', @args);
- my $term = get_value('term', @args);
- my $relationship = get_value('relationship', @args);
+ my $direction = $args{'direction'};
+ my $ontology = $args{'ontology'};
+ my $relationship = $args{'relationship'};
+
+ my $type = $args{'term'};
+ return 0 unless $type;
+ my $result = $self->query_object(type => $type);
+ my $row = shift @$result;
+ my $lsid = $row->{object_lsid};
my $defs;
if ( $direction eq 'root' ) {
@@ -1300,7 +1301,7 @@
where
s1.${ontology}_id = t2t.${ontology}1_id and
s2.${ontology}_id = t2t.${ontology}2_id and
- s1.${ontology}_lsid = ?", undef, $term ); # ")
+ s1.${ontology}_lsid = ?", undef, $lsid ); # ")
} else {
$defs = $self->dbh->selectall_arrayref( "
select distinct s2.${ontology}_lsid, relationship_type from
@@ -1311,7 +1312,7 @@
relationship_type = ? and
s1.${ontology}_id = t2t.${ontology}1_id and
s2.${ontology}_id = t2t.${ontology}2_id and
- s1.${ontology}_lsid = ?", undef, $relationship, $term ); # ")
+ s1.${ontology}_lsid = ?", undef, $relationship, $lsid ); # ")
}
} else {
unless ( defined $relationship ) {
@@ -1323,7 +1324,7 @@
where
s1.${ontology}_id = t2t.${ontology}1_id and
s2.${ontology}_id = t2t.${ontology}2_id and
- s2.${ontology}_lsid = ?", undef, $term ); # ")
+ s2.${ontology}_lsid = ?", undef, $lsid); # ")
} else {
$defs = $self->dbh->selectall_arrayref( "
select distinct s2.${ontology}_lsid, relationship_type from
@@ -1334,7 +1335,7 @@
relationship_type = ? and
s1.${ontology}_id = t2t.${ontology}1_id and
s2.${ontology}_id = t2t.${ontology}2_id and
- s2.${ontology}_lsid = ?", undef, $relationship, $term ); # ")
+ s2.${ontology}_lsid = ?", undef, $relationship, $lsid ); # ")
}
}
return $defs;
More information about the MOBY-guts
mailing list