windows-server-2003/ds/netapi/svcimgs/ntrepl/frsconfig/findbalpar.cmd

@rem = '
@goto endofperl
';



sub FindBalParens {
    my $record = shift;

    my ($pre, $match, $result);
    my $count = 0;
    my $post = '';
    my $trailbs = '';
    my $leftparfound = 0;
#
# Look for the first expression with balanced parens.
# Parens that are part of a quoted string or escaped with a backslash are skipped.
#
#   The return value is a 3 element array:
#     [0] n=-1 means extra right parens found.
#         n=0  means a balanced expr found or no parens at all.
#         n>0  means n extra Left Parens found.
#     [1] contains the consumed part of the input string if [0] <= 0 above.
#         otherwise it contains the entire input string
#     [2] contains the remaining part of the string if [0] <= 0 above
#         otherwise it is the null string except for the no parens found case.
#
#     In the case of no parens found outside of quoted string or escaped chars
#     [0] is zero, [1] is the input string, [2] = "FRS-NO-PARENS".
#
    print $record, "\n";


    if (!($record =~ m/[\(\)]/)) {
        print "0, Found: $record     Rest:  FRS-NO-PARENS\n";
        return [0, $record, "FRS-NO-PARENS"];  # return 0 if no parens found.
    }


    if ($record =~ m/\\+$/) {
        ($trailbs) = $record =~ m/(\\+$)/;  # strip trailing \ so they don't foul marker
        $record =~ s/(\\+$)//;
    }
    
 
    $record .= '(*)';           # append marker

    while ( $record =~ m{
    (                           # Start of captured result
     (?:[^\"\\\(\)]*            # swallow chars up to " or \ or ( or )

        (?:                     # followed by 4 alternatives
           (?=\()               #   1. positive lookahead assertion for ( ends match
          |(?=\))               #   2. positive lookahead assertion for ) ends match
          |(?:\\.)              #   3. if backslash, swallow it + next char
          |(?:\"                #   4. if leading quote then find end of quoted
                                #      string but respect backslash escape char.
             (?:[^\"\\]*        # swallow up to next " or \ if any

                 (?:\\.         # if prev ended on \ then swallow it + next char
                     [^\"\\]*   # continue to next quote or \, if any
                 )*             # loop if we hit \
              )
              \"?               # consume trailing quote, if any.  could be eos
           )

        )                       # end of 4 alternatives
     )+                         # continue after quoted string or \
     [\(\)]?                    # end match with next ( or ) (if any) ends captured result

    | (?:[^\(]+) /?             # no quotes up to next (, if any, or eos

    | \(                        # eat extra (

    )
    }gx ) {

	$pre = $`;
	$match = $+;
	$post = $';

        #
        # if the marker is consumed in the match then we must be
        # in the middle of a quoted string so leave count unchanged.
        #
	if (substr($+,-3,3) ne '(*)') {
            if (substr($+,-1,1) eq ')') {$count--;}
            if (substr($+,-1,1) eq '(') {$count++;}
            #
            # record left paren found if count > 0 and it wasn't
            # caused by a split marker.
            #
            if (($count > 0) && ($post ne '*)')) {$leftparfound = 1;}
        } 

        #print "($count) paren match:'$+'\n";

        #
        # if the count hits zero then return balanced part.
        # if the count goes negative then we've seen more right parens than left parens
        #
        if ($count le 0) {goto RETURN;}
    }

RETURN:
    #
    # Clean off the marker.
    #
    $result = $pre . $match;

    if ($post =~ m/\(\*\)$/) {
        substr($post, -3, 3) = '';
    } else {
        if ($post eq '*)') {
            $post = '';
            substr($result, -1, 1) = '';
        } else {
            $result =~ s/\(\*\)$//;
        }
    }


    #
    # add back trailing backslashes
    #
    if ($post ne "") {
        $post = $post . $trailbs;
    } else {
        $result = $result . $trailbs;
        #
        # The entire string was consumed so if the Count is zero 
        # check if we ever found an unquoted left paren.  If not
        # then return "FRS-NO-PARENS" as the result in [2].
        #
        if (($count eq 0) && ($leftparfound eq 0)) {$post = "FRS-NO-PARENS";}
    }

    print "$count, Found: $result     Rest: $post \n";
    return [$count, $result , $post ];

}


    $rest = '/RP=foo  /R\P="D:\RSB"  /SP="D:\staging" /COMPUTER="bchb/hubsite/servers/" /NAME="bchb.hubsite.ajax.com" /XXX/';
    print "\n\n";
    @pars = &FindBalParens ($rest);

    $rest = ' ()  (foo)';
    print "\n\n";
    @pars = &FindBalParens ($rest);

    $rest = ' (  "(" \)  )';
    print "\n\n";
    @pars = &FindBalParens ($rest);

    $rest = '(kl(lkldkf(/ /) "))))))" ) (()cc) "(" \)  )  (junk)';
    print "\n\n";
    @pars = &FindBalParens ($rest);

    $rest = '(kl(lkldkf(/ /) "))))))" ) (()unbalanced\) "(" \)  )  junk';
    print "\n\n";
    @pars = &FindBalParens ($rest);

    $rest = ' junk "()" \( (kl(lkldkf(/ /) "))))))" ) (()unbalanced\) "(" \)  )  junk';
    print "\n\n";
    @pars = &FindBalParens ($rest);

    $rest = 'junk';
    print "\n\n";
    @pars = &FindBalParens ($rest);

    $rest = ')))';
    print "\n\n";
    @pars = &FindBalParens ($rest);

    $rest = '"))) (((" \)  \(';
    print "\n\n";
    @pars = &FindBalParens ($rest);

    $rest = '"))) ((( )  (';
    print "\n\n";
    @pars = &FindBalParens ($rest);

    $rest = '"))) ((( )  (';
    print "\n\n";
    @pars = &FindBalParens ($rest);

    $rest = 'junk"(';
    print "\n\n";
    @pars = &FindBalParens ($rest);

    $rest = 'junk\(';
    print "\n\n";
    @pars = &FindBalParens ($rest);

    $rest = 'junk';
    print "\n\n";
    @pars = &FindBalParens ($rest);

    $rest = '"junk(*)';
    print "\n\n";
    @pars = &FindBalParens ($rest);

    $rest = '"junk"(*)';
    print "\n\n";
    @pars = &FindBalParens ($rest);

    $rest = '"junk"(*)\\';
    print "\n\n";
    @pars = &FindBalParens ($rest);

    $rest = '"junk"(*)\\\\\\';
    print "\n\n";
    @pars = &FindBalParens ($rest);

    $rest = '"junk (*)\\';
    print "\n\n";
    @pars = &FindBalParens ($rest);

    $rest = '"junk (*)\\\\\\';
    print "\n\n";
    @pars = &FindBalParens ($rest);

    $rest = ')';
    print "\n\n";
    @pars = &FindBalParens ($rest);

    $rest = ')(';
    print "\n\n";
    @pars = &FindBalParens ($rest);

    $rest = '(';
    print "\n\n";
    @pars = &FindBalParens ($rest);

    $rest = ' junk "()" \() (kl(lkldkf(/ /) ))"))))))" ) (()unbalanced\) "(" \)  )  junk';
    print "\n\n";
    @pars = &FindBalParens ($rest);

    $rest = 'junk \)\( )';
    print "\n\n";
    @pars = &FindBalParens ($rest);



 __END__
:endofperl
@rem  -d -w
@perl -w %~dpn0.cmd %*
@goto :QUIT
@:QUIT