sub wrap { my ($lines, $pos, $markup) = @_; my $idx = int($pos / 50); substr $lines->[$idx], $pos % 50, 0, $markup; } my %dna; my $name1 = "name1"; my $name2 = "name2"; $dna{$name1} = "ATATTATCCCCCTATATATGGAGGGAGAGGGGGGGGGGGGGGGGGGGGGGGGGGGAGAGAGGAGATTTTTTTTTTTTTTTT"; $dna{$name2} = "ATATATTATATATATTATATTCGCGCGCGCGGCGCGCGCGGCGCGCGCGTTTTTTTTTTTTTTAGGAGAGAGAGGGAGGAGGAGAGGGGAGT"; my %class =(AGGAG => 'sd', TTTTT => 'terminator'); my $regex = join '|', keys %class; $regex = qr/((?i:$regex))/; my %highlight; for my $name (keys %dna) { while ($dna{$name} =~ /$regex/g) { $highlight{$name}{ pos($dna{$name}) - 5 } = $class{$1}; } } for my $key (keys %highlight) { print "
$key
"; my @lines = unpack '(A50)*', $dna{$key}; for my $pos (sort { $b <=> $a } keys %{ $highlight{$key} }) { my $class = $highlight{$key}{$pos}; wrap(\@lines, $pos + 5, ''); wrap(\@lines, $pos, ""); } print join "