use strict; use warnings; my $YBL027W = 'GUAUGUUUAACAGUGAUACUAAAUUUUGAACCUUUCACAAGAUUUAUCUUUAAAUAUGUUAUGA'; my $seq = shift || 'GUAUG'; my @pos; while( $YBL027W =~ m/\Q$seq\E/gis ){ push @pos, pos($YBL027W) - length( $seq ); } print regex => $/; printf ' \%d0', $_ for 1 .. 8; print $/, ( 0 .. 9 ) x 8, $/; print $YBL027W,$/; my $req = ' ' x length $YBL027W; substr($req, $_, 1, '^') for @pos; print $req, $/; print "@pos $/"; @pos = (); for( my $lindex = index( $YBL027W, $seq); $lindex != -1; $lindex = index( $YBL027W, $seq, $lindex + length $seq) # + length $seq so it matches the m//atch solution # otherwise UUU in UUUU would match twice ( [UUU]U and U[UUU] ) ) { push @pos, $lindex; } print $/, index => $/; printf ' \%d0', $_ for 1 .. 8; print $/, ( 0 .. 9 ) x 8, $/; print $YBL027W,$/; $req = ' ' x length $YBL027W; substr($req, $_, 1, '^') for @pos; print $req, $/; print "@pos $/"; __END__ loose$ perl substring.pl regex \10 \20 \30 \40 \50 \60 \70 \80 01234567890123456789012345678901234567890123456789012345678901234567890123456789 GUAUGUUUAACAGUGAUACUAAAUUUUGAACCUUUCACAAGAUUUAUCUUUAAAUAUGUUAUGA ^ 0 index \10 \20 \30 \40 \50 \60 \70 \80 01234567890123456789012345678901234567890123456789012345678901234567890123456789 GUAUGUUUAACAGUGAUACUAAAUUUUGAACCUUUCACAAGAUUUAUCUUUAAAUAUGUUAUGA ^ 0 loose$ perl substring.pl UUUAA regex \10 \20 \30 \40 \50 \60 \70 \80 01234567890123456789012345678901234567890123456789012345678901234567890123456789 GUAUGUUUAACAGUGAUACUAAAUUUUGAACCUUUCACAAGAUUUAUCUUUAAAUAUGUUAUGA ^ ^ 5 48 index \10 \20 \30 \40 \50 \60 \70 \80 01234567890123456789012345678901234567890123456789012345678901234567890123456789 GUAUGUUUAACAGUGAUACUAAAUUUUGAACCUUUCACAAGAUUUAUCUUUAAAUAUGUUAUGA ^ ^ 5 48 loose$