# -*-Perl-*-
#
#  ACEDB (aceclient) interface routines for Equus
#
#
#
#######################################################################
# 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.                      #
#######################################################################

#######################################
#

# Look for entries in plate object which
# can have row based sub-trees. Read these
# from an ace file dump from the relevant
# query.
# 
# Consolidate possible clashing entries of
# a-h, etc
#
#######################################

sub readRowEntries {
    
    my($plate)=@_;

    #
    # Do 'query find' on $plate
    # Put result on filehandle
    #

    unless ( &queryPlate ($plate, *PLATE) ) {
	warn "Failed to make plate query: &queryPlate ($plate, PLATE)";
	return 0;
    }

    #
    # Read plate object into hash
    #

    my %plate_obj;
    &readPlateObject(\%plate_obj, *PLATE);

    #
    # For Seq and Loading entries, expand 'a-h'
    # notation.
    #
}

########################################
# 
# readPlateObject($hash_ref, FILEHANDLE)
# 
# - read plate object off FILEHANDLE into
# hash
# 
# - hash treats Seq, Load and ASP tags
# specially as these are constructed
# sub trees
#
########################################
sub readPlateObject {

    local($obj_ref, *HANDLE)=@_;

    my($tag, $row, $item, $plate);

    while (<HANDLE>) {

	if ( ($plate) = /Plate\s+:\s+\"(\S+)\"/ ) {

	    $$obj_ref{'Plate'} = $plate;

	    while (<HANDLE>) {

		last if /^\/\//;

		chomp;
		if ( ($row, $item) = /^Seq\s+\"(.*)\"\s+(.*)/ ) {
		    $$obj_ref{'Seq'}->{$row} = $item;
		} elsif ( ($row, $item) = /^Loading\s+\"(.*)\"\s+(.*)/ ) {
		    $$obj_ref{'Loading'}->{$row} = $item;
		} elsif ( ($row, $item) = /^ASP\s+\"(.*)\"\s+(.*)/ ) {
		    $$obj_ref{'ASP'}->{$row} = $item;		    
		} elsif ( ($tag, $item) = /^(\S+)\"\s+(.*)/ ) {
		    $$obj_ref{'ASP'}->{$row} = $item;		    
		}
	    }
	}
    }

    1;

}



########################################
#  
# queryPlate($plate_name, $string_ref);
# 
# Get partcular plate object 
# from equus 
# 
# 
########################################

sub queryPlate {

    local ($plate, *QUERY)=@_;


    if ($plate eq '' ) {
	warn "$prog: \$plate found to be null";
	return 0;
    }


    my $commands=qq{
where find plate $plate
write
q
};

    unless ( &openEquus($commands, *QUERY) ) {
	warn "$prog: Unable to open aceclient: &openEquus returned zero\n";
	return 0;
    }

    1;
}

########################################
#  
# queryItem($item_name, $string, *FILEHANDLE);
# 
########################################

sub queryItem {

    local ($item, $string, *QUERY)=@_;


    if ($string eq '' ) {
	warn "$prog: \$string found to be null";
	return 0;
    }


    my $commands=qq{
where find $item $string
write
q
};

    unless ( &openEquus($commands, *QUERY) ) {
	warn "$prog: Unable to open aceclient: &openEquus returned zero\n";
	return 0;
    }

    1;
}
    
########################################
# 
# openEquus($text_commands, HANDLE)
# 
# Open Equus aceclient, 
# Pass commands,
# return filehandle
#  
# 
########################################
   
sub openEquus {

    local ($text_commands, *EQUUS)=@_;

    #
    # Get path of aceclient
    #    

    unless ( &equusBin(\$equusbin) || $equusbin ne '') {
	warn "$prog: Unable to open determine path for aceclient";
	return 0;
    }

    # Derive $aceprog

    my $aceprog = "$equusbin/aceclient equus -port 200001";

    open (EQUUS, "echo '$text_commands' | $aceprog |")
	|| warn "$prog: Unable to open aceclient: $!"
	    && return 0;

    1;

}

########################################
# 
# $err = &equusBin(\$path);
# 
# Get full path name of architechture specfic
# bin directory for equus
# 
########################################
sub equusBin {

    my($path_ref)=@_;

    unless(defined($equus)) {
	#$equus=glob('~equus');
	$equus=(getpwnam('equus'))[7];
    }


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



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

    return 1;

}

########################################
#
# runTableMaker($table_def, $param, *FILEHANDLE)
#
# - Open acelclient and run $table_def
#   with $param subtitutions
#
# -Pipe output to *FILEHANDLE
#
########################################
sub runTableMaker {

    local ($table_def, $param, *TABLE)=@_;

    ########################################
    # 
    # The aceclient commands to run the table
    # maker query. Excel should have supplied
    # the correct parameter substitutions to 
    # match the particular table.
    # 
    ########################################


    my $commands=qq{
table $table_def $param
q
};


    unless ( &openEquus($commands, TABLE) ) {
	warn "$prog: Unable to open aceclient: &openEquus returned zero";
	return 0;
    }

    1;

}

#################################
#
# Parse ace file into database
#
#################################
sub enterAce {

    my($acefile)=@_;

    #$debug =1;

    #############################
    # 
    # Check file's credentials
    # 
    #############################

    ($acefile) = glob("$acefile");

    if ( &validateFile($acefile)  ) {
	warn "File OK\n" if $debug;
    } else {
	warn "File NOT OK\n" if $debug;
	return 0;
    }
    
    #############################
    # 
    # Open aceprog and read the ace file
    # 
    #############################

    my $commands="parse $acefile\nq\n";

    print "\nCOMMANDS:\n$commands\n" if $debug;


    unless ( &openEquus($commands, ACE) ) {
	warn "$prog: Unable to open aceclient: &openEquus returned zero\n";
	return 0;
    }

    if ( <ACE> =~ /0 Active Objects/ ) {
	warn "$prog: Probable acefile entry error\n";
	close(ACE);
	return 0;
    }

    close (ACE) 
        || warn "$prog: \"$aceprog\" returned bad exit code: $!\n"
            && return 0;

    1;

}


#################################
#
# Check the state of the Ace file
#
#################################
sub validateFile {

    my($file)=@_;

    if ( $file eq '' ) {
	warn "$prog: File \"$file\": null file name\n" if $debug;
	return 0;
    }

    stat($file);

    unless ( -e _ ) {
	warn "$prog: File \"$file\": not found\n" if $debug;
	return 0;
    }

    unless ( -r _ ) {
	warn "$prog: File \"$file\": unreadable\n" if $debug;
	return 0;
    }

    if ( -z _ ) {
	warn "$prog: File \"$file\": zero length\n" if $debug;
	return 0;
    }

    1;
}


1;

