#!/usr/bin/perl -w

use strict;
use re 'eval';
sub showvars ;

my $s = "abcdefghi";
my (@a, $pos);

print qq{"$s" =~ /(b)(.(.))/;\n};
#match($s, qr{(b)(.(.))}x ) and exit;

# This doesn't set $^N correctly and we need to know the nesting
# The rest of the regex vars should be ok if you know the number of pa
+rens
# If not then add braces up to $99, but $+, $#+ and the extra $n's wil
+l be wrong
match($s, qr/
    (?{ $pos = 1;   # pos if $& start

        #  @a = your_fn($_)
        @a = ([0,3],[0,1],[1,2],[2,1]); 
                    # offset & length of captures
                    # $a[0] is $&, $a[1] is $1, etc. 
                    # $a[1][0] is $-[0] and $a[1][1] is $+[0] - $-[0]
      })

    # Capture $1:
    # Wrap this in (?= ) to not bump pos
    (?= 
        (??{ qr!.{$a[1][0]}! })     # Advance to start of $1
        ((??{ qr!.{$a[1][1]}! }))   # Capture the right length
    )
    # $2, $3, etc.
    (?= (??{ qr!.{$a[2][0]}! }) ((??{ qr!.{$a[2][1]}! })) )
    (?= (??{ qr!.{$a[3][0]}! }) ((??{ qr!.{$a[3][1]}! })) )
    # I think the parens are counted at regex compile time
    # so they need to be known in advance (or $+, $#+, $4 will be wron
+g)

    # bump pos until where at the right spot
    (??{ (pos == $pos) ? qr{} : qr{(?!)}; })

    # capture $&
    (??{ qr!.{$a[0][1]}! })
/xs );

sub match {
    my ($s, $qr) = @_;
    $s =~ $qr or die "No match $s =~ $qr";

    showvars qw($` $& $');
    showvars qw($+ $^N);
    showvars qw($1 $2 $3 $4 $5 $6);
    showvars qw(@-);
    showvars qw(@+);
}

sub showvars {
    no warnings 'uninitialized';
    print "$_ = (",join(",",eval $_),") " for @_;
    print "\n";
}

# $+ text of last sucessful match
# $^N similar, but of last rightmost closing paren
# @+ array or end pos, $+[0] is whole, $#+ is last good
[download]