#!/usr/bin/perl

use strict;
use DBI;

# DBI

my ($dsn) = "DBI:mysql:database";
my ($user_name) = "";
my ($password) = "";
my ($dbh, $sth);
my (@ary);

#######################
# Connect to Database #
#######################

my $dbh         = DBI->connect ($dsn, $user_name, $password, { RaiseError => 1 });

#####################
# Statement Handles #
#####################

my $sth         = $dbh->prepare ("SELECT * FROM loxp_rev2");

print "plate\twell\twt\tmut\twt2\tmut2\tle\tre\tle2\tre2\tclass\tpos1\tpos2\tpos3\tpos4\tpos5\tpos6\tpos7\tpos8\tcount\n";

$sth->execute();

while ( my $href = $sth->fetchrow_hashref ) {

  my $flag = 'perfect_match';
  my @mismatch = (0,0,0,0,0,0,0,0);

	my $plate	= $href->{plate};
	my $well	= $href->{well};
	my $wt1   = revcom($href->{wt});
	my $mut1  = revcom($href->{mut});
	my @wt1   = split(//,$wt1);
	my @mut1  = split(//,$mut1);
	my $count = 0;
	my @mismatch = (0,0,0,0,0,0,0,0);
	my $le = $wt1; 
	my $re = $mut1;
	my ($wt2,$mut2,@wt2,@mut2,$le2,$re2); # store theoretical second read in these variables

	if ($wt1 ne $mut1) {

		$le = $mut1[0] . $wt1[1] . $wt1[2] . $wt1[3] . $wt1[4] . $wt1[5] . $wt1[6] . $wt1[7];
		$re = $wt1[0] . $mut1[1] . $mut1[2] . $mut1[3] . $mut1[4] . $mut1[5] . $mut1[6] . $mut1[7];

		$wt2 	= $wt1[0] . $mut1[1] . $mut1[2] . $mut1[3] . $mut1[4] . $mut1[5] . $mut1[6] . $wt1[7];
		$mut2	= $mut1[0] . $wt1[1] . $wt1[2] . $wt1[3] . $wt1[4] . $wt1[5] . $wt1[6] . $mut1[7];

		@wt2 	= split(//,$wt2);
		@mut2	= split(//,$mut2);

		$le2 = $mut2[0] . $wt2[1] . $wt2[2] . $wt2[3] . $wt2[4] . $wt2[5] . $wt2[6] . $wt2[7];
		$re2 = $wt2[0] . $mut2[1] . $mut2[2] . $mut2[3] . $mut2[4] . $mut2[5] . $mut2[6] . $mut2[7];

		if (($le eq $le2) && ($re eq $re2)) {
			$flag = 'clean';
		} elsif (($le eq $re2) && ($le2 eq $re)) {
			$flag = 'clean_unclear_origin';
		} else {
			$flag = 'ambiguous';
		}

		my $i	= 0;

		while ($i < 8) {
	
		if ($wt1[$i] ne $mut1[$i]) {
			$mismatch[$i] = 1;
			$count++;
		}
				
#		print $i+1 . "\t" . $wt1[$i] . "\t" . $mut1[$i] . "\n";
		$i++;

		}
	}
	print "$plate\t$well\t$wt1\t$mut1\t$wt2\t$mut2\t$le\t$re\t$le2\t$re2\t$flag\t$mismatch[0]\t$mismatch[1]\t$mismatch[2]\t$mismatch[3]\t$mismatch[4]\t$mismatch[5]\t$mismatch[6]\t$mismatch[7]\t$count\n";
}

sub revcom {

	use strict;

	my($dna) = @_;

	my $revcom_dna = reverse $dna;
	$revcom_dna =~ tr/atgcATGC/tacgTACG/;
	return($revcom_dna);
}