find the first occurrence of '<IPDR>'      # fast
  walk the string to the '</IPDR>'           # fastish
  skip back to the last occurrence of 'test' # fast
  walk forward to the '</IPDR>' again        # fastish
  signal success                             # done

##</code><code>##

  find the first occurrence of '<IPDR>'      # fast
  walk the string to the end                 # fastish
  skip back to the last occurrence of 'test' # fast
  walk forward to end of string again        # fastish
  repeat last two steps for each additional occurrence of 'test'
    # slow - quadratic in the number of occurrences of 'test'
  (no more 'test's to try) signal failure    # done

##</code><code>##

use strict;
use Benchmark qw/ cmpthese timethese /;
my($head, $tailg, $tailb, $test, $fill)
        = ("<IPDR>", "</IPDR>", "</IPDR", "test", "x" x 100);
my $reuncut = qr{
    $head
    (?:(?!$tailg).)*
    $test
    (?:(?!$tailg).)*
    $tailg
}sxio;
my $recut = qr{
    (?>
        $head
        (?:(?!$tailg).)*
        $test
    )
    (?:(?!$tailg).)*
    $tailg
}sxio;

my $trial;
for my $bool (qw/ g b /) {
    my $tail = ($bool eq 'g') ? $tailg : $tailb;
    for my $cut (qw/ cut uncut /) {
        my $re = ($cut eq 'cut') ? $recut : $reuncut;
        for my $count (1, 10, 100, 1000) {
            my $str = join '', $head, $fill, $test x $count, $fill, $tail;
            $trial->{"$cut$count$bool"} = sub {
                die if ($bool eq 'g') ^ ($str =~ $re);
            };
        }
    }
}
timethese(-1, $trial);

##</code><code>##

   uncut1g:   12799.05/s
     cut1g:   12799.05/s
   uncut1b:   11821.50/s
     cut1b:    8219.27/s

  uncut10g:   11486.54/s
    cut10g:   11486.54/s
  uncut10b:    2559.05/s
    cut10b:    7244.34/s

 uncut100g:    5743.27/s
   cut100g:    5743.27/s
 uncut100b:     125.00/s
   cut100b:    3381.13/s

uncut1000g:     956.48/s
  cut1000g:     956.48/s
uncut1000b:       1.85/s
  cut1000b:     532.38/s