my @lst = qw( A,G AG,CT TC,CA GAT,CGA CGAT,TG ,G ACGT X,A AA,G AC,GGC ATGA,TGG ATCXG,AAC ATA,TG GTA,YC); for (@lst) { my $good = do { m/^ [ATCG]+ , [ATCG]+ $/x and not grep m/(.) .* \1/x, split ','; }; print $_, $good ? ' good' : ' bad', "\n"; }