#!/usr/bin/perl # use strict; use warnings; our @toTest = ( "Cont(ains balanced( nested Br(ack)ets )in t)he text", "Con(tains i(mbalan(ced Br(ack)ets, )one c)lose missing", "Contains i(mbalan(ced Br(ack)ets, )one op)en m)missing", "No brackets in this string", "Won)ky br(ackets in) this s(tring", "More wonky br(ackets in) th)is s(tring", "Just the one( leading bracket", "And just th)e one trailing bracket", "So(me m(ultip)le n(est(s in) thi)s o)ne", "Ther(e is( mo(re) de(e)p )nes(ti(n(g i)n (mul)ti)p(l)es) he)re", "Some d((oub)le b)rackets", "ab(())cde", "ab(c(d)e", "ab(c)d)e"); our @memoList; our ($rxBefore, $rxNest, $rxAfter, $rxWhole); $rxBefore = $rxAfter = qr{([^()]*)}; $rxNest = qr {(?x) ( \( (?: (?>[^()]+) | (??{$rxNest}) )* \) ) (?{push @memoList, $+}) }; $rxWhole = qr{^$rxBefore$rxNest$rxAfter$}; testString($_) for @toTest; sub testString { my $string = shift; @memoList = (); print "\nString: $string\n"; if($string =~ /$rxWhole/) { print " Match succeeded\n"; print " ---------------\n"; print " Before brackets:-\n"; print " $1\n"; print " Bracket pairs:-\n"; print " $_\n" for @memoList; print " After brackets:-\n"; print " $3\n"; } else { print " Match failed\n"; } }