use CGI qw(:standard);
use strict;

print   header;



BEGIN{ push @INC,'C:/src/String-1.5','C:/src/bioperl-live','C:/src/ensembl/modules','C:/src/ensembl-compara/modules','C:/src/ensembl-variation/modules','C:/src/ensembl-functgenomics/modules','C:/src/DBD-mysql-4.021';};

use strict;
use warnings;
use string;
my $T_one='GAATTCACGGATAGCCWGGTACGATGATAGATGAATTCGACTAGAATGCCWGGAAGAATgGAATTC';
my $Ta='GAATTCACGGATAGCCWGGTACGATGATAGATGAATTCGACTAGAATGCCWGGAAGAATgGAATTC';
my $rr='GAATTCACGGATAGCCWGGTACGATGATAGATGAATTCGACTAGAATGCCWGGAAGAATgGAATTC';
my @P=('GAATTC','CCWGG');
my @next;
my @loc;
my $m;
my $l=0;
my $lt;my $T;
my @text=(0);
my @tt=($T_one,$Ta,$rr);

for(my $i=0;$i<3;$i++){  $T=$tt[$i];

	@loc=();
	print "<\br>";  
				
	@text=();
		 my $str = new String($T);   # USE  OF STRING MODULE TO FETCH THE SEQUENCE
		print  "length of gene sequence array     ", $lt= $str->length, "\n";    # LENGTH OF THE SEQUENCE
		  $lt= $str->length;
		  my $z=0;                         # FOR ARRAY INCREMENT
		      for(my $k=0; $k<$lt;$k++){
		      	 $text[$z]=$str->charAt($k);   #ASSIGNING THE ARRAY OBJECT VALUES TO AN ARRAY
		      	$z++;
		  	   } #END OF FOR LOOP
				
			
		foreach my $P(@P){
						print knuth_morris_pratt($T,$P);
						print"\n";
						}
						
				
				
				
				@loc = sort {$a <=> $b} @loc;
				print"</br>";print "@loc";print "</br>";
				

				my $i=0;
						for(my $k=0;$k<$lt;$k++){
							print $i;
							if ($k == $loc[$i]){ 
								print "<span style=background-color:red;>" .  $text[$k] . "</span>";
								$i++;
								 
							}
							else
							{ print $text[$k];
								
							}
						}  # end of $k for loop

#print"\n";print "@loc";print "<\n>";
                         # FOR ARRAY INCREMENT
		      print "</br>";
}   #end of $T for each loop











sub knuth_morris_pratt_next {
    my ( $P ) = @_; # The pattern.
    use integer;
    $m=length $P;
    my ($i, $j ) = (  0, -1 );
    
    for ($next[0] = -1; $i < $m; ) {
        # Note that this while() is skipped during the first for() pass.
        while ( $j > -1 &&
                substr( $P, $i, 1 ) ne substr( $P, $j, 1 ) ) {
            $j = $next[ $j ];
        }
        $i++;
        $j++;
        $next[ $i ] =
            substr( $P, $j, 1 ) eq substr( $P, $i, 1 ) ?
                $next[ $j ] : $j;
    }
   return ( $m, @next ); # Length of pattern and prefix function.
}

#######################################
sub knuth_morris_pratt {
    my ( $T, $P ) = @_; # Text and pattern.
    use integer;
    my( $m, @next) = knuth_morris_pratt_next( $P );
    my ( $n, $i, $j ) = ( length($T), 0, 0 );
 
    while ( $i < $n ) {
        while ( $j > -1 && substr( $P, $j, 1 ) ne substr( $T, $i, 1 ) ) {
            $j = $next[ $j ];
        }
        $i++;
        $j++;
       
       if($j >= $m){  my $a=$i-$j;
       	
       #	$j=$j-1;print "\n";
       	
       	$j=$next[$j];
       	
       	for(my $z=0;$z<$m;$z++){
       	$loc[$l]=$a;
        $l++;
        $a++;
       	}
       
       }
        
    }
    return ; # Mismatch. 
     
}
#################################