#!/usr/bin/perl

use strict;
use Data::Dumper;

my %params = getParams();

opendir(DIR,".");
my @validated_files;
my $status;
while (my $file = readdir(DIR))
{
  if ($file =~ m/^chr.{1,2}\.xml\.\d+\.valid/)
  {
    if ($params{chr} eq "0")
    {
     $status = "Complete Genome";
     push @validated_files, $file; 
    }
    else
    {
      $status = "Chr".$params{chr};
      push @validated_files, $file if ($file =~ m/chr$params{chr}\./);
    }
  }
}
print "Processing : $status\n";
@validated_files = sort  @validated_files;

my $last_chr = "";
my $current_chr = "";
my %probes;


for (my $i=0; $i<@validated_files; $i++)
{
      
   ($current_chr) = ($validated_files[$i] =~ m/^chr(.+?)\./);
   if ($current_chr ne $last_chr)
   {
     print "\nProcessing Chr$current_chr\n";
     if ($last_chr ne "")
     {
        print UNIQUE "</probe_results>\n\n";
        print NON_UNIQUE "</probe_results>\n\n";
        close UNIQUE;
        close NON_UNIQUE;
     }

     $last_chr = $current_chr;
     my $chr_file = "chr$current_chr.xml";
   
     %probes = index_file($chr_file, "human");  
    
     open(PROBES, "<$chr_file");
     

     open(UNIQUE,">>chr$current_chr.probes.xml.valid");
     print UNIQUE "<?xml version='1.0' encoding='ISO-8859-1'?>\n\n"; 
     print UNIQUE "<probe_results>\n\n";

     open(NON_UNIQUE,">>chr$current_chr.probes.xml.invalid");
     print NON_UNIQUE "<?xml version='1.0' encoding='ISO-8859-1'?>\n\n"; 
     print NON_UNIQUE "<probe_results>\n\n";
     
   } 
  
   print "Processing --> $validated_files[$i]\n";

   open(FILE, "<".$validated_files[$i]);
    
   my $tmp_ctr = 0;
   my $mask_ctr = 0;
   my $species = "";
   my $probe_cnt=0;
    
   while(<FILE>)
   {
      my $result;
      my $header;
      my $start_bp=0;
      my $end_bp = 0;

      if (($_ =~ tr/ //) == 1)
      {
        ($result, $header) = ($_ =~ m/^(.+) (.+)$/);
      }
      else
      {
        ($result, $header, $start_bp, $end_bp) = ($_ =~ m/^(.+) +(.+) +(\d+) +(\d+)$/);
      }

      if ($species eq "")
      {
        ($species) = ($header =~ m/^(.+?),/);
      }
      if (exists($probes{$header}))
      {

        if ($result eq "VALID")
        { 
          printProbe(\*UNIQUE, \*PROBES, $probes{$header}, $species, $start_bp, $end_bp);
        }
        elsif ($result ne "NOT_FOUND")
        {
          printProbe(\*NON_UNIQUE, \*PROBES, $probes{$header}, $species, $start_bp, $end_bp);
        }
      }
   }
   close FILE;
}




sub printProbe
{
  local *OUTFILE = shift;
  local *INFILE  = shift;
  my $position   = shift;
  my $species    = shift;
  my $start_bp   = shift;
  my $end_bp     = shift;

  seek INFILE, $position, 0;
  my $rc = fileno(OUTFILE);
  #print "RC [$rc]\n";
  my $found_species = 0;
  while (($_ = <INFILE>) !~ m/<\/probe>/)
  {
     $found_species = 1 if ($_ =~ m/<name>$species<\/name>/);

     if ($found_species == 1) 
     {
        my ($tag) = ($_ =~ m/^.+?<(.+?)>/);
        if (($tag eq "probe_start") && ($start_bp > 0))
        {
          print OUTFILE "         <probe_start>$start_bp</probe_start>\n";
        }
        elsif (($tag eq "probe_end") && ($end_bp > 0))
        {
          print OUTFILE "         <probe_end>$end_bp</probe_end>\n";
          $found_species = 0;
        }
        else
        {
          print OUTFILE $_;
        }
      
     }
     else
     {
       print OUTFILE $_;
     }
  }
  print OUTFILE $_;
  print OUTFILE "\n";

  return;
}




sub index_file
{
  my $file = shift;
  my $species = shift;
  my %lookup;
  print "Indexing file [$file]\n";
  open (FILE,"<".$file);
  while (<FILE>)
  {
    my $header = "";
    if ($_ =~ m/<probe>/)
    {
      my $fp = tell FILE;      
      $fp = $fp - length($_);
      while (($_= <FILE>) !~ m/<\/probe>/)
      {
        if ($_ =~ m/$species/)
        {
          $header = $species;
          $_ = <FILE>;
          $_ = <FILE>;
          $_ = <FILE>;
          my ($chromosome) = ($_ =~ m/chromosome>(.+)</);
          $header .= ",$chromosome";
          $_ = <FILE>;
          my ($start) = ($_ =~ m/start>(.+)</);
          $header .= ",$start";
          $_ = <FILE>;
          my ($end) = ($_ =~ m/end>(.+)</);
          $header .= ",$end";
          $lookup{$header} = $fp;
        }
      }
    }
  }
  return %lookup;
}

#########################################################################
# getParams - gets all options from the command line or keeps defaults
#             dies if required options are not included
#
#########################################################################
sub getParams {
    my %opts;
    my $errstr = "";
    use Getopt::Long;
    use Data::Dumper;
 
    GetOptions(\%opts, 'help','chr:s');
    if ($opts{help})
    {
      $errstr = " ";
    }

    if ($errstr) {
        print <<"END_USAGE";
Usage: separate_probes.pl [-mask] 

Probe Sources:
-mask                  OPTIONAL - if set, the probes that are invalid will be masked out of the axte file.

END_USAGE
        print "\n$errstr" if ($errstr);
        die("\n");
    }
    return (
            chr  => $opts{chr} || "0"
           );
}


##############################################################################
# Start Description
# For one chromosome, match validation results with full XML probe information to produce two output file, one limited to unique probes and the other to non-unique probes.
#
#
# End Description
##############################################################################