#!/usr/bin/perl --
use warnings; use strict;
use autodie;
Main( @ARGV );
exit( 0 );
sub Main {
#~     RegPosOut910992( 'testReg.txt', 'testPos.txt', 'testOut.txt' );
    if( @_ == 3 ){
        RegPosOut910992( @_ );
    } else {
        RPSDemo();
    }
}

sub RegPosOut910992 {
    my( $region, $position , $writeOut  )= @_;
    use autodie;
    open my $Reg, '<', $region;
    open my $Pos, '<', $position;
    open my $Out, '>', $writeOut;
    
RLINE:
    while( my $rline = <$Reg> ){
        my @r_arr = MeaningfullName( $rline );
        seek $Pos, 0,0; # Rewind!!!
PLINE:
        while( my $pline = <$Pos> ){
            my @p_arr = MeaningfullName( $pline );
            next PLINE if $p_arr[1] > $r_arr[2];
            if( IsMeaningfulName( \@p_arr, \@r_arr ) ){
                print $Out Laundromat( \@p_arr, \@r_arr ) ;
            }
        }
    }
} ## end sub RegPosOut910992

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",
            "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;
    $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__

    RegPosOut910992 ( \$region, \$position, \my $actualOutput );
    warn "\n$actualOutput\n";
    $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" );
} ## end sub RPSDemo