in reply to logically recurse parentheses

I have a script which evolved out of this thread which built on suggestions from ikegami. It matches balanced parentheses and pulls out the nested pairs in depth first, left to right order. Here's the script

use strict;
use warnings;

my @toTest =
(
   q{Cont(ains balanced( nested Br(ack)ets )in t)he text},
   q{Con(tains i(mbalan(ced Br(ack)ets, )one c)lose missing},
   q{Contains i(mbalan(ced Br(ack)ets, )one op)en m)missing},
   q{No brackets in this string},
   q{Won)ky br(ackets in) this s(tring},
   q{More wonky br(ackets in) th)is s(tring},
   q{Just the one( leading bracket},
   q{And just th)e one trailing bracket},
   q{So(me m(ultip)le n(est(s in) thi)s o)ne},
   q{Ther(e is( mo(re) de(e)p )nes(ti(n(g i)n (mul)ti)p(l)es) he)re},
   q{Th(er(e is( mo(re) de(e)p )nes(ti(n(g i)n (mul)ti)p(l)es) he)re},
   q{Ther(e is( mo(re) de(e)p )nes(ti(n(g i)n (mul)ti)p(l)es) he)r)e},
   q{Ther(e is( mo(re) de(e)p )n(es(ti(n(g i)n (mul)ti)p(l)es) he)re},
   q{Some d((oub)le b)rackets},
   q{(Some d((oub)le b)rackets)},
   q{ab(())cde},
   q{ab(c(d)e},
   q{ab(c)d)e},
   q{ab(c)de},
);

my @memoList;
my $rxNest;
$rxNest = qr
{(?x)
   (
      \(
      [^()]*
      (?:
         (??{$rxNest})
         [^()]*
      )*
      \)
   )
   (?{ [ @{$^R}, $^N ] })
};

my $rxOnlyNested;
{
    use re q(eval);
    $rxOnlyNested = qr
    {(?x)
       (?{ [] })
       ^
       [^()]*
       (?:
          $rxNest
          [^()]*
       )+
       \z
       (?{ @memoList = @{$^R} })
    };
}

testString($_) for @toTest;

sub testString
{
    my $string = shift;
    @memoList = ();
    print qq{\nString: $string\n};
    if($string =~ /$rxOnlyNested/)
    {
        print qq{     Match succeeded\n};
        print qq{     ---------------\n};
        print qq{     Before brackets:-\n};
        print qq{       -->@{[substr $string, 0, $-[1]]}<--\n};
        print qq{     Bracket pairs:-\n};
        print qq{          $_\n} for @memoList;
        print qq{     After brackets:-\n};
        print qq{       -->@{[substr $string, $+[1]]}<--\n};
    }
    else
    {
        print qq{     Match failed\n};
    }
}

[download]

and the output


String: Cont(ains balanced( nested Br(ack)ets )in t)he text
     Match succeeded
     ---------------
     Before brackets:-
       -->Cont<--
     Bracket pairs:-
          (ack)
          ( nested Br(ack)ets )
          (ains balanced( nested Br(ack)ets )in t)
     After brackets:-
       -->he text<--

String: Con(tains i(mbalan(ced Br(ack)ets, )one c)lose missing
     Match failed

String: Contains i(mbalan(ced Br(ack)ets, )one op)en m)missing
     Match failed

String: No brackets in this string
     Match failed

String: Won)ky br(ackets in) this s(tring
     Match failed

String: More wonky br(ackets in) th)is s(tring
     Match failed

String: Just the one( leading bracket
     Match failed

String: And just th)e one trailing bracket
     Match failed

String: So(me m(ultip)le n(est(s in) thi)s o)ne
     Match succeeded
     ---------------
     Before brackets:-
       -->So<--
     Bracket pairs:-
          (ultip)
          (s in)
          (est(s in) thi)
          (me m(ultip)le n(est(s in) thi)s o)
     After brackets:-
       -->ne<--

String: Ther(e is( mo(re) de(e)p )nes(ti(n(g i)n (mul)ti)p(l)es) he)re
     Match succeeded
     ---------------
     Before brackets:-
       -->Ther<--
     Bracket pairs:-
          (re)
          (e)
          ( mo(re) de(e)p )
          (g i)
          (mul)
          (n(g i)n (mul)ti)
          (l)
          (ti(n(g i)n (mul)ti)p(l)es)
          (e is( mo(re) de(e)p )nes(ti(n(g i)n (mul)ti)p(l)es) he)
     After brackets:-
       -->re<--

String: Th(er(e is( mo(re) de(e)p )nes(ti(n(g i)n (mul)ti)p(l)es) he)r
+e
     Match failed

String: Ther(e is( mo(re) de(e)p )nes(ti(n(g i)n (mul)ti)p(l)es) he)r)
+e
     Match failed

String: Ther(e is( mo(re) de(e)p )n(es(ti(n(g i)n (mul)ti)p(l)es) he)r
+e
     Match failed

String: Some d((oub)le b)rackets
     Match succeeded
     ---------------
     Before brackets:-
       -->Some d<--
     Bracket pairs:-
          (oub)
          ((oub)le b)
     After brackets:-
       -->rackets<--

String: (Some d((oub)le b)rackets)
     Match succeeded
     ---------------
     Before brackets:-
       --><--
     Bracket pairs:-
          (oub)
          ((oub)le b)
          (Some d((oub)le b)rackets)
     After brackets:-
       --><--

String: ab(())cde
     Match succeeded
     ---------------
     Before brackets:-
       -->ab<--
     Bracket pairs:-
          ()
          (())
     After brackets:-
       -->cde<--

String: ab(c(d)e
     Match failed

String: ab(c)d)e
     Match failed

String: ab(c)de
     Match succeeded
     ---------------
     Before brackets:-
       -->ab<--
     Bracket pairs:-
          (c)
     After brackets:-
       -->de<--

[download]

I hope you can get some use out of this.

Cheers,

JohnGG

In Section Seekers of Perl Wisdom