# -*-Perl-*-
#
# EquusTables.pm
#
# Manage selection of predefined table defs 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.                      #
#######################################################################

package EquusTables;

my ($tables, $def);

########################################
# 
# Initialise the package object.
# 
########################################

sub init {

    my $type=shift;

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

    my %params=@_;

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

    bless $self, $type;

}

sub setDefaults {

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

    ($$def_ref{'equus'}) = (getpwnam('equus'))[7];
    $$def_ref{'table_root'} = $$def_ref{'equus'} . '/equus/tables';

    &getTablesStruct($$def_ref{'table_root'}); # Defines $tables for this package.

}

###################################
# getTablesStruct	
# 
#     Get perl struct containig table
#   list, columns, etc
# 
# 
###################################
sub getTablesStruct {

    my $table_root = shift;

    ###################################
    #
    # Return a perl struct of tables and
    # columns per team.
    #
    ###################################

    my $tables_struct;
    my $lookup_file = $table_root . '/TABLES.lookup';
    

    unless (open(LOOKUP, "$lookup_file")) {
	$errors .=  "Couldn't open tables lookup: \"$lookup_file\": $!\n";
	return 1;
    }
    
    local $/;
    ($tables_struct)=<LOOKUP>;
    
    close(LOOKUP);

    eval($tables_struct);

    return (%$tables, %$def);

}






sub getTeams {

    return (keys(%$tables));

}

sub getTables {

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

    return unless $team;
    return (keys(%{$tables->{$team}}));

}

sub getCols {

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

    return (&getColumnNames($type, $table, 'All'));

}


sub getVisibleCols {

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

    return (&getColumnNames($type, $table, 'Visible'));

}


sub getColumnNames {

    my ($type, $table, $view) = @_;

    return unless $table;
   
    my %cols;
    foreach (keys(%{$def->{$table}})) {

	if ($def->{$table}->{$_}->{'view'} eq 'Visible' || $view eq 'All') {
	    
	    my $colname = $_;
	    my $colpos = $def->{$table}->{$_}->{'pos'};
	    $cols{ $colpos } = $colname; 

	}
    }

    my (@cols);

    foreach (sort(keys(%cols))) {
	push(@cols, $cols{$_});	
    }
	
    return (@cols);


}


1;
