#!/usr/local/bin/perl

# A simple BioMart service CGI script 
# requests: registry, dataset names, dataset configuration and query results


use strict;
use XML::Simple qw(:strict);
use CGI;
use SiteDefs;

use BioMart::Initializer;
use BioMart::Query;
use BioMart::AttributeTable;
use BioMart::QueryPlanner;
use BioMart::ResultTable;

my $CGI       = CGI->new();
my $type = $CGI->param('type');
my $virtual_schema_name =$CGI->param('virtualschema');# || 'default'; 
my $dataset =$CGI->param('dataset');
my $version = $CGI->param('version');
my $atts =$CGI->param('attribute');
my $fils =$CGI->param('filter');
my $mart =$CGI->param('mart');
my $martuser =$CGI->param('martuser') || 'default';
my $interface =$CGI->param('interface') || 'default';

my $server_port= $SiteDefs::ENSEMBL_PROXY_PORT || $SiteDefs::ENSEMBL_PORT;
my $server_host= $SiteDefs::ENSEMBL_SERVER;
my $path = "/Multi/martservice";

use MartView::RegistryCache;
MartView::RegistryCache->init();
my $initializer = $MartView::RegistryCache::initializer;
my $registry = $initializer->getRegistry();

if ($type eq "registry") {
    &get_registry($registry,$server_host,$server_port,$path);
}  
elsif ($type eq "datasets") {
    &get_datasets($registry,$virtual_schema_name,$mart,$martuser);
}  
elsif ($type eq "interfaces"){
    &get_interfaces($registry,$virtual_schema_name,$mart,$martuser,$dataset);
}
elsif ($type eq "configuration") {
    &get_configuration($registry,$virtual_schema_name,$dataset,$interface,$martuser);
} 
elsif ($type eq "filters") {
    &get_filters($registry,$virtual_schema_name,$dataset,$interface,$martuser);
}
elsif ($type eq "attributes") {
    &get_attributes($registry,$virtual_schema_name,$dataset,$interface,$martuser);
}
elsif ($type eq "versioncheck") {
    &version_check($registry,$virtual_schema_name,$mart,$version);
} 
elsif ($type eq "version") {
    &version($registry,$virtual_schema_name,$mart);
} 
else{
    my $xml = $CGI->param('query');
    &run_query($registry,$xml);
}

#
# returns registry XML
#

sub get_registry {
    
    my ($registry,$server_host,$server_port,$path)=@_;
    

    my $xml = $registry->toXML();
    my $reg_file = XMLin($xml, forcearray=> [qw(virtualSchema RegistryURLLocation RegistryDBLocation MartDBLocation MartURLLocation)], keyattr => [],KeepRoot=>1);
    
    my $mr =$reg_file->{'MartRegistry'};
	
    while (my ($key,$value) = each (%{$mr})){
	
	
	if ($mr->{'virtualSchema'}){	
	    foreach my $lr (@{$mr->{'virtualSchema'}}){
		&_set_location($lr);
	    }
	} else {
	    &_set_location($mr);
	}
}
    
    
    if ($mr->{'virtualSchema'}){
	foreach my $lr (@{$mr->{'virtualSchema'}}){
	    &_reset_attributes($lr);
	} 	
    } else {
	&_reset_attributes($mr);
    }
    

    my $newconfig=XMLout($reg_file, keyattr => [],KeepRoot=>1);
    
    #pprint STDERR "\n$newconfig";

    print "\n$newconfig";

}


sub _set_location {
    
    my ($lr)=@_;
    
    my $serverVirtualSchema = 'default';
    
    if (defined  $lr->{'name'})
    {
	$serverVirtualSchema=$lr->{'name'};
    }
    
    my @new_location;
    my @to_ignore = qw (schema database databaseType user password);
    foreach my $location_atts (@{$lr->{'MartDBLocation'}}){
	
	while (my ($att,$val) = each (%{$location_atts})){
	    delete $$location_atts{$att} if (grep $att eq $_, @to_ignore);
	}
	my %new_location_atts= %$location_atts;
	$new_location_atts{'serverVirtualSchema'} = $serverVirtualSchema;
	push (@new_location,\%new_location_atts);
    }
    
    if (defined @new_location) {
	$lr->{'MartURLLocation'}=\@new_location;
    }
    delete ($lr->{'MartDBLocation'});  
} 


sub _reset_attributes {
    my ($lr)=@_;
    
    foreach my $dblc (@{ $lr->{'MartURLLocation'} })
    {
	unless ($dblc->{'redirect'}==1){
	    
	    $dblc->{'host'}=$server_host;
	    $dblc->{'port'}=$server_port;
	    $dblc->{'path'}=$path;
	    
	}
    }
    
}


#
# returns datasets tab delimited
#

sub get_datasets {
    
    my ($registry,$virtual_schema_name,$mart,$mart_user)=@_;
     
    if ($virtual_schema_name eq ''){
	my $seen;
	foreach my $virtualSchema (@{$registry->getAllVirtualSchemas}){
	    foreach my $location (@{$virtualSchema->getAllLocations}){
		next unless ($location->name eq $mart);
		if ($seen){
		    # duplicated mart name as virtual_schema_name not set
		    print "\nMart name conflict for $mart. Need to further qualify with the virtualSchemaName as well\n";
		    return;
		}
		$virtual_schema_name = $virtualSchema->name;
		$seen++;
	    }
	}
    }

    my $names=$registry->getAllDatasetNames($virtual_schema_name);
    

    foreach my $ppname (@$names){
	my $dataset=$registry->getDatasetByName($virtual_schema_name, $ppname,$mart_user);
	next if (!$dataset);
	if ($mart eq $dataset->locationName) {
	    my $type;
	    if ($dataset->isa("BioMart::Dataset::TableSet")) {
		$type="TableSet";
	    }
	    else {
		$type ="GenomicSequence";
	    }
	    
	    print " \n";
	    
	    print $type,"\t",$dataset->name,"\t",$dataset->displayName,"\t",$dataset->visible,"\t",
		$dataset->version,"\t",$dataset->initialBatchSize,"\t",$dataset->maxBatchSize,"\n";
	    
	}
    }
}

sub get_interfaces{
    my ($registry,$virtual_schema_name,$mart,$mart_user,$dataset)=@_;
    my $dataset=$registry->getDatasetByName($virtual_schema_name, $dataset,$mart_user);
    next if (!$dataset);
    print "\n".$dataset->interfaces."\n";
    return;
}


#
# check if mart config version matches client version - returns boolean
#

sub version_check {
    my ($registry,$virtual_schema_name,$mart,$version)=@_;
    
    my $mart=&_find_mart($registry,$virtual_schema_name,$mart);
    print "\n".$mart->versionCheck($version)."\n";
    return;
    
    
}

#
# returns mart config version
#

sub version {
    my ($registry,$virtual_schema_name,$mart)=@_;
    
    my $mart=&_find_mart($registry,$virtual_schema_name,$mart);
    print "\n".$mart->version()."\n";
    return;
       
}



sub _find_mart {

    my ($registry,$virtual_schema_name,$mart)=@_;


 my $found_location;
    my $seen;
    foreach my $virtualSchema (@{$registry->getAllVirtualSchemas}){
	next unless ($virtual_schema_name eq '' || $virtualSchema->name eq $virtual_schema_name);
	foreach my $location (@{$virtualSchema->getAllLocations}){
	    next unless ($location->name eq $mart);
	    if ($seen){
		# duplicated mart name as virtual_schema_name not set
		print "\nMart name conflict for $mart. Need to further qualify with the virtualSchemaName as well\n";
		return;
	    }
	    $found_location = $location;
	    $seen++;
            #print "\n".$location->versionCheck($version)."\n";
	    #return;
	}
    }
    if (!$found_location){
	print "\nMart name $mart not found on server for the serverVirtualSchema specified\n";
	return;
    }

    return $found_location;

}


sub get_configuration {
    
    my ($registry,$virtual_schema_name,$dataset,$interface,$mart_user)=@_;
    
    
    if ($virtual_schema_name eq ''){
	my $seen;
	foreach my $virtualSchema (@{$registry->getAllVirtualSchemas}){
	    foreach my $dsetName (@{$registry->getAllDatasetNames($virtualSchema->name)}){
		next unless ($dsetName eq $dataset);
		if ($seen){
		    # duplicated mart name as virtual_schema_name not set
		    print "\nDataset name conflict for $dataset. Need to further qualify with the virtualSchemaName as well\n";
		    return;
		}
		$virtual_schema_name = $virtualSchema->name;
		$seen++;
	    }
	}
    }
    
    my @dss = split(/\,/,$dataset);
    my $xmlTree;
    
  
    
    foreach my $ds (@dss){
	$xmlTree = $registry->getDatasetByName($virtual_schema_name, $ds,$mart_user)->getConfigurationTree($interface)->toXML();
    }
        
    #print STDERR "$xmlTree\n";
    
    print  "\n$xmlTree\n";

}

sub get_filters {
    
    my ($registry,$virtual_schema_name,$dataset,$interface,$mart_user)=@_;
    
    
    if ($virtual_schema_name eq ''){
	my $seen;
	foreach my $virtualSchema (@{$registry->getAllVirtualSchemas}){
	    foreach my $dsetName (@{$registry->getAllDatasetNames($virtualSchema->name)}){
		next unless ($dsetName eq $dataset);
		if ($seen){
		    # duplicated mart name as virtual_schema_name not set
		    print "\nDataset name conflict for $dataset. Need to further qualify with the virtualSchemaName as well\n";
		    return;
		}
		$virtual_schema_name = $virtualSchema->name;
		$seen++;
	    }
	}
    }
    
    my $ct = $registry->getDatasetByName($virtual_schema_name, $dataset,$mart_user)->getConfigurationTree($interface);

    print "\n";
    foreach my $fpage (@{$ct->getAllFilterTrees}){
	next if ($fpage->hideDisplay eq 'true'); 
	foreach my $fgroup (@{$fpage->getAllFilterGroups}){
	    foreach my $fcollection(@{$fgroup->getAllCollections}){
		foreach my $filter(@{$fcollection->getAllFilters}){
		    if (${$filter->getAllOptions}[0] && ${$filter->getAllOptions}[0]->filter){
			foreach my $option(@{$filter->getAllOptions}){
			    my $options = $option->filter->getAllOptions;
			    my @vals;
			    foreach (@$options){
				push @vals,$_->value;
			    }
			    print $option->filter->name."\t".$option->filter->displayName."\t[".join(",",@vals)."]\n";
			}
		    }
		    else{
			my $options = $filter->getAllOptions;
			my @vals;
			foreach (@$options){
			    push @vals,$_->value;
			}
			print $filter->name."\t".$filter->displayName."\t[".join(",",@vals)."]\n";
		    }
		}
	    }
	}
    }
    print  "\n";

}

sub get_attributes {
    
    my ($registry,$virtual_schema_name,$dataset,$interface,$mart_user)=@_;
    
    
    if ($virtual_schema_name eq ''){
	my $seen;
	foreach my $virtualSchema (@{$registry->getAllVirtualSchemas}){
	    foreach my $dsetName (@{$registry->getAllDatasetNames($virtualSchema->name)}){
		next unless ($dsetName eq $dataset);
		if ($seen){
		    # duplicated mart name as virtual_schema_name not set
		    print "\nDataset name conflict for $dataset. Need to further qualify with the virtualSchemaName as well\n";
		    return;
		}
		$virtual_schema_name = $virtualSchema->name;
		$seen++;
	    }
	}
    }
    
    my $ct = $registry->getDatasetByName($virtual_schema_name, $dataset,$mart_user)->getConfigurationTree($interface);

    print "\n";
    foreach my $apage (@{$ct->getAllAttributeTrees}){
	next if ($apage->hideDisplay eq 'true'); 
	foreach my $agroup (@{$apage->getAllAttributeGroups}){
	    foreach my $acollection(@{$agroup->getAllCollections}){
		foreach my $attribute(@{$acollection->getAllAttributes}){
			print $attribute->name."\t".$attribute->displayName."\n";
		}
	    }
	}
    }
    print  "\n";

}

sub run_query {
    my ($registry,$xml) = @_;
    my $query = BioMart::Query->new(
	'registry' => $registry,
        'virtualSchemaName' => 'default',
	'xml'      => $xml);	
    
    if ($query->get('errstring')){
	print $query->get('errstring');
	return;
    }
    

    my $query_planner = BioMart::QueryPlanner->new();
    
    my $rtable = $query_planner->getResultTable($query,undef);
    
    if ($rtable =~ /^ERROR::/){
	print "\n".$rtable."\n";
    }
    elsif ($query->count == 1){
	print "\n$rtable\n"; 
    }
    else{
	print "\n";
	return unless ($rtable->hasMoreRows);
	#print "\n";
	while (my $row = $rtable->nextRow){
          print join( "\t", @{$row} );
          print "\n";
	}
    }
}




