lib/MOBY/Adaptor/moby/queryapi/mysql.pm

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;

use vars qw /$VERSION/;
$VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /: (\d+)\.(\d+)/;

@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 _getDBHandle {
    my ($ontology) = @_;
    my $CONF = MOBY::Config->new;
    my $adap = $CONF->getDataAdaptor(source => $ontology);
    return $adap->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}){
				    #added a check for servicename to support case sensitivity
				    if ($key eq "servicename") {
					$condition .= $key . " LIKE binary ? ";
					push(@bindvalues, $pair{$key});
				    } elsif ($pair{$key} eq "IS NOT NULL"){
					$condition .= $key . " IS NOT NULL ";
				    } else {
				        $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 where 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_instance_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 $collid = $args{collection_input_id};
    my $id_to_use = $siid?$siid:$collid;
    
    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 ";
      
	my $condition;
      $siid && ($condition = " service_instance_id = ? and collection_input_id IS NULL");
      $collid && ($condition = " collection_input_id = ?");
      $statement .= $condition;
      
    my $result = do_query($dbh, $statement, ($id_to_use));
    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_id = ?");
    $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_id = ?";

    $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_output_id};
    my $dbh = $self->dbh;
    my $id_to_use = $siid?$siid:$collid;
    
    my $statement = "select
      simple_output_id,
      object_type_uri,
      namespace_type_uris,
      article_name,
      service_instance_id,
      collection_output_id
      from simple_output where ";
      my $condition;
      $siid && ($condition = " service_instance_id = ? and collection_output_id IS NULL");
      $collid && ($condition = " collection_output_id = ?");
    $statement .= $condition;


    my $result = do_query($dbh, $statement, ($id_to_use));
    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_id = ?");
    $collid && ($statement2 = "delete from simple_output where collection_output_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,
      description,
      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,description,service_instance_id) values (?,?,?,?,?,?,?,?)},
	    undef,
	    (
	       $args{'default_value'}, $args{'maximum_value'},
	       $args{'minimum_value'}, $args{'enum_value'},
	       $args{'datatype'}, $args{'article_name'}, $args{'description'},$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_id=?";

    $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 = _getDBHandle("mobyobject");
	my $result;
	if ($type){
	    $result = do_query($dbh, $statement, ($type));
	} else {
	    $result = do_query($dbh, $statement);
	}	    
 	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 $result = $self->query_object(type => $term);
	my $row = shift(@$result);
	my $id = $row->{object_id};
	my $lsid = $row->{object_lsid};
	my $statement = "delete from object where object_lsid = ?";
	$dbh->do( $statement,undef, ($lsid) );
	
	$self->_delete_object_term2term(id => $id);
	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 $o1id = $args{id};
	return 0 unless defined($o1id);
	my $dbh = $self->dbh;	
	my $statement = "delete from object_term2term where object1_id=?";
	$dbh->do( $statement,undef, ($o1id));
	
	if ($dbh->err){
		return (1, $dbh->errstr);
	}
	else{
		return 0;
	}
}

# pass servicename and authority_uri
# TODO added LIKE binary here
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 LIKE binary ? 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!!
# IMPORTANT: must use quotes for the keys of the hash (eg. 'authority.authority_uri' => $value )
sub query_service_instance {
	my ($self, %args) = @_;	
	my $dbh = $self->dbh;
    	
	my @args;
	while (my ($k, $v) = each %args){
	    push @args, ({$k => $v}, "and"); # format for the_add_condition subroutine
	    								 # but too bad won't be scalable for "or"
	}
    	
	if (keys(%args)){ pop @args;}  # remove final "and"
	
	my $statement = "select 
			service_instance_id, 
			category, 
			servicename, 
			service_type_uri, 
			authority.authority_uri, 
			url, 
			service_instance.contact_email, 
			authoritative, 
			description, 
			signatureURL,
			lsid 
			from service_instance, authority ";
        my @bindvalues;
 	($statement, @bindvalues) =_add_condition($statement, @args);
	if (keys(%args)){
	    $statement .= " and authority.authority_id = service_instance.authority_id";
	} else {
	    $statement .= " where authority.authority_id = service_instance.authority_id";
	}
 	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.authority_uri from service_instance right join authority on authority.authority_id = service_instance.authority_id  where servicename IS NOT NULL order by authority.authority_uri;";
	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}||"";
	my $condition = "";
	if ($type =~ /^urn\:lsid/){
	    $condition = "where service_lsid = ?";
	} elsif ($type) {
	    $condition = "where service_type = ?";
	} else {
	    $condition = "";
	}
	
	my $dbh = _getDBHandle("mobyservice");

	my $statement = "select
	  service_id, 
          service_lsid,
          service_type,
          description,
          authority,
          contact_email
	  from
	  service 
          $condition";
	my $result;
	if ($type){
	    $result = do_query($dbh, $statement, ($type));
	} else {
	    $result = do_query($dbh, $statement);
	}
 	return $result;		
}

sub new_query_service{
	my ($self, %args) = @_;
	my $type = $args{type}||"";
	my $condition = "";
	if ($type =~ /^urn\:lsid/){
	    $condition = "where s1.service_lsid = ?";
	} elsif ($type) {
	    $condition = "where s1.service_type = ?";
	} else {
	    $condition = "";
	}
	
	my $dbh = _getDBHandle("mobyservice");

	my $statement = "select
	  s1.service_id as service_id, 
          s1.service_lsid as service_lsid,
          s1.service_type as service_type,
          s1.description as description,
          s1.authority as authority,
          s1.contact_email as contact_email,
	  s2.service_type as parent_type,
	  s2.service_lsid as parent_lsid  
          from
	  service as s1
	  left join service_term2term as t
	    on s1.service_id= t.service1_id
	left join service as s2
	on s2.service_id=t.service2_id
        $condition";
	my $result;
	if ($type){
	    $result = do_query($dbh, $statement, ($type));
	} else {
	    $result = do_query($dbh, $statement);
	}
 	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 'type' as a term or lsid
sub delete_service{
	my ($self, %args) = @_;	
	my $type = $args{type};
	my $result = $self->query_service(type => $type);
	my $row = shift(@$result);
	my $id = $row->{service_id};
	my $lsid = $row->{service_lsid};
	return 0 unless $lsid;
	my $dbh = $self->dbh;
	my $statement = "delete from service where service_lsid = ?";
	$dbh->do( $statement, undef, ($lsid));
	$self->_delete_service_term2term(id => $id);
	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 $id = $args{id};
	return 0 unless (defined($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 = "  relationship_lsid = ? and ";
	} elsif ($type) {
	    $condition = "  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};
	my $condition = "";
	if ($type =~ /^urn\:lsid/){
	    $condition = " where namespace_lsid = ?";
	} elsif ($type) {
	    $condition = " where namespace_type = ?";
	} else {
	    $condition = "";
	}
	
	my $dbh = _getDBHandle("mobynamespace");
	
	my $statement = "select
          namespace_id,
          namespace_lsid,
          namespace_type,
          description,
          authority,
          contact_email
          from namespace $condition";
	my $result;
	if ($type){
	    $result = do_query($dbh, $statement, ($type));
	} else {
	    $result = do_query($dbh, $statement);
	}
 	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 $type = $args{type};
	my $result = $self->query_namespace(type => $type);
	my $row = shift(@$result);
	my $id = $row->{namespace_id};
	my $lsid = $row->{namespace_lsid};
	return 0 unless $lsid;
	my $dbh = $self->dbh;
	my $statement = "delete from namespace where namespace_lsid = ?";
	$dbh->do( $statement, undef, ($lsid));
	$self->_delete_namespace_term2term(id => $id);
	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 $id = $args{id};
	return 0 unless defined($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;
	}
}
# 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_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, $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, $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, $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, $lsid
	);
	return $errorMsg
	  if ($id);	  
	  
	return 0;
}

# custom query routine for Moby::Central.pm -> deregisterNamespace()
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,'$lsid')"
	  );
	$sth->execute;

	while ( my ( $id, $ns ) = $sth->fetchrow_array() ) {
		my @nss = split ",", $ns;
		foreach (@nss) {
			$_ =~ s/\s//g;
			my $errstr = "Namespace Type $type ($_) is used by a service (service ID number $id) and may not be deregistered";
			return (1, $errstr)
			  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,'$lsid')"
	  );
	$sth->execute;
	while ( my ( $id, $ns ) = $sth->fetchrow_array() ) {
		my @nss = split ",", $ns;
		foreach (@nss) {
			$_ =~ s/\s//g;
			my $errstr = "Namespace Type $type ($_) is used by a service (service ID number $id) and may not be deregistered";
			return (1, $errstr)
			  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, '$lsid')"
	  );
	$sth->execute;
	while ( my ( $id, $ns ) = $sth->fetchrow_array() ) {
		my @nss = split ",", $ns;
		foreach (@nss) {
			$_ =~ s/\s//g;
			my $errstr = "Namespace Type $type ($_) is used by a service (service ID number $id) and may not be deregistered";
			return (1, $errstr)
			  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, '$lsid')"
	  );
	$sth->execute;
	while ( my ( $id, $ns ) = $sth->fetchrow_array() ) {
		my @nss = split ",", $ns;
		foreach (@nss) {
			$_ =~ s/\s//g;
			my $errstr = "Namespace Type $type ($_) is used by a service (service ID number $id) and may not be deregistered";
			return (1, $errstr)
			  if ( $_ eq $lsid );
		}
	}		
	return (0, "");
}

# custom query routine for Moby::Central.pm -> findService()	
sub check_keywords{
	my ($self, %args) = @_;	
	my $dbh = $self->dbh;		
	my $param = $args{keywords};
	return ([{}]) unless (ref($param) =~ /ARRAY/);
	my @keywords = @$param;
	#my %findme = %$param;
	my $searchstring;
	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

	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);
}	
	
# custom query subroutine for Moby::Central.pm->_searchForSimple()
sub find_by_simple{
	my ($self, %args) = @_;	
	my $dbh = $self->dbh;	
	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 collection_${inout}_id IS 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 find_by_collection{
	my ($self, %args) = @_;	
	my $dbh = $self->dbh;	
	my $inout = $args{'inout'};
	my $objectURI = $args{'objectURI'};
	my $namespaceURIs = $args{'namespaceURIs'};
	
	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 get_service_names{		
	my ($self, %args) = @_;	
	my $dbh = $self->dbh;	
	my $statement = "select authority_uri, servicename, lsid 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 get_parent_terms{
	my ($self, %args) = @_;	
	my $dbh = $self->dbh;
	
	my $type_id = $args{'relationship_type_id'};
	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, $args{'term'});
	
	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 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_type,
	object_lsid,
	description,
	authority,
	contact_email,
	object2_articlename 
	from object_term2term, object 
	where object1_id = ? and object2_id = object_id";
	
	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 get_relationship{
	my ($self, %args) = @_;	
	my $dbh = $self->dbh;
	my $direction = $args{'direction'};
	my $ontology = $args{'ontology'};
	my $relationship = $args{'relationship'}; # this is assumed to be an LSID

	my $type = $args{'term'};
	return 0 unless $type;
	my $lsid;
	if ($ontology eq "service"){
	    my $result = $self->query_service(type => $type);
	    my $row = shift @$result;
	    $lsid = $row->{service_lsid};
	} else {
	    my $result = $self->query_object(type => $type);
	    my $row = shift @$result;
	    $lsid = $row->{object_lsid};
	}
	my $defs;
	my $extra_columns;
	$extra_columns = ", relationship_type ";
	if ($ontology eq "object"){$extra_columns .=", object2_articlename ";}
	if ( $direction eq 'root' ) {
		unless ( defined $relationship ) {
			$defs = $self->dbh->selectall_arrayref( "
            select distinct s2.${ontology}_lsid $extra_columns 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, $lsid );    # ")
		} else {
			$defs = $self->dbh->selectall_arrayref( "
            select distinct s2.${ontology}_lsid $extra_columns 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, $lsid );    # ")
		}
	} else {
		unless ( defined $relationship ) {
			$defs = $self->dbh->selectall_arrayref( "
            select distinct s1.${ontology}_lsid $extra_columns 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, $lsid);                   # ")
		} else {
			$defs = $self->dbh->selectall_arrayref( "
            select distinct s1.${ontology}_lsid $extra_columns 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, $lsid );    # ")
		}
	}
	return $defs;
}

# Get all relationships in the queried database in one go.  The
# complete table ${ontology}_term2term is transferred into a hash
# whose reference is finally returned.  Important: note that the hash
# is built 'direction aware', that is for objects 'object1_id' is used
# as key when direction is 'root' and 'object2_id' as value. Vice
# versa for the 'leaves' direction.  Likewise for services.
# Returns a hash reference.
sub get_all_relationships {

  my ($self, %args) = @_;
  my $direction = $args{'direction'};
  my $ontology = $args{'ontology'};
  # my $relationship = $args{'relationship'}; # has to be lsid!

  my $relHash;
  my $dbh = _getDBHandle("moby$ontology");

  my $statement = "select ${ontology}1_id, ${ontology}2_id, relationship_type";
  $statement .= ", object2_articlename, assertion_id " if $ontology eq 'object';
  $statement .= " from ${ontology}_term2term";
  # my $relationship_lsid = "urn:lsid:biomoby.org:${ontology}relation:isa";
  my $defs = $dbh->selectall_arrayref($statement);

  return {} unless @$defs;
  foreach my $def (@$defs) {
    my $relationship = $def->[2];
    if ( $relationship =~ /has/i ) {
      # HAS or HASA
      # >1 has/hasa child possible; also store articlename and assertion_id
      # hash structure: $relHash->{has/a-lsid}->{object1_id}->[object2_id,articlename,assertion_id]
      push @{$relHash->{$relationship}->{$def->[0]}}, [$def->[1],$def->[3],$def->[4]] if $direction eq 'root';
      push @{$relHash->{$relationship}->{$def->[1]}}, [$def->[0],$def->[3],$def->[4]] if $direction eq 'leaves';
    }
    elsif ( $relationship =~ /isa/i ) {
      # ISA
      push @{$relHash->{$relationship}->{$def->[1]}}, $def->[0] if $direction eq 'leaves'; # >1 child possible!
      $relHash->{$relationship}->{$def->[0]} = $def->[1] if $direction eq 'root'; # no multi parents!
    }
    else { return {}; }
  }
  return $relHash;
}

# retrieve details for a number of entities from table $ontology
# represented by a list of ${ontology}_id's;
# used in MOBY::OntologyServer::Relationships
sub get_details_for_id_list {
  my ($self, $ontology, $fields, $idList) = @_;

  return {} unless @$idList;
  return {} unless @$fields;

  my $dbh = _getDBHandle("moby$ontology");
  my $result = {};

  # avoid errors due to wrong field names:
  my %existingFields;
  my @queryFields = ();
  my $resArray = $dbh->selectall_arrayref("SHOW COLUMNS FROM $ontology");
  foreach my $row ( @$resArray ) {
    $existingFields{$row->[0]}++;
  }
  foreach my $field ( @$fields ) {
    next if $field eq "${ontology}_id";
    if ( exists $existingFields{$field} ) {
      push @queryFields, $field;
    }
    else {
      warn "Requested field $field does not exist in table $ontology!";
    }
  }

  #
  my $statement = "select ${ontology}_id, ". join(",", @queryFields). 
    " from $ontology where ${ontology}_id in (" .
      join(",", @$idList) . ")";
  $resArray = $dbh->selectall_arrayref($statement);
  foreach my $row ( @$resArray ) {
    my $entityId = shift @$row;
    foreach my $field (@queryFields) {
      my $value = shift @$row;
      $result->{$entityId}->{$field} = $value ? $value : '';
    }
  }
  return $result;
}

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;
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)