#! C:/Perl/bin/perl

use strict;
use warnings;
use Smart::Comments '###';

$| = 1;

my  $pattern = "JEJE";
my  $string = "EJKJUJHJDJEJEJEDEJOJOJJJAHJHJSHJEFEJUJEJUJKIJS";

my  $test_regex = _build_test( $pattern );
### $test_regex
for my $x ( 0..((length $string) - (length$pattern)) ){
    my $test_string = substr( $string, $x, length$pattern );
    my $score = _test_for_score( 1, $test_string, $test_regex );
    #### $test_string
    #### <where> - returned: $score
    if( $score and $score >= 2 ){
        print "String: $test_string, position: $x, score: $score\n";
    }
}

sub _test_for_score{
    my ( $min_score, $test_string, $test_regex ) = @_;
    my  $score = undef;
    my  $x = length $test_string;
    for my $regex ( reverse @$test_regex ){
        #### $x
        #### $regex
        if( $test_string =~ /$regex/ ){
            $score = $x;
            last;
        }
        $x--;
    }
    return $score;
}

sub _build_test{
    my ( $pattern ) = @_;
    my  $test_reg;
    my  $pattern_reg = [ split //, $pattern ];
    for my $substitutions ( 0..(length $pattern) ){
        my $return_reg = _build_score_reg( $substitutions, $pattern_reg );
        my $string = join '|', @$return_reg;
        # add the look ahead / look behind assertions to $string here ...
        $test_reg->[ (length $pattern) - $substitutions ] = qr/$string/;
        #### $test_reg
    }
    return $test_reg;
}

# This is the fuzzy regex build part
sub _build_score_reg{
    my ( $score, $pattern_reg, $finsished_pos ) = @_;
    $finsished_pos ||= 0;
    #### <where> - reached _build_score_reg
    #### <where> - score   : $score
    #### <where> - pattern : $pattern_reg
    #### <where> - complete: $finsished_pos
    my $sub_reg;
    if( $score == 0 ){
        $sub_reg->[0] = join '', @$pattern_reg;
    }else{
        for my $x ( $finsished_pos..$#$pattern_reg ){
            #### <where> - running position: $x
            last if ( $#$pattern_reg - $score + 1 ) < $x;
            my $copy_reg = [ @$pattern_reg ];# To not overwrite the passed reference
            $copy_reg->[$x] = '.';
            #### $copy_reg
            #### $finsished_pos
            my $recursive_reg = _build_score_reg( $score - 1, $copy_reg, $x + 1 );
            #### $recursive_reg
            push @$sub_reg, ( join '|', @$recursive_reg );
            #### $sub_reg
        }
    }
    #### $sub_reg
    return $sub_reg;
}