I separated out the record processing into a separate routine for clarity. The way I would handle this is to keep a short buffer (here it's @cognate_rows) of the strings you expect to pair up.

By the way, it's probably wise for you to investigate bioperl -- I bet this is a standard format.

sub _parse_paired {
    my $this = shift;
    my $pkey = 1;

    # don't know why these keys are here...
    my $c = { comments => '',
          left_instance => '',
          right_instance => '',
          match => '' };    
    
    ### build up each record and place in the collection ###
    $INPUT_RECORD_SEPARATOR = "\n\n\n";
    while (my $record = $this->{handle}->getline()) {
      my $rec_href = _build_record($record, $pkey);
      $c->{pkey} = $rec_href;

      ++$pkey;
    }

    return $c;
}

#here's the routine I factored out:
sub _build_record {
  my ($record, $key) = (@_);
  my %data = (); 
   # keys will be left_sequence and right_sequence

  my @rows = split /\n/, $record;

  my (@cognate_rows);
  my $curr_cognate_matches = 1;
  while (@rows) {
    local $_ = shift @rows;
    chomp;
    if (/^\s*$/) { 
      next; #skip blanks
    }
    if (/^\s+\d+/) {
      # you may have to adjust how _load_stats 
      # works, or pass in $c to this routine.
      _load_stats($key, $_, \%data);
    }
    elsif (/^Sbjct/) {
      push @cognate_rows, $_;
      if (@cognate_rows == 2) {
    # we've found two rows that we expect to go together here.

    # if it matters, we know whether $curr_cognate_matches when we
    # reach this point
    my ($l, $r);
    (undef, $l, undef) = split /\s+/, $cognate_rows[0];
    (undef, $r, undef) = split /\s+/, $cognate_rows[1];
    $data{left_sequence} .= $l;
    $data{right_sequence} .= $r;
    # reset match to true
    $curr_cognate_matches = 1;
        # dump the buffer
        @cognate_rows = ();
      }
    }
    elsif (/!/) {
      # we know the current @cognate_rows *don't* match
      $curr_cognate_matches = 0;
      next; #discard this line
    }
  } #end while rows

  return \%data;
}
[download]

Code is completely untested. It compiles, under strict, provided you're using English. That's as far as I've gone to check this.

"By the way, it's probably wise for you to investigate bioperl -- I bet this is a standard format."

It isn't. In fact when I asked the bioperl list if a parser exists for this tool, and if they would be interested in one, I got no answer.

Whether this will prove more efficient is speculative, but as the entire record is parsed in a single call to the regex engine, I think ought to be. It requires 5.8 because of the use of $^N which wasn't available before.

I haven't wrapped it up as a function, I'm putting the gathered statistics into the hash for later processing and I've guessed as to where comment cards are possible, probably incorrectly.

The sequence of regexes may look scarry, but they really aren't if you take the time to look at them and understand what they are doing. Many here are only too willing to explain anything that you don't follow, including myself. I could have littered the regexes with comments, but that just seems to make them look more complicated (to me).

The essence of the technique used here is to follow each capture group with a {?{ $var .= $^N  }) code block, to assign or append the captured data as the regex progresses. This greatly simplifies the situation where you have optional capture groups in the regex, which means that you are never sure which part has been captured into which $n variable.

#! perl -slw
use strict;
require 5.008;
use Data::Dumper;
use re 'eval';

my $re_comment = qr[^ \# ( \s* [^\n]+ )(?{ $c->{comment} .= $^N; })]x;

my $re_stats = qr[^ \s+ ( \d+ [^\n]+ ) \n]x;

my $re_seq   = qr[^ Sbjct: \s+ ( [^ ]+ ) \s+ \d+ \n]x;

my $re_bang  = qr[^ \s* ! \s* \n]x;

my $re_pair  = qr[
    $re_seq (?{ $c->{left_instance} .= $^N; })
    (?:$re_bang)?
    $re_seq (?{ $c->{right_instance} .= $^N; })
    $re_comment? \n
]x;

my $re_record= qr[
    $re_stats (?{ $c->{stats} .= $^N })
    (?: $re_pair )+
]x;

local $/ = "\n\n\n";
while( <DATA> ) {
    our $c = {};
    print m[$re_record]mo
    ? Dumper $c
    : 'Failed to match';
}

__DATA__
          140 8778 333 D 140 8778 334 -7 3.60e-56 -259 95.00
Sbjct: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 39
+3
!
Sbjct: -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 39
+4

Sbjct: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGGGGGGGGGCCTT 45
+3
Sbjct: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGGGGGGGGGCCTT 45
+4

Sbjct: TTAAAATTCCCCCC-GGGGGG 474
!
Sbjct: TTAAAATTCCCCCCGGGGGGG 475


          140 8778 333 D 140 8778 334 -7 3.60e-56 -259 95.00
Sbjct: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 39
+3
!
Sbjct: -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 39
+4
# some comment
Sbjct: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGGGGGGGGGCCTT 45
+3
Sbjct: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGGGGGGGGGCCTT 45
+4
# some more comment
Sbjct: TTAAAATTCCCCCC-GGGGGG 474
!
Sbjct: TTAAAATTCCCCCCGGGGGGG 475


          140 8778 333 D 140 8778 334 -7 3.60e-56 -259 95.00
Sbjct: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 39
+3
!
Sbjct: -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 39
+4

Sbjct: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGGGGGGGGGCCTT 45
+3
Sbjct: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGGGGGGGGGCCTT 45
+4

Sbjct: TTAAAATTCCCCCC-GGGGGG 474
!
Sbjct: TTAAAATTCCCCCCGGGGGGG 475
[download]

Ouput

D:\Perl\test>254442
$VAR1 = {
          'right_instance' => '-AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAG
+GGGGGGGGCCTTTTAAAATTCCCCCCGGGGGGG',
          'stats' => '140 8778 333 D 140 8778 334 -7 3.60e-56 -259 95.
+00',
          'left_instance' => 'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGG
+GGGGGGGCCTTTTAAAATTCCCCCC-GGGGGG'
        };

$VAR1 = {
          'comment' => ' some comment some more comment',
          'right_instance' => '-AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAG
+GGGGGGGGCCTTTTAAAATTCCCCCCGGGGGGG',
          'stats' => '140 8778 333 D 140 8778 334 -7 3.60e-56 -259 95.
+00',
          'left_instance' => 'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGG
+GGGGGGGCCTTTTAAAATTCCCCCC-GGGGGG'
        };

$VAR1 = {
          'right_instance' => '-AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAG
+GGGGGGGGCCTTTTAAAATTCCCCCCGGGGGGG',
          'stats' => '140 8778 333 D 140 8778 334 -7 3.60e-56 -259 95.
+00',
          'left_instance' => 'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGG
+GGGGGGGCCTTTTAAAATTCCCCCC-GGGGGG'
        };
[download]

1. might or might not have a comment at start
2. might or might not have that row of mostly numbers
3. first part of right sequence
4. might or might not have a ! preceded by optional whitespace
5. first part of left sequence
6. a blank line, followed by more parts of the right and left sequence

#$pkey is just a counter
$c->{$pkey}{left_instance}{sequence}; 
$c->{$pkey}{right_instance}{sequence};
$c->{$pkey}{comments};
#i am guessing $c->{$pkey}{match} as well but don't know 
#what that does.
[download]

-enlil

  my @bangs = $record =~ m/^[^\n]*\![^\n]*\n/mg;
  $record =~ s/^[^\n]*\![^\n]*\n//mg;
[download]

Because although for my quick'n'dirty purposes, this would suffice, the program is intended to be a parser and as the ! lines do represent information, I should have the means in place to grab them.