# -*-Perl-*-
#
# EquusIO.pm
#
# ACEDB (aceclient) interface routines for Equus
#
#
# 
#Make instance vars name of equus, bin dir, port, machine etc
#######################################################################
# This software has been created by Genome Research Limited (GRL).    # 
# GRL hereby grants permission to use, copy, modify and distribute    # 
# this software and its documentation for non-commercial purposes     # 
# without fee at the user's own risk on the basis set out below.      #
# GRL neither undertakes nor accepts any duty whether contractual or  # 
# otherwise in connection with the software, its use or the use of    # 
# any derivative, and makes no representations or warranties, express #
# or implied, concerning the software, its suitability, fitness for   #
# a particular purpose or non-infringement.                           #
# In no event shall the authors of the software or GRL be responsible # 
# or liable for any loss or damage whatsoever arising in any way      # 
# directly or indirectly out of the use of this software or its       # 
# derivatives, even if advised of the possibility of such damage.     #
# Our software can be freely distributed under the conditions set out # 
# above, and must contain this copyright notice.                      #
#######################################################################

package EquusIO;

########################################
# 
# Construct the object
# 
########################################

sub init {

    my $type = shift;

    my $self = {};
    $type->setDefaults($self);

    my %params = @_; #args overide defaults

    foreach (keys(%{$self})) {
	if (defined($params{$_})) {
	    $self->{$_} = $params{$_};
	}
    }

    bless $self, $type;

}

sub setDefaults {

    my ($type, $def_ref)=@_;

    $$def_ref{'host'} = 'equus';
    $$def_ref{'port'} = '200001';

    ###################################
    #
    # Derive client
    #
    ###################################

    # ($$def_ref{'equus'}) = glob('~equus');
    $$def_ref{'equus'} = [getpwnam('equus')]->[7];
    $$def_ref{'equusbin'} = $type->equusBin($$def_ref{'equus'});
    $$def_ref{'dbdir'} = $$def_ref{'equus'} . '/equus';
    $$def_ref{'tempdir'} = $$def_ref{'equus'} . '/temptables';

    $$def_ref{'client'} = 
	$$def_ref{'equusbin'} . "/aceclient " . $$def_ref{'host'} . " -port " .  $$def_ref{'port'};

    $$def_ref{'xace'} = 
	$$def_ref{'equusbin'} . '/xace ' . $$def_ref{'dbdir'};

}


########################################
# 
# $err = &openEquus
# 
########################################
sub openEquus {

    my $type = shift;
    my(%args)=@_;


    if (defined($args{'-handle'})) {
	local *EQUUS = $args{'-handle'}; 
    }

    my $elog = $args{'-errors'}; 


    ###################################
    #
    # If commands came as array, join into a string.
    #
    ###################################
    my $commands;
    if (ref($args{'-commands'}) eq 'ARRAY') {
	$commands = join("\n", @{$args{'-commands'}});	
    } else {
	$commands = $args{'-commands'};
    }

    if ($commands eq '') {
	$$elog .= 'No commands passed to &openEquus';
	return 1;
    }

    ###################################
    #
    # Open the client and pass the commands
    #
    ###################################

    my $client = $type->{'client'};

    unless (open (EQUUS, "echo '$commands' | $client |")) {
	$$elog .= "Unable to open aceclient: $!";
	return 1;
    }



    unless (defined($args{'-handle'})) {

	###################################    
	#
	# Spew handle onto string, hash, or
	# print it if no output specified.
	#
	###################################

	if (defined($args{'-output'})) {

	    if (ref($args{'-output'}) eq 'HASH') {

		$type->aceOutputToHash($args{'-commands'}, $args{'-output'}, EQUUS);

	    } 
	    else {

		local $/;
		(${$args{'-output'}}) = <EQUUS>;
	    }

        } else {
	    while(<EQUUS>) { print; }
	}

        ###################################
        #
        # Close it down
        #
        ###################################

        unless (close (EQUUS)) {
	    $$elog .= "Error closing aceclient: $!";
	    return 1;
	}
    }
    
    0;

}

sub aceOutputToHash {

    shift;
    local($commands_ref, $hash_ref, *HANDLE)=@_;

    my $i;
    my $key = '';

    while (<HANDLE>) {
	print;

 	for ($i=0; $i <= $#$commands_ref; $i++) {

	    print $$commands_ref[$i], "\n";

  	    if ( /$$commands_ref[$i]/) {
		warn "HERE\n";
  		$key = splice(@{$commands_ref}, $i, 1);
 		$i--;
  	    }
 	}

	$$hash_ref{$key} .= $_ if $key ne '';

    }

}

########################################
#
# Get ace string save to tempfile
# in $this-{'tempdir'}
#
########################################
sub parseAceStr {

    my ($this, $str_ref, $msg_ref, $err_ref) =@_;

    # Check tmp directory
    #
    if ( ! -d "$this->{'tempdir'}" ) {
	$$err_ref .= "Can't find directory: $this->{'tempdir'}\n";
	return 1;
    }


    # Write ace file
    #
    my $tempace = $this->{'tempdir'} . "/equustempace" . $$;
    if (&writeText($tempace, $str_ref)) {
	$$err_ref .= "Failed to write temporary ace file: \"$tempace\"\n";
	return 1;
    }

    # Read ace file into Equus
    # 
    my $err = $this->openEquus(-output => $msg_ref,
			       -errors => $err_ref,
			       -commands => ["parse $tempace"]); 

    unlink("$tempace");
    return 1 if $err;
    
    return 0;

}

########################################
#
# save text to new file.
# return 1 on error.
#
########################################
sub writeText {

    my ($filename, $string_ref) = @_;

    open (FILE, ">$filename")
	|| warn "Couldn't open file: \"$filename\" for writing in &writeText: $!\n"
	    && return 1;

    
    print FILE $$string_ref;

    close(FILE);

    return 0;
    
}





########################################
# 
# Get full path name of architechture specfic
# bin directory for equus
# 
########################################
sub equusBin {

    my($type, $equus)=@_;
    my $path;

    unless(defined($ENV{'SYSTEM'})) {
	chop($ENV{'SYSTEM'}=`uname -sr`);
    }
    my $ostype=$ENV{'SYSTEM'};

    if ($ostype =~ /^OSF1/ ) {
	$path = "$equus/OSFbin";
    } elsif ($ostype =~ /^Sun/) {
	if ($ostype =~ /\b5/) {	# Solaris
	    $path = "$equus/SOLbin";
	} else {			#SUNos
	    $path ="$equus/SUNbin";
	}
    } elsif ($ostype =~ /^IRIX/) {
	$path = "$equus/SGIbin";
    } else {
	warn "Unknown system type: \"$ostype\"";
	return 0;
    }

    return $path;

}



############################################################
# $result = &outputClean($value)
#
# Remove junk from equus aceclient output
############################################################
sub outputClean {

    my($type, $value) = @_;

    $value =~ s/acedb\@\S+> //g; # prompts
    $value =~ s/\n\/\/.*\n/\n/g; # comments lines
    $value =~ s/\/\/.*//g;	# trailing comments
    $value =~ s/\n\s*\n/\n/g;	# multiple blank lines
    $value =~ s/^\s*$//g;       # blank lines
    $value =~ s/\\//g;          # Escape chars

    $value;
}



1;
