7.4.2. Translating the Problem into Code

We can take some shortcuts when translating this into $stream->unget_token($token) code. The following HTML is typical:

<B CLASS="h3">Top Stories</B><BR>
...
<B CLASS="h3"><A href="/hi/english/business/newsid_1576000/1576290.stm">Bank
of England mulls rate cut</A></B><BR>

When we see the first B-h3 start-tag token, we think it might be the start of a B-h3-A-href pattern. So we get another token and see if it's an A-href token. It's not (it's the text token Top Stories), so we put it back into the stream (useful in case some other pattern we're looking for involves that being the first token), and we keep looping. Later, we see another B-h3, we get another token, and we inspect it to see if it's an A-href token. This time it is, so we process its href value and resume looping. There's no reason for us to put that a-href back, so the next iteration of the loop will resume with the next token being Bank of England mulls rate cut.

sub scan_bbc_stream {
  my($stream, $docbase) = @_;

 Token:
  while(my $token = $stream->get_token) {

    if ($token->[0] eq 'S'  and  $token->[1] eq 'b'  and  
       ($token->[2]{'class'} || '') eq 'h3') {
      # The href we want is in the NEXT token... probably.
      # Like: <B CLASS="h3"><A href="magic_url_here">

      my(@next) = ($stream->get_token);

      if ($next[0] and $next[0][0] eq 'S'  and  $next[0][1] eq 'a'  and
          defined $next[0][2]{'href'} ) {
         # We found <a href="...">!  This rule matches!
         print URI->new_abs($next[0][2]{'href'}, $docbase), "\n";
         next Token;
      }
      # We get here only if we've given up on this rule:
      $stream->unget_token(@next);
    }

    # fall thru to subsequent rules here...

  }
  return;
}

The general form of the rule above is this: if the current token looks promising, pull off a token and see if that looks promising too. If, at any point, we see an unexpected token or hit the end of the stream, we restore what we've pulled off (held in the temporary array @next), and continue to try other rules. But if all the expectations in this rule are met, we make it to the part that processes this bunch of tokens (here it's just a single line, which prints the URL), and then call next Token to start another iteration of this loop without restoring the tokens that have matched this pattern. (If you are disturbed by this use of a named block and last ing and next ing around, consider that this could be written as a giant if/else statement at the risk of potentially greater damage to what's left of your sanity.)

Each such rule, then, can pull from the stream however many tokens it needs to either match or reject the pattern it's after. Either it matches and starts another iteration of this loop, or it restores the stream to exactly the way it was before this rule started pulling from it. This business of a temporary @next list may seem like overkill when we only have to look one token ahead, only ever looking at $next[0]. However, the if block for the next pattern (which requires looking two tokens ahead) shows how the same framework can be accommodating:

# Add this right after the first if-block ends.
if($token->[0] eq 'S'  and  $token->[1] eq 'a'  and
   defined $token->[2]{'href'} ) {
  # Like: <A href="magic_url_here"> <B class="h2">

  my(@next) = ($stream->get_token);
  if ($next[0] and $next[0][0] eq 'T' and $next[0][1] =~ m/^\s+/s ) {
    # We found whitespace.
    push @next, $stream->get_token;
    if ($next[1] and $next[1][0] eq 'S'  and  $next[1][1] eq 'b'  and
       ($next[1][2]{'class'} || '') =~ m/^h[12]$/s ) {
      # We found <b class="h2">!  This rule matches!
      print URI->new_abs( $token->[2]{'href'}, $docbase ), "\n";
      next Token;
    }
  }
  # We get here only if we've given up on this rule:
  $stream->unget_token(@next);
}