#!/usr/bin/perl --
use warnings; use strict;
use autodie;

Main( @ARGV );
exit( 0 );
sub Main {
#~     RPSFiles( @_ );
#~     RPSFiles( 'testReg.txt', 'testPos.txt', 'testOut.txt' );
    RPSDemo();
}

sub RPSFiles{
    my( $region, $position , $writeOut  ) = @_;
    use autodie; # die if open/close..... fails
    open my $Reg, '<', $region;
    open my $Pos, '<', $position;
    open my $Out, '>', $writeOut;
    RegPosOut910992 ( $Reg, $Pos, $Out );
    close $Reg;
    close $Pos;
    close $Out;
}

sub RegPosOut910992 {
    my( $Reg, $Pos, $Out ) = @_;

#~     my $rline; 
#~     my $pline; 


    RLINE: while (my $rline=<$Reg>) {
#~         chomp($rline);
#~             my @r_arr=split("\t",$rline);
#~                 
#~                 chomp($r_arr[0]);
#~                 my @rID = split("r",$r_arr[0]);
#~                 $r_arr[0] = $rID[1]; #this removes the "chr" portion of the first element and leaves number
#~                 #i.e. instead of [0] -> "chr24"; [0] -> "24"
        my @r_arr = MeaningfullName( $rline );

        seek $Pos, 0,0; # Rewind!!!
        PLINE: while(my $pline=<$Pos>) {			
#~                 if(!$rline) {
#~                     last;
#~                 }
            
#~             chomp($pline);
#~                 my @p_arr=split("\t",$pline);
#~                 
#~                     chomp($p_arr[0]);
#~                     my @pID = split("r",$p_arr[0]);
#~                     $p_arr[0] = $pID[1];
            my @p_arr = MeaningfullName( $pline );
            
                if($p_arr[1] > $r_arr[2]) {
#~                   $rline=<$Reg>; 
#~                   redo;
                  next PLINE;
                }
            
                else {				
#~                       if($p_arr[0] == $r_arr[0] && $p_arr[1] >= $r_arr[1] && $p_arr[1] <= $r_arr[2]) {
                      if( IsMeaningfulName( \@p_arr, \@r_arr ) ) {
#~                         #NOTE: [0] element in each array now corresponds to chr number
#~                         # r[1] is start of region and r[2] is end of region
#~                         # p[1] is the position of the base pair
#~                         shift(@p_arr);
#~                         print ($Out "chr$r_arr[0]\t$r_arr[1]\t$r_arr[2]\t$r_arr[3]\t"); 
#~                             print $Out join ("\t", @p_arr), "\n"; 
#~                             #essentially I'm joining the two files with matching lines
#~                             #w/ columns separated by tab
                            print $Out Laundromat( \@p_arr, \@r_arr ) ;
                       }
                }
        } 
    }
#~     close $Reg;
#~     close $Pos;
#~     close $Out;

}

sub Laundromat {
    my ( $p_arr , $r_arr ) = @_;
    return
        "chr$$r_arr[0]\t$$r_arr[1]\t$$r_arr[2]\t$$r_arr[3]\t"
        . join (
            "\t",
#~             @{$p_arr}[ 1 .. $#$p_arr ],
            "chr$$p_arr[0]",
            @{$p_arr}[ 1 .. $#$p_arr ],
        ), "\n";
}


sub IsMeaningfulName {
    my ( $p_arr , $r_arr ) = @_;
    return scalar(
        $$p_arr[0] == $$r_arr[0]
        and
        $$p_arr[1] >= $$r_arr[1]
        and
        $$p_arr[1] <= $$r_arr[2]
    );
}

sub MeaningfullName {
    my @eaning = grep length, split /\s+/, shift;
#~ use YAPE::Regex::Explain ;
#~ die YAPE::Regex::Explain->new(qr/\D/)->explain;
    $eaning[0] =~ s/\D//g;
    return @eaning;
}

sub RPSDemo {
#~ http://perlmonks.com/?abspart=1;displaytype=displaycode;node_id=911103;part=2
    my $region = <<'__REGION__';
chr1	100	159	0
chr1	200	260	0
chr1	500	750	0
chr3	450	700	0
chr4	100	300	0
chr7	350	600	0
chr9	100	125	0
chr11	679	687	0
chr22	100	200	0
chr22	300	400	0
__REGION__

#~ http://perlmonks.com/?abspart=1;displaytype=displaycode;node_id=911103;part=1
    my $position = <<'__POSITION__';
chr1	104	104	0	0	+
chr1	145	145	0	0	+
chr1	205	205	0	0	+
chr1	600	600	0	0	+
chr3	500	500	0	0	+
chr4	150	150	0	0	+
chr4	175	175	0	0	+
chr7	400	400	0	0	+
chr7	550	550	0	0	+
chr9	100	100	0	0	+
chr11	680	680	0	0	+
chr11	681	681	0	0	+
chr22	105	105	0	0	+
chr22	110	110	0	0	+
chr22	350	350	0	0	+
__POSITION__

#~ 2011-06-24-16:23:33
#~ http://perlmonks.com/?abspart=1;displaytype=displaycode;node_id=911112;part=1
    my $wantedOutput = <<'__CORRECT_OUTPUT__';
chr1	100	159	0	chr1	104	104	0	0	+
chr1	100	159	0	chr1	145	145	0	0	+
chr1	200	260	0	chr1	205	205	0	0	+
chr1	500	750	0	chr1	600	600	0	0	+
chr3	450	700	0	chr3	500	500	0	0	+
chr4	100	300	0	chr4	150	150	0	0	+
chr4	100	300	0	chr4	175	175	0	0	+
chr7	350	600	0	chr7	400	400	0	0	+
chr7	350	600	0	chr7	550	550	0	0	+
chr9	100	125	0	chr9	100	100	0	0	+
chr11	679	687	0	chr11	680	680	0	0	+
chr11	679	687	0	chr11	681	681	0	0	+
chr22	100	200	0	chr22	105	105	0	0	+
chr22	100	200	0	chr22	110	110	0	0	+
chr22	300	400	0	chr22	350	350	0	0	+
__CORRECT_OUTPUT__

    open my $Reg, '<', \$region;
    open my $Pos, '<', \$position;
    open my $Out, '>', \my $actualOutput;
    
#~     RegPosOut910992 ( $Reg, $Pos, \*STDOUT );
    RegPosOut910992 ( $Reg, $Pos, $Out );
    
    $wantedOutput =~ s/[\r\n]+/\n/g; # just in case
    $actualOutput =~ s/[\r\n]+/\n/g;
    require Test::More;
    Test::More->import(qw' tests 1 ');
    Test::More::is( $wantedOutput , $actualOutput, "RPSDemo works" );
}