use strict;
use warnings;
use Roman;
chdir 'G:\back\Downloads\doc\yeastAug05';
my $filePath_eQTL_list='G:\back\Downloads\doc\yeastAug05\output\terms_in';
#==============format of qtl information===================
# a standard name for a genetic feature should be used consistently
# each qtl forms a file, file name is form by
#  1) name of trait gene (gene's expression profile is used a trait)
#  2) followed by a undersore '_'
#  3) followed by additional qtl identifier (a trait can have more than one qtls)
# within each file, there are genes/markers contained within a qtl,
# each line only one gene name
# 
# example:
# content of file 'YAL002W_1' (1st qtl of YAL002W)
# YHL002C-A
# YHLWtau1
# YHL013C
# CEN8
# YHLWdelta2
# YHL003C
# YHL001W
# ...
#=========================================================
my $filePath_working='G:\back\Downloads\doc\yeastAug05\svg';
my $filePath_gff='G:\back\Downloads\doc\yeastAug05\sources\saccharomyces_cerevisiae.gff';



my $insertGene='insert8.gene';
my %insert=();
if($insertGene){
	load_insert($insertGene);
}


my %featureList=();
gff();


my %eQTL_list=();
load_qtl();

my @groupList=();
my %groups=();
#load_group($filePath_working.'.\KEGG.MARK');

output();

sub load_group{
	open(IN,$_[0]) or die;
	while (<IN>) {
		if (/\#/) {
			next;
		}
		
		chomp;
		
		if (length($_)==0) {
			next;
		}
		
		my $group_id='';
		
		if (s/^(.*)=//) {
			if (length($1)>0){
				$group_id=$1;
				push(@groupList,$group_id);
				$groups{$group_id}=[split(/\s+/)];
			}
		}
	}
	close(IN);
}


sub output{
	open(OUT,'>.\svg\input.xml') or die;
	print OUT '<?xml version="1.0" encoding="ISO-8859-1"?>'."\n".'<QTLViewer>'."\n";
	print OUT "\t",'<setting>',"\n","\t\t",'<title>','Yeast eQTL Two Dimensional Plot','</title>',"\n";
	print OUT "\t\t",'<urlPrefix>http://db.yeastgenome.org/cgi-bin/locus.pl?locus=</urlPrefix>',"\n";
	print OUT "\t\t",'<traitOrder>group</traitOrder>',"\n"; 
	print OUT "\t",'</setting>',"\n";
	foreach my $eORF (keys %eQTL_list) {
		
		foreach my $pORFList (@{$eQTL_list{$eORF}}) {
			print OUT "\t",'<QTL>',"\n\t\t",'<ofTrait>',$eORF,'</ofTrait>',"\n";
			foreach my $pORF (@{$pORFList}) {
				print OUT "\t\t\t",'<onMap>',$pORF,'</onMap>',"\n";
			}
			print OUT "\t",'</QTL>',"\n";
		}
	}

	foreach my $f (keys %featureList) {
		print OUT "\t",'<marker name="',$f,'" chr="chromosome ',$featureList{$f}{chr},'" position="',$featureList{$f}{pos},'"/>',"\n";
	}
	
	foreach my $chr ((1..16)) {
		print OUT "\t",'<chr>chromosome '.$chr.'</chr>',"\n";
	}

	foreach my $g (reverse @groupList) {
#	foreach my $g (sort keys %groups) {
		print OUT "\t",'<group>',"\n";
		print OUT "\t\t",'<groupName>',$g,'</groupName>',"\n";
		foreach my $ele (@{$groups{$g}}) {
			print OUT "\t\t",'<member>',$ele,'</member>',"\n";
		}
		print OUT "\t",'</group>',"\n";
	}
	print OUT '</QTLViewer>';
	close(OUT);

}

sub gff{
	
	
	unless (open (GFF,$filePath_gff)){die;}
	while (<GFF>) {
		if (/FASTA/) {last;
		}

		if (/ID.*Name/) {
			my ($chr,$pos)=();

			my @space=split/\t/;
		
			if ($space[3]=~/\d+/ and $space[4]=~/\d+/) {
				$pos=($space[3]+$space[4])/2;
			}
			else{
				next;
			}

			$space[0]=~/chr(\w+)/;
			if (isroman($1)) {
				$chr= arabic($1)
			}
			else{
				if ($1 ne "Mito") {
					print $_;
					die ;
				}
				next;
			}

			$space[8]=~/ID=([-\.\)\(\w]+);.*Name=([-\.\)\(\w]+);/;

			if ($1 ne $2) {
				print $_."\n";
				die "error in $_ \n $1 not equal to $2\n";
			}
			
			$featureList{$1}{chr}=$chr;
			$featureList{$1}{pos}=$pos;

			if (exists $insert{$1}) {
				foreach my $i (@{$insert{$1}}) {
					$featureList{$i}{chr}=$chr;
					$featureList{$i}{pos}=$pos+1;
				}
			}
		}
	}
	close(GFF);


	print "number of feature in gff:",scalar keys %featureList,"\n";

}

sub load_qtl{
	
	opendir THISDIR, $filePath_eQTL_list  or die "serious dainbramage: $!";
	my @allfiles = grep /Y[A-P][LR]\d/,readdir THISDIR;
	closedir THISDIR;
	
	foreach my $file (@allfiles) {
		if (length($file)<4) {
			die;
		}
		$file=~/(.*)_/ or die;
		my $eORF=$1;

		open(IN,$filePath_eQTL_list.'\\'.$file) or die;
	
		my @genes=();
		while (<IN>) {
			chomp;
			next unless ($_);
			push(@genes,$_) ;
		}

		close(IN);

		push(@{$eQTL_list{$eORF}},[sort(@genes)]);
	}

}


sub load_insert{
	open(IN,$filePath_working.'\\'.$insertGene) or die;
	while (<IN>) {
		if (/\#/) {
			next;
		}
		chomp;
		if (length($_)==0) {
			next;
		}
		
		my @s=split(/\s+/);
		my $group_id=shift(@s) ;
		foreach my $gene (@s) {
			push(@{$insert{$group_id}},$gene);
		}
	}
	close(IN);
}
print "\a\a\a";