#!/usr/bin/perl
use strict;

while(  1  ) {
    my $valid= <DATA>  or  exit( 0 );
    chomp( $valid );
    my $dirty= <DATA>  or  die "Missing second sequence";
    chomp( $dirty );
    $valid =~ s#(...)#(.*?)\Q$1\E#g;
    my @intron=  $dirty =~ /^$valid(.*?)/;
    for my $intron (  @intron  ) {
        next   if  ! length($intron);
        print "$intron\n";
    }
}
__END__
ATGGAGTCGACGAATTTGAAGAAT
GCACCGATGGAGTAGGTCGACGATCTCAATTTGTCGAAGAAT
[download]

GCACCG
TAGG
ATCTC
TCG

If we aren't sure whether the strings actually do match, then you could use an experimental regex feature to disable backtracking at certain points (that we know is doomed to fail). But I'll just append the shorter string onto the end of the longer string. This ensures a match and it is easy to tell if the original string would not have matched:

#!/usr/bin/perl
use strict;

while(  1  ) {
    my $valid= <DATA>  or  exit( 0 );
    chomp( $valid );
    my $dirty= <DATA>  or  die "Missing second sequence";
    chomp( $dirty );
    print "Comparing $valid\nto $dirty\n";
    my $dlen= length( $dirty );
    $dirty .= $valid;
    $valid =~ s#(...)#(.*?)\Q$1\E#g;
    my @intron=  $dirty =~ /^$valid(.*?)/
        or  die "Ouch!  We backtracked";
    if(  $dlen < $+[0]  ) {
        print "No match.\n";
    } else {
        for my $intron (  @intron  ) {
            next   if  ! length($intron);
            print "$intron\n";
        }
    }
}
__END__
ATGGAGTCGACGAATTTGAAGAAT
GCACCGATGGAGTAGGTCGACGATCTCAATTTGTCGAAGAAT
ATGGAGTCGACGAATTTGAAGAAT
GCACCGATGGAGTAGGTCGACGATCTCAATTTGTCGAAGACT
[download]

Comparing ATGGAGTCGACGAATTTGAAGAAT
to GCACCGATGGAGTAGGTCGACGATCTCAATTTGTCGAAGAAT
GCACCG
TAGG
ATCTC
TCG
Comparing ATGGAGTCGACGAATTTGAAGAAT
to GCACCGATGGAGTAGGTCGACGATCTCAATTTGTCGAAGACT
No match.

Now I assume that these DNA/RNA strings can get very, very long. This solution should be pretty efficient but it would compile a very, very large regular expression. This might require too much memory. Luckily it is easy (and still efficient) to do the problem in chunks to reduce memory requirements.

#!/usr/bin/perl
use strict;

my $maxCodons= 2;

while(  1  ) {
    my $valid= <DATA>  or  exit( 0 );
    chomp( $valid );
    my $dirty= <DATA>  or  die "Missing second sequence";
    chomp( $dirty );
    print "Comparing $valid\nto $dirty\n";
    my $dlen= length( $dirty );
    $dirty .= $valid;
    my $pos= 0;
    while(  "" ne $valid  ) {
        my $part= substr( $valid, 0, 3*$maxCodons, "" );
        $part =~ s#(...)#(.*?)\Q$1\E#g;
        pos($dirty)= $pos;
        my @intron=  $dirty =~ /\G$part/
            or  die "Ouch!  We backtracked";
        $pos= $+[0];
        if(  $dlen < $pos  ) {
            print "Match was not complete.\n";
            $valid= "";
        } else {
            for my $intron (  @intron  ) {
                next   if  ! length($intron);
                print "$intron\n";
            }
        }
        if(  "" eq $valid  &&  $pos < $dlen  ) {
            print substr( $dirty, $pos, $dlen-$pos ), $/;
        }
    }
}
__END__
ATGGAGTCGACGAATTTGAAGAAT
GCACCGATGGAGTAGGTCGACGATCTCAATTTGTCGAAGAATTGG
ATGGAGTCGACGAATTTGAAGAAT
GCACCGATGGAGTAGGTCGACGATCTCAATTTGTCGAAGACTTGG
[download]

which produces

Comparing ATGGAGTCGACGAATTTGAAGAAT
to GCACCGATGGAGTAGGTCGACGATCTCAATTTGTCGAAGAATTGG
GCACCG
TAGG
ATCTC
TCG
TGG
Comparing ATGGAGTCGACGAATTTGAAGAAT
to GCACCGATGGAGTAGGTCGACGATCTCAATTTGTCGAAGACTTGG
GCACCG
TAGG
ATCTC
Match was not complete.

If you set $maxCodons to 1 then you end up doing about the same as this index version:

#!/usr/bin/perl
use strict;

while(  1  ) {
    my $valid= <DATA>  or  exit( 0 );
    chomp( $valid );
    my $dirty= <DATA>  or  die "Missing second sequence";
    chomp( $dirty );
    print "Comparing $valid\nto $dirty\n";
    my $pos= 0;
    while(  "" ne $valid  ) {
        my $codon= substr( $valid, 0, 3, "" );
        my $next= index( $dirty, $codon, $pos );
        if(  $next < 0  ) {
            print "Match was not complete.\n";
            last;
        }
        if(  $pos < $next  ) {
            print substr( $dirty, $pos, $next-$pos ), $/;
        }
        $pos= $next + 3;
        if(  "" eq $valid  &&  $pos < length($dirty)  ) {
            print substr( $dirty, $pos ), $/;
        }
    }
}
__END__
ATGGAGTCGACGAATTTGAAGAAT
GCACCGATGGAGTAGGTCGACGATCTCAATTTGTCGAAGAATTGG
ATGGAGTCGACGAATTTGAAGAAT
GCACCGATGGAGTAGGTCGACGATCTCAATTTGTCGAAGACTTGG
[download]

which produces the same results.

I think I may have one or more off-by-one errors left in the above code despite the quick tests seeming to indicate otherwise. (:

                - tye