#!/usr/bin/perl


#ProcessResult("hallo");
#exit;

if($#ARGV == -1) {
    print "Bitte Argument angeben: Fasta Datei.\n";
    exit;
}

my $fastafile = $ARGV[0];

if (-e $resultfile) {
    system("rm $resultfile");
}

my $postfile = "postfiletmp";
my $domain = "http://www.cbrc.jp";

open(FASTAFILE, '<', "$fastafile");
my $postdata;


# Dies ist die Hauptschleife in der die Matrize(n) extrahiert und
# und an MatCompare geschickt werden. Die Resultate werden alle 
# an die Datei $resultfile rangehaengt. Nach dieser Schleife werden
# zum Abschluss alle Eintrage aus der Resultatsmenge nach der 
# Wahrscheinlichkeit (0.9) ausgesondert und in $resultfile  
# geschrieben.

my $label;
my $nextline;

while (<FASTAFILE>) {


    if(($_ =~ m/^>/) || ($nextline =~ m/>/)) {
    
	if($nextline =~ m/>/) {
	    $nextline =~ s/>//;
	    $nextline =~ s/ //;
	    chop($nextline);

	    # Brauchen dieses label fuer ProzessResult()
	    $label = $nextline;

	    $postdata = "taxonomy=V&label=$label&seq=";
	    $postdata .= $_;

	} else {

	    $_ =~ s/>//;
	    $_ =~ s/ //;
	    chop($_);

	    # Brauchen dieses Label fuer ProzessRequest()
	    $label = $_;

	    $postdata = "taxonomy=V&label=$label&seq=";
	}

	while (<FASTAFILE>) {
	    
	    if(($_ =~ m/^>/) || (length($_) == 1)) {
		$nextline = $_;
		last;
	    } else {
		$postdata = $postdata . $_;
	    }
	}

	# speicher Postdata zum versenden an TFSearch
	open(POSTFILE, '>', $postfile);
	print POSTFILE $postdata;
	close(POSTFILE);

	# schicke post
	print "\nSende Post Request: \n";
	system("cat $postfile\n");
	system("wget -O wget.result --post-file $postfile $domain/htbin/nph-tfsearch");
	
	system("rm $postfile");

	ProcessResult($label);

    } # end if($_ =~ m/M./) #
}

close(FASTAFILE);

if(-e "wget.result") {
   # system("rm wget.result");
}

exit;



sub ProcessResult {
    
    # nimm parameter - Name des promoters
    my($alabel) = @_;
    
    open(WGETRESULT, "<wget.result");
    
    # Lese Datei in array
    my @lines = <WGETRESULT>;
    close(WGETRESULT);

    my $line;
    my $region;

    my @motif;
    my @promoter;
    my @score;
    my @start;
    my @end;
    my @nextbase;
    my @strand;
    my @sequences;

    my $deletechars;
    my $direction; # 1 => forward; 0 => reverse
    my @field;

    my @resultline;

    # The sequence offset of the region.
    my $baseoffset;
    my $sequence;

    for(my $loop1 = 0; $loop1 < $#lines; $loop1++) {


	if($lines[$loop1] =~ m/^\s+[0-9]+\s+/){
	    @field = split(" ", $lines[$loop1]);
	    $baseoffset = $field[0];

	    $sequence = substr($lines[$loop1], 4, index($lines[$loop1], "entry") - 4);
	    $sequence =~ s/ //g;

	    next;
	}


	if($lines[$loop1] =~ m/>M[0-9]*</) {

	    $deletechars = 0;

	    $line = $lines[$loop1];
	    @field = split(" ", $line);
	   
	    push @motif, substr($field[2], rindex($field[2], "M"), rindex($field[2], "<") - rindex($field[2], "M"));
	    push @score, $field[4];
	    push @promoter, $field[3];
	    

	    my $offset1 = 0;
	    my $offset2 = 0;

	    # 57 is the max length of the marking region.
	    # The marking region is the area where the arrows are painted
	    # underneath the sequence.
	    # Prepare input string: cut first 5 blank charakters.

	    $line = substr($line, 5);
	    @field = split("<", $line);
	    $region = $field[0];
	    $region =~ s/&lt;/</;
	    

	    for(my $i = 1; $i < length($region); $i++) {
		
		$ch = substr($region, $i - 1, 1);


		# look for end of marking region
		if(($offset1 != 0) && ($ch =~ m/ /)) {
		    		    			
		    $offset2 = $baseoffset + $i - 2 - $deletechars;
		    
		    # go out
		    last;
		}

		# look for start of marking region Corrected by Julian Jöris || (($ch =~ m/>/) && $i == 1)
		if((($ch =~ m/&/) || ($ch =~ m/-/) || ($ch =~ m/</)  || (($ch =~ m/>/) && $i == 1)) && ($offset1 == 0)) {
		    $offset1 = $baseoffset + $i - 1 - $deletechars;

		    if($ch =~ m/</) {
			$direction = 0;   # reverse
			
		    } else {
			$direction = 1;   # forward
		    }
		}
		
		# consider empty charakter in regions (10 base blocks)
		if(($i % 11) == 0 ) {
		    $deletechars++;
		}

	    } # end for (my $i ...) 
	    
	    push @nextbase, $baseoffset + 50;
	    push @start, $offset1;
	    push @end, $offset2;
	        # debug: if offset2 == 0 (overlapping) by Julian Jöris
	    if($offset2 == 0) {
	    	push @sequences, substr($sequence, $offset1 - $baseoffset);
	    } else {
	    	push @sequences, substr($sequence, $offset1 - $baseoffset, $offset2 - $offset1 + 1);
	    }
	    # push @sequences, substr($sequence, $offset1 - $baseoffset, $offset2 - $offset1 + 1);
	    push @strand, $direction;


	} # end if

    } # end for


    # put together the discontinues pieces
    for($i = 0; $i < $#motif; $i++ ) {
	
	if(($end[$i] == 0) && (length($motif[$i]) > 0)) {

	    my $contfound = 0;

	    for($j = $i + 1; $j < $#motif; $j++) {
				
		if(($start[$j] == $nextbase[$i]) && ($motif[$i] eq $motif[$j])) { # == substituted by eq Julian Jöris

		    $end[$i] = $end[$j];
		    $sequences[$i] .= $sequences[$j];
		    delete $motif[$j];
		    $contfound = 1;
		    last;
		}
	    }

	    if($contfound == 0) {
		$end[$i] = $nextbase[$i] - 1;
	    }
	}
    }

    # look for dublicates with a little tolerance (can happen with same pieces matching reverse and forward)
#    for($i = 0; $i < $#motif; $i++ ) {
#	
#        if(length($motif[$i]) > 0) {
#
#	    for($j = $i + 1; $j < $#motif; $j++) {
#
#               if(( (($start[$j] - $start[$i]) < 5)) && (($start[$j] - $start[$i]) > -5)) {
#		    if(( (($end[$j] - $end[$i]) < 5)) && (($end[$j] - $end[$i]) > -5)) { 
#                    
#			if($score[i] > $score[$j]) {
#			    delete $motif[$j];
#			} else {
#			    delete $motif[$i];
#
#		        }
#			last;
#		    }
#		}
#	    }
#       }
#    }


    # build the line 

    for ($i = 0; $i <=$#motif; $i++) { # < substituted by <= Julian Jöris

	if(length($motif[$i]) > 0) {
	    
	    $score[$i] = $score[$i] / 100;
	    $score[$i] = sprintf("%.2f", $score[$i]);

	    push @resultline, $start[$i] . "\t" . $end[$i] . "\t" . $score[$i] . "\t" . $motif[$i] . "\t" . $sequences[$i] . "\ttfsearch\t" . $strand[$i]. "\t$alabel\n";
	}

    }

    open(RESULTFILE, ">$alabel.tf.data");
    print RESULTFILE @resultline;
    close(RESULTFILE);

}


