#! perl -slw
use strict;
use 5.014;
use Time::HiRes qw[ time ];

my %tests = (
    tye => sub {
        state $re = qr[^((.*?).*?)(?=.)\1*\2$];
        my $r = shift;
        $$r =~ $re and return $1;
        return;
    },
    choroba => sub {
        state $re = qr[^((.*).*)\1*\2$];
        my $r = shift;
        $$r =~ $re and return $1;
        return;
    },
    damianc => sub {
        state $re = qr[
            ^(.+?)(?{$^N}) ## $1 as $^R
            (?| \1+$()     ## Exact rep, no $2
              | \1*(.+)$   ## Partial rep as $2
                  ## Check its a proper prefix
                  (??{ $^N eq substr( $^R, 0, length($^N)) ? '' : '(?!)' })
            )
        ]x;
        my $r = shift;
        $$r =~ $re and return $1;
        return;
    },
    tobyink => sub {
        my $input  = shift;
        my $length = length $$input;

        for my $i ( 1 .. $length ) {
            my $possible = substr( $$input, 0, $i );
            my $repeated = $possible x ( 1 + int( $length / $i ) );
            return $possible if $$input eq substr( $repeated, 0, $length );
        }
        return;
    },
    hdb => sub {
        my $input = shift;
        my $length = length $$input;
        my $i = 0;
        my $possible;
        while( 1 ) {
            $possible = substr $$input, 0, $i+1; # increase length by 1
            $i = index $$input, $possible, $i+1; # find next occurence of candidate
            return if $i < 0;            # if not found return full string => no repetition
            $possible = substr $$input, 0, $i;   # this is the minimum length candidate
            return $possible if $$input eq substr( $possible x ( 1 + int( $length / $i ) ), 0, $length ); # success
        }
    },
    Eily => sub {
        my $input = shift;
        local $_ = reverse $$input;
        /^(.*)(.+?\1)\2*$/ and return reverse $2;
        return;
    },
    anomalous => sub {
        state $re = qr[ \A (.+?) \1* (.*) (?(?{ 0 != index $1, $2 }) (*FAIL)) \z ]xms;
        my $r = shift;
        $$r =~ $re and return $1;
        return
    },
    svc4 => sub {
        my $search = shift;
        my $tail_length = 1;
        my $tail_step   = int( length( $$search ) / 2 );

        while ($tail_step > 0) {
            $tail_length += $tail_step
                while substr( $$search, 0, $tail_length + $tail_step )
                eq    substr( $$search, -( $tail_length + $tail_step ), ( $tail_length + $tail_step ) )
            ;
            $tail_step = int( $tail_step / 2 );
        }

        my $body_length = length( $$search ) - $tail_length;
        my $longest = $body_length;
        my $n = $body_length - 1;
        while( $n > 1 ) {
            if( ( $body_length % $n ) == 0 ) {
                if( substr( $$search, 0, $n ) eq substr( $$search, $n, $n ) ) {
                    $longest = $n;
                    last;
                }
            }
            $n--;
        }
        return substr( $$search, 1, $longest );
    },
);

our $SHOW //= 1;

## basic functionality
my $base = 'fredfre';
for my $rep ( 2 .. 3 ) {
    my $full = $base x $rep;
    for my $x ( 1 .. length( $base ) ) {
        my $str = substr( $full, 0, -$x ); ## make partial
        print "Looking for '$base' in '$str'";
        for my $test ( keys %tests ) {
            my $res;
            eval {
                local $SIG{ALRM} = sub { die "timeout" };
                alarm 10;
                $res = $tests{ $test }->( \$str ) // 'none found';
                alarm 0;
            };
            $SHOW and printf "%10s -> %s\n", $test, $res // $@;
            if( $res ne $base and not $base eq $str
            or $@ eq 'timeout'
            ) {
                delete $tests{ $test };
                printf "\n%10s found '%s'; excluded from further consideration\n\n",
                    $test, $res // $@
                ;
            }
        }
    }
}
print "Partisipants in performance tests: @{[ keys %tests ]}";
exit;