use strict;

my $seq = lc do { local @ARGV = ( 'seq' ); <> };
$seq =~ tr/t/u/;

my @matches = with_regex( $seq );
print "$_\n" for @matches;

sub with_regex {
  my $ks   = 'gccrccaugg';
  my @ks1  = split //, $ks;
  my @ks2  = map { s/^r$/[ag]/; $_ } @ks1;

  my @pos;
  push @pos, [ $-[ 1 ], $+[ 1 ] ] while $ks =~ /(?=(aug))/g;

  my @ks3 = @ks2;
  splice @ks3, $_->[0], $_->[1]-$_->[0] for reverse @pos;

  my @alts =
    map join( '', @$_ ),
      map {
        my $a_ref = $_;
        splice @$a_ref, $_->[0], 0, qw( a u g ) for @pos;
        $a_ref
      }
        map make_alts( $_, @ks3 ),
          map choose( scalar @ks3, $_ ), 0 .. 3;

  my $re_string = join '|', @alts;
  my $re = qr/(?=($re_string))/i;

  my $seq = shift;
  my @m = ( $seq =~ /$re/g );

  return @m;
}

sub make_alts {
  my $indices = shift;
  my @p = @_;
  $p[ $_ ] = '[acgu]' for @$indices;
  return \@p
}

sub choose {
  my ( $n, $m ) = @_;
  return _choose( $m, 0..$n-1 );
}

sub _choose {
  my ( $m, @n ) = @_;
  return []     if  0 == $m;
  return [ @n ] if @n == $m;

  my @ret;
  for my $i ( 0 .. $#n - $m + 1 ) {
    push @ret, [ $n[ $i ], @$_ ]
      for _choose( $m - 1, @n[ $i+1 .. $#n ] );
  }
  return @ret;
}