use v5.14;
use Test::More;
use Benchmark qw(:all);
use IO::Callback;

my @I;

package RNO {
    use Moo::Role;
    requires 'replace_nth_comma';
    
    my @gamut = (
        ['a|b,c,d', 1, 'a,b,c,d'],
        ['a,b|c,d', 2, 'a,b,c,d'],
        ['a,b,c|d', 3, 'a,b,c,d'],
        ['aa,bb,cc|dd', 3, 'aa,bb,cc,dd'],
        ['|,,', 1, ',,,'],
        [',|,', 2, ',,,'],
        [',,|', 3, ',,,'],
        [',,,', 4, ',,,'],
    );
    
    sub test_count { scalar @gamut };
    
    sub test {
        my $class = shift;
        my $passes;
        for my $t (@gamut) {
            my ($target, @args) = @$t;
            my $result = $class->replace_nth_comma(@args);
            $passes += ::is($result, $target, "$class, target $target"
+);
        }
        return $passes;
    }
    
    sub bench {
        my $class = shift;
        for my $count (0..63) {
            for my $t (@gamut) {
                my ($target, @args) = @$t;
                my $result = $class->replace_nth_comma(@args);
            }
        }
    }
}

# OP
package RNO_1004836 { 
    use Moo; with 'RNO';
    push @I, __PACKAGE__;
    sub replace_nth_comma {
        my (undef, $count, $str) = @_;
        $count++;  # off by one
        $str =~ s/(,)/--$count == 1 ? "|":$1/ge;
        return $str;
    }
}

# AnomalousMonk
package RNO_1004848 {
    use Moo; with 'RNO';
    push @I, __PACKAGE__;
    sub replace_nth_comma {
        my (undef, $count, $str) = @_;
        $count--;  # off by one, other way
        $str =~ s{ (?: , [^,]*){$count} \K , }{|}xms;
        return $str;
    }
}

# Kenosis
package RNO_1004858 {
    use Moo; with 'RNO';
    push @I, __PACKAGE__;
    sub replace_nth_comma {
        my (undef, $count, $str) = @_;
        $str =~ s/(,)/!--$count ? '|' : $1/ge;
        return $str;
    }
}

# choroba
package RNO_1004892 {
    use Moo; with 'RNO';
    push @I, __PACKAGE__;
    sub replace_nth_comma {
        my (undef, $count, $str) = @_;
        my $pos = '0E0'; # plain 0 means the string begins with $from
        while ($count-- and $pos >= 0) {
            $pos = index $str, q(,), $pos eq '0E0' ? $pos : $pos + 1;
        }
        substr $str, $pos, 1, q(|) if $pos > 0;
        return $str;
    }
}

# trizen
package RNO_1004895 {
    use Moo; with 'RNO';
    push @I, __PACKAGE__;
    sub replace_nth_comma {
        my (undef, $count, $str) = @_;
        while ($str =~ /,/g) {
            if (--$count == 0) {
                substr($str, $-[0], $+[0] - $-[0], '|');
                last;
            }
        }
        return $str;
    }
}

# grizzley
package RNO_1004906 {
    use Moo; with 'RNO';
    push @I, __PACKAGE__;
    sub replace_nth_comma {
        my (undef, $count, $str) = @_;
        $count--;  # off by one, other way
        $str =~ s/((,.*?){$count}),/$1|/;
        return $str;
    }
}

# LanX
package RNO_1005026 {
    use Moo; with 'RNO';
    push @I, __PACKAGE__;
    sub replace_nth_comma {
        no warnings;
        my (undef, $count, $str) = @_;
        my @str= split /,/, $str;
        $str = join( "," , @str[0..$count-1] ) . "|" . join ( "," , @s
+tr[$count..$#str] );
        return $str;
    }
}

my @passed;
for (@I) {
    push @passed, $_ if $_->test == $_->test_count;
}
done_testing;

select(IO::Callback->new('>', sub {
    my $str = shift;
    $str =~ s/^/# /m;
    print STDOUT $str;
}));

say "Passed: @passed";

say "Benchmarks...";
cmpthese(-1, { map { my $class = $_; $class => sub { $class->bench } }
+ @passed });
[download]