my $regex = mkre($s);
while( $string =~ m/$regex/g )
{
    print $1, "\n";
    # do other stuff
}

sub mkre {
  my $s = shift;
  my $index = 1; # using \1 to capture the whole match
  my(%seen, @elems);
  for (split //, $s) {
    if ($seen{$_}) {
      push @elems, "\\$seen{$_}";
    } else {
      push @elems, sprintf '(?! %s)', join ' | ', map "\\$_", 2 .. $index
          if $index > 1; # changed to start with \2
      $seen{$_} = ++$index;
      push @elems, '(\\w)';
    }
  }
  my $re = join( ' ', '(', @elems, ')' ); # create \1
  warn "$s: $re\n" if $DEBUG;
  qr/$re/x;
}