[MOBY-guts] biomoby commit
Mark Wilkinson
mwilkinson at pub.open-bio.org
Mon Jul 25 23:45:29 UTC 2005
mwilkinson
Mon Jul 25 19:45:29 EDT 2005
Update of /home/repository/moby/moby-live/Perl/MOBY/Adaptor/moby/queryapi
In directory pub.open-bio.org:/tmp/cvs-serv22352/MOBY/Adaptor/moby/queryapi
Modified Files:
mysql.pm
Log Message:
almost finished perlifying the adaptor code.
moby-live/Perl/MOBY/Adaptor/moby/queryapi mysql.pm,1.37,1.38
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/Adaptor/moby/queryapi/mysql.pm,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -r1.37 -r1.38
--- /home/repository/moby/moby-live/Perl/MOBY/Adaptor/moby/queryapi/mysql.pm 2005/07/25 22:10:26 1.37
+++ /home/repository/moby/moby-live/Perl/MOBY/Adaptor/moby/queryapi/mysql.pm 2005/07/25 23:45:29 1.38
@@ -1,1331 +1,1382 @@
-package MOBY::Adaptor::moby::queryapi::mysql;
-
-use strict;
-use vars qw($AUTOLOAD @ISA);
-use Carp;
-use MOBY::Adaptor::moby::queryapi;
-use DBI;
-use DBD::mysql;
-
- at ISA = qw{MOBY::Adaptor::moby::queryapi}; # implements the interface
-
-{
- #Encapsulated class data
-
- #___________________________________________________________
- #ATTRIBUTES
- my %_attr_data = # DEFAULT ACCESSIBILITY
- (
- driver => ["DBI:mysql", 'read/write'],
- dbh => [undef, 'read/write'],
-
- );
-
- #_____________________________________________________________
-
- # METHODS, to operate on encapsulated class data
-
- # Is a specified object attribute accessible in a given mode
- sub _accessible {
- my ($self, $attr, $mode) = @_;
- $_attr_data{$attr}[1] =~ /$mode/
- }
-
- # Classwide default value for a specified object attribute
- sub _default_for {
- my ($self, $attr) = @_;
- $_attr_data{$attr}[0];
- }
-
- # List of names of all specified object attributes
- sub _standard_keys {
- keys %_attr_data;
- }
-
- sub driver {
- my ($self, $arg) = @_;
- $self->{driver} = $arg if defined $arg;
- return $self->{driver};
- }
- sub dbh {
- my ($self, $arg) = @_;
- $self->{dbh} = $arg if defined $arg;
- return $self->{dbh};
- }
-
-}
-
-sub new {
- my ($caller, %args) = @_;
- my $self = $caller->SUPER::new(%args);
-
- my $caller_is_obj = ref($caller);
- my $class = $caller_is_obj || $caller;
-
- foreach my $attrname ( $self->_standard_keys ) {
- if (exists $args{$attrname} && defined $args{$attrname}) {
- $self->{$attrname} = $args{$attrname} }
- elsif ($caller_is_obj) {
- $self->{$attrname} = $caller->{$attrname} }
- else {
- $self->{$attrname} = $self->_default_for($attrname) }
- }
-
- return unless $self->driver;
- my $driver = $self->driver; # inherited from the adaptorI (queryapi)
- my $username = $self->username;
- my $password = $self->password;
- my $port = $self->port;
- my $url = $self->url;
- my $dbname = $self->dbname;
-
- my ($dsn) = "$driver:$dbname:$url:$port";
- my $dbh = DBI->connect($dsn, $username, $password, {RaiseError => 1}) or die "can't connect to database";
-
-
- ##############################################################
- unless ($dbh) {
- print STDERR "Couldn't connect to the datasource \n",($self->_dump()),"\n\n";
- return undef;
- }
-
- $self->dbh($dbh);
- #############################################################
-
- return undef unless $self->dbh;
- return $self;
-
-}
-
-sub _add_condition{
- my ($statement, @params) = @_;
- my @bindvalues = ();
- my $condition = "where ";
-
- foreach my $param (@params )
- {
- if (($param eq 'and') || ($param eq 'or'))
- {
- $condition .= $param . " ";
- }
- else
- {
- my %pair = %$param;
-
- for my $key (keys %pair)
- {
- if (defined $pair{$key})
- {
- $condition .= $key . " = ? ";
- push(@bindvalues, $pair{$key});
- }
- else
- {
- $condition .= $key . " IS NULL "
- }
- }
- }
- }
- $statement .= $condition;
- return ($statement, @bindvalues);
- }
-
-# preforms query but returns a reference to an array containing hash references
-sub do_query{
- my ($dbh, $statement, @bindvalues) = @_;
- my $sth = $dbh -> prepare($statement);
- if (@bindvalues < 1)
- {
- $sth->execute;
- }
- else
- {
- $sth->execute(@bindvalues);
- }
- # returns an array of hash references
- my $arrayHashRef = $sth->fetchall_arrayref({});
- return $arrayHashRef;
-}
-
-sub get_value{
- my ($key, @params) = @_;
-
- foreach my $param (@params )
- {
- my %pair = %$param;
- for my $tmp (keys %pair)
- {
- if ($tmp eq $key){
- return $pair{$key};
- }
- }
- }
-}
-
-sub _getSIIDFromLSID {
- my ($self, $lsid) = @_;
- my $dbh = $self->dbh;
- my $sth = $dbh->prepare("select service_instance_id from service_instance were lsid=?");
- $sth->execute($lsid);
- my ($siid) = $sth->fetchrow_array();
- return $siid;
-}
-
-# this should NOT retun a collection ID... needs more work...
-# args passed in: service_lsid
-sub query_collection_input{
- my ($self, %args) = @_;
- my $dbh = $self->dbh;
- my $serv_lsid = $args{'service_lsid'};
-
- my $statement = "select
- collection_input_id,
- article_name
- from collection_input as c, service_instance as si where si.service_instance_id = c.service_instance_id and si.lsid = ?";
- my $result = do_query($dbh, $statement, [$serv_lsid]);
- return $result;
-}
-
-# args passed in: service_instance_lsid, article_name
-sub insert_collection_input {
- my ($self, %args) = @_;
- my $article = $args{article_name};
- my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
-
- $self->dbh->do("insert into collection_input (service_instance_id, article_name) values (?,?)",
- undef, $siid, $article);
- my $id=$self->dbh->{mysql_insertid};
- return $id;
-}
-
-# pass in service_instance_lsid
-sub delete_collection_input{
- my ($self, %args) = @_;
- my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
-
- my $statement = "delete from collection_input where service_instance_id = ?";
- $self->dbh->do( $statement, undef, $siid);
-
- if ($self->dbh->err){
- return (1, $self->dbh->errstr);
- }
- else{
- return 0;
- }
-}
-
-# pass service_instance_lsid
-sub query_collection_output{
- my ($self, %args) = @_;
- my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
- my $dbh = $self->dbh;
-
- my $statement = "select
- collection_output_id,
- article_name,
- service_instance_id
- from collection_output where service_instance_id = ? ";
- my $result = do_query($dbh, $statement, [$siid]);
- return $result;
-}
-
-# pass service_instance_lsid, article_name
-sub insert_collection_output {
- my ($self, %args) = @_;
- my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
- my $dbh = $self->dbh;
- $self->dbh->do("insert into collection_output (service_instance_id, article_name) values (?,?)",
- undef, $siid,$args{'article_name'});
- my $id=$self->dbh->{mysql_insertid};
- return $id;
-}
-
-# pass argument service_instance_lsid
-sub delete_collection_output{
- my ($self, %args) = @_;
- my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
- my $dbh = $self->dbh;
- my $statement = "delete from collection_output where service_instance_id = ?";
- my @bindvalues = ();
- $dbh->do( $statement, undef, ($siid));
-
- if ($dbh->err){
- return (1, $dbh->errstr);
- }
- else{
- return 0;
- }
-}
-
-# pass service_instance_lsid
-sub query_simple_input{
- my ($self, %args) = @_;
- my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
- my $dbh = $self->dbh;
-
- my $statement = "select
- simple_input_id,
- object_type_uri,
- namespace_type_uris,
- article_name,
- service_instance_id,
- collection_input_id
- from simple_input where service_instance_id = ? and collection_input_id IS NULL";
- my $result = do_query($dbh, $statement, ($siid));
- return $result;
-}
-
-# pass service_instance_lsid, object_type_uri, namespace_type_uris, article_name, collection_input_id
-sub insert_simple_input {
- my ($self, %args) = @_;
- my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
- my $dbh = $self->dbh;
- $dbh->do("insert into simple_input
- (object_type_uri,
- namespace_type_uris,
- article_name,
- service_instance_id,
- collection_input_id)
- values (?,?,?,?,?)",
- undef,
- $args{'object_type_uri'},
- $args{'namespace_type_uris'},
- $args{'article_name'},
- $siid,
- $args{'collection_input_id'});
- my $id=$dbh->{mysql_insertid};
- return $id;
-}
-
-# pass service_instance_lsid
-sub delete_simple_input{
- my ($self, %args) = @_;
- my $dbh = $self->dbh;
- my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
- my ($collid) = $args{collection_input_id};
- my $statement1; my $statement2;
- $siid && ($statement1 = "delete from simple_input where service_instance_lsid = ?");
- $collid && ($statement2 = "delete from simple_input where collection_input_id = ?");
-
- $siid && ($dbh->do( $statement1, undef,($siid)));
- $collid && ($dbh->do($statement2, undef,($collid)));
- if ($dbh->err){
- return (1, $dbh->errstr);
- }
- else{
- return 0;
- }
-}
-
-sub delete_inputs { # this should replace all other delete_*_input
- my ($self, %args) = @_;
- my $dbh = $self->dbh;
- my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
- my $result_ids = $self->query_collection_input(service_instance_lsid => $self->lsid);
-
- my $statement = "delete from simple_input where service_instance_lsid = ?";
-
- $dbh->do( $statement, undef,($siid));
- if ($dbh->err){
- return (1, $dbh->errstr);
- }
- else{
- return 0;
- }
-
-}
-
-sub delete_output { # this should replace all other delete_*_output
-
-}
-
-# UGH this has to know too much bout the underlying database structure e.g. that one is null and other is full
-# this problem is in MOBY::Central line 3321 3346 and 3374
-#****** FIX
-# send service_instance_lsid, collection_input_id
-sub query_simple_output{
- my ($self, %args) = @_;
- my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
- my $collid = $args{collection_input_id};
- my $dbh = $self->dbh;
-
- my $statement = "select
- simple_output_id,
- object_type_uri,
- namespace_type_uris,
- article_name,
- service_instance_id,
- collection_output_id
- from simple_output where service_instance_id = ? and collection_input_id= ?";
- my $result = do_query($dbh, $statement, ($siid, $collid));
- return $result;
-}
-
-# pass args service_instance_id and collection_output_id
-sub insert_simple_output {
- my ($self, %args) = @_;
- my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
- my $dbh = $self->dbh;
-
- $dbh->do("insert into simple_output
- (object_type_uri,
- namespace_type_uris,
- article_name,
- service_instance_id,
- collection_output_id)
- values (?,?,?,?,?)",
- undef,(
- $args{'object_type_uri'},
- $args{'namespace_type_uris'},
- $args{'article_name'},
- $siid,
- $args{'collection_output_id'}));
- my $id=$dbh->{mysql_insertid};
- return $id;
-
-}
-
-# pass service_instance_id or collection_output_id
-sub delete_simple_output{
- my ($self, %args) = @_;
- my $dbh = $self->dbh;
- my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
- my ($collid) = $args{collection_output_id};
- my $statement1; my $statement2;
- $siid && ($statement1 = "delete from simple_output where service_instance_lsid = ?");
- $collid && ($statement2 = "delete from simple_output where collection_input_id = ?");
-
- $siid && ($dbh->do( $statement1, undef,($siid)));
- $collid && ($dbh->do($statement2, undef,($collid)));
- if ($dbh->err){
- return (1, $dbh->errstr);
- }
- else{
- return 0;
- }
-}
-
-# pass service_instance_lsid
-sub query_secondary_input{
- my ($self, %args) = @_;
- my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
- my $dbh = $self->dbh;
-
- my $statement = "select
- secondary_input_id,
- default_value,
- maximum_value,
- minimum_value,
- enum_value,
- datatype,
- article_name,
- service_instance_id
- from secondary_input where service_instance_id = ?";
- my $result = do_query($dbh, $statement, ($siid));
- return $result;
-}
-
-# pass default_value, maximum_value minimum_value enum_value datatype article_name service_instance_lsid
-sub insert_secondary_input{
- my ($self, %args) = @_;
- my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
- my $dbh = $self->dbh;
- $dbh->do(q{insert into secondary_input (default_value,maximum_value,minimum_value,enum_value,datatype,article_name,service_instance_id) values (?,?,?,?,?,?,?)},
- undef,
- (
- $args{'default_value'}, $args{'maximum_value'},
- $args{'minimum_value'}, $args{'enum_value'},
- $args{'datatype'}, $args{'article_name'},$siid)
- );
- return $dbh->{mysql_insertid};
-}
-
-# pass service_instance_lsid
-sub delete_secondary_input{
- my ($self, %args) = @_;
- my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
- my $dbh = $self->dbh;
- my $statement = "delete from secondary_input where service_instance_lsid=?";
-
- $dbh->do( $statement, undef, ($siid));
- if ($dbh->err){
- return (1, $dbh->errstr);
- }
- else{
- return 0;
- }
-}
-
-
-# receives argument "type", that may be either an LSID or a type term
-sub query_object {
- my ($self, %args) = @_;
- my $type = $args{type};
- my $condition;
- if ($type =~ /^urn\:lsid/){
- $condition = "where object_lsid = ?";
- } else {
- $condition = "where object_type = ?";
- }
- my $statement = "select
- object_id,
- object_lsid,
- object_type,
- description,
- authority,
- contact_email
- from object $condition";
-
- my $dbh = $self->dbh;
- my $result = do_query($dbh, $statement, ($type));
- return $result;
-}
-
-# inserts a new tuple into object table
-# pass object_type object_lsid description authority contact_email
-sub insert_object{
- my ($self, %args) = @_;
- my $dbh = $self->dbh;
- $dbh->do("insert into object
- (object_type,
- object_lsid,
- description,
- authority,
- contact_email)
- values (?,?,?,?,?)",
- undef,
- $args{'object_type'},
- $args{'object_lsid'},
- $args{'description'},
- $args{'authority'},
- $args{'contact_email'});
- my $id=$dbh->{mysql_insertid};
- return $id;
-}
-
-# pass 'type' which is either an LSID or a term
-sub delete_object{
- my ($self, %args) = @_;
- my $dbh = $self->dbh;
- my $term = $args{type};
- return 0 unless $term;
- my $statement = "delete from object where ";
- my $condition;
- if ($term =~ /^urn\:lsid/){
- $condition = " object_lsid = ?";
- } else {
- $condition = " object_type = ?";
- }
- $statement = $statement.$condition;
- $dbh->do( $statement,undef, ($term) );
-
- $self->_delete_object_term2term(type => $term);
- if ($dbh->err){
- return (1, $dbh->errstr);
- }
- else{
- return 0;
- }
-}
-
-# pass "type" here, should be an LSID, preferably...
-sub query_object_term2term{
- my ($self, %args) = @_;
- my $type = $args{type};
- my $result = $self->query_object(type => $type);
- my $row = shift(@$result);
- my $id = $row->{object_id};
- return [{}] unless $id;
- my $dbh = $self->dbh;
-
- my $statement = "select
- assertion_id,
- relationship_type,
- object1_id,
- object2_id,
- object2_articlename
- from object_term2term where object2_id = ?";
- my $result2 = do_query($dbh, $statement, ($id));
- return $result2;
-}
-
-# pass object1_type, object2_type, object2_articlename, relationship_type
-sub insert_object_term2term{
- my ($self, %args) = @_;
- my $type1 = $args{object1_type};
- my $result = $self->query_object(type => $type1);
- my $row = shift(@$result);
- my $id1 = $row->{object_id};
- my $type2 = $args{object2_type};
- $result = $self->query_object(type => $type2);
- $row = shift(@$result);
- my $id2 = $row->{object_id};
- my $relationship_type = $args{relationship_type};
- my $object2_articlename = $args{object2_articlename};
-
- my $dbh = $self->dbh;
- $dbh->do(
- q{insert into object_term2term (relationship_type, object1_id, object2_id, object2_articlename) values (?,?,?,?)},
- undef,
- $relationship_type,
- $id1,
- $id2,
- $object2_articlename
- );
-
- return $dbh->{mysql_insertid};
-}
-
-# pass object 'type' as term or lsid
-# this should be a private routine, not a public one.
-# SHOULD NOT BE DOCUMENTED IN THE API
-sub _delete_object_term2term{
- my ($self, %args) = @_;
- 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 $dbh = $self->dbh;
- my $statement = "delete from object_term2term where object1_id=?";
- $dbh->do( $statement,undef, ($id));
-
- if ($dbh->err){
- return (1, $dbh->errstr);
- }
- else{
- return 0;
- }
-}
-
-# pass servicename and authority_uri
-sub query_service_existence {
- my ($self, %args) = @_;
- my $dbh = $self->dbh;
-
- my $servicename = $args{'servicename'};
- my $authURI = $args{'authority_uri'};
-# my $id = $args{'authority_id'}; # is it safe to remove this? better be!
-# unless ($id){
- my $result = $self->query_authority(authority_uri => $authURI);
- return 0 unless @$result[0];
- my $id = @$result[0]->{authority_id};
- return 0 unless $id;
-# }
- my $statement = "select
- service_instance_id,
- category,
- servicename,
- service_type_uri,
- authority_id,
- url,
- contact_email,
- authoritative,
- description,
- signatureURL,
- lsid
- from service_instance where servicename = ? and authority_id = ?";
- my $final = do_query($dbh, $statement, ($servicename, $id));
- if (@$final[0]){return 1} else {return 0}
-
-}
-# selects all the columns from service_instance table
-# where is lsid?
-
-sub query_service_instance {
- my ($self, %args) = @_;
- my $dbh = $self->dbh;
-
- my $authority_id;
- #if ($args{'authority_uri'}){ # need to transform URI to a row ID
- # my $result = $self->query_authority(authority_uri => $args{'authority_uri'});
- # return 0 unless @$result[0];
- # $authority_id = @$result[0]->{authority_id};
- # return 0 unless $authority_id;
- #}
- #delete $args{'authority_uri'}; # this can't be passed into the search since it doens't exist in the table
- my @args;
- while (my ($k, $v) = each %args){
- push @args, ({$k => $v}, "and"); # format for the_add_condition subroutine
- }
-# if ($authority_id){
-# push @args, ({authority_id => $authority_id}) ;
-# } else {
-# pop @args; # remove final "and"
-# }
-
- my $statement = "select
- service_instance_id,
- category,
- servicename,
- service_type_uri,
- authority.authority_uri,
- url,
- contact_email,
- authoritative,
- description,
- signatureURL,
- lsid
- from service_instance left join authority on authority.authority_id ";
- my @bindvalues;
- ($statement, @bindvalues) =_add_condition($statement, @args);
- my $final = do_query($dbh, $statement, @bindvalues);
- return $final;
-}
-
-# custom query for Moby::Central.pm->findService()
-# hmmmmmmm.... I'm not sure that this routine should exist...
-# it is redundant to the routine above, if the routine above were executed
-# multiple times. I think that is the more correct (though less efficient)
-# way to go, since it is "scalable" to every possible underlying data source
-# ********FIX change this later...
-sub match_service_type_uri{
- my ($self, %args) = @_;
- my $dbh = $self->dbh;
- my $uri_list = $args{'service_type_uri'};
- my $statement = "select service_instance_id,category, servicename, service_type_uri, authority_id, url, contact_email, authoritative, description, signatureURL, lsid from service_instance where service_type_uri in ($uri_list)";
- my @bindvalues = ();
- my $result = do_query($dbh, $statement, @bindvalues);
- return $result;
-}
-
-# passs........ blah blah.....
-sub insert_service_instance {
- my ($self, %args) = @_;
- my $dbh = $self->dbh;
-
- $dbh->do(q{insert into service_instance (category, servicename, service_type_uri, authority_id, url, contact_email, authoritative, description, signatureURL, lsid) values (?,?,?,?,?,?,?,?,?,?)},
- undef,(
- $args{'category'},
- $args{'servicename'},
- $args{'service_type_uri'},
- $args{'authority_id'},
- $args{'url'},
- $args{'contact_email'},
- $args{'authoritative'},
- $args{'description'},
- $args{'signatureURL'},
- $args{'lsid'}));
-
- my $id = $dbh->{mysql_insertid};
- return $id;
-}
-
-# pass service_instance_lsid
-sub delete_service_instance{
- my ($self, %args) = @_;
- my $dbh = $self->dbh;
- my $statement = "delete from service_instance where lsid = ?";
- $dbh->do( $statement,undef, ($args{service_instance_lsid}) );
- if ($dbh->err){
- return (1, $dbh->errstr);
- }
- else{
- return 0;
- }
-}
-
-# Selects all columns
-# pass authority_uri
-sub query_authority {
- my ($self, %args) = @_;
- my $authURI = $args{authority_uri};
- my $dbh = $self->dbh;
-
- my $statement = "select
- authority_id,
- authority_common_name,
- authority_uri,
- contact_email
- from authority where authority_uri = ?";
- my $result = do_query($dbh, $statement, ($authURI));
- return $result;
-}
-
-# custom query routine used in Moby::Central.pm -> retrieveServiceProviders()
-sub getUniqueAuthorityURI{
- my ($self, @args) = @_;
- my $dbh = $self->dbh;
- my $statement = "select distinct authority_uri from authority";
- my @bindvalues = ();
- my $result = do_query($dbh, $statement, @bindvalues);
- return $result;
-}
-
-sub insert_authority{
- my ($self, @args) = @_;
- my $dbh = $self->dbh;
- $dbh->do("insert into authority
- (authority_common_name,
- authority_uri,
- contact_email)
- values (?,?,?)",
- undef,
- (get_value('authority_common_name', @args),
- get_value('authority_uri', @args),
- get_value('contact_email', @args)));
- my $id = $dbh->{mysql_insertid};
- return $id;
-}
-
-sub query_service{
- my ($self, @args) = @_;
- my $dbh = $self->dbh;
- my $statement = "select
- service_id,
- service_lsid,
- service_type,
- description,
- authority,
- contact_email
- from service ";
- my @bindvalues = ();
- if (@args > 0)
- {
- ($statement, @bindvalues) =_add_condition($statement, @args);
- }
-
- my $result = do_query($dbh, $statement, @bindvalues);
- return $result;
-}
-
-sub insert_service{
- my ($self, @args) = @_;
- my $dbh = $self->dbh;
- $dbh->do(
-q{insert into service (service_type, service_lsid, description, authority, contact_email) values (?,?,?,?,?)},
- undef,
- (
- get_value('service_type', @args), get_value('service_lsid', @args), get_value('description', @args),
- get_value('authority', @args), get_value('contact_email', @args)
- )
- );
- return $dbh->{mysql_insertid};
-}
-
-sub delete_service{
- my ($self, @args) = @_;
- my $dbh = $self->dbh;
- my $statement = "delete from service ";
- my @bindvalues = ();
- ($statement, @bindvalues) =_add_condition($statement, @args);
- $dbh->do( $statement,
- undef, @bindvalues );
-
- if ($dbh->err){
- return (1, $dbh->errstr);
- }
- else{
- return 0;
- }
-}
-
-sub query_service_term2term{
- my ($self, @args) = @_;
- my $dbh = $self->dbh;
- my $statement = "select
- assertion_id,
- relationship_type,
- service1_id,
- service2_id
- from service_term2term ";
- my @bindvalues = ();
- if (@args > 0)
- {
- ($statement, @bindvalues) =_add_condition($statement, @args);
- }
-
- my $result = do_query($dbh, $statement, @bindvalues);
- return $result;
-}
-
-sub insert_service_term2term{
- my ($self, @args) = @_;
- my $dbh = $self->dbh;
- $dbh->do(
-q{insert into service_term2term (relationship_type, service1_id, service2_id) values (?,?,?)},
- undef,
- ( get_value('relationship_type', @args), get_value('service1_id', @args), get_value('service2_id', @args))
- );
- return $dbh->{mysql_insertid};
-}
-
-sub delete_service_term2term{
- my ($self, @args) = @_;
- my $dbh = $self->dbh;
- my $statement = "delete from service_term2term ";
- my @bindvalues = ();
- ($statement, @bindvalues) =_add_condition($statement, @args);
- $dbh->do( $statement,
- undef, @bindvalues );
-
- if ($dbh->err){
- return (1, $dbh->errstr);
- }
- else{
- return 0;
- }
-}
-
-sub query_relationship{
- my ($self, @args) = @_;
- my $dbh = $self->dbh;
-
- my $statement = "select
- relationship_id,
- relationship_lsid,
- relationship_type,
- container,
- description,
- authority,
- contact_email,
- ontology
- from relationship ";
- my @bindvalues = ();
-
- if (@args > 0)
- {
- ($statement, @bindvalues) =_add_condition($statement, @args);
- }
-
- my $result = do_query($dbh, $statement, @bindvalues);
- return $result;
-}
-
-sub query_namespace{
- my ($self, @args) = @_;
- my $dbh = $self->dbh;
-
- my $statement = "select
- namespace_id,
- namespace_lsid,
- namespace_type,
- description,
- authority,
- contact_email
- from namespace ";
- my @bindvalues = ();
-
- if (@args > 0)
- {
- ($statement, @bindvalues) =_add_condition($statement, @args);
- }
-
- my $result = do_query($dbh, $statement, @bindvalues);
- return $result;
-}
-
-sub insert_namespace{
- my ($self, @args) = @_;
- my $dbh = $self->dbh;
- $dbh->do(
-q{insert into namespace (namespace_type, namespace_lsid, description, authority,contact_email) values (?,?,?,?,?)},
- undef,
- (
- get_value('namespace_type', @args), get_value('namespace_lsid', @args), get_value('description', @args),
- get_value('authority', @args), get_value('contact_email', @args)
- )
- );
- return $dbh->{mysql_insertid};
-}
-
-sub delete_namespace{
- my ($self, @args) = @_;
- my $dbh = $self->dbh;
- my $statement = "delete from namespace ";
- my @bindvalues = ();
- ($statement, @bindvalues) =_add_condition($statement, @args);
- $dbh->do( $statement,
- undef, @bindvalues );
-
- if ($dbh->err){
- return (1, $dbh->errstr);
- }
- else{
- return 0;
- }
-}
-
-sub query_namespace_term2term{
- my ($self, @args) = @_;
- my $dbh = $self->dbh;
-
- my $statement = "select
- assertion_id,
- relationship_type,
- namespace1_id,
- namespace2_id
- from namespace_term2term ";
- my @bindvalues = ();
-
- if (@args > 0)
- {
- ($statement, @bindvalues) =_add_condition($statement, @args);
- }
-
- my $result = do_query($dbh, $statement, @bindvalues);
- return $result;
-}
-
-sub delete_namespace_term2term{
- my ($self, @args) = @_;
- my $dbh = $self->dbh;
- my $statement = "delete from namespace_term2term ";
- my @bindvalues = ();
- ($statement, @bindvalues) =_add_condition($statement, @args);
- $dbh->do( $statement,
- undef, @bindvalues );
-
- if ($dbh->err){
- return (1, $dbh->errstr);
- }
- else{
- return 0;
- }
-}
-
-# custom query subroutine for Moby::Central.pm->deregisterObjectClass()
-sub checkClassUsedByService
-{
- my ($self, @args) = @_;
- my $dbh = $self->dbh;
- my $errorMsg = 1;
- my $existingURI = get_value('object_type_uri', @args);
-
- 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
- );
- 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
- );
- 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
- );
- 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
- );
- return $errorMsg
- if ($id);
-
- return 0;
-}
-
-# 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;
-
- 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')"
- );
- $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";
- return (1, $errstr)
- if ( $_ eq $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,'$existingURI')"
- );
- $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";
- return (1, $errstr)
- if ( $_ eq $existingURI );
- }
- }
- $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')"
- );
- $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";
- return (1, $errstr)
- if ( $_ eq $existingURI );
- }
- }
- $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')"
- );
- $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";
- return (1, $errstr)
- if ( $_ eq $existingURI );
- }
- }
- return (0, "");
-}
-
-# custom query routine for Moby::Central.pm -> findService()
-sub checkKeywords{
- my ($self, @args) = @_;
- my $dbh = $self->dbh;
- my $param = get_value('findme', @args);
- my %findme = %$param;
- my $searchstring;
-
- foreach my $kw ( @{ $findme{keywords} } ) {
-# $debug && &_LOG("KEYWORD $kw\n");
- $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);
-}
-
-# custom query subroutine for Moby::Central.pm->_searchForSimple()
-sub getFromSimple{
- 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 $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
- $nsquery .= " OR INSTR(namespace_type_uris, '$ns') ";
- }
- if ($nsquery) {
- $nsquery =~ s/OR//; # just the first
- $nsquery .= " OR namespace_type_uris IS NULL";
- $query .= " AND ($nsquery) ";
- }
-
- my $result = do_query($dbh, $query, ());
- return $result;
-}
-
-# custom query subroutine for Moby::Central.pm->_searchForCollection()
-sub getFromCollection{
- 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 $query = "select
- c.service_instance_id,
- s.namespace_type_uris
- from
- simple_$inout as s,
- collection_$inout as c
- where
- s.collection_${inout}_id IS NOT NULL
- AND s.collection_${inout}_id = c.collection_${inout}_id
- AND object_type_uri = '$objectURI' ";
- my $nsquery;
- foreach my $ns ( @{$namespaceURIs} ) { # namespaces are already URI's
- $nsquery .= " OR INSTR(namespace_type_uris, '$ns') ";
- }
- if ($nsquery) {
- $nsquery =~ s/^\sOR//; # just the first
- $nsquery .= " OR namespace_type_uris IS NULL";
- $query .= " AND ($nsquery) "; # add the AND clause
- }
-
- my $result = do_query($dbh, $query, ());
- return $result;
-}
-
-# custom query subroutine for Moby::Central.pm->RetrieveServiceNames
-sub getServiceNames{
- 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 = ();
-
- my $result = do_query($dbh, $statement, @bindvalues);
- return $result;
-}
-
-# custom query for Moby::Central.pm->_flatten
-sub getParentTerms{
- my ($self, @args) = @_;
- my $dbh = $self->dbh;
-
- my $type_id = get_value('relationship_type_id', @args);
- my $statement = "
- select
- OE1.term
- from
- OntologyEntry as OE1,
- OntologyEntry as OE2,
- Term2Term as TT
- where
- ontologyentry2_id = OE2.id
- and ontologyentry1_id = OE1.id
- and relationship_type_id = $type_id
- and OE2.term = ?";
-
- my @bindvalues = ();
- push(@bindvalues, get_value('term', @args));
-
- my $result = do_query($dbh, $statement, @bindvalues);
- return $result;
-}
-
-# custom query subroutine for selecting from object_term2term and object tables
-# used in Moby::OntologyServer.pm->retrieveObject()
-sub getObjectRelationships{
- my ($self, @args) = @_;
- my $dbh = $self->dbh;
-
- my $statement = "select
- relationship_type,
- object_lsid,
- object2_articlename
- 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;
-}
-
-# 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) = @_;
- 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 $defs;
-
- if ( $direction eq 'root' ) {
- unless ( defined $relationship ) {
- $defs = $self->dbh->selectall_arrayref( "
- select distinct s2.${ontology}_lsid, relationship_type from
- ${ontology}_term2term as t2t,
- $ontology as s1,
- $ontology as s2
- where
- s1.${ontology}_id = t2t.${ontology}1_id and
- s2.${ontology}_id = t2t.${ontology}2_id and
- s1.${ontology}_lsid = ?", undef, $term ); # ")
- } else {
- $defs = $self->dbh->selectall_arrayref( "
- select distinct s2.${ontology}_lsid, relationship_type from
- ${ontology}_term2term as t2t,
- $ontology as s1,
- $ontology as s2
- where
- 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 ); # ")
- }
- } else {
- unless ( defined $relationship ) {
- $defs = $self->dbh->selectall_arrayref( "
- select distinct s2.${ontology}_lsid, relationship_type from
- ${ontology}_term2term as t2t,
- $ontology as s1,
- $ontology as s2
- where
- s1.${ontology}_id = t2t.${ontology}1_id and
- s2.${ontology}_id = t2t.${ontology}2_id and
- s2.${ontology}_lsid = ?", undef, $term ); # ")
- } else {
- $defs = $self->dbh->selectall_arrayref( "
- select distinct s2.${ontology}_lsid, relationship_type from
- ${ontology}_term2term as t2t,
- $ontology as s1,
- $ontology as s2
- where
- 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 ); # ")
- }
- }
- return $defs;
-}
-
-sub _checkURI {
-
-# my $uri = "http://www.ics.uci.edu/pub/ietf/uri/#Related";
-#print "$1, $2, $3, $4, $5, $6, $7, $8, $9" if
-# $uri =~ m{^(([^:/?#]+):)?(//([^/?#]*))?([^?#]*)(\?([^#]*))?(#(.*))?};
-#
-#The license for this recipe is available here.
-#
-#Discussion:
-#
-#If the match is successful, a URL such as
-#
-#http://www.ics.uci.edu/pub/ietf/uri/#Related
-#
-#will be broken down into the following group match variables:
-#
-#$1 = http:
-#$2 = http
-#$3 = //www.ics.uci.edu
-#$4 = www.ics.uci.edu
-#$5 = /pub/ietf/uri/
-#$6 =
-#$7 =
-#$8 = #Related
-#$9 = Related
-#
-#In general, this regular expression breaks a URI down into the following parts,
-#as defined in the RFC:
-#
-#scheme = $2
-#authority = $4
-#path = $5
-#query = $7
-#fragment = $9
-
-}
-
-sub DESTROY {}
-
-1;
+package MOBY::Adaptor::moby::queryapi::mysql;
+
+use strict;
+use vars qw($AUTOLOAD @ISA);
+use Carp;
+use MOBY::Adaptor::moby::queryapi;
+use DBI;
+use DBD::mysql;
+
+ at ISA = qw{MOBY::Adaptor::moby::queryapi}; # implements the interface
+
+{
+ #Encapsulated class data
+
+ #___________________________________________________________
+ #ATTRIBUTES
+ my %_attr_data = # DEFAULT ACCESSIBILITY
+ (
+ driver => ["DBI:mysql", 'read/write'],
+ dbh => [undef, 'read/write'],
+
+ );
+
+ #_____________________________________________________________
+
+ # METHODS, to operate on encapsulated class data
+
+ # Is a specified object attribute accessible in a given mode
+ sub _accessible {
+ my ($self, $attr, $mode) = @_;
+ $_attr_data{$attr}[1] =~ /$mode/
+ }
+
+ # Classwide default value for a specified object attribute
+ sub _default_for {
+ my ($self, $attr) = @_;
+ $_attr_data{$attr}[0];
+ }
+
+ # List of names of all specified object attributes
+ sub _standard_keys {
+ keys %_attr_data;
+ }
+
+ sub driver {
+ my ($self, $arg) = @_;
+ $self->{driver} = $arg if defined $arg;
+ return $self->{driver};
+ }
+ sub dbh {
+ my ($self, $arg) = @_;
+ $self->{dbh} = $arg if defined $arg;
+ return $self->{dbh};
+ }
+
+}
+
+sub new {
+ my ($caller, %args) = @_;
+ my $self = $caller->SUPER::new(%args);
+
+ my $caller_is_obj = ref($caller);
+ my $class = $caller_is_obj || $caller;
+
+ foreach my $attrname ( $self->_standard_keys ) {
+ if (exists $args{$attrname} && defined $args{$attrname}) {
+ $self->{$attrname} = $args{$attrname} }
+ elsif ($caller_is_obj) {
+ $self->{$attrname} = $caller->{$attrname} }
+ else {
+ $self->{$attrname} = $self->_default_for($attrname) }
+ }
+
+ return unless $self->driver;
+ my $driver = $self->driver; # inherited from the adaptorI (queryapi)
+ my $username = $self->username;
+ my $password = $self->password;
+ my $port = $self->port;
+ my $url = $self->url;
+ my $dbname = $self->dbname;
+
+ my ($dsn) = "$driver:$dbname:$url:$port";
+ my $dbh = DBI->connect($dsn, $username, $password, {RaiseError => 1}) or die "can't connect to database";
+
+
+ ##############################################################
+ unless ($dbh) {
+ print STDERR "Couldn't connect to the datasource \n",($self->_dump()),"\n\n";
+ return undef;
+ }
+
+ $self->dbh($dbh);
+ #############################################################
+
+ return undef unless $self->dbh;
+ return $self;
+
+}
+
+sub _add_condition{
+ my ($statement, @params) = @_;
+ my @bindvalues = ();
+ my $condition = "where ";
+
+ foreach my $param (@params )
+ {
+ if (($param eq 'and') || ($param eq 'or'))
+ {
+ $condition .= $param . " ";
+ }
+ else
+ {
+ my %pair = %$param;
+
+ for my $key (keys %pair)
+ {
+ if (defined $pair{$key})
+ {
+ $condition .= $key . " = ? ";
+ push(@bindvalues, $pair{$key});
+ }
+ else
+ {
+ $condition .= $key . " IS NULL "
+ }
+ }
+ }
+ }
+ $statement .= $condition;
+ return ($statement, @bindvalues);
+ }
+
+# preforms query but returns a reference to an array containing hash references
+sub do_query{
+ my ($dbh, $statement, @bindvalues) = @_;
+ my $sth = $dbh -> prepare($statement);
+ if (@bindvalues < 1)
+ {
+ $sth->execute;
+ }
+ else
+ {
+ $sth->execute(@bindvalues);
+ }
+ # returns an array of hash references
+ my $arrayHashRef = $sth->fetchall_arrayref({});
+ return $arrayHashRef;
+}
+
+sub get_value{
+ my ($key, @params) = @_;
+
+ foreach my $param (@params )
+ {
+ my %pair = %$param;
+ for my $tmp (keys %pair)
+ {
+ if ($tmp eq $key){
+ return $pair{$key};
+ }
+ }
+ }
+}
+
+sub _getSIIDFromLSID {
+ my ($self, $lsid) = @_;
+ my $dbh = $self->dbh;
+ my $sth = $dbh->prepare("select service_instance_id from service_instance were lsid=?");
+ $sth->execute($lsid);
+ my ($siid) = $sth->fetchrow_array();
+ return $siid;
+}
+
+# this should NOT retun a collection ID... needs more work...
+# args passed in: service_lsid
+sub query_collection_input{
+ my ($self, %args) = @_;
+ my $dbh = $self->dbh;
+ my $serv_lsid = $args{'service_lsid'};
+
+ my $statement = "select
+ collection_input_id,
+ article_name
+ from collection_input as c, service_instance as si where si.service_instance_id = c.service_instance_id and si.lsid = ?";
+ my $result = do_query($dbh, $statement, [$serv_lsid]);
+ return $result;
+}
+
+# args passed in: service_instance_lsid, article_name
+sub insert_collection_input {
+ my ($self, %args) = @_;
+ my $article = $args{article_name};
+ my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
+
+ $self->dbh->do("insert into collection_input (service_instance_id, article_name) values (?,?)",
+ undef, $siid, $article);
+ my $id=$self->dbh->{mysql_insertid};
+ return $id;
+}
+
+# pass in service_instance_lsid
+sub delete_collection_input{
+ my ($self, %args) = @_;
+ my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
+
+ my $statement = "delete from collection_input where service_instance_id = ?";
+ $self->dbh->do( $statement, undef, $siid);
+
+ if ($self->dbh->err){
+ return (1, $self->dbh->errstr);
+ }
+ else{
+ return 0;
+ }
+}
+
+# pass service_instance_lsid
+sub query_collection_output{
+ my ($self, %args) = @_;
+ my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
+ my $dbh = $self->dbh;
+
+ my $statement = "select
+ collection_output_id,
+ article_name,
+ service_instance_id
+ from collection_output where service_instance_id = ? ";
+ my $result = do_query($dbh, $statement, [$siid]);
+ return $result;
+}
+
+# pass service_instance_lsid, article_name
+sub insert_collection_output {
+ my ($self, %args) = @_;
+ my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
+ my $dbh = $self->dbh;
+ $self->dbh->do("insert into collection_output (service_instance_id, article_name) values (?,?)",
+ undef, $siid,$args{'article_name'});
+ my $id=$self->dbh->{mysql_insertid};
+ return $id;
+}
+
+# pass argument service_instance_lsid
+sub delete_collection_output{
+ my ($self, %args) = @_;
+ my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
+ my $dbh = $self->dbh;
+ my $statement = "delete from collection_output where service_instance_id = ?";
+ my @bindvalues = ();
+ $dbh->do( $statement, undef, ($siid));
+
+ if ($dbh->err){
+ return (1, $dbh->errstr);
+ }
+ else{
+ return 0;
+ }
+}
+
+# pass service_instance_lsid
+sub query_simple_input{
+ my ($self, %args) = @_;
+ my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
+ my $dbh = $self->dbh;
+
+ my $statement = "select
+ simple_input_id,
+ object_type_uri,
+ namespace_type_uris,
+ article_name,
+ service_instance_id,
+ collection_input_id
+ from simple_input where service_instance_id = ? and collection_input_id IS NULL";
+ my $result = do_query($dbh, $statement, ($siid));
+ return $result;
+}
+
+# pass service_instance_lsid, object_type_uri, namespace_type_uris, article_name, collection_input_id
+sub insert_simple_input {
+ my ($self, %args) = @_;
+ my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
+ my $dbh = $self->dbh;
+ $dbh->do("insert into simple_input
+ (object_type_uri,
+ namespace_type_uris,
+ article_name,
+ service_instance_id,
+ collection_input_id)
+ values (?,?,?,?,?)",
+ undef,
+ $args{'object_type_uri'},
+ $args{'namespace_type_uris'},
+ $args{'article_name'},
+ $siid,
+ $args{'collection_input_id'});
+ my $id=$dbh->{mysql_insertid};
+ return $id;
+}
+
+# pass service_instance_lsid
+sub delete_simple_input{
+ my ($self, %args) = @_;
+ my $dbh = $self->dbh;
+ my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
+ my ($collid) = $args{collection_input_id};
+ my $statement1; my $statement2;
+ $siid && ($statement1 = "delete from simple_input where service_instance_lsid = ?");
+ $collid && ($statement2 = "delete from simple_input where collection_input_id = ?");
+
+ $siid && ($dbh->do( $statement1, undef,($siid)));
+ $collid && ($dbh->do($statement2, undef,($collid)));
+ if ($dbh->err){
+ return (1, $dbh->errstr);
+ }
+ else{
+ return 0;
+ }
+}
+
+sub delete_inputs { # this should replace all other delete_*_input
+ my ($self, %args) = @_;
+ my $dbh = $self->dbh;
+ my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
+ my $result_ids = $self->query_collection_input(service_instance_lsid => $self->lsid);
+
+ my $statement = "delete from simple_input where service_instance_lsid = ?";
+
+ $dbh->do( $statement, undef,($siid));
+ if ($dbh->err){
+ return (1, $dbh->errstr);
+ }
+ else{
+ return 0;
+ }
+
+}
+
+sub delete_output { # this should replace all other delete_*_output
+
+}
+
+# UGH this has to know too much bout the underlying database structure e.g. that one is null and other is full
+# this problem is in MOBY::Central line 3321 3346 and 3374
+#****** FIX
+# send service_instance_lsid, collection_input_id
+sub query_simple_output{
+ my ($self, %args) = @_;
+ my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
+ my $collid = $args{collection_input_id};
+ my $dbh = $self->dbh;
+
+ my $statement = "select
+ simple_output_id,
+ object_type_uri,
+ namespace_type_uris,
+ article_name,
+ service_instance_id,
+ collection_output_id
+ from simple_output where service_instance_id = ? and collection_input_id= ?";
+ my $result = do_query($dbh, $statement, ($siid, $collid));
+ return $result;
+}
+
+# pass args service_instance_id and collection_output_id
+sub insert_simple_output {
+ my ($self, %args) = @_;
+ my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
+ my $dbh = $self->dbh;
+
+ $dbh->do("insert into simple_output
+ (object_type_uri,
+ namespace_type_uris,
+ article_name,
+ service_instance_id,
+ collection_output_id)
+ values (?,?,?,?,?)",
+ undef,(
+ $args{'object_type_uri'},
+ $args{'namespace_type_uris'},
+ $args{'article_name'},
+ $siid,
+ $args{'collection_output_id'}));
+ my $id=$dbh->{mysql_insertid};
+ return $id;
+
+}
+
+# pass service_instance_id or collection_output_id
+sub delete_simple_output{
+ my ($self, %args) = @_;
+ my $dbh = $self->dbh;
+ my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
+ my ($collid) = $args{collection_output_id};
+ my $statement1; my $statement2;
+ $siid && ($statement1 = "delete from simple_output where service_instance_lsid = ?");
+ $collid && ($statement2 = "delete from simple_output where collection_input_id = ?");
+
+ $siid && ($dbh->do( $statement1, undef,($siid)));
+ $collid && ($dbh->do($statement2, undef,($collid)));
+ if ($dbh->err){
+ return (1, $dbh->errstr);
+ }
+ else{
+ return 0;
+ }
+}
+
+# pass service_instance_lsid
+sub query_secondary_input{
+ my ($self, %args) = @_;
+ my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
+ my $dbh = $self->dbh;
+
+ my $statement = "select
+ secondary_input_id,
+ default_value,
+ maximum_value,
+ minimum_value,
+ enum_value,
+ datatype,
+ article_name,
+ service_instance_id
+ from secondary_input where service_instance_id = ?";
+ my $result = do_query($dbh, $statement, ($siid));
+ return $result;
+}
+
+# pass default_value, maximum_value minimum_value enum_value datatype article_name service_instance_lsid
+sub insert_secondary_input{
+ my ($self, %args) = @_;
+ my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
+ my $dbh = $self->dbh;
+ $dbh->do(q{insert into secondary_input (default_value,maximum_value,minimum_value,enum_value,datatype,article_name,service_instance_id) values (?,?,?,?,?,?,?)},
+ undef,
+ (
+ $args{'default_value'}, $args{'maximum_value'},
+ $args{'minimum_value'}, $args{'enum_value'},
+ $args{'datatype'}, $args{'article_name'},$siid)
+ );
+ return $dbh->{mysql_insertid};
+}
+
+# pass service_instance_lsid
+sub delete_secondary_input{
+ my ($self, %args) = @_;
+ my ($siid) = $self->getSIIDFromLSID($args{service_instance_lsid});
+ my $dbh = $self->dbh;
+ my $statement = "delete from secondary_input where service_instance_lsid=?";
+
+ $dbh->do( $statement, undef, ($siid));
+ if ($dbh->err){
+ return (1, $dbh->errstr);
+ }
+ else{
+ return 0;
+ }
+}
+
+
+# receives argument "type", that may be either an LSID or a type term
+sub query_object {
+ my ($self, %args) = @_;
+ my $type = $args{type};
+ my $condition = "";
+ if ($type =~ /^urn\:lsid/){
+ $condition = "where object_lsid = ?";
+ } elsif ($type) {
+ $condition = "where object_type = ?";
+ }
+ my $statement = "select
+ object_id,
+ object_lsid,
+ object_type,
+ description,
+ authority,
+ contact_email
+ from object $condition";
+
+ my $dbh = $self->dbh;
+ my $result = do_query($dbh, $statement, ($type));
+ return $result;
+}
+
+# inserts a new tuple into object table
+# pass object_type object_lsid description authority contact_email
+sub insert_object{
+ my ($self, %args) = @_;
+ my $dbh = $self->dbh;
+ $dbh->do("insert into object
+ (object_type,
+ object_lsid,
+ description,
+ authority,
+ contact_email)
+ values (?,?,?,?,?)",
+ undef,
+ $args{'object_type'},
+ $args{'object_lsid'},
+ $args{'description'},
+ $args{'authority'},
+ $args{'contact_email'});
+ my $id=$dbh->{mysql_insertid};
+ return $id;
+}
+
+# pass 'type' which is either an LSID or a term
+sub delete_object{
+ my ($self, %args) = @_;
+ my $dbh = $self->dbh;
+ my $term = $args{type};
+ return 0 unless $term;
+ my $statement = "delete from object where ";
+ my $condition;
+ if ($term =~ /^urn\:lsid/){
+ $condition = " object_lsid = ?";
+ } else {
+ $condition = " object_type = ?";
+ }
+ $statement = $statement.$condition;
+ $dbh->do( $statement,undef, ($term) );
+
+ $self->_delete_object_term2term(type => $term);
+ if ($dbh->err){
+ return (1, $dbh->errstr);
+ }
+ else{
+ return 0;
+ }
+}
+
+# pass "type" here, should be an LSID, preferably...
+sub query_object_term2term{
+ my ($self, %args) = @_;
+ my $type = $args{type};
+ my $result = $self->query_object(type => $type);
+ my $row = shift(@$result);
+ my $id = $row->{object_id};
+ return [{}] unless $id;
+ my $dbh = $self->dbh;
+
+ my $statement = "select
+ assertion_id,
+ relationship_type,
+ object1_id,
+ object2_id,
+ object2_articlename
+ from object_term2term where object2_id = ?";
+ my $result2 = do_query($dbh, $statement, ($id));
+ return $result2;
+}
+
+# pass object1_type, object2_type, object2_articlename, relationship_type
+sub insert_object_term2term{
+ my ($self, %args) = @_;
+ my $type1 = $args{object1_type};
+ my $result = $self->query_object(type => $type1);
+ my $row = shift(@$result);
+ my $id1 = $row->{object_id};
+ my $type2 = $args{object2_type};
+ $result = $self->query_object(type => $type2);
+ $row = shift(@$result);
+ my $id2 = $row->{object_id};
+ my $relationship_type = $args{relationship_type};
+ my $object2_articlename = $args{object2_articlename};
+
+ my $dbh = $self->dbh;
+ $dbh->do(
+ q{insert into object_term2term (relationship_type, object1_id, object2_id, object2_articlename) values (?,?,?,?)},
+ undef,
+ $relationship_type,
+ $id1,
+ $id2,
+ $object2_articlename
+ );
+
+ return $dbh->{mysql_insertid};
+}
+
+# pass object 'type' as term or lsid
+# this should be a private routine, not a public one.
+# SHOULD NOT BE DOCUMENTED IN THE API
+sub _delete_object_term2term{
+ my ($self, %args) = @_;
+ 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 $dbh = $self->dbh;
+ my $statement = "delete from object_term2term where object1_id=?";
+ $dbh->do( $statement,undef, ($id));
+
+ if ($dbh->err){
+ return (1, $dbh->errstr);
+ }
+ else{
+ return 0;
+ }
+}
+
+# pass servicename and authority_uri
+sub query_service_existence {
+ my ($self, %args) = @_;
+ my $dbh = $self->dbh;
+
+ my $servicename = $args{'servicename'};
+ my $authURI = $args{'authority_uri'};
+ my $result = $self->_query_authority(authority_uri => $authURI);
+ return 0 unless @$result[0];
+ my $id = @$result[0]->{authority_id};
+ return 0 unless $id;
+ my $statement = "select
+ service_instance_id,
+ category,
+ servicename,
+ service_type_uri,
+ authority_id,
+ url,
+ contact_email,
+ authoritative,
+ description,
+ signatureURL,
+ lsid
+ from service_instance where servicename = ? and authority_id = ?";
+ my $final = do_query($dbh, $statement, ($servicename, $id));
+ if (@$final[0]){return 1} else {return 0}
+
+}
+# selects all the columns from service_instance table
+# PAY ATTENTION to what this returns. Not auth_id but auth_uri!!
+sub query_service_instance {
+ my ($self, %args) = @_;
+ my $dbh = $self->dbh;
+
+ #my $authority_id;
+ #if ($args{'authority_uri'}){ # need to transform URI to a row ID
+ # my $result = $self->query_authority(authority_uri => $args{'authority_uri'});
+ # return 0 unless @$result[0];
+ # $authority_id = @$result[0]->{authority_id};
+ # return 0 unless $authority_id;
+ #}
+ #delete $args{'authority_uri'}; # this can't be passed into the search since it doens't exist in the table
+ my @args;
+ while (my ($k, $v) = each %args){
+ push @args, ({$k => $v}, "and"); # format for the_add_condition subroutine
+ }
+# if ($authority_id){
+# push @args, ({authority_id => $authority_id}) ;
+# } else {
+# pop @args; # remove final "and"
+# }
+
+ my $statement = "select
+ service_instance_id,
+ category,
+ servicename,
+ service_type_uri,
+ authority.authority_uri,
+ url,
+ contact_email,
+ authoritative,
+ description,
+ signatureURL,
+ lsid
+ from service_instance left join authority on authority.authority_id ";
+ my @bindvalues;
+ ($statement, @bindvalues) =_add_condition($statement, @args);
+ my $final = do_query($dbh, $statement, @bindvalues);
+ return $final;
+}
+
+# custom query for Moby::Central.pm->findService()
+# hmmmmmmm.... I'm not sure that this routine should exist...
+# it is redundant to the routine above, if the routine above were executed
+# multiple times. I think that is the more correct (though less efficient)
+# way to go, since it is "scalable" to every possible underlying data source
+# ********FIX change this later...
+sub match_service_type_uri{
+ my ($self, %args) = @_;
+ my $dbh = $self->dbh;
+ my $uri_list = $args{'service_type_uri'};
+ my $statement = "select service_instance_id,category, servicename, service_type_uri, authority_id, url, contact_email, authoritative, description, signatureURL, lsid from service_instance where service_type_uri in ($uri_list)";
+ my @bindvalues = ();
+ my $result = do_query($dbh, $statement, @bindvalues);
+ return $result;
+}
+
+# passs........ blah blah.....
+sub insert_service_instance {
+ my ($self, %args) = @_;
+ my $dbh = $self->dbh;
+ my $authority_id;
+ if ($args{'authority_uri'}){ # need to transform URI to a row ID
+ my $result = $self->_query_authority(authority_uri => $args{'authority_uri'});
+ return undef unless @$result[0];
+ $authority_id = @$result[0]->{authority_id};
+ return undef unless $authority_id;
+ }
+
+ $dbh->do(q{insert into service_instance (category, servicename, service_type_uri, authority_id, url, contact_email, authoritative, description, signatureURL, lsid) values (?,?,?,?,?,?,?,?,?,?)},
+ undef,(
+ $args{'category'},
+ $args{'servicename'},
+ $args{'service_type_uri'},
+ $authority_id,
+ $args{'url'},
+ $args{'contact_email'},
+ $args{'authoritative'},
+ $args{'description'},
+ $args{'signatureURL'},
+ $args{'lsid'}));
+
+ my $id = $dbh->{mysql_insertid};
+ return $id;
+}
+
+# pass service_instance_lsid
+sub delete_service_instance{
+ my ($self, %args) = @_;
+ my $dbh = $self->dbh;
+ my $statement = "delete from service_instance where lsid = ?";
+ $dbh->do( $statement,undef, ($args{service_instance_lsid}) );
+ if ($dbh->err){
+ return (1, $dbh->errstr);
+ }
+ else{
+ return 0;
+ }
+}
+
+# Selects all columns EXCEPT authority_id
+# pass authority_uri
+sub query_authority {
+ my ($self, %args) = @_;
+ my $authURI = $args{authority_uri};
+ my $dbh = $self->dbh;
+
+ my $statement = "select
+ authority_common_name,
+ authority_uri,
+ contact_email
+ from authority where authority_uri = ?";
+ my $result = do_query($dbh, $statement, ($authURI));
+ return $result;
+}
+
+# Selects all columns including authority_id
+# pass authority_uri. NOTE THAT THIS IS A PRIVATE ROUTINE
+# SHOULD NOT BE DOCUMENTED IN THE API
+sub _query_authority {
+ my ($self, %args) = @_;
+ my $authURI = $args{authority_uri};
+ my $dbh = $self->dbh;
+
+ my $statement = "select
+ authority_common_name,
+ authority_uri,
+ authority_id,
+ contact_email
+ from authority where authority_uri = ?";
+ my $result = do_query($dbh, $statement, ($authURI));
+ return $result;
+}
+
+# custom query routine used in Moby::Central.pm -> retrieveServiceProviders()
+# no args passed
+sub get_all_authorities{
+ my ($self, @args) = @_;
+ my $dbh = $self->dbh;
+ my $statement = "select distinct authority_uri from authority";
+ my @bindvalues = ();
+ my $result = do_query($dbh, $statement, @bindvalues);
+ return $result;
+}
+
+# pass authority_common_name, authority_uri, contact_email, return ID of some sort
+sub insert_authority{
+ my ($self, %args) = @_;
+ my $dbh = $self->dbh;
+ $dbh->do("insert into authority
+ (authority_common_name,
+ authority_uri,
+ contact_email)
+ values (?,?,?)",
+ undef,
+ ($args{'authority_common_name'},
+ $args{'authority_uri'},
+ $args{'contact_email'}));
+ my $id = $dbh->{mysql_insertid};
+ return $id;
+}
+
+# pass service_type, as term or LSID
+sub query_service{
+ my ($self, %args) = @_;
+ my $type = $args{type};
+ return [{}] unless $type;
+ my $condition = "";
+ if ($type =~ /^urn\:lsid/){
+ $condition = "where service_lsid = ?";
+ } elsif ($type) {
+ $condition = "where service_type = ?";
+ }
+
+ my $dbh = $self->dbh;
+ my $statement = "select
+ service_id,
+ service_lsid,
+ service_type,
+ description,
+ authority,
+ contact_email
+ from service $condition";
+ my $result = do_query($dbh, $statement, ($type));
+ return $result;
+}
+
+# pass in ....
+sub insert_service{
+ my ($self, %args) = @_;
+ my $dbh = $self->dbh;
+ $dbh->do(q{insert into service (service_type, service_lsid, description, authority, contact_email) values (?,?,?,?,?)},
+ undef,
+ (
+ $args{'service_type'}, $args{'service_lsid'}, $args{'description'},
+ $args{'authority'}, $args{'contact_email'}
+ )
+ );
+ return $dbh->{mysql_insertid};
+}
+
+# pass in service type as LSID (service_lsid)
+sub delete_service{
+ my ($self, %args) = @_;
+ my $dbh = $self->dbh;
+ my $statement = "delete from service where service_lsid = ?";
+ $dbh->do( $statement, undef, ($args{service_lsid}));
+ $self->_delete_service_term2term;
+ if ($dbh->err){
+ return (1, $dbh->errstr);
+ }
+ else{
+ return 0;
+ }
+}
+
+sub query_service_term2term{
+ my ($self, %args) = @_;
+ my $type = $args{type};
+ my $result = $self->query_service(type => $type);
+ my $row = shift(@$result);
+ my $id = $row->{service_id};
+ return [{}] unless $id;
+ my $dbh = $self->dbh;
+
+ my $statement = "select
+ assertion_id,
+ relationship_type,
+ service1_id,
+ service2_id,
+ from service_term2term where service2_id = ?";
+ my $result2 = do_query($dbh, $statement, ($id));
+ return $result2;
+}
+
+#pass relationshiptype, servce1_type, service2_type
+sub insert_service_term2term{
+ my ($self, %args) = @_;
+ my $type1 = $args{service1_type};
+ my $result = $self->query_service(type => $type1);
+ my $row = shift(@$result);
+ my $id1 = $row->{service_id};
+ my $type2 = $args{service2_type};
+ $result = $self->query_service(type => $type2);
+ $row = shift(@$result);
+ my $id2 = $row->{service_id};
+ my $relationship_type = $args{relationship_type};
+
+ my $dbh = $self->dbh;
+ $dbh->do(q{insert into service_term2term (relationship_type, service1_id, service2_id) values (?,?,?)},
+ undef,
+ ($relationship_type,
+ $id1,
+ $id2)
+ );
+
+ return $dbh->{mysql_insertid};
+}
+
+
+# NOTE THAT THIS IS A PRIVATE FUNCTION AND SHOULD
+# NOT BE DOCUMENTED IN THE API.
+sub _delete_service_term2term{
+ my ($self, %args) = @_;
+ my $type = $args{type};
+ return 0 unless $type;
+ my $result = $self->query_service(type => $type);
+ my $row = shift @$result;
+ my $id = $row->service_id;
+
+ my $dbh = $self->dbh;
+ my $statement = "delete from service_term2term where service1_id=?";
+ $dbh->do( $statement,undef, ($id));
+ if ($dbh->err){
+ return (1, $dbh->errstr);
+ }
+ else{
+ return 0;
+ }
+}
+
+
+sub query_relationship{
+ my ($self, %args) = @_;
+ my $type = $args{type};
+ return [{}] unless $type;
+ my $condition = "";
+ if ($type =~ /^urn\:lsid/){
+ $condition = "where relationship_lsid = ? and ";
+ } elsif ($type) {
+ $condition = "where relationship_type = ? and";
+ }
+ my $ont = $args{ontology};
+
+ my $dbh = $self->dbh;
+
+ my $statement = "select
+ relationship_id,
+ relationship_lsid,
+ relationship_type,
+ container,
+ description,
+ authority,
+ contact_email,
+ ontology
+ from relationship where $condition ontology = ?";
+
+ if ($type){
+ return do_query($dbh, $statement, ($type, $ont));
+ } else {
+ return do_query($dbh, $statement, ($ont));
+ }
+}
+
+sub query_namespace{
+ my ($self, %args) = @_;
+ my $type = $args{type};
+ return [{}] unless $type;
+ my $condition = "";
+ if ($type =~ /^urn\:lsid/){
+ $condition = "where namespace_lsid = ? and ";
+ } elsif ($type) {
+ $condition = "where namespace_type = ? and";
+ }
+ my $dbh = $self->dbh;
+
+ my $statement = "select
+ namespace_id,
+ namespace_lsid,
+ namespace_type,
+ description,
+ authority,
+ contact_email
+ from namespace $condition";
+ my $result = do_query($dbh, $statement, ($type));
+ return $result;
+}
+
+
+sub insert_namespace{
+ my ($self, %args) = @_;
+ my $dbh = $self->dbh;
+ $dbh->do(q{insert into namespace (namespace_type, namespace_lsid, description, authority,contact_email) values (?,?,?,?,?)},
+ undef,
+ (
+ $args{'namespace_type'}, $args{'namespace_lsid'},$args{'description'},$args{'authority'},$args{'contact_email'}
+ )
+ );
+ return $dbh->{mysql_insertid};
+}
+
+# pass namesapce_lsid
+sub delete_namespace{
+ my ($self, %args) = @_;
+ my $lsid = $args{namespace_lsid};
+ my $dbh = $self->dbh;
+ my $statement = "delete from namespace where namespace_lsid = ?";
+ $dbh->do( $statement, undef, ($lsid));
+ $self->_delete_namespace_term2term;
+ if ($dbh->err){
+ return (1, $dbh->errstr);
+ }
+ else{
+ return 0;
+ }
+}
+
+sub query_namespace_term2term{
+ my ($self, %args) = @_;
+ my $type = $args{type};
+ my $result = $self->query_namespace(type => $type);
+ my $row = shift(@$result);
+ my $id = $row->{namespace_id};
+ return [{}] unless $id;
+ my $dbh = $self->dbh;
+
+ my $statement = "select
+ assertion_id,
+ relationship_type,
+ namespace1_id,
+ namespace2_id,
+ from namespace_term2term where namespace2_id = ?";
+ my $result2 = do_query($dbh, $statement, ($id));
+ return $result2;
+}
+
+# PRIVATE, NOT PART OF API!
+sub _delete_namespace_term2term{
+ my ($self, %args) = @_;
+ my $type = $args{type};
+ return 0 unless $type;
+ my $result = $self->query_namespace(type => $type);
+ my $row = shift @$result;
+ my $id = $row->namespace_id;
+
+ my $dbh = $self->dbh;
+ my $statement = "delete from namespace_term2term where namespace1_id=?";
+ $dbh->do( $statement,undef, ($id));
+ if ($dbh->err){
+ return (1, $dbh->errstr);
+ }
+ else{
+ 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
+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 $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
+ );
+ 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
+ );
+ 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
+ );
+ 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
+ );
+ return $errorMsg
+ if ($id);
+
+ return 0;
+}
+
+# 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;
+
+ 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')"
+ );
+ $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";
+ return (1, $errstr)
+ if ( $_ eq $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,'$existingURI')"
+ );
+ $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";
+ return (1, $errstr)
+ if ( $_ eq $existingURI );
+ }
+ }
+ $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')"
+ );
+ $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";
+ return (1, $errstr)
+ if ( $_ eq $existingURI );
+ }
+ }
+ $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')"
+ );
+ $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";
+ return (1, $errstr)
+ if ( $_ eq $existingURI );
+ }
+ }
+ return (0, "");
+}
+
+# custom query routine for Moby::Central.pm -> findService()
+sub checkKeywords{
+ my ($self, @args) = @_;
+ my $dbh = $self->dbh;
+ my $param = get_value('findme', @args);
+ my %findme = %$param;
+ my $searchstring;
+
+ foreach my $kw ( @{ $findme{keywords} } ) {
+# $debug && &_LOG("KEYWORD $kw\n");
+ $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);
+}
+
+# custom query subroutine for Moby::Central.pm->_searchForSimple()
+sub getFromSimple{
+ 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 $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
+ $nsquery .= " OR INSTR(namespace_type_uris, '$ns') ";
+ }
+ if ($nsquery) {
+ $nsquery =~ s/OR//; # just the first
+ $nsquery .= " OR namespace_type_uris IS NULL";
+ $query .= " AND ($nsquery) ";
+ }
+
+ my $result = do_query($dbh, $query, ());
+ return $result;
+}
+
+# custom query subroutine for Moby::Central.pm->_searchForCollection()
+sub getFromCollection{
+ 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 $query = "select
+ c.service_instance_id,
+ s.namespace_type_uris
+ from
+ simple_$inout as s,
+ collection_$inout as c
+ where
+ s.collection_${inout}_id IS NOT NULL
+ AND s.collection_${inout}_id = c.collection_${inout}_id
+ AND object_type_uri = '$objectURI' ";
+ my $nsquery;
+ foreach my $ns ( @{$namespaceURIs} ) { # namespaces are already URI's
+ $nsquery .= " OR INSTR(namespace_type_uris, '$ns') ";
+ }
+ if ($nsquery) {
+ $nsquery =~ s/^\sOR//; # just the first
+ $nsquery .= " OR namespace_type_uris IS NULL";
+ $query .= " AND ($nsquery) "; # add the AND clause
+ }
+
+ my $result = do_query($dbh, $query, ());
+ return $result;
+}
+
+# custom query subroutine for Moby::Central.pm->RetrieveServiceNames
+sub getServiceNames{
+ 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 = ();
+
+ my $result = do_query($dbh, $statement, @bindvalues);
+ return $result;
+}
+
+# custom query for Moby::Central.pm->_flatten
+sub getParentTerms{
+ my ($self, @args) = @_;
+ my $dbh = $self->dbh;
+
+ my $type_id = get_value('relationship_type_id', @args);
+ my $statement = "
+ select
+ OE1.term
+ from
+ OntologyEntry as OE1,
+ OntologyEntry as OE2,
+ Term2Term as TT
+ where
+ ontologyentry2_id = OE2.id
+ and ontologyentry1_id = OE1.id
+ and relationship_type_id = $type_id
+ and OE2.term = ?";
+
+ my @bindvalues = ();
+ push(@bindvalues, get_value('term', @args));
+
+ my $result = do_query($dbh, $statement, @bindvalues);
+ return $result;
+}
+
+# custom query subroutine for selecting from object_term2term and object tables
+# used in Moby::OntologyServer.pm->retrieveObject()
+sub getObjectRelationships{
+ my ($self, @args) = @_;
+ my $dbh = $self->dbh;
+
+ my $statement = "select
+ relationship_type,
+ object_lsid,
+ object2_articlename
+ 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;
+}
+
+# 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) = @_;
+ 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 $defs;
+
+ if ( $direction eq 'root' ) {
+ unless ( defined $relationship ) {
+ $defs = $self->dbh->selectall_arrayref( "
+ select distinct s2.${ontology}_lsid, relationship_type from
+ ${ontology}_term2term as t2t,
+ $ontology as s1,
+ $ontology as s2
+ where
+ s1.${ontology}_id = t2t.${ontology}1_id and
+ s2.${ontology}_id = t2t.${ontology}2_id and
+ s1.${ontology}_lsid = ?", undef, $term ); # ")
+ } else {
+ $defs = $self->dbh->selectall_arrayref( "
+ select distinct s2.${ontology}_lsid, relationship_type from
+ ${ontology}_term2term as t2t,
+ $ontology as s1,
+ $ontology as s2
+ where
+ 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 ); # ")
+ }
+ } else {
+ unless ( defined $relationship ) {
+ $defs = $self->dbh->selectall_arrayref( "
+ select distinct s2.${ontology}_lsid, relationship_type from
+ ${ontology}_term2term as t2t,
+ $ontology as s1,
+ $ontology as s2
+ where
+ s1.${ontology}_id = t2t.${ontology}1_id and
+ s2.${ontology}_id = t2t.${ontology}2_id and
+ s2.${ontology}_lsid = ?", undef, $term ); # ")
+ } else {
+ $defs = $self->dbh->selectall_arrayref( "
+ select distinct s2.${ontology}_lsid, relationship_type from
+ ${ontology}_term2term as t2t,
+ $ontology as s1,
+ $ontology as s2
+ where
+ 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 ); # ")
+ }
+ }
+ return $defs;
+}
+
+sub _checkURI {
+
+# my $uri = "http://www.ics.uci.edu/pub/ietf/uri/#Related";
+#print "$1, $2, $3, $4, $5, $6, $7, $8, $9" if
+# $uri =~ m{^(([^:/?#]+):)?(//([^/?#]*))?([^?#]*)(\?([^#]*))?(#(.*))?};
+#
+#The license for this recipe is available here.
+#
+#Discussion:
+#
+#If the match is successful, a URL such as
+#
+#http://www.ics.uci.edu/pub/ietf/uri/#Related
+#
+#will be broken down into the following group match variables:
+#
+#$1 = http:
+#$2 = http
+#$3 = //www.ics.uci.edu
+#$4 = www.ics.uci.edu
+#$5 = /pub/ietf/uri/
+#$6 =
+#$7 =
+#$8 = #Related
+#$9 = Related
+#
+#In general, this regular expression breaks a URI down into the following parts,
+#as defined in the RFC:
+#
+#scheme = $2
+#authority = $4
+#path = $5
+#query = $7
+#fragment = $9
+
+}
+
+sub DESTROY {}
+
+1;
More information about the MOBY-guts
mailing list