#!/usr/athena/bin/perl -w

# run as "protect.pl test" to see debug output
$debug = shift; 

sub protect ($) {
    # Mimics the protect function from zwgc-desc language.  Returns a
    # string which will be evaluated identically to expr, but will not
    # affect any surrounding environments.  That is, any characters
    # which could close outside environments are quoted, and any
    # environments in expr which are not closed at the end are closed.

    # attempts to follow each case used by the real parser in
    # owl_fmtext_append_ztext() from fmtext.c, and will probably need
    # to be updated as changes are made to that

    my $text = shift;
    my $ptr = 0;
    my %braces = ('{','}', '[',']', '<','>', '(',')');
    my $openers = join '', keys(%braces);
    my $closers = join '', values(%braces);
    my @charstack = ();
    warn "$openers, $closers" if $debug;
    while ($text =~ m/([@\Q$closers\E])/g) {
        $ptr = pos($text);
        warn "$ptr,$1" if $debug;
        if ($1 eq '@') {
            
            # if we've hit our max stack depth it will print so continue
            if (@charstack == 32) {
                next;
            }

            # if it's an @@ it will print as an @ so continue
            if (substr($text, $ptr, 1) eq "@") {
                pos($text) = $ptr+1;
                next;
            } 
            
            # if there's no opener it will print as @ so continue
            if ($text !~ m/(.*?)([\Q$openers \E])/g || $2 eq ' ') {
                pos($text) = $ptr;
                next;
            }

            # if it's a command we understand, put the opener on the
            # stack, and continue
            if ($1 eq "bold" || $1 eq "b" ||		# bold
                $1 eq "i" || $1 eq "italic" ||		# italic
                $1 eq "" || 1) 				# empty (quoting)
            {
                unshift @charstack, $2;
                next;
            }
                
            # if it wasn't understood assume it gets printed and continue
            next;

        }

        # if the stack is empty I need to escape it
        if (!@charstack) {

            # find a set of braces that doesn't conflict
            my ($open,$close);
            keys %braces; # reset the iterator
            while (($open,$close) = each %braces) {
                last if $close ne $1;
            }

            # insert them around the character
            substr $text, $ptr-1, 1, "\@$open$1$close";
            pos($text) = $ptr+3;
            next;
        }

        
        # if it's the closer I'm looking for remove it from the stack
        # and continue
        if ($1 eq $braces{$charstack[0]}) {
            shift @charstack;
            next;
        }
        
        # otherwise it's a different closer so ignore it and continue
        next;
    }

    # we finished the string, now to close anything left on the stack
    foreach my $open (@charstack) {
        $text .= $braces{$open};
    }
    
    warn $text if $debug;

    return $text;
}

sub protect_test ($) {
    my $text = shift;
    print "     text: '$text'\n";
    my $prot_text = protect($text);
    print "prot_text: '$prot_text'\n";
}

if ($debug) {
    protect_test('a');
    protect_test('@');
    protect_test('@@');
    protect_test('@@(');
    protect_test('@<test>');
    protect_test('@( @b[ @i{test');
    protect_test(') > } ]');
}

1;
