#!/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 );
}

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

    my $rline; 
    my $pline; 

    while ($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 th
+e first element and leaves number
            #i.e. instead of [0] -> "chr24"; [0] -> "24"

        while($pline=<$Pos>) {            
                if(!$rline) {
                    last;
                } #end if
            
            chomp($pline);
            my @p_arr=split("\t",$pline);
            
                chomp($p_arr[0]);
                my @pID = split("r",$p_arr[0]);
                $p_arr[0] = $pID[1];
            
                if($p_arr[1] > $r_arr[2]) {
                  $rline=<$Reg>; 
                  redo;
                } #end if
            
                else {                
                      if($p_arr[0] == $r_arr[0] && $p_arr[1] >= $r_arr
+[1] && $p_arr[1] <= $r_arr[2]) {
                        #NOTE: [0] element in each array now correspon
+ds to chr number
                        # r[1] is start of region and r[2] is end of r
+egion
                        # 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 wit
+h matching lines
                            #w/ columns separated by tab
                       } #end if
                } #end else        
        } # end while <$Pos>    
    } #end while <$Reg>
    close $Reg;
    close $Pos;
    close $Out;

}

sub RPSDemo {
    my $region = <<'__REGION__';
chr1  400  500  0  0  +
chr1  600  700  0  0  +
chr3  200  225  0  0  +
chr4  650  700  0  0  +
chr7  100  120  0  0  +
chr7  300  400  0  0  +
__REGION__

    my $position = <<'__POSITION__';
chr1  415  0  0  +
chr1  600  0  0  +
chr3  205  0  0  +
chr4  681  0  0  +
chr7  110  0  0  +
chr7  350  0  0  +
__POSITION__

    open my $Reg, '<', \$region;
    open my $Pos, '<', \$position;
    RegPosOut910992 ( $Reg, $Pos, \*STDOUT );
}
[download]